#!/usr/bin/perl
#Copyright (c) 2009-2010 by Emin Gabrielyan, Switzernet
$version="aa24.perl.txt";

use IO::Socket;
use Net::FTP;

local $log=3;
local $timeout=60;
local $fpasswds="../passwords.txt";
local $ffolders="folders.txt";
local $fnames="names.txt";
local $fcollect="collect.txt";
local $stat=$ARGV[0];

die "bad argument" if($stat ne "support" && $stat ne "oper");

local $SIG{ALRM} = sub { die "Server timeout" };

sub mksearches
{
  my ($search)=@_;
  open file,"<$fnames" or {die "cannot access the names"};
  my @names=<file>;
  close file;
  my %searches=();
  foreach(@names)
  {
    s/ +/ /g;
    s/^ *//;
    s/ *$//;
    s/[\r\n]//g;
    my $name=$_;
    s/[^a-z ][^ ]*( |$)/$1/ig;
    s/ +/ /g;
    s/^ *//;
    s/ *$//;
    if(!/^ *$/)
    {
      s/(^| )/ from /ig;
      $searches{$search.$_}=$name;
    }
  }
  return %searches;
}

sub getfolders
{
  my ($login,$server,$type)=@_;

  open file,"<$ffolders" or {die "cannot list folders"};

  my $flogin="", $fserver="", @dironl=(), @subdir=();

  while(<file>)
  {
    $flogin=$1 if(/^Login: +([^ \r\n]+)[\r\n ]*$/);      
    $fserver=$1 if(/^Server: +([^ \r\n]+)[\r\n ]*$/);
    if($flogin eq $login && $fserver eq $server)
    {
      push(@dironl,$1) if(/^Dir: +([^ \r\n]+)[\r\n ]*$/);
      push(@subdir,$1) if(/^Sub: +([^ \r\n]+)[\r\n ]*$/);
    }
  }

  close file;
  return ($type?@subdir:@dironl);
}

sub getpasswd
{
  my ($proto,$host,$user)=@_;

  open file,"<$fpasswds" or die "cannot access the passwords";
  my @lines=<file>;
  close file;
  my $passw="";
  foreach(@lines)
  {
    if(/^$proto +$host +$user +([^ \r\n]+)[\r\n]*$/)
    {
      $passw=$1;
      last;
    }
  }
  return $passw;
}

sub subfolders
{
  my ($login,$server)=@_;
  my @dironl=&getfolders($login,$server,0);
  my @subdir=&getfolders($login,$server,1);

  if($log>=2)
  {
    print "\n";
    print " Login: $login\n";
    print "Server: $server\n";
    $"=", ";
    print "   Dir: @dironl\n";
    print "   Sub: @subdir\n";
    print "\n";
  }

  alarm($timeout);

  local $c=IO::Socket::INET->new(Proto=>"tcp",PeerAddr=>"$server",PeerPort=>143) or {die "cannot connect to IMAP"};
  local $tag=1000;
  local @folders;

  while(<$c>) {print if($show); last if(/^\* OK/)}

  sub dialog{
    my @commands=@_;
    foreach $cmd (@commands)
    {
      alarm($timeout);
      $tag++;
      my $send="$tag $cmd\n";
      my $expect="$tag OK";
      print $send if($log>=4);
      print $c $send;
      while(<$c>)
      {
        print if($log>=4);
        $found{$cmd}+=split/ +/,$1 if(/^\* SEARCH(?: +(\d|\d[\d ]*\d))?[^\d]*$/);
        push(@folders,$1) if(/^\* LIST \([^)]*\) \"[^\"]*\" (\"[^\"]*\")[\r\n]*$/);
        last if(/^$expect/)
      }
    }
  }

  my $passw=&getpasswd('imap',$server,$login);

  &dialog("noop", "login $login $passw", "noop");

  print "On $server as $login\n" if($log>=2);

  @folders=();
  &dialog("noop", "list \"\" \"$_\"", "noop") foreach(@dironl);
  &dialog("noop", "list \"$_\" *", "noop") foreach(@subdir);

  my @seq;
  foreach(@folders)
  {
    print "$_\n" if($log>=2);
    @seq=("examine $_");
    push(@seq,$_) foreach(keys %searches);
    &dialog(@seq);
  }

  &dialog("noop", "logout");
  close $c;
  alarm(0);
}

