#!/usr/local/bin/perl -w
#
##################  MEDLINE FIELD EXTRACTION AND TABLE SUMMARY    #############
#                                                                             #
#                             ALL FIELDS                                      #
#                                                                             #
#                     PROGRAM 4:  File opening and processing                 #
#                                                                             #
#                        By Mike Galsworthy                                   #
#                                                                             #
###############################################################################

use Getopt::Long;

my ($web);

GetOptions ("web:s" => \$web);

my $filename = $web . ".txt";

open FILE, "<$filename" or die $!;

if (!($showtop)) {
    $showtop = 10; #arbitrary default value
    }

my $AU = '(nothing)';
my $MEDLINEcount = 0;
my $Male = 0;
my $Female = 0;
my $Animals = 0;
my $Humans = 0;
my $InfantP = 0;
my $InfantN = 0;
my $Infant = 0;
my $ChildP = 0;
my $Child = 0;
my $Adolescent = 0;
my $Adult = 0;
my $MiddleAged = 0;
my $Aged = 0;
my $Aged80over = 0;
my $YearsTotal = 0;

while (<FILE>) {
    chomp;
    if (/^QRY /) {
        $term = substr($_,6);
        }
    if (/^CNT /) {
        $Count = substr($_,6);
        }
    if (/^KP /) {
        $keep = substr($_,6);
        }
    if (/^STAT- /) {
        $STAT = substr($_,6);
             if ($STAT =~ /MEDLINE/) {
                $MEDLINEcount++;
             }
        }
    if (/^AU /) {
        $AU = substr($_,6);
               if ($term =~ m/($AU)/i) {
               $AU = "[$AU]";
               }
        $tableAU{$AU}++;
        }
    if (/^TA /) {
        $TA = substr($_,6);
               if ($term =~ m/($TA)/i) {
               $TA = "[$TA]";
               }
        $tableTA{$TA}++;
        }
    if (/^MH /) {
        $MH = substr($_,6);
             if ($MH =~ /\*/) {   # Starred terms
            $MHstarred = $MH;
            $tableMHstarred{$MHstarred}++;
            }
            if ($MH =~ /^\*/) {    #to take the "*" off
            $MH = substr($MH,1);  #Major MeSH Headings
            }
            my $slash = index($MH, '/');
            if ($slash > 0)  {             # if slash
              $MH = substr($MH,0,$slash)   # then remove
            }
 #           if ($term =~ m/($MH)/i) {
 #              $MH = "[$MH]";
 #              }
            if ($MH eq "Male") {     ##############################
              $Male++;               #                            #
              $MH = "removed";       #                            #
            }                        #   Male : Female            #
            if ($MH eq "Female") {   #                            #
              $Female++;             #                            #
              $MH = "removed";       ##############################
            }
            if ($MH eq "Animals") {  ##############################
              $Animals++;            #                            #
              $MH = "removed";       #                            #
            }                        #    Humans : Animals        #
            if ($MH eq "Humans") {   #                            #
              $Humans++;             #                            #
              $MH = "removed";       ##############################
            }
            if ($MH eq "Infant, Premature") {
              $InfantP++;
              $MH = "removed";
            }
            if ($MH eq "Infant, Newborn") {
              $InfantN++;
              $MH = "removed";
            }
            if ($MH eq "Infant") {
              $Infant++;
              $MH = "removed";
            }
            if ($MH eq "Child, Preschool") {
              $ChildP++;
              $MH = "removed";
            }
            if ($MH eq "Child") {
              $Child++;
              $MH = "removed";
            }
            if ($MH eq "Adolescent") {
              $Adolescent++;
              $MH = "removed";
            }
            if ($MH eq "Adult") {
              $Adult++;
              $MH = "removed";
            }
            if ($MH eq "Middle Aged") {
              $MiddleAged++;
              $MH = "removed";
            }
            if ($MH eq "Aged") {
              $Aged++;
              $MH = "removed";
            }
            if ($MH eq "Aged, 80 and over") {
              $Aged80over++;
              $MH = "removed";
            }
        $tableMH{$MH}++;
        }
     if (/^DP /) {
         $DP = substr($_,6,4);  # cut at 10 to leave only years
         $tableDP{$DP}++;
    }
}
print "There were $MEDLINEcount records with MEDLINE entries (i.e. with data for research ratios, age profiles and MeSH tables)";

print "<br><br> Here are the top $showtop Authors:  <br><br><table> ";

my @sorted_authors = sort { $tableAU{$b} <=> $tableAU{$a} || $b cmp $a } keys %tableAU;

$countAU = $showtop;

 foreach $AU (@sorted_authors)
   {
   if ($countAU > 0) {
     print '<tr><td width="100" align="right">';
     print $tableAU{$AU};
     print '</td><td width="50"></td><td align="left">';
     print $AU;
     print '</td></tr>';
     $countAU--;
     }
   }
print "</table>";

