#!/usr/bin/perl -wT

######################################################################
##
## parse_items
##
## Created 7.9.1999 by Lasse A Vartiainen (lav@iki.fi)
##
##
##
######################################################################

use strict;
use Getopt::Long;
use Getopt::Std;
use English; # Allows the use of some more legible system variables
use FileHandle;
use Time::Local;

#--- Initialize ---
$Main::MYNAME= basename($0);
$Main::VERSION= "0.01 990907 lav\@iki.fi";
$Main::OUTPUT=\*STDOUT;
#$Main::OUTPUT=\*STDERR; #Bebug output

$Main::verbose=1;  # 1-info/warning 2-block debug 3-line debug 4-line debug_2 5-atom debug
$Main::filename="/u/opi/95/lav/mud/nil.items";
$Main::sql=0;
$Main::doshowlen=0;
@Main::keys=("Name","Affects","Apply","Capacity","Charges","Class","Contains","Damage","Effects","Flags","Immune","Material","Restricts","Spell","Type","Value","Weight","Notes","Other","Where","Submitter", "Update");
$Main::submitter="lbase";
$Main::dofilter=0; #Filter out entries already in the filter reference file
$Main::filterfile="";

#--- Options ---
Getopt::Long::config("auto_abbrev","ignore_case","getopt_compat",
                     "permute","norequire_order","nobundling",
                     "nopass_through");
GetOptions
    (
     "v!"         => \$Main::verbose,
     "verbose:i"  => \$Main::verbose,
     "debug:i"  => \$Main::verbose,
     "filename=s"    => \$Main::filename,
     "sql!"    => \$Main::sql,
     "len!"    => \$Main::doshowlen,     
     "help!"       => \$Main::doshowhelp,
     "hcfix!"  => \$Main::dohcfix,
     "freddyfix" => \$Main::freddyfix,
     "submitter:s" =>\$Main::submitter,
     "filter!" => \$Main::dofilter,
     "reference=s" => \$Main::filterfile,
     );

#--- Begin ---
$| = 1 if $Main::verbose;       #Nonbuffered output if verbose

info("$Main::MYNAME - $Main::VERSION\n",1) unless $Main::sql;
if(defined($Main::doshowhelp)) {do_showhelp();exit 0;}
info("Use '$Main::MYNAME --help' to see the documentation.\n",1)  unless $Main::sql;

if($Main::sql) {$Main::OUTPUT=\*STDERR; }

if(("$Main::filename" eq "") && ("$ARGV[0]" ne "")) {    
    $Main::filename="$ARGV[0]"; }

if("$Main::filename" eq "") {
    error("Missing filename");
}

if($Main::dofilter) {
    print "Filtering..\n";
    if("$Main::filterfile" eq "") {error("Missing reference-file to check which entries should be filtered out.\n");}
    else {filter($Main::filename, $Main::filterfile);}
    exit;    
}


	
#--- Main ---

open (AFILE,"<$Main::filename")|| error("Couldn't open $Main::filename");

#Parse HC's format to common (Ie. transfer the line before 'object' as last one)
if($Main::dohcfix) {dohcfix();exit;}
#Parse HC's format to common (Ie. transfer the time-line before 'object' to update-field)
if($Main::freddyfix) {dofreddyfix();exit;}

#rec - recognized. classified - dont print
my($entry,$classified,$rec)=(0,0,0);
my($curline)="";
my($key,$data)=("","");
my(%object);