sub dateandtime
{
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
  $year+=1900;
  $mon+=1;
  return ($sec,$min,$hour,$mday,$mon,$year);
}

sub trapezoid
{
  my $x=$_[0];
  $x=$x-6*int($x/6);
  return $x if($x<1);
  return 1 if($x>=1 && $x<=3);
  return 4-$x if($x>3 && $x<4);
  return 0;
}

sub mkcolor
{
  my $x=6*($_[0]-$_[1])/($_[2]-$_[1]+1);

  return (&trapezoid($x+2), &trapezoid($x), &trapezoid($x+4));
}

sub save
{
  my ($year_of_stat,$month_of_stat,$filename)=@_;
  my @mmmm=qw(January February March April May June July August September October November December);
  my @mmm=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  my ($sec,$min,$hour,$mday,$mon,$year)=&dateandtime;

  open file,">$filename" or die "cannot write";

print file <<____;
<html>
<head>
<title>Support email statistics of Switzernet on contracts@ billing@ support@ rates@ usd-online@ accounts</title>
</head>
<body><font face=arial>
<table border=0 cellpadding=0 cellspacing=0 height=750><tr>
<td valign=bottom bgcolor=#eeeeee align=center>
____

  my @invoke=(sort { $a cmp $b } keys %searches);
  my $n=@invoke;
  my $s=0;
  for(my $i=$n-1;$i>=0;$i--)
  {
    my $imap=$invoke[$i];
    $s+=$found{$imap};
  }
  printf file "<font size=2><u>Total %d</u></font><br>",$s;

print file <<____;
<table border=0 cellpadding=0 cellspacing=2 width=75>
____

  for(my $i=$n-1;$i>=0;$i--)
  {
    my ($r,$g,$b)=&mkcolor($i,0,$n-1);
    my $imap=$invoke[$i];
    my $name=$searches{$imap};
    my $count=$found{$imap};
    my $h=$count*($stat eq "oper"?0.075:0.15);
    printf file "<tr><td valign=middle align=center bgcolor=#%02x%02x%02x height=%.1f><font size=2 color=white>",255*$r,255*$g,255*$b,$h;
    my $label=$name;
    $label=~s/ //g;
    $label=~s/^(.{1,5}).*$/$1/;
    $label.=" ".$count;
    print file $label if($h>10);
    print file "</font></td></tr>\r\n";
  }

print file <<____;
</table>
</td>
<td valign=bottom>
<table border=0 cellpadding=0 cellspacing=0 width=200>
____

  for(my $i=$n-1;$i>=0;$i--)
  {
    my ($r,$g,$b)=&mkcolor($i,0,$n-1);
    my $imap=$invoke[$i];
    my $name=$searches{$imap};
    my $count=$found{$imap};
    printf file "<tr bgcolor=#%02x%02x%02x>",255*(0.9+0.1*$r),255*(0.9+0.1*$g),255*(0.9+0.1*$b);
    printf file "<td valign=middle align=right>";
    printf file "<font size=2 color=#%02x%02x%02x>",255*0.8*$r,255*0.8*$g,255*0.8*$b;
    printf file "%s</font></td>",$name;
    printf file "<td valign=middle align=right>";
    printf file "<font size=2 color=#%02x%02x%02x>",255*0.8*$r,255*0.8*$g,255*0.8*$b;
    printf file "%d</font></td></tr>",$count;
  }

print file <<____;
</table>
</td>
</tr></table>
<font size=1>
____

  printf file "<font size=3><b>%s'%02d</b></font><br>",$mmm[$month_of_stat-1],$year_of_stat%100;
  for(my $i=1;$i<=31;$i++)
  {
    printf file "<a href=%02d.htm>%02d</a> ",$i,$i;
  }
  print  file "<a href=today.htm>today</a><br>";
  printf file "<font size=1 color=gray><i>Created by %s on %04d-%02d-%02d %02d:%02d:%02d</i></font>",$version,$year,$mon,$mday,$hour,$min,$sec;

print file <<____;
</font>
</font></body>
</html>
____

  close file;
}

