#!/usr/bin/perl

use strict;
use warnings;

use FTN::JAM;
use Getopt::Long;
use File::Spec::Functions;
use Cwd 'abs_path';
use File::Copy;
use Time::TZOffset qw/tzoffset/;
#use pkt;

my $vers = 'v.0.0.0.1';

my ( $datefrom, $echoarea, %fromnames, %msgsize, %quotecount, $basedir, $dh, 
     $sortoder, $needhelp, $topten, $sysopname, %echoes, $echotag, $tilldate,
     %monthes, $monthly, $areafile, %areas, $report, @msgs, $configfile,
	 %config, $mday, $mon, $year );

my $robots = '(Robot)|(UA )|(UKR )|(UKRAINE)|(processor)|(news)|(Business)|(anekdot.ru)|(rulezz)|(Finance)|(Htick)|(HPT)|(Areafix)|(Allfix)|(66NODE)|(File Manager)|(binkd team)|(time[ -]*bot)|(meduza.io)|((faq)|(file)|(news)[ -]*server)|(Brother Fox)|(eku.ru)|(Prikol Bot)|(Admin Sender)|(Security Bot)|(Doctor Bot)|(Family BBS)|(ldm\@weather.cod.edu)|(Roon\'s BBS)|(Hàòóñÿàðõàòóñÿ)|(bot-time)|(R50C NodelistMaker)|(CRBBS Tagline Bot)|(Freezer Master)|(CRBBS Binkd Bot)|(T-Hist)|(2ndchoiceBOT)|(PKTlog)|(Uudecode)|(ArgLog)|(4pda.ru)|(3:770/1)|(Rules Bot)|(Bender Rodriguez)|(golded\+ inspector)|(Moderator)';

my $curpath = abs_path($0);
    $curpath =~ /^(.*?)[\\\/]([^\\\/]+)$/;
my ( $programfile, $programpath ) = ( $2, $1 );
	$programfile =~ /(.*?)\.pl$/i;
my $pfile = $1;


sub usage()
{

    print <<ENDUSE;

    Usage: $programfile [options]
    ~~~~~~
    Options are:
            --help,-h                    - this text.
            -c,--config		             - configuration file name. Required.
            --date-from,-d dd.mm.yyyy    - the date from which start to collect
                                           statistics. Optional. Default scan
                                           from the start of the message base.
            --end-date,-e dd.mm.yyyy     - the date till which to collect
                                           statistics. Optional. Default scan
                                           till the end of the message base.
            --area,-a ECHO.TAG           - echo area name to collect statistics.
                                           Optional. Default scan all areas.
            --from-file,-f                 file name of husky areas file.
                                           Required.
            --sort,-s sort_bay           - sort oder. Where sort_by is one
                                           of "quote" - sort by quotes number,
                                           "msg" - messages number, "size" - 
                                           total messages size. Optional.
                                           Default sort by messages count.
            --monthly,-m                 - show monthly stat.
            --base-dir,-b msg_base_dir   - full path to the message base is.
                                           Optional. Default /home/fido/echo.
            --top-ten,-t                 - create top ten for all sort oders.
                                           
ENDUSE
exit;
}


sub readconf()
{
    my ( $F, $line, $key );
    return 0 unless defined $configfile;
    print "Reading config file $configfile\n";
    unless( open( $F, '<', $configfile ) ) {
		print STDERR "Can't open config file $configfile ($!).";
		exit;
    }
    my $lines = 0;
    while( $line = <$F> ) {
		$lines++;
		$line =~ s/[\r\n]//g;
		$line =~ s/	/ /g;
		next if $line =~ /^\s*[\#\;]/;
		next if $line =~ /^\s+$/;
		next if $line eq '';
		next unless $line =~ /\s*(\S+)\s+(.*?)\s*$/;
		$key = lc($1);
		$config{$key} = $2;
    }
    close($F);
    print "$lines lines read.\n";
    return 1;
}

sub ReadMessageHeader
{
    my ( $handleref, $msgnum, $BaseMsgNum ) = @_;

    my ( $buf, @data, @m_header, $SubfieldLen, $tzutc );

#	print "Reading message header \#$msgnum\n";
#	writelog( "Reading message header \#$msgnum" );

    if ( !seek( $$handleref{jdx}, ( $msgnum - $BaseMsgNum ) * 8, 0 ) )
    {
        print( STDERR  "IO_ERROR: Can't seek idx to msg.\n" );
		return ( 0, 0, 0, 0 );
    }

    if ( read( $$handleref{jdx}, $buf, 8 ) != 8 ) {
        print( STDERR  "IO_ERROR: Can't read msg idx.\n" );
		return ( 0, 0, 0, 0 );
    }

    @data = unpack( "LL", $buf );

    if ( !seek( $$handleref{jhr}, $data[1], 0 ) ) {
        print( STDERR  "IO_ERROR: Can't seek header to msg.\n" );
		return ( 0, 0, 0, 0 );
    }

    if ( read( $$handleref{jhr}, $buf, 76 ) != 76 ) {
        print( STDERR  "IO_ERROR: Can't read msg header (msg $msgnum).\n" );
		return ( 0, 0, 0, 0 );
    }

    @m_header = unpack( "Z[4]SSLLLLLLLLLLLLLLLLL", $buf );

    if ( $m_header[0] ne "JAM" ) {
        print( STDERR  "MSGHEADER_CORRUPT\n" );
		return ( 0, 0, 0, 0 );
    }

    if ( $m_header[1] != 1 ) {
        print( STDERR  "MSGHEADER_UNKNOWN\n" );
		return ( 0, 0, 0, 0 );
    }
#	my ( $DateWritten, $DateProcessed, $Attributes ) = 
#				( $m_header[10], $m_header[12], $m_header[14] );
	my ( $sign, $mm, $hh, $msgid, $replyto );
	my ( $m_from, $m_to );
	$tzutc = $replyto = $msgid = 0;
	$SubfieldLen = $m_header[3];
        if ( read( $$handleref{jhr}, $buf, $SubfieldLen ) != $SubfieldLen ) {
            print( STDERR  "IO_ERROR: Can't read msg header subfields.\n" );
			return ( 0, 0, 0, 0 );
        }

        while ($buf) {
            @data = unpack( "LL", $buf );
			if ( $data[0] == 2004 ) {
				$tzutc = substr( $buf, 8, $data[1] );
				if ( $tzutc =~ /(\-?)(\d\d)(\d\d)/) {
					( $sign, $hh, $mm ) = ( $1, $2, $3 );
					$tzutc = ( $hh * 3600 ) + ( $mm * 60 );
					$tzutc = "$sign$tzutc" if defined $sign;
				} else { $tzutc = 0; }
			}
#------------------------------------------------------------------------------
			if ( $data[0] == 2 ) {
				$m_from = substr( $buf, 8, $data[1] );
			}
			if ( $data[0] == 3 ) {
				$m_to = substr( $buf, 8, $data[1] );
			}
#------------------------------------------------------------------------------
#			if ( $data[0] == 4 ) {
#				$msgid = substr( $buf, 8, $data[1] );
#			}
#			if ( $data[0] == 5 ) {
#				$replyto = substr( $buf, 8, $data[1] );
#			}
            $buf = substr( $buf, 8 + $data[1] );
        }

	return ( ($m_header[10] - $tzutc), $m_from, $m_to, $m_header[17] );
}

my ( $totalmsgs, %bydays );

sub listbase($)
{
   my ( $mb ) = @_;
   my ( $handle, %baseheader, $nummsgs, $m_from, $m_to, $m_subj, $m_length,
	%msgheader, @subfields, $msgtext, $mday,$mon,$year, $msg_date,
	$m_fromaddr, $wday );

	my @weekd = qw(  ¢á. ¯­. ¢â. áà. çâ. ¯â. á¡. );

	$handle = FTN::JAM::OpenMB($mb);
	if(!$handle) {
#		die "Failed to open $mb";
		print STDERR "Failed to open $mb\n";
		return;
	}

	if (!FTN::JAM::ReadMBHeader($handle,\%baseheader)) {
		die "Failed to read messagebase header of $mb\n";
	}

	if (!FTN::JAM::GetMBSize($handle,\$nummsgs)) {
		die "Failed to get size of messagebase $mb\n";
	}

	$totalmsgs = 0;
	%bydays = ();
	for (my $i = $baseheader{BaseMsgNum}; $i < $baseheader{BaseMsgNum}+$nummsgs; $i++) {

			( $msg_date, $m_from, $m_to, $m_length ) = ReadMessageHeader( $handle, $i, $baseheader{BaseMsgNum} );

#			(undef, $m_from, undef, $m_to, undef, $m_subj, undef, $m_fromaddr ) = @subfields;
			( $mday, $mon, $year, $wday ) = ( localtime( $msg_date ) )[3...6];
			$msg_date = sprintf("%04d%02d%02d",$year+1900,$mon+1,$mday);
			if ( defined( $datefrom ) ){
				next unless $msg_date ge $datefrom;
			}
#			"end-date"       => \$tilldate,
			if ( defined( $tilldate ) ){
#				next unless $msg_date le $tilldate;
				next if $msg_date ge $tilldate;
			}
			next if $m_from =~ /$robots/i;
#			%monthes, $monthly );

			$monthes{sprintf( "%04d.%02d", $year+1900, $mon+1 )} ++ if $monthly;
#			$sysopname
			$echoes{$m_from} = '' unless defined $echoes{$m_from};
			$echoes{$m_from} .= "$echotag\n";
			
			$fromnames{$m_from}{msg} = 0 unless defined $fromnames{$m_from}{msg};
			$fromnames{$m_from}{size} = 0 unless defined $fromnames{$m_from}{size};
			$fromnames{$m_from}{quote} = 0 unless defined $fromnames{$m_from}{quote};

#			$fromnames{$m_from}{size} += length( $msgtext );
			$fromnames{$m_from}{size} += $m_length;
			$fromnames{$m_from}{msg} ++;

			$totalmsgs ++;
			my $dd = sprintf("%02d", $mday);
			$bydays{"$dd $weekd[$wday]"} ++;

			next if $m_to =~ /^All$/i;
			$fromnames{$m_to}{msg} = 0 unless defined( $fromnames{$m_to}{msg} );
			$fromnames{$m_to}{size} = 0 unless defined( $fromnames{$m_to}{size} );
			$fromnames{$m_to}{quote} = 0 unless defined( $fromnames{$m_to}{quote} );
			$fromnames{$m_to}{quote} ++;
	}

	FTN::JAM::CloseMB($handle);
}


sub readareas()
{
    my ( $F, $line, $key, $areapath );
    return unless defined $areafile;
    print "Reading areafile $areafile\n";
    unless( open( $F, '<', $areafile ) ) {
		print STDERR "Can't open file $areafile ($!).\n";
		exit;
    }
    my $lines = 0;
    while( $line = <$F> ) {
		$line =~ s/[\r\n]//g;
		$line =~ s/	/ /g;
		next if $line =~ /^\s*[\#\;]/;
		next if $line =~ /^\s+$/;
		next if $line eq '';
		next unless $line =~ /^\s*\w+Area\s*(\S+)\s+(\S+).*?\-b\s+JAM/i;
		$key = uc($1);
		$areapath = $2;
		next if $areapath =~ /^passthrough$/i;
		$areas{$key}{areapath} = $areapath;
		if ( $line =~ /\s\-p\s+(\d+)/i ) {
			$areas{$key}{purgedays} = ( $1 * 86400 );
		}
		if ( $line =~ /\s\-m\s+(\d+)/i ) {
			$areas{$key}{maxmsgs} = $1;
		}
		$lines++;
    }
    close($F);
    print "$lines areas read.\n";
}


sub madetopten()
{
	my ( $str, $l );
    foreach $sortoder ( 'msg', 'size', 'quote' ) {
		$l=0;
		$report .= "\nSorted by $sortoder\n";
		print "\nSorted by $sortoder\n";
		$str = sprintf( "%3s %-30s %8s %7s %6s %7s %10s\n", 'N', 'Name', 'Messages', 'Total %', 'Quoted', 'Quote %', 'Total size' );
		$report .= $str;
		print( $str );
		foreach my $n ( sort { $fromnames{$b}{$sortoder} <=> $fromnames{$a}{$sortoder} } keys %fromnames ) {
		    next if $fromnames{$n}{msg} == 0;
#		    next if ( $sortoder eq 'quote' ) && ( $fromnames{$n}{msg} > $fromnames{$n}{quote} );
		    $l++;
			$str = sprintf( "%3s %-30s %8s %7s %6s %7s %10s\n", $l, $n, $fromnames{$n}{msg}, 
							sprintf( "%3.2f%%", ( $fromnames{$n}{msg}/$totalmsgs*100 ) ), 
							$fromnames{$n}{quote}, 
							sprintf( "%3.2f%%", ( $fromnames{$n}{quote}/$fromnames{$n}{msg}*100 ) ), 
							$fromnames{$n}{size} );
			$report .= $str;
		    print( $str );
			if ( $topten ) {
	    		last if $l == 10;
			}
		}
#		$l=0;
    }
	$report .= sprintf("\n%48s\n", 'Messages per day.' );
	foreach my $m ( sort keys %bydays ) {
		$report .= sprintf("%35s %5s %7s\n", $m, $bydays{$m}, 
							sprintf( "%3.2f%%", $bydays{$m}/$totalmsgs*100 )
							);
	}
}

sub writefile($$)
{
	my ( $filename, $buff ) = @_;
	my ( $HANDLE );

#	my $tmp_fn = $filename . time();

#	if ( open ( $HANDLE, '>', $tmp_fn ) ) {
	if ( open ( $HANDLE, '>', $filename ) ) {
	    binmode($HANDLE);
	    print( $HANDLE $buff );
	    close( $HANDLE );
#	    print STDERR "Can't create $filename ($!)." unless move( $tmp_fn, $filename );
#	    chmod 0755, $filename if $^O eq 'linux';
#	    print "$filename saved.\n\n";
	} else {
	    print STDERR "Can't open $filename ($!).\n";
#	    writelog( "Can't open $filename ($!)." );
	}
}

sub packpkt
{
    my ($pkt_from,$pkt_to,$password, @msgs ) = @_;
    $pkt_from =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
    my ( $pkt_origzone, $pkt_orignet, $pkt_orignode, $pkt_origpnt ) = ( $1, $2, $3, $4 );
    $pkt_origpnt = 0 if !defined $pkt_origpnt || $pkt_origpnt eq '';
    $pkt_to =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
    my ( $pkt_destzone,$pkt_destnet,$pkt_destnode,$pkt_destpnt ) = ( $1,$2,$3,$4 );
    $pkt_destpnt = 0 if !defined $pkt_destpnt || $pkt_destpnt eq '';
    $password = '' unless defined $password;
    $password .= "\x00" while length($password) < 8;

    my ($second,$minute,$hour,$day,$month,$year,$wday,$yday,$isdst) = localtime();
    $year = $year + 1900;
    $yday++;

    my $pkthdr = pack("S2S3S3 S2S2 C2A8S2S2 C2SS4I", $pkt_orignode,
    $pkt_destnode,$year,$month,
    $day,$hour,$minute,$second,0,2,$pkt_orignet,$pkt_destnet,3,3,
    $password,$pkt_origzone,$pkt_destzone,0, 0x0100,3,3,0x0001,
    $pkt_origzone,$pkt_destzone,$pkt_origpnt,$pkt_destpnt, 0 );

    return $pkthdr . join('',@msgs) . "\000\000";
}

sub packedmsg($$$$$$$;$$)
{
    my ( $msg_fromname, $msg_toname, $msg_fromaddr, $msg_toaddr, $attr,
         $msg_txt, $msg_subj, $msg_area, $msg_chrs ) = @_;

    my ( $msgheader,$m_txt,$msg_destzone,$msg_destnet,$msg_destnode,
         $msg_destpnt);

    if (length($msg_fromname) > 35){
		$msg_fromname = substr($msg_fromname,0,35);
    }
    $msg_fromname .= "\000";
    if (length($msg_toname) > 35){
		$msg_toname = substr($msg_toname,0,35);
    }
    $msg_toname .= "\000";
    if (length($msg_subj) > 71){
		$msg_subj = substr($msg_subj,0,71);
    }
    $msg_subj .= "\000";

    localtime =~ /[a-z]+ ([a-z]+)[ ]+(\d+) (\d+)\:(\d+)\:(\d+) \d\d(\d\d)/i;
    my $DateTime = sprintf("%02s", $2)." $1 $6  $3:$4:$5\000";

    $msg_fromaddr =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
    
    my ( $msg_origzone, $msg_orignet, $msg_orignode, $msg_origpnt ) = ( $1, $2, $3, $4 );
    $msg_origpnt = 0 if !defined( $msg_origpnt ) || $msg_origpnt eq '';

    if ( defined($msg_toaddr) ) {
       $msg_toaddr =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
       ($msg_destzone,$msg_destnet,$msg_destnode,$msg_destpnt) = ( $1, $2, $3, $4 );
       $msg_destpnt = 0 if !defined($msg_destpnt) || $msg_destpnt eq '';
    } else {
       ($msg_destzone,$msg_destnet,$msg_destnode,$msg_destpnt) = ( 0, 0, 0, 0 );
    }

    $msgheader = pack( "S7Z20", 2,$msg_orignode,$msg_destnode,
    $msg_orignet,$msg_destnet,$attr,0,$DateTime ) . $msg_toname .
    $msg_fromname . $msg_subj;

    $m_txt = "AREA:$msg_area\r" if defined($msg_area);
    my $TZUTC = sprintf( "%04d", tzoffset( localtime() ) );
    $m_txt .= "\001MSGID: $msg_fromaddr ".sprintf("%08x", time())."\r\001TZUTC: $TZUTC\r";
    
#   NO INTL in Echmail permitted
    $m_txt .= "\001INTL $msg_destzone:$msg_destnet/$msg_destnode $msg_origzone:$msg_orignet/$msg_orignode\r" if !defined $msg_area;
    $m_txt .= "\001CHRS: ".uc($msg_chrs)." 2\r" if defined $msg_chrs;
    $m_txt .= "\001FMPT $msg_origpnt\r" if $msg_origpnt != 0;
    $m_txt .= "\001TOPT $msg_destpnt\r" if $msg_destpnt != 0 && !defined $msg_area;
#    $msg_fromaddr =~ /(\d+\:\d+\/\d+\.?\d*)/;
#    $msg_txt .= "\r--- \r \* Origin: perl packPKT by Stas Mishchenkov [2:460/58] \($1\)\r";

    my ( $g_sec, $g_min, $g_hour, $g_mday,$g_month,$g_year) = (gmtime)[0...5];
	$msg_txt .= sprintf("\r--- \r \* Origin: \@%04d%02d%02d\.%02d%02d%02d\.UTC $programfile $vers ($msg_fromaddr)\r",
						$g_year+1900, $g_month+1, $g_mday, $g_hour, $g_min,
						$g_sec );
#		$g_year+1900, $g_month+1, $g_mday, $g_hour, $g_min, $g_sec );
#    if ( defined( $msg_area ) ) {
#       if ( $msg_origpnt == 0 ) {
#            $msg_txt .= "SEEN\-BY: $msg_orignet\/$msg_orignode\r".
#	    "\x01PATH: $msg_orignet\/$msg_orignode\r";
#       }
#    } else {
#		$msg_txt .= sprintf("\x01Via $msg_fromaddr \@%04d%02d%02d\.%02d%02d%02d\.UTC $programfile $vers\r",
#		$g_year+1900, $g_month+1, $g_mday, $g_hour, $g_min, $g_sec );
#    }
return "$msgheader$m_txt$msg_txt\000";
}

# --- main ---------------------------------------------------------------------

my $options = join( ' ', @ARGV );

GetOptions (
		"date-from=s"    => \$datefrom,
		"end-date=s"     => \$tilldate,
        "config=s"       => \$configfile,
		"from-file=s"    => \$areafile,
		"area=s"         => \$echoarea,
		"sort=s"         => \$sortoder,
		"base-dir=s"     => \$basedir,
		"top-ten"        => \$topten,
		"name=s"         => \$sysopname,
		"monthly"        => \$monthly,
		"help"           => \$needhelp
		);


usage() if $needhelp || ! $options;

#usage() if ! $echoarea && ! $areafile;

#usage() if $echoarea && ! $basedir;


	readconf();
    $areafile = $config{areafile};
	readareas();

	if ( defined($datefrom) ){
	  if ( $datefrom =~ /(\d\d)[\.\/](\d\d)[\.\/](\d\d\d\d)/ ) {
	  	print "Stat from $datefrom\n";
	  	$datefrom = sprintf( "%04d%02d%02d", $3, $2, $1 );
	  } else {
		( $mday, $mon, $year ) = ( localtime() )[3...5];
		if ( $mon == 0 ) {
			$mon = 12;
			$year --;
		}
	  	$datefrom = sprintf( "%04d%02d%02d", $year+1900, $mon, '01' );
	  }
	} else {
		( $mday, $mon, $year ) = ( localtime() )[3...5];
		if ( $mon == 0 ) {
			$mon = 12;
			$year --;
		}
	  	$datefrom = sprintf( "%04d%02d%02d", $year+1900, $mon, '01' );
	}

	if (defined($tilldate)){
		if ( $tilldate =~ /(\d\d)[\.\/](\d\d)[\.\/](\d\d\d\d)/ ) {
		  	print "   till $tilldate\n";
		  	$tilldate = sprintf( "%04d%02d%02d", $3, $2, $1 );
		} else {
			( $mday, $mon, $year ) = ( localtime() )[3...5];
	  		$tilldate = sprintf( "%04d%02d%02d", $year+1900, $mon+1, '01' );
		}
	} else {
		( $mday, $mon, $year ) = ( localtime() )[3...5];
		$tilldate = sprintf( "%04d%02d%02d", $year+1900, $mon+1, '01' );
	}
	my ( $subj );
	foreach my $a ( sort keys %areas ) {
		if ( $a =~ /$echoarea/i ) {
			%fromnames = ();
			$echotag = uc( $a );
			print "\n\'$echotag\'\n";
			$report = "\n\'$echotag\'\n";
			listbase( $areas{$echotag}{areapath} );
			$report .= "      Total mesddages (except robots): $totalmsgs\n";
			madetopten();
			$report =~ s/\n/\r/g;
			$subj = "Message number statistics from $datefrom till $tilldate";
			$subj = "Top ten from $datefrom till $tilldate" if $topten;
			push @msgs, packedmsg( $config{fromname}, $config{toname},
									$config{toaddress}, $config{toaddress},
									0x0100, $report,
									$subj, $echotag, 'CP866' );
		}
	}

	my $pktname;
	if ( $config{toaddress} =~ /\d+\:(\d+)\/(\d+)/ ) {
		$pktname = sprintf( "%08x", ( time() + $1*10000 + $2 ) ) . '.pkt';
	} else {
		$pktname = sprintf( "%08x", time() ) . '.pkt';
	}

#	writefile( catfile( $config{placepktto}, 'j_report.txt' ), $report );

	writefile( catfile( $config{placepktto}, $pktname ),
				packpkt( $config{fromaddress}, $config{toaddress},
						 $config{password}, @msgs )
			);