#!/usr/bin/perl
######################################################################
## get_items_from_logs
##
## Created 23.6.2001 by Lasse A Vartiainen
## $Modified: 2018- 5-22 17:02:16 by lav@iki.fi $
##
##
######################################################################

#use
# get_items_from_logs.pl * >.items

#--- Initialize ---
use FindBin; use lib "$FindBin::Bin";
use Getopt::Long;
use English; # Allows the use of some more legible system variables
use Time::Local;

use strict;
use warnings;

use Utils qw(bail print_r debug debugf fatal);
use Arctic;

my $ARC = Arctic->init("items");
my $OPT = Arctic->opt;

my $VERSION    = "get_items_from_logs.pl v0.01 010623 lav\@iki.fi";

my $KNOWN = {};

my $CAL= { "Jan" => "01","Feb" => "02","Mar" => "03",
           "Apr" => "04","May" => "05","Jun" => "06",
           "Jul" => "07","Aug" => "08","Sep" => "09",
           "Oct" => "10","Nov" => "11","Dec" => "12",
          };

#--- Main ---

debugf(4, "$VERSION started [%s]\n", scalar(localtime()));

#Reset the time_stamp only once, default guess as per previous round
#For best result, the input files should be sorted in creation order

# SCAN : look "Object" line and optional time markers
# COMB : join following lines to single entry, looking for end markers
# EXTRA: additional lines, up to END_LORE or lines matching object keywords
# ADD  : Handle entry
my($SCAN, $COMB, $EXTRA, $ADD) = (0, 1, 2, 3);
my $STATE = $SCAN;

my $MAX_EXTRA = 200;

my $ENTRY = undef;