sub upload
{
  my ($file,$host,$user,$dir,$year_of_stat,$month_of_stat)=@_;

  my ($sec,$min,$hour,$mday,$mon,$year)=&dateandtime;

  my $passw=&getpasswd('ftp',$host,$user);

  my $ftp = Net::FTP->new($host, Debug => ($log>=4?1:0)) or die "Cannot connect to ftp";

  $ftp->login($user,$passw) or die "Cannot login ", $ftp->message;
  print "ftp logged in $host\n" if ($log>=2);

  $ftp->cwd($dir) or die "Cannot change working directory ", $ftp->message;

  $ftp->put($file,sprintf("uploads/%02d%02d%02d,%02d%02d%02d,stats,%04d,%02d.htm",
    $year%100,$mon,$mday,$hour,$min,$sec,$year_of_stat,$month_of_stat))
    or die "cannot upload to [uploads]";
  print "ftp cp to [uploads] ok\n" if ($log>=2);

  $ftp->put($file,sprintf("%02d%02d/today.htm",$year_of_stat%100,$month_of_stat))
    or die "cannot upload to [yymm]";
  print "ftp cp to [yymm]/today.htm ok\n" if ($log>=2);

  if($year==$year_of_stat && $mon==$month_of_stat)
  {
    $ftp->put($file,sprintf("%02d%02d/%02d.htm",$year_of_stat%100,$month_of_stat,$mday))
      or die "cannot upload to [yymm]";
    print "ftp cp to [yymm]/dd.htm ok\n" if ($log>=2);
  }

  $ftp->quit();
}


sub collect
{

  open file,"<$fcollect" or die "cannot access the account list";
  my @lines=<file>;
  close file;
  foreach(@lines)
  {
    if(/^([^ ]+) +([^ ]+) +([^ \r\n]+)[ \r\n]*$/)
    {
      my $type=$1;
      my $login=$2;
      my $server=$3;

      if($type eq $stat)
      {
        &subfolders($login,$server);
      }
    }
  }
}

sub monthlyreport
{
  my ($year,$month,$criteria)=@_;
  my @mmm=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

  printf "\nPreparing monthly report %04d-%02d\n",$year,$month if($log>=2);

  my $search="search $criteria since 1-$mmm[$month-1]-$year before 1-".$mmm[$month%12]."-".($year+int($month/12));
  $search=~s/ +/ /g;

  local %searches=&mksearches($search);
  local %found=();

  &collect;

  if($log>=2)
  {
    print "\nSatatistics of names:\n";
    printf "%5d %s\n",$found{$_},$searches{$_} foreach(sort { $a cmp $b } keys %found)
  }

  &save($year,$month,"out.htm");

  my $dir=$stat eq "oper"?"oper":"stats";
  &upload("out.htm","ftp.switzernet.com","admin\@switzernet.com","/1/public/091017-support-numbers/".$dir,$year,$month);
  &upload("out.htm","unappel.ch","unappel","/htdocs/public/091017-support-numbers/".$dir,$year,$month);
  &upload("out.htm","www.unappel.ch","unappel","/htdocs/public/091017-support-numbers/".$dir,$year,$month);
  &upload("out.htm","intarnet.com","intarnet","/public_html/2/public/091017-support-numbers/".$dir,$year,$month);
  &upload("out.htm","parinternet.ch","parinter","/parinternet.ch/2/public/091017-support-numbers/".$dir,$year,$month);
}

sub cron
{
  my ($criteria)=@_;
  my ($sec,$min,$hour,$mday,$mon,$year)=&dateandtime;

  if($mday<=2)
  {
    &monthlyreport($year-($mon==1),$mon==1?12:$mon-1,$criteria);
  }

  &monthlyreport($year,$mon,$criteria);
}

sub ytd
{
  my ($criteria)=@_;
  my ($sec,$min,$hour,$mday,$mon,$year)=&dateandtime;

  for(my $m=1;$m<=$mon;$m++)
  {
    &monthlyreport($year,$m,$criteria);
  }
}

my $criteria=$stat eq "oper"?"":"not to undisclosed not to inconnus not to switzernet.com not to intarnet.com";

print "criteria=\"$criteria\"\n";

#&ytd($criteria);

&cron($criteria);

#&monthlyreport(2010,2,$criteria);


sub prevmon
{
  my ($criteria)=@_;
  my ($sec,$min,$hour,$mday,$mon,$year)=&dateandtime;
  &monthlyreport($year-($mon==1),$mon==1?12:$mon-1,$criteria);
}

#&prevmon($criteria);

