Log Cleanup

From Gwen Morse's Wiki
Revision as of 10:32, 13 August 2014 by Eachna (Talk | contribs)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search
#!/usr/bin/perl --

use strict;

## log_cleanup ("micro").  2007/07/04 by Azundris.
## minimal log clean-up. you probably want to use log_process instead.
##
## invocation:  ./log_cleanup < logfile > outfile
##

## read in paragraph mode -- this is necessary if the client word-wraps the
## logs; if it doesn't and one pose is one line in the log (regardless of
## length), put a # in front of the following line to disable it:
$/='';

## no user-configurables after this point.



## ----------------------------------------------------------------------------

## no previous paragraph yet, set to empty string
my $p="";

## line counter
my $c=0;

while(<>) {
  ## removing trailing newlines
  chomp;
  chomp;

  ## remove line-breaks in the middle of poses/paragraphs
  s/\n/ /sg;

  ## remove extra spaces
  s/\s{2,}/ /g;
  s/^(.*?)[\t ]+$/$1/g;



  ## if this paragraph is a duplicate of the previous one, discard it
  if ( $p eq $_ ) {
    next; }



  ## technical feedback from the game server
  if ( $_ =~ m/^GAME: .*$/ ) {
    next; }

  if ( $_ =~ m/^Huh\?  \(Type "help" for help\.\)/ ) {
    next; }



  ## output multi-descer ("You changed your description")
  if ( $_ =~ m/^Excellent choice!/ ) {
    next; }



  ## remember this paragraph so we can catch duplicates
  $p=$_;

  print $_."\n\n";

  $c++; }
#!/usr/bin/perl --

use strict;

## read a log of a role-playing session generated by the tinyFugue (tf)
## MUSH/MUD client, clean it, and highlight it using standard bulletin
## board markup.
##
## Supported:
##
##   /italics/
##   *bold*
##   _underline_
##   -strikethru-  (discouraged, converted to underline for now)
##
##   * * *         (centered on its own line as chapter divider)
##   §             (ignore when online item on a line. can therefore be used
##                  to force extra empty lines in output where outright empty
##                  lines in input would be compressed into one.)
##   <Phone>       (is highlit the same as on-channel conversations)
##   title         (first non-empty line in log is consider title -> bold)
##   "Dialog"      (quotes get "dialog" color and will be italicized)
##   {desc}        (highlight in "desc" color. supports multi-line.)
##
## invocation:  ./log_process < logfile > outfile
##
## by Azundris http://azundr.is/  http://www.azundris.com/
## 2005/02/15  basics
## 2005/02/17  support *markup*
## 2005/02/18  support -markup-
## 2005/03/26  allow / (for italics) within quoted text
## 2005/04/02  don't detect / (for italics) in [/x] from previous substitution
## 2005/04/04  multi-detect / (for italics) in ""
## 2005/06/12  recognize <Phone>, have colour configurables in preamble
## 2005/07/02  fix a bug with -emphasis-
## 2005/07/07  ignore gag/ungag
## 2005/07/07  be more lenient on multi-paragraph descs
## 2006/03/16  detect / (for italics) correctly at start of paragraph
## 2011/10/11  additional comments/instructions

## Extra empty: §  (s/\n\n\n/\n\n§\n\n/g)

## read in paragraph mode -- this is necessary if the client word-wraps the
## logs; if it doesn't and one pose is one line in the log (regardless of
## length), put a # in front of the following line to disable it:
$/= '';


my %cols = ( 'OOC'     => 'darkred',
             'desc'    => 'darkred',
             'page'    => 'green',
             'channel' => 'olive',
             'dialog'  => 'darkblue' );

## no user-configurables after this point.



## ----------------------------------------------------------------------------

## no previous paragraph yet, set to empty string
my $p="";

## line counter
my $c=0;