while(1) {
    $curline = getLine(\*AFILE);

    #Remove all '\'s, they will just confuse the system
    $curline =~ s/\\/\//g;

    debug("Processing line : $curline\n",3);
    $rec=0;

    #If current line has Object, process all previous first
    if($curline =~ /Object *\'(.*)\'/ || ("$curline" eq "EOF")) {	
	if(defined($object{'Name'})) {
	    debug("\tProcessing previous entry: $object{'Name'}.\n",2);
	} else {
	    debug("Beginning the process-loop\n",2);
	}
	    
        if($classified) {
	    my($tmpA)=$object{'Name'};
	    my($tmpB)=$object{'Submitter'};
	    my($tmpC)="";$tmpC=$object{'Update'} if(defined($object{'Update'}));	    
	    undef(%object);
	    $object{'Name'}=$tmpA;	    
	    $object{'Notes'}="Classified object";
	    $object{'Submitter'}=$tmpB;
	    $object{'Update'}=$tmpC if("$tmpC" ne "");
	}

	if(defined($object{'Name'})) {
	    chomp($object{'Other'}) if(defined($object{'Other'}));
	    chomp($object{'Notes'}) if(defined($object{'Notes'}));
	    debug("\t Ended, displaying the entry \'$object{'Name'}\':\n",3);
	    if($Main::doshowlen) { print show_len(%object); }
	    elsif($Main::sql) { print show_sql(%object);}
	    else { print show_object(%object);}
	}
	$entry=0;$classified=0;	
	#delete the object
	undef(%object);

	if("$curline" eq "EOF") {
	    debug("END_OF_FILE, exiting the process loop.\n",2);
	    last; #break the while-loop
	}
    }

    
    #Process fields

    if($curline =~ /Object *\'(.*)\'/) {	
	$rec++;$entry=1;$classified=0;
	$object{'Name'}=$1;
	debug("\tA new entry begins: $1.\n",3);
    }


    $key="Weight";
    if($curline =~ /$key\s*:\s*?(\d+)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }
    
    $key="Value";
    if($curline =~ /$key\s*:\s*?(\d+)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }
    
    $key="Capacity";
    if($curline =~ /(Capacity|Capacity is)\s*:\s*(\d+)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$2; }
    
    $key="Contains";
    if($curline =~ /$key\s*:\s*(\d+)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }
    
    $key="Charges";
    if($curline =~ /$key\s*:\s*?(\d+)/i ||
       $curline =~ /Has (\d+) charge/) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }

    
    $key="Material";
    if($curline =~ /$key\s*:\s*(\w+)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }
    
    $key="Item Type";
    if($curline =~ /$key\s*:\s*(\w+)/i) {       
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"Type"}=$1; }
    
    $key="Class";
    if($curline =~ /($key|^ *Type)\s*:\s*(\w+)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$2; }
    
    $key="Damage";
    if(($curline =~ /Damage dice is '(.*)'/i) ||
       ($curline =~ /Damage *:+ *(\w+)/i)) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }
    
    
    $key="Where";
    if($curline =~ /^.{0,5}Where\s*:\s*(.*)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }
    
    $key="Restricts";
    if($curline =~ /$key\s*:\s*(.*)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }

    $key="Submitter";
    if($curline =~ /$key\s*:\s*(.*)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }

    $key="Update";
    if($curline =~ /$key\s*:\s*(.*)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$1; }

    
    $key="Affects";
    if($curline =~ /$key\s*:\s*(.*)/i) {
	$data=$1;$data =~ s/  +/  /g;
	$rec++;$object{"$key"}.=$data."    "; }
    
    $key="Effects";
    if($curline =~ /(following ability|following abilities|Effects)\s*:\s*(.*)/i) {
	$data=$2;$data =~ s/  +/  /g;
	$rec++;$object{"$key"}.=$data."    "; }

    $key="Immune";
    if($curline =~ /$key\s*:\s*(.*)/i) {   	
	$rec++;$object{"$key"}.=$1."    "; }
    
    $key="Spell";
    if( ($curline =~ /Level *(\d+) *spell[s ]*of\s*:\s*([\w\s]+)/i) ||
       ($curline =~ /Level *(\d+)\s*:\s*([\w\s]+)/i)) {
	$rec++;$object{"$key"}.=$1.":".$2; }
    
    
    $key="Notes";
    if($curline =~ /Item is\s*:\s*(.*)/i) {
	$data=$1;
	if(($data =~ /[A-Z]{3,}/) && !($data =~ /NOID/i)) { $key="Flags"; }
	$rec++;$object{"$key"}.=$data; }    
    if($curline =~ /cannot discern anything/) {
	$rec++;$object{"$key"}.=" NOID ";
    }
    
    $key="Apply";
    if($curline =~ /(AC-apply is *|$key\s*:\s*)(\d+)/i) {
	if(defined($object{"$key"})) {
	    debug("WARNING: Duplicated entry $key with \"$object{'Name'}\".\n",1);}
	$rec++;$object{"$key"}=$2; }

    
    if($curline =~ /(Can affect you as|feel informed)/i) {
	$rec++;	debug("\tIgnoring the line.\n",3); next;   }

    if($curline =~ /\§/) {
	$classified=1; debug("\tEntry classified\n",3);  }

    #Pass empty lines till we see next 'Object'
    if(("$curline" eq "") || ($curline =~ /^[ \t]*$/)) {
	debug("\tPassing an empty line.\n",3);
	next;}
    
    if(($rec == 0) && ($curline =~ /\w+/))  {
	$object{'Other'}.=$curline."\n";
	debug("\tWas unrecognized line.\n",3);	
    }

    debug("\tLine processed by $rec entities.\n",3);
}
exit;

