#!/usr/bin/perl -w
#######################################################################
#                   TOPPOSTERS.PL
# 
# A Perl script to grab the an HTML archive file produced by Mailman
# (www.list.org) and to extract the number of posts contributed per 
# list member for a given month. Also checks for a subject string that
# matches the variable $match and displays this as a percentage.
#
# It takes one optional parameter of the month number (default = current
# month), passed in either as the CGI variable "month" or as an 
# argument if called from the command line.
# 
#######################################################################
# 
# To use this script on another site, all you should have to do is to
# alter the two variables below, and then tweak the HTML output in the 
# functions at the end of this script.

# base URI for the archive directory, e.g. ***
$base_uri = "http://brightonnewmedia.org/pipermail/bnmlist/";

# profile_uri ***
$profile_uri = "http://www.aim23.com/bnm/cgi-bin/bnm.exe?sys=home&func=showtemplate&templatename=export";

# find string "[OT]"
$match = "\\[OT\\]";

# KNOWN BUGS:
# This should ***
#

#######################################################################
# main program beings here
#######################################################################
# kludge for my server
BEGIN { push @INC, ('/usr/local/lib/perl5/site_perl/5.6.1',
'/usr/local/lib/perl5/site_perl/5.6.1/i586-linux/'); }

use LWP::UserAgent;
use LWP::Simple;
use CGI;
use URI::Escape;

# get profile data (from web or 'cache' file)
%profiles = &getprofiles($profile_uri);

# print "*** PROF\n\n";
# foreach $key (keys(%profiles)) {
#   print "The key is $key, val is $profiles{$key}***!!!\n";
# }

# setup variables

undef %posters;
undef %matchers;

@months = qw(January February March April May June July August September
October November December);

$rank = 1;

# read month from CGI variables or arguments
if ($ARGV[0]) {
  $monthno = $ARGV[0] - 1;
} else {
  $monthno = (localtime(time))[4];
}

# read year from CGI variables or arguments
if ($ARGV[1]) {
  $theyear = $ARGV[1];
} else {
  $yearno = (localtime(time))[5];
  $theyear = $yearno + 1900;
}

$themonth = $months[$monthno];

# get HTML file to parse
$filename = "$theyear-$themonth";

# Create a user agent object
# *** n.b. with LWP::Simple this is easier -= see man lwpcook
$ua = new LWP::UserAgent;
$ua->agent("Tristan's Agent 0.1 (tristan\@roddis.org)" . $ua->agent);

# Create a request
my $req = new HTTP::Request GET => "$base_uri$filename/author.html";
# print "$base_uri$filename/author.html";

# Pass request to the user agent and get a response back
my $res = $ua->request($req);

# Check the outcome of the response
if (!$res->is_success) {
   die "Can't retrieve file $base_uri$filename from website:
$res->status_line \n";
}

#$html = $res->content;
#print "res is $html\n";
#exit;

# open(MYFILE, '<example.html');

# parse HTML extracting names

foreach (split("\n",$res->content)) {
#  chomp;
  if (m/<li>.*$match/i) {
    $matched = 1;
  } elsif (m/<i>(.*)/i) {
    $posters{$1}++ unless ($1 =~ /<\/i>/);
#    print "YYYY :$1:$_\n";
#    if ($1 =~ /<\/i>/) { print "NNN for $1\n"}
    if ($matched) {
      $matchers{$1}++;
    }
    undef $matched;
  }
}

#@in = reverse sort {$a <=> $b} values %posters;
#$prev = 'nonesuch';
#@out = grep($_ ne $prev && (($prev) = $_), @in);

#foreach $value (@out) {
#    print "VAL=$value\n";
#}

#foreach $name (sort keys %posters) {
#  print "NM=$name and val=$posters{$name}#\n";
#}

#exit;

#foreach $value (reverse sort {$a <=> $b} values %posters) {
#  if (defined($value)) {
#  print "VAL=$value\n";

#@in = reverse sort {$a <=> $b} values %posters;
#$prev = 'nonesuch';
#@out = grep($_ ne $prev && (($prev) = $_), @in);

#foreach $value (@out) {

 # foreach $name (sort keys %posters) {
  #  if ($value == $posters{$name}) {
#      &HTML_row($name, $posters{$name}, $matchers{$name}, $row);
   #   print"nm=$name, val=$posters{$name}, mat=$matchers{$name}\n";
 #     delete $posters{$name};
 #   }
#  }
#  }
#}
#exit;

# start HTML output
if (!$ARGV[0]) {
  print "Content-type:text/html\n\n";
}
&HTML_header("$themonth $theyear");

# sort names by number of posts and output a table row
# row odd/even variable
$row = 1;
@in = reverse sort {$a <=> $b} values %posters;
$prev = 'nonesuch';
@out = grep($_ ne $prev && (($prev) = $_), @in);

foreach $value (@out) {
#foreach $value (reverse sort {$a <=> $b} values %posters) {
#  print "VAL=$value\n";
  foreach $name (sort keys %posters) {
    if ($value == $posters{$name}) {
      $row = ($row == 1) ? 0: 1;
      &HTML_row($name, $posters{$name}, $matchers{$name}, $row);
      delete $posters{$name};
    }
  }
}
&HTML_footer;
# end of program flow

# Function to retrieve information on who has an active profile from Tom 
# Nixon's server...

sub getprofiles {
  my $uri = shift;
  my $cachefile = "./profilelist.txt";
  my %profs;

  # modification time in days: 1 hr = 0.0416; 1 min = 0.000694
  my $modtime = -M($cachefile);

  if ($modtime gt 0.00278) { # 4 minutes
    # print "$modtime: get new file";
    # file not recent - get new data
    my $newdata = get $uri;
    if ($newdata) {
      open (CACHE, ">$cachefile");
      print CACHE $newdata; 
      close CACHE;
    }   
  } else {
    # print "$modtime: using old file\n";
  }
  
  # read file and create hash
  open (CACHE, "<$cachefile");
  while (<CACHE>) {
    chomp;
    if (m/,/) {
      my ($id, $name) = split(/,/);
      $name =~ s/\"//g;
      $name =~ s/\n//g;
      $name =~ s/\r//g;
      $profs{$name} = $id;
    }
  }  
  close CACHE;
  return %profs;
}

#######################################################################
# Add your own HTML in to the print blocks of the three functions below
#######################################################################

sub HTML_header {
  my $date = shift;

  print <<END
<html>
<head>
  <title>Top posters</title>
  <style>
  body {background-color:white; font-family:sans-serif;}
  .small {font-size: 10px;}
  </style>
</head>
<body>

<h1>Top posters to <acronym title="Brighton New Media">BNM</acronym> for 
$date</h1>

<p>Below is a list of all the people who sent messages to the <a
href="http://www.brightonnewmedia.org">BNM list</a> during $date.  
Clicking on the 'stats' link will show you a person's historical posting
record. Clicking on 'random example' will show you an example of their previous messages. If a person has a thumbnail picture next to their name, then you
can click on it to see a larger image. Finally, if a person's name is
hyperlinked, then you can click on it to go and view their <a
href="http://www.aim23.com/bnm/">BNM profile</a> over on Tom N's
server...</p>

<div align="center">

<table border="0">
END
}


sub HTML_row {
  my ($name, $posts, $matches, $row) = @_;
  undef my $profileid;

  # test for existence of a profile
  foreach $prof (keys(%profiles)) {
    if ($name eq $prof) {
      $profileid = $profiles{$name};
      last;
    }
  }

  my $bgcolor = ($row == 1) ? "#CCCCFF" : "#AAAACC";
  if ($matches) {
    $percentage = sprintf("%d", 100*$matches/$posts);
  } else {
    $percentage = 0;
    $matches = 0;
  }
  # image widths used in the HTML below
  my $mwidth = $matches * 3;
  my $pwidth = ($posts - $matches) * 3;
  
  print"<tr bgcolor=\"$bgcolor\"><td align=\"left\" 
valign=\"middle\">$rank</td><td align=\"right\" 
valign=\"middle\">";

  if (-e "./photos/$name.jpg" || -e "./photos/$name.gif") {
    # add thumbnail image
    $URLname = $name;
    $URLname =~ s/ /%20/g;
    print "<a href=\"photos/$URLname" . "_big.jpg\"><img src = \"photos/$URLname" . "_thumb.jpg\" 
align=\"left\" alt=\"click to see 
large photo\"></a>&nbsp;";
  }

  if ($profileid) {
    print "<a href=\"http://www.aim23.com/bnm/cgi-bin/view.asp?t=$profileid\" 
title=\"click to see $name\'s profile\">$name</a>"; 
  } else {
    print "$name";
  }
  my $encoded_name = uri_escape($name);
  print "<br><span class=\"small\"><a 
href=\"showhistory.cgi?name=$encoded_name\">stats</a> <a href=\"examplepost.cgi?name=$encoded_name\">random example</a></span></td>";
  print <<END;
<td
align="left" valign="top"><img src="images/redbar.png" height="10"
width="$mwidth" hspace="0"><img src="images/greenbar.png" height="10"
width="$pwidth" hspace="0"><br>($posts posts, $percentage% off-topic)</td></tr>

END

  $rank++;
}


sub HTML_footer {
#  print "</table>\n</div>\n</body>\n</html>";
  print <<END
</table>
<p style="font-size:10px"><b>Small print</b> I have nothing to do with the 
<a href="http://brightonnewmedia.org/list/listinfo/bnmlist/index.html">BNM 
list</a>, apart form being a member. This is just a Perl script that scans 
the <a href="http://brightonnewmedia.org/pipermail/bnmlist/">archives</a>. 
If you would like to see your photo included in future rankings, please 
<a href="mailto:tristan\@roddis.org?subject=photo for the BNM ranking 
page">email me a large JPEG of yourself</a>. This is intended for 
recreational purposes only. Your milage may vary. Contents may settle 
in transit. Complaints or queries, email me at <a 
href="mailto:tristan\@roddis.org">tristan\@roddis.org</a>.</p>
</div> 
</body>
</html>
END
}