la2.pl

############################
# Written by Tomas ok4bx - www.bxhome.org
# Script generate table with count of qso on every Mode/BAND from ADI log file.
# Result format is suitable for TEXY parser (http://texy.info)
#
# You can use it and share this script for free,
# only you must keep reference to my website in source and generated code!
#
$log_file = "log3.adi";
@bands = qw/160m 80m 40m 30m 20m 17m 15m 12m 10m 6m 2m/;
@modes = qw/ssb cw rtty psk31 psk63 qpsk31 qpsk63 hell fm/;

$soubor=slurp($log_file);
sub slurp {local$/=<>if local@ARGV=@_}

############################
# Skip ADI header
$soubor =~ m%\<eoh\>(.*)%is;
$soubor = $1;

############################
# Parse ADI file
$qso=0;
@adi_qso = split(/\<eor\>|\<EOR\>/,$soubor);
foreach $record (@adi_qso) {
  $qso++;
  #if ($qso % 250 ==0) {print "#";}
  while ( $record =~ m%^.*?<(.*?):(\d+).*?>(.*)$%si  ) {
    $k = lc($1);
    $l = $2;
    $record = $3;
    $v = substr($record,0,$l);
    $logbook[$qso]{$k}=$v;
  }
}

############################
# Count Statistic
for $q (@logbook) {
  $table { lc($q->{band}) }{ lc($q->{mode}) } ++;
}

############################
# Table Header
print "| Mode |";
foreach $b (@bands) {
    printf" %4s |",$b;
    $sep .= "-------";
}
print "      |\n|--------------".$sep."\n";

############################
# Create table content
$total=0;
foreach $m (@modes) {
    $total_mode = 0;
    printf "|%6s|", $m;
    foreach $b (@bands) {
        printf "%5s |", $table{$b}{$m};
        $total += $table{$b}{$m};
        $total_mode += $table{$b}{$m};
        $total_band{$b} += $table{$b}{$m}
    }
    printf "%5s |", $total_mode;
    print "\n";
}

#############################
# Table Footer Sums
print "|      |";
foreach $b (@bands) {
    printf "%5s |", $total_band{$b};
}
printf "%5s |", $total;

#############################
# Bottom Info
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
print "\n\nCreated on ";
printf "%2d/%02d/%04d",$mday,$mon+1,$year+1900;
print " with \"la2.pl\":[http://web.bxhome.org/blog/ok4bx/2008/08/perl-script-your-qso-statistic]\n";