#!/usr/bin/perl

use strict;
use warnings;

use FTN::JAM;
use Getopt::Long;
use File::Spec;
use Cwd 'abs_path';

my $vers = 'v.0.0.0.2';

my ( $datefrom, $echoarea, %fromnames, %msgsize, %quotecount, $basedir, $dh, 
     $sortoder, $needhelp, $topten, $sysopname, %echoes, $echotag, $tilldate,
     %monthes, $monthly );
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 = $1;
	$programfile =~ /(.*?)\.pl$/i;
my $pfile = $1;


sub usage()
{

    print <<ENDUSE;

    Usage: $programfile [options]
    ~~~~~~
    Options are:
            --help,-h                    - this text.
            --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,-e ECHO.TAG           - echo area name to collect statistics.
                                           Optional. Default scan all areas.
            --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 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] );
}


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 );

	$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";
	}

	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 ) = ( localtime( $msg_date ) )[3...5];
			$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 $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} ++;

			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);
}


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

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

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

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

$basedir = '/home/fido/mail/echo' unless defined $basedir;
if ( defined( $echoarea ) ) {
	$echoarea =~ s/\*/\.\*/g;
} else { $echoarea = '.*'; }

if (defined($datefrom)){
  if ( $datefrom =~ /(\d\d)[\.\/](\d\d)[\.\/](\d\d\d\d)/ ) {
  	print "Stat from $datefrom\n";
  	$datefrom = $3.$2.$1;
  } else { undef $datefrom; }
}

if (defined($tilldate)){
  if ( $tilldate =~ /(\d\d)[\.\/](\d\d)[\.\/](\d\d\d\d)/ ) {
  	print "   till $tilldate\n";
  	$tilldate = $3.$2.$1;
  } else { undef $tilldate; }
}

$sortoder='msg' unless defined $sortoder;

unless ( opendir($dh, $basedir) ) {
	print STDERR "Can't open $basedir ($!).\n";
	exit;
}

while( readdir($dh) ) {
	next if $_ eq '.';
	next if $_ eq '..';
	next if $_ =~ /_tmp/i;
	next if $_ =~ /(bad)|(dupe)|(carbon.)mail/i;
	if ( $_ =~ /^($echoarea)\.jdt$/i ) {
		$echotag = uc( $1 );
		print STDERR "\'$echotag\'\n";
		listbase( File::Spec->catfile( $basedir, $1 ) );
	}
}
close($dh);

my $l=0;
if ( $topten ) {
    foreach $sortoder ( 'msg', 'size', 'quote' ) {
	print "\nSorted by $sortoder\n";
	print( sprintf( "%4s %-35s %9s %8s %7s %11s\n", 'N', 'Name', 'Messages', 'Quoted', 'Q.%', 'Total size' ) );
	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++;
	    print( sprintf( "%4s %-36s %8s %8s % 7s %11s\n", $l, $n, $fromnames{$n}{msg}, $fromnames{$n}{quote}, sprintf( "%3.2f", ( $fromnames{$n}{quote}/$fromnames{$n}{msg}*100 ) ) . '%', $fromnames{$n}{size} ) );
	    last if $l == 10;
	}
	$l=0;
    }
} else {
  print( sprintf( "%4s %-35s %9s %8s % 7s %11s\n", 'N', 'Name', 'Messages', 'Quoted', 'Q.%', 'Total size' ) );
  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++;
	print( sprintf( "%4s %-36s %9s %9s % 7s %10s\n", $l, $n, $fromnames{$n}{msg}, $fromnames{$n}{quote}, sprintf( "%3.2f", ( $fromnames{$n}{quote}/$fromnames{$n}{msg}*100 ) ) . '%', $fromnames{$n}{size} ) );
  }
}

	if( $monthly ) {
		print "\nTotal messages per month:\n";
		foreach my $m ( sort keys %monthes ) {
			print sprintf( "    $m %12s\n", $monthes{$m} );
		}
	}