foreach my $log ($ARC->logs(@ARGV)) {
    Progress->show if($OPT->verbose <= 1);

    my $file    = $log->file;
    my $STATE   = $SCAN;
    my $entries = Items->total;

    $ENTRY = entry_process(undef, file=>$file);
    $ENTRY->{curdate} //= "$1$2$3" if($file =~ m/nil_.*([12][0-9][0-9][0-9])-([01][0-9])-([0123][0-9])/);

    debugf(5, "* Scanning [%s] %s\n", $ENTRY->{curdate} // "", $file);

    foreach ($log->lines) {
        my $line = "$_\n";
        if($line =~ m/^ *Object '(.+)'/) {
            entry_process($ENTRY)->{object} = $1;  # Process previous entry if needed
            push(@{ $ENTRY->{lines} }, sprintf("Object '%s'\n", $1));
            $STATE = $COMB;

        } elsif(!defined($ENTRY->{curdate})) {
            if($line =~ m/^Start logging: (\d\d?)\.(\d\d?)\.(20[01][0-0])/) {
                $ENTRY->{curdate} = sprintf("%04d%02d%02d", $3, $2, $1);
                debugf(5, " - Found Start logging time : %s\n", $ENTRY->{curdate});

            } elsif($line =~ /^Local Time : (.*?)([A-Z]{3,4})/) { #PST|PDT|EST|EDT|CDT etc
                $ENTRY->{curdate} = parse_time($1);
                debugf(5, " - Found Local Time : %s\n", $ENTRY->{curdate} // "???");
            }

            # Check for various end markers
        } elsif($STATE == $COMB) {
            next if($line =~ m/\A\s*\Z/);

            my $move;  # Next state
            $move  //= $EXTRA if($line =~ m/\dH.*\dV.*\dX / or $line =~ / Exits:/);
            $move  //= $ADD   if($line =~ m/END_LORE/ and $ENTRY->{keep_all} = 1);

            #printf(STDERR "COMB %d->%s: %s", $STATE, $move // "", $line);

            push(@{ $ENTRY->{lines} }, $line) if(!defined($move));
            $STATE  = $move              if( defined($move));
        }

        if($STATE == $EXTRA) {
            if($line =~ m/END_LORE/) {
                $ENTRY->{keep_all} = 1;
                $STATE = $ADD;
            } elsif(scalar(@{ $ENTRY->{extra} }) >= $MAX_EXTRA) {
                $STATE = $ADD;
            } else {
                push(@{ $ENTRY->{extra} }, $line);
            }
        }

        if($STATE == $ADD) {
            entry_process($ENTRY);
            $STATE = $SCAN;
        }
    } # for lines
    entry_process($ENTRY);

    debugf(4, "Found %3d objects from : %s\n", Items->total - $entries, $file) if($entries < Items->total);
}

$_->print foreach(Items->sorted);
Progress->footer;

exit 0;

sub entry_process {
    my($entry, %keys) = @_;
    $entry     //= { };
    $entry->{$_} = $keys{$_} foreach(keys %keys);

    my $arr = $entry->{lines};
    if($arr and @$arr) {
        my $text    = entry_item($entry);
        my $file    = $entry->{file};
        my $object  = $entry->{object};
        my $date    = entry_date($entry);

        print_r(0, "OBJ: ",$entry) if(!$object);
        if(!$KNOWN->{$text}++) {
            $text .= sprintf(" Update   : %s\n",         $date);
            $text .= sprintf(" Submitter: logfile_%s\n", $file);
            $text .= sprintf(" Search   : less -p \"%s\" %s/%s\n", $object, "$2$3", "$1$2-$3$4")
              if($file =~ m|(nil_.*20)([01][0-9])-(\d\d)(-.*)|);

            Items->new( text=>$text, file=>$file, object=>$object, date=>$date, len=>length($text) );
            entry_clear($entry);
        }
    }
    $entry->{lines} //= [];
    $entry->{extra} //= [];

    return $entry;
}

sub entry_date {
    my($entry) = @_;
    my $date = $entry->{curdate};

    if(!defined($date)) {
        my $file = $entry->{file};
        if(my @t = localtime((stat($file))[9])) {
            return sprintf("%04d%02d%02d", 1900+$t[5], $t[4]+1, $t[3]);
        }
    }
    return $date // "00000000";

}

sub entry_clear {
    my($entry) = @_;
    my $keep = { map { $_=>1 } qw(file curdate) };
    delete $entry->{$_} foreach(grep { ! $keep->{$_} } (keys %$entry));
    return $entry;
}

sub entry_item {
    my($entry) = @_;
    return unless(defined($entry) and defined($entry->{lines}) );

    my $lines = $entry->{lines};
    my $extra = $entry->{extra};

    my $keep;
    if(@$extra) {
        if($entry->{keep_all}) {
            $keep = $extra;
        } elsif($entry->{object}) {
            # Look for lines with at least two words from the item proper name, in any order
            if(my @words = grep { length($_) >= 3 } split(/ +/, $entry->{object})) {
                my $pattern = join("|", @words);
                $keep = [grep {
                    m/($pattern)\W.*($pattern)/ or
                      m/\.\.it/                 or
                      m/\. \(..\%\)/            or
                      m/You can't pour from/    or
                      m/You can't write/        or
                      m/is wearable:/
                  } @$extra];
                $keep = [grep {
                    not ( m/\A\s*</               or # Ignore worn items
                          m/\AA magical sign/     or
                          m/\AAn orrery/          or
                          m/(scroll of recall)/   or
                          m/(a scroll of legend)/
                        ) } @$keep];
            }
        }
    }
    unshift(@$keep, "DescTo   :\n") if($keep);
    $keep //= [];
    my $str = join("", @$lines, @$keep);


    remove_zeroes(\$str);
    remove_time(  \$str);
    remove_ansi(  \$str);

    $str =~ s/\r//g;              #Remove windows CR:s
    $str =~ s/\n\n/\n/g;          #Remove extra LineFeeds
    $str =~ s/\n([^ ])/\n $1/g;   #Force lines to start with 1 space

    return $str;
}

sub add_entry {
    my($file, $date, $arr) = @_;
    my $str = join("", @$arr);

    delete $arr->[$_] foreach(0 .. $#{$arr});
    return $SCAN;
}

sub parse_time {
    my($data) = @_;
    if($data =~ /(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) (\d\d) ([\d:]+) (\d\d\d\d) /) {
        return sprintf("%4s-%2s-%2s", $4, $CAL->{$1} // "00", $2);
    }
    debugf(1, "parse_time(): Unexpected parsing failure (M=<%s>,D=<%s>,T=<%s>,Y=<%s> from <%s>\n", $1, $2, $3, $4, $data);
    return;
}


sub remove_zeroes {
    my($ref) = @_;
    $$ref =~ s/\000[^n]{0,2}//gs;
}

sub remove_time {
    my($ref) = @_;
    while ($$ref =~  s/\d*?//g){};
}

sub remove_ansi {
    my($ref) = @_;
    my $count = 0;
    if(ref($ref) eq "ARRAY") {
        foreach(@$ref) {
            $count++ while(s/[^a-zA-Z ]\[[^ ]*?m//g or s/\e[\[0]*//g);
        }
    } else {
        $count++ while($$ref =~ s/[^a-zA-Z ]\[[^ ]*?m//g or $$ref =~ s/\e[\[0]*//g);
    }
    debugf(5, " - Removed ansi codes : %d\n", $count);
    return $count;
}

1; # package Main

INIT {
    package Items;
    use strict;
    use warnings;
    use Utils qw(bail print_r debug debugf fatal);

    our $MEMBERS = [];

    sub new    { my($class, @args) = @_; my $self = bless { @args }, $class; push (@$MEMBERS, $self); return $self; }
    sub text   { return $_[0]->{text}; }
    sub print  { print " " . $_[0]->{text} . "\n"; }
    sub len    { return $_[0]->{len } //= length($_[0]->{text}); }

    sub aref   { return $MEMBERS ; }
    sub all    { return @$MEMBERS; }
    sub sorted { return sort { $a->{object} cmp $b->{object} or $a->{date} cmp $b->{date} or $a->{len} <=> $b->{len} } @$MEMBERS; }
    sub total  { return scalar(@$MEMBERS); }

    1; # package Item
}
## Local Variables:
## mode: perl
## make-backup-files: t
## End:
