#!/usr/bin/perl
# Last-Revised Time-stamp: "2012-06-13 13:18:22 MDT"
#
# See http://www.interglacial.com/rss/ for info on RSS feeds
#

use strict;
use constant DEBUG => $ENV{'MAILTO'} ? 0 : 10;
#sub XML::RSS::SimpleGen::DEBUG () {6};

my $Unavailable;
my @Birdflu;
use XML::RSS::SimpleGen 12;
$|++;

my $RSS_AGE_LIMIT = 4;

Main();
exit;

#===========================================================================
sub Main {

  promed_main();
  my $Unavailable = 0;


  $RSS_AGE_LIMIT = 20; # Just because its content changes less often.
  #$Unavailable = 0;
  promed_birdflu();

  DEBUG and print "\n\nAll done.\n";
  return;
}
#===========================================================================

sub promed_main {
  my $url = 'http://www.promedmail.org/';

  rss_new(
    $url,
    "ProMED-mail",
    "ProMED-mail - the Program for Monitoring Emerging Diseases - is an
Internet-based reporting system dedicated to rapid global dissemination
of information on outbreaks of infectious diseases and acute exposures
to toxins that affect human health, including those in animals and in
plants grown for food or animal feed.",
  );

  my $rss_fs = "promed-mail.rss";
  #rss_every_other_hour;
  rss_hourly;
  rss_language("en-US");
  rss_webmaster('sburke@cpan.org');
  rss_self_url(      "http://interglacial.com/rss/$rss_fs" );
  rss_generator_url( "http://interglacial.com/rss/promed-mail.pl" );
  rss_livejournal( 'promed' );
  rss_item_limit(50);

  get_url($url);
  DEBUG > 12 and print "Got from $url : {{\n$_\n}}\n\n";
  extract_stuff($_, $url);
  write_rss( $rss_fs, $url);
  return;
}

#---------------------------------------------------------------------------

sub promed_birdflu {
  my $url = 'http://www.promedmail.org/';
  DEBUG and print "-" x 75, "\n";
  rss_new(
    $url,
    "ProMED-mail's avian influenza news",
  );

  my $rss_fs = "promed-mail-bird-flu.rss";
  #rss_every_other_hour;
  rss_hourly();
  rss_language("en-US");
  rss_webmaster('sburke@cpan.org');
  rss_self_url(      "http://interglacial.com/rss/$rss_fs" );
  rss_generator_url( "http://interglacial.com/rss/promed-mail.pl" );
  # rss_livejournal( 'promed' );
  rss_item_limit(50);

  DEBUG and print "Putting ", scalar(@Birdflu), " items into $rss_fs.\n";

  my $count = 0;
  foreach my $i (@Birdflu) {
    ++$count;
    my($u,$desc) = @$i;
    DEBUG >2 and print "B $count - Desc $desc\n   U: $u\n\n";
    rss_item( $u, $desc );
  }

  write_rss( $rss_fs, $url);
  return;
}

#---------------------------------------------------------------------------

sub write_rss {
  my($rss_out_fs, $url) = @_;

  unless(rss_item_count) {
    if($Unavailable) {
      if( -M $rss_out_fs > .5 ) {
        #  We shouldn't get 'Unavailable' for more than that many days!
        die "$0:'Unavailables' from $url for too long!!\n\t\tABORTING";
      } else {
	DEBUG and print "$url returned 'Unavailable'.";
	return;
      }
    } else {
      die "$0: No items in $url :\n{{\n$_\n}}\nAborting" ;
    }
  }
  DEBUG and print "Saving to $rss_out_fs\n\n", "*" x 70, "\n\n";
  rss_save($rss_out_fs, $RSS_AGE_LIMIT);
  return;
}
#---------------------------------------------------------------------------
sub extract_stuff {
  my( $in, $url ) = @_;
  (my $base = $url) =~ s<\?.*><>g;

  DEBUG and print "Considering ", length($in), " bytes from $url ...\n";
  my $super_matcher = 
    qr~
      # example:
      #  id="id1145958">Meningitis, meningococcal - France ex African Meningitis Belt</a></li></li>
      \b
        id="id  ([0-9]+)  "
        >
        (  [^\cm\cj]*? ) # nongreedy match until:
        </a></li></li>
    ~x
  ;
  my $count = 0;
  while( $in =~ /$super_matcher/g ) {
    my($id_num, $desc) = ($1,$2);
    ++$count;
    my $u = "http://www.promedmail.org/direct.php?id=$id_num";
    DEBUG > 2 and print "$count - Desc: $desc\n   U: $u\n\n";
    rss_item($u, $desc);
    if($desc =~ m/avian\s+/i and $desc =~ m/influen/i) {
      push @Birdflu, [$u, $desc];
    }
  }

  if(rss_item_count() == 0) {
    $Unavailable = 1;
  }

  return;
}

#---------------------------------------------------------------------------

__END__