#--- FUNCTIONS AND ROUTINES ---

sub filter {
    my($file,$reffile)=@_;
    my($reference)=read_file($reffile);
    my($title,$text,$curline)=("","","");
    my($entry,$line)=(0,0);
    
    open (AFILE,"<$file")|| error("Couldn't open $file");
    while(($curline = getLine(\*AFILE)) ne "EOF") {
	$line++;
	if($curline =~ /Object *\'(.*)\'/i) {	
	    $entry=1;$title=$1;$text="";
	    debug("\tA new entry begins: $1.\n",3);
	}
	
        #If we get an empty line
	if($entry && (("$curline" eq "") || ($curline =~ /^[ \t]*$/))) {
	    debug("\t Ended, displaying the entry \'$title\':\n",3);
	    if(!($reference =~ /$title/)) {
		print "$text\n";
	    } else {
		debug("Entry \'$title\' exists, skipping.\n",2);
	    }
	    
	    $text="";$entry=0;
	}
	if($entry) {$text.="$curline\n";};
	
    }
}

sub dofreddyfix {
    my($curline)="";
    my($update)="";
    my($entry)=0;    
    while(($curline = getLine(\*AFILE)) ne "EOF") {
	if($curline =~ /Object \'/){
	    $entry=1;}

	if($curline =~ /Start logging: (\d+)\.(\d+)\.(\d+) (\d+):(\d+)/) {
	    $update="$3$2$1$4$5"."00";
	}
	$curline =~ s/Loads    :/Where    :/;
	

	#An empty line
	if($entry && (("$curline" eq "") || ($curline =~ /^[ \t]*$/))) {
	    print " Submitter: Freddybase\n";
	    print " Update   : $update\n";
	    print "\n";
	    $entry=0;
       }
	

	if ($entry) {print " $curline\n";}
	else {debug("DEBUG NON ENTRY: <$curline>\n",3);}
	    

    }
}

sub dohcfix {
    my($curline)="";
    my($last)="";
    my($entry)=0;
    while(($curline = getLine(\*AFILE)) ne "EOF") {
	if(!($curline =~ /Object \'/) && !$entry) {
	    $last=$curline;debug("DEBUG: New last line: $last\n",3);
	}
	else {$entry=1;}
	
	#An empty line
	if($entry && (("$curline" eq "") || ($curline =~ /^[ \t]*$/))) {
	    print " Submitter: HCbase\n";
	    if("$last" ne "") {print " Where    : $last\n";}
	    print "\n";
	    $last="";$entry=0;
	}
		
	if ($entry) {print " $curline\n";}
	else {debug("DEBUG NON ENTRY: <$curline>\n",3);}
	
	
    }
}
	    


sub show_object {
    my(%item)=@_;
    my($block)="";
    
    my($key);
    foreach $key (@Main::keys) {
	#print "Processing key $key\n";
	if(defined($object{$key})) {
	    $block.="-${key}\t: ".$object{$key}."\n";
	}
    }
    $block.="\n";
    $block =~ s/-Name/+Object/;
    return $block;
}

sub show_sql {
    my(%item)=@_;
    my($key);

    my($block)="INSERT INTO Item VALUES (''";
    my($atom)="";
    
    foreach $key (@Main::keys) {
	#print STDERR "Processing key $key\n";
	if(defined($object{$key})) {
	    $atom=$object{$key};
	    $atom =~ s/^\s+//g; #Remove heading&tailing spaces
	    $atom =~ s/\s+$//g;
	    $atom =~ s/\'/\\\'/g; #Quote
	    $atom =~ s/\\',/',/g; #but no quote end of entry
	    $atom =~ s/\"/\\\"/g;
	    $block.=",\'$atom\'";
	} else {
	    $block.=",\'\'";
	}
    }    
    $block.=");"; #Add ending
    #If no submitter given (ends 2nd last field empty), insert it
    $block =~ s/\'\',\'([^\']*)\'\)/\'$Main::submitter\',\'$1\'\)/;
    
    $block =~ s/\(\'\',\'(.*?)\'/\(\'\',\'\L$1\E\'/; #Lowercase Object '*'
    $block =~ s/\n/\r/g;
    $block.="\n";
    return $block;
}

sub show_len {
    my(%item)=@_;
    my($i)=0;
    my($block)="";
    
    my($key);
    foreach $key (@Main::keys) {
	if(defined($object{$key})) {
	    $block.="${key}\t: ".length($object{$key})."\n";
	}
    }
    $block.="\n";
    return $block;
}

exit;

# -- TOOLKITSS --

# Return next no-comment line from parameter line. If eof, return empty
# string.
# Inputs: FILE-handle
# Output: next line from parameter file without newline, or EOF
# Globals(IN): 
# Globals(OUT): 
sub getLine
{
    my($fh)=shift;
    while(<$fh>) 
    { 
        chomp($_);
        #Remove all doublequotes
        $_ =~ tr/\"//d; 
        
        # We must chomp "^M" too for DOS-texts!
        $/=chr(13);chomp($_);$/="\n";
        
        # Strip whitespaces from beginning and end of line
        /^\s*(.*)\s*$/; $_ = $1;
        
        if (/^\#/) {next;} # Is this a comment line?
        else {
            debug("getLine: Got : $_\n",4);
            return $_; 
        }
    }
    return "EOF";
}


sub save_file {
    my($filename,$data)=@_;
    my($tmp);
    
    open (SFILE,">$filename")|| return -2;
    $tmp = syswrite(SFILE,$data,length($data));
    if($tmp != length($data)) {
        error("Wrote $tmp of ".length($data)." bytes to $filename",0);
        return -3;
    }
    close(SFILE);
    return 0;
}

# Print given message if current verbose level allows it
#
# Inputs: Message to be printed, [priority level of the message (default=1)]
# Output: None
# Globals(IN) : $Main::verbose, $Main::OUTPUT
# Globals(OUT): -
sub debug {
    my($data,$level)=@_;
    if(!defined($level)) {my($level)=1;}
    if($Main::verbose>=$level) {
        printf { $Main::OUTPUT } $data;
    }
}

sub info {
    debug(@_,1);
}

sub basename {
    my($name)=@_;
    $name =~ /(.*\/)*(.*?)$/;
    return $2;
}


# Print error message and exit if error level > 1
# Inputs: Error message, [Error level]
# Output: -
# Globals(IN): -
# Globals(OUT): -
sub error {
    my($msg,$error)=@_;
    if(defined($error) && ($error < 1)) {
        print STDERR $msg."\n";
    } else {
        die("\n$msg\n$!\n");
    }
}

sub read_file {
    my($filename)=@_;
    my($buf,$tmp)=("","");
    open (RFILE,"<$filename")|| error("Couldn't open $filename");
    
    debug("Reading from $filename...",3);
    my($len)=(stat($filename))[7];
    if($len) {
        if(($tmp = read(RFILE,$buf,$len)) != $len) {
            error("Got only $tmp bytes out of $len while reading \"$filename\"")
;}          
        close(RFILE);   
    } else {
        debug("waiting for input...",3);
        while(<RFILE>) {$buf.=$_;}
        $tmp=length($buf);
    }
    debug("got $tmp bytes\n",3);
    return $buf;
}

sub do_showhelp {
    print "Usage: \n";
    print "\t$Main::MYNAME -v --verbose --file --sql --len --help --hcfix --submitter --filter --reference\n";
    print "\nOptions:\n";
    print "\t--verbose     Verbose level [$Main::verbose]\n";
    print "\n";
}