while(<>) {

  ## removing trailing newlines
  chomp;
  chomp;

  ## remove line-breaks in the middle of poses/paragraphs
  s/\n/ /sg;

  ## remove extra spaces
  s/\s{2,}/ /g;
  s/^(.*?)[\t ]+$/$1/g;



  ## if this paragraph is a duplicate of the previous one, discard it
  if ( $p eq $_ ) {
    next; }


  ## if this paragraph is an "over"-marker, discard it
  if ( "§" eq $_ ) {
    print "\n";
    next; }


  ## technical feedback from the game server
  if ( $_ =~ m/^GAME: .*$/ ) {
    next; }

  if ( $_ =~ m/^Huh\?  \(Type "help" for help\.\)/ ) {
    next; }



  ## ignore multi-descer ("You changed your description")
  if ( $_ =~ m/^Excellent choice!/ ) {
    next; }

  ## ignore spell-checker
  if ( $_ =~ m/^No misspellings found./ ) {
    next; }

  ## ignore gag / ungag
  if ( $_ =~ m/^You will no longer hear messages on channel / ) {
    next; }
  if ( $_ =~ m/^You will now hear messages on channel / ) {
    next; }



  ## remember this paragraph so we can catch duplicates
  $p=$_;



  ## make log title (first non-empty line in log) bold
  if($c==0) {
    s-(.*)-[b]${1}[/b]-; }



  ## HANDLE MARKUP

  ## _underline_ -> [u]underline[/u]
  s-_([^_]+?)_-[u]${1}[/u]-g;

  ## "/italics/" -> "[u]italics[/u]"  (in quoted text)
  while(m-"(|((.*)[^\[]))/([^/"]*)([^\[])/(.*)"-) {
    s-"(|((.*)[^\[]))/([^/"]*)([^\[])/(.*)"-"${1}[u]${4}${5}[/u]${6}"-g; }

  ## /italics/ -> [i]italics[/i]      (in narration)
  s-^/([^/]+?[^\[])/-[i]${1}[/i]-g;
  s-([^\[])/([^/]+?[^\[])/-${1}[i]${2}[/i]-g;
# s-([^\[])/([^/]+?)([^\[])/-${1}[i]${2}${3}[/i]-g;
# s-^/([^/]+?)([^\[])/-${1}[i]${2}${3}[/i]-g;

  ## -strikethru- -> [u]strikethru[/u]
  s&\s-+(\w+?)-\s+& [u]${1}[/u] &g;

  ## *bold* -> [b]bold[/b]
  if ( $_ =~ m/^\* \* \*$/ ) {
    print "[i]* * *[/i]\n\n";
    next; }
  else {
    s-\*+([^*]+?)\*+-[b]${1}[/b]-g; }



  ## HANDLE ENTITIES

  ## -- -> —
# s/-{2,}/—/g;



  ## HIGHLIGHT BY COMMUNICATION TYPE

  ## paging (long distance communication)
  if ( $_ =~ m/^.* pages[^:]*: .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }
  elsif ( $_ =~ m/^You paged .* with .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }
  elsif ( $_ =~ m/^Long distance to [^:]*: .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }
  elsif ( $_ =~ m/^From afar.*, .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }



  ## Out Of Character (stage direction)
  elsif ( $_ =~ m/^\<OOC\>\s.*/ ) {
    print "[color=".$cols{'OOC'}."]".$_."[/color]\n\n"; }



  ## room and other descriptions
  elsif ( $_ =~ m/^\{(.*)\}$/ ) {
    print "[color=".$cols{'desc'}."]".$1."[/color]\n\n"; }

  elsif ( $_ =~ m/^\{(.*)$/ ) {
    print "[color=".$cols{'desc'}."]".$1."[/color]\n\n"; }

  elsif ( $_ =~ m/^(.*)\}$/ ) {
    print "[color=".$cols{'desc'}."]".$1."[/color]\n\n"; }



  ## channels (MUSH-wide public conversation)
  elsif (!( $_ =~ m/^\<Phone\> .*/ ) && ( $_ =~ m/^\<\w+\> .*/ )) {
#   print "[color=".$cols{'channel'}."]".$_."[/color]\n\n";
  }



  ## the actual play
  else {
    s-"([^"]+)"-[i][color=$cols{'dialog'}]"$1"[/color][/i]-g;
    print $_."\n\n"; }

  $c++; }