print "<br><br> Here are the top $showtop Journals: <br><br><table> ";
$countTA = $showtop;
 foreach $TA (sort{$tableTA{$b} <=> $tableTA{$a}} keys %tableTA)
   {
   if ($countTA > 0) {
     print '<tr><td width="100" align="right">';
     print $tableTA{$TA};
     print '</td><td width="50"></td><td align="left">';
     print $TA;
     print '</td></tr>';
     $countTA--;
     }
   }
print "</table>";

print "<br> Research ratios: <br><br><table> ";

print '<tr><td width="100" align="right">Humans</td>';
print '<td width="4" align="center">:</td>';
print '<td width="100" align="left">Animals</td></tr>';
print '<tr><td width="100" align="right">';
print $Humans;
print '</td><td width="4" align="center">:</td><td align="left">';
print $Animals;
print '</td></tr>';
print "</table><br>";

print "<table>";
print '<tr><td width="100" align="right">Male</td>';
print '<td width="4" align="center">:</td>';
print '<td width="100" align="left">Female</td></tr>';
print '<tr><td width="100" align="right">';
print $Male;
print '</td><td width="4" align="center">:</td><td align="left">';
print $Female;
print '</td></tr>';
print "</table>";



print "<br> Age profile of (Human) subject populations: <br><br><table> ";

print '<tr><td width="200" align="right">Infant, premature:&nbsp</td><td align="left">';
print $InfantP;
print '</td></tr>';
print '<tr><td width="200" align="right">Infant, newborn:&nbsp</td><td align="left">';
print $InfantN;
print '</td></tr>';
print '<tr><td width="200" align="right">Infant:&nbsp</td><td align="left">';
print $Infant;
print '</td></tr>';
print '<tr><td width="200" align="right">Child, preschool:&nbsp</td><td align="left">';
print $ChildP;
print '</td></tr>';
print '<tr><td width="200" align="right">Child:&nbsp</td><td align="left">';
print $Child;
print '</td></tr>';
print '<tr><td width="200" align="right">Adolescent:&nbsp</td><td align="left">';
print $Adolescent;
print '</td></tr>';
print '<tr><td width="200" align="right">Adult:&nbsp</td><td align="left">';
print $Adult;
print '</td></tr>';
print '<tr><td width="200" align="right">Middle Aged:&nbsp</td><td align="left">';
print $MiddleAged;
print '</td></tr>';
print '<tr><td width="200" align="right">Aged:&nbsp</td><td align="left">';
print $Aged;
print '</td></tr>';
print '<tr><td width="200" align="right">Aged, 80 and over:&nbsp</td><td align="left">';
print $Aged80over;
print '</td></tr>';
print "</table>";


print "<br><br> Here are the top $showtop Major MeSH Headings: <br><br><table> ";
delete $tableMH{"removed"};
$countMH = $showtop;
 foreach $MH (sort{$tableMH{$b} <=> $tableMH{$a}} keys %tableMH)
   {
   if ($countMH > 0) {
     print '<tr><td width="100" align="right">';
     print $tableMH{$MH};
     print '</td><td width="50"></td><td align="left">';
     print $MH;
     print '</td></tr>';
     $countMH--;
     }
   }
print "</table>";

print "<br><br> Here are the top $showtop starred MeSH terms: <br><br><table> ";
$countMHstarred = $showtop;
 foreach $MHstarred (sort{$tableMHstarred{$b} <=> $tableMHstarred{$a}} keys %tableMHstarred)
   {
   if ($countMHstarred > 0) {
     print '<tr><td width="100" align="right">';
     print $tableMHstarred{$MHstarred};
     print '</td><td width="50"></td><td align="left">';
     print $MHstarred;
     print '</td></tr>';
     $countMHstarred--;
     }
   }
print "</table>";

print "<br><br> Here are the results (number of papers) sorted by year: <br><br><table>";

foreach $DP (reverse sort (keys (%tableDP)))
   {
     $YearsTotal = $YearsTotal + $tableDP{$DP};
     print '<tr><td width="100" align="right">';
     print $tableDP{$DP};
     print '</td><td width="50"></td><td align="left">';
     print $DP;
     print '</td></tr>';
   }
print "</table>";

my $PercentDone = ($YearsTotal/$Count) * 100;
my $PercentDoneRounded = sprintf("%.1f", $PercentDone);

if ($Count>$YearsTotal) {
    print " <br> <img src='yellowtriangle.bmp'> <b> NOTE: </b> These dates tail off abruptly because I only processed ";
    print "the first $YearsTotal records ($PercentDoneRounded%) out of the $Count associated with that query. <br>";
    print "Use the Timeline button to quickly break down all $Count records into their year of publication. <br>";
    }

close FILE;

unlink($filename);

chop ($term);
chop ($Count);
open FILE, ">>log.txt" or die $!;
print FILE "                                 [file complete: $term ($YearsTotal)]\r\n";
close FILE;