[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: How to display only partial message body



#!/usr/bin/perl
# this is last30-xml.pl
#------------------------------------

BEGIN {push @INC, '/home/wfnorg/lib/perl5/i386-linux', '/home/wfnorg/bin';}
my $www = '/home/wfnorg/www';

# This script produces 8 seperate RSS feeds.
# It does an mhonarc -scan , and then uses some if-then logic to build lists of articles
# that should go into each feed.

$page_pcusa = "$www/rss/pcusa-rss.xml";
$page_wfn = "$www/rss/wfn-rss.xml";
$page_ens = "$www/rss/ens-rss.xml";
$page_elca = "$www/rss/elca-rss.xml";
$page_nccc = "$www/rss/nccc-rss.xml";
$page_lwf = "$www/rss/lwf-rss.xml";
$page_ucc = "$www/rss/ucc-rss.xml";
$page_wcc = "$www/rss/wcc-rss.xml";
$page_lcms = "$www/rss/lcms-rss.xml";

# ----------- ENVIRONMENT -------------
use lib '/home/wfnorg/lib/perl5/site_perl/5.8.4';
#        '/home/wfnorg/lib/perl5/lib/site_perl/5.005';
use Unicode::String;
require HTML::HeadParser;
use Date::Manip;
use HTTP::Headers;

# I don't think i use MongerFile anymore, but if it does not work, uncomment this line.
#use MongerFile;

my $www = '/home/wfnorg/www';
my $mh = '/home/wfnorg/mh/bin/mhonarc';
$base_url = "http://www.wfn.org";;
$i=20;

$wfn_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>WorldFaith News - www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>Official news releases of national and world faith groups</description>
     <language>en-us</language>
		 ];

my $pcusa_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>PCUSA News @ www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>Official news releases of PCUSA</description>
     <language>en-us</language>
		 ];

$rss_bottom = qq[

</channel>
</rss>

	  ];

my $ens_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>ENS News @ www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>Episcopal Church in the USA - News Service</description>
     <language>en-us</language>
		 ];

my $elca_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>ELCA News @ www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>Evangelical Lutheran Church in America News Releases</description>
     <language>en-us</language>
		 ];

my $nccc_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>

     <title>NCC USA News @ wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>National Council of the Churches USA</description>
     <language>en-us</language>
		 ];

my $lwf_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>LWF News @ www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>Lutheran World Federation</description>
     <language>en-us</language>
		 ];

my $ucc_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>UCC News @ www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>United Church of Christ - News Releases and Special Reports</description>
     <language>en-us</language>
		 ];

my $wcc_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>World Council of Churches @ www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>World Council of Churches official news releases</description>
     <language>en-us</language>
		 ];

my $lcms_top = qq[<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0">

   <channel>
   
     <title>LCMS News @ www.wfn.org</title>
     <link>http://www.wfn.org/</link>
     <description>LCMS news releases</description>
     <language>en-us</language>
		 ];

# ----------- DATE VARIABLES ----------
sub cleanup
{    my ($in) = shift;
    $in =~ s/&/+/g;
  $in =~ s/"//g;
#  $in =~ s///g;
  $in =~ s/</[/g;
  $in =~ s/>/]/g;
#  return $in;
  my $u = Unicode::String->new($in);
  return $u->utf8;
}

sub strip_whitespace {
    my (@refs) = @_;
    foreach $ref (@refs) {
	$$ref =~ s/^\s+//g;
	$$ref =~ s/\s+$//g;
    }
} 


sub doit {
my $h = HTTP::Headers->new;
my ($from, $file, $date, $url) = @_;
#-----------------------------------
#--- parse html file, and extract TITLE, DESCRIPTION
my $p = HTML::HeadParser->new($h);
open (FILE, $file) or die "could not open $filename";
$head = '';
while (<FILE>) { 
    $head .= $_;
    last if /^<\/HEAD>/;
}
close (FILE) or die "could not close $file";
$p->parse($head) and  print "not finished";

#my $FF = new MongerFile($file);
#$date =	$FF->created_gmt;
my $created = $^T - int((-M "$file") * 86400);
$created = $created - (7 * 60 * 60);
my $date = gmtime($created);
my $Title = $p->header('Title');
#print "title: $Title\n";
$Title = substr($Title, 10); 
#print "subst: $Title\n";
#print $p->header('X-meta-description');
$description = $p->header('X-meta-description');

#-----------------------------------
# prepare for printing
strip_whitespace (\$from);
#print "A $Title \n";    
$Title = &cleanup($Title);
#print "t $Title \n";    
$f = &cleanup($from);
$d = &cleanup($description);
$date=&UnixDate($date,'%g');
#print "DATE: ", $date, "\n";
undef $h;
undef $FF;
return qq[

		    <item>
		    <link>$url</link>
		    <title>$Title ($f)</title>
                    <pubDate>$date</pubDate>
		    <description>$d</description>
      		    </item>

		    ];
}

my $err;
my $todayM = &ParseDate("today"); # date format is YYYYMMDDHH:MM:SS.
my ($today_year, $today_month) = unpack ("A4 A2", $todayM);
#print "YYYYMMDDHH:MM:SS\n";  #print "$todayM\n"; #print "$today_year : $today_month\n";
my $start = &DateCalc("today","- 28days",\$err);
my ($start_year, $start_month) = unpack ("A4 A2", $start);
#print "$start\n"; #print "$start_year : $start_month\n";

# ----------- DO THIS -----------------

open W, ">$page_wfn" or die;
print W $wfn_top;

open P, ">$page_pcusa" or die;
print P $pcusa_top;

open ens, ">$page_ens" or die;
print ens $ens_top;
open elca, ">$page_elca" or die;
print elca $elca_top;
open nccc, ">$page_nccc" or die;
print nccc $nccc_top;
open lwf, ">$page_lwf" or die;
print lwf $lwf_top;
open ucc, ">$page_ucc" or die;
print ucc $ucc_top;
open wcc, ">$page_wcc" or die;
print wcc $wcc_top;
open lcms, ">$page_lcms" or die;
print lcms $lcms_top;


&grab_scan($today_year, $today_month);
&grab_scan($start_year, $start_month, $start);

print ens $rss_bottom; close ens;
print elca $rss_bottom; close elca;
print nccc $rss_bottom; close nccc;
print lwf $rss_bottom; close lwf;
print ucc $rss_bottom; close ucc;
print wcc $rss_bottom; close wcc;
print lcms $rss_bottom; close lcms;

print W $rss_bottom;
close W;

print P $rss_bottom;
close P;

sub grab_scan($$;$){
  local ($YYYY, $MM, $filter_startdate) = @_;
  $outdir = "$www/$YYYY/$MM";
  local ($start_filtering) = '';
  $myCommand = "$mh -quiet -nolock -reverse -scan -outdir $outdir |";
#  print $myCommand;
  open (SCAN, $myCommand) or 
      die "could not scan $outdir $!";
  while (<SCAN>){
#     print;
      next unless /^\s*\d+\s+\d+/;
      next if $start_filtering; # save computer a bit of time
      $scan_template = 'A5 A12 A32 A92';
      my ($msgid, $date, $from, $subject) = unpack($scan_template, $_);

      # skip if filter_startdate is earlier than $item_date
      if ($filter_startdate){
         $item_date = &ParseDate($date);
         #print "$filter_startdate\n$item_date\n";
         $start_filtering++ if &Date_Cmp($filter_startdate, $item_date) eq 1;
         next if $start_filtering;
      }
      # mhonarc -scan has buggy titles for diacriticals, so here is one

      $lmsgid = sprintf( "%05d", $msgid ) ;
      my $file="$www/$YYYY/$MM/msg$lmsgid.html";
      my $url = "$base_url/$YYYY/$MM/msg$lmsgid.html";

#      print "a$subject\n";
      my $test = $subject;
#      if (($i > 1) or ($test =~ m/PCUSANEWS|ENS|ELCA|NCC|LWF|UCC|WCC|NCCC/)){
#          print "b$subject\n";
	  $text = &doit ($from, $file, $date, $url);
#          print "c$subject\n";

      if ($i-- > 1) {
          print W $text;
      };

      if ($subject =~ /PCUSANEWS/) {
	  print P $text;
      };

      if ($test =~ /ENS/){
          print ens $text;
      };

      if ($from =~ /ELCA\.ORG/){
          print elca $text;
      };

      if ( ($from =~ /ncc/) || ($subject =~ /NCC/)) {
          print nccc $text;
      };

      if ($subject =~ /LWF/){
          print lwf $text;
      };

      if ($from =~ /ucc\.org/){
          print ucc $text;
      };

      if ($from =~ /wcc-coe\.org/){
          print wcc $text;
      };

      if ($subject =~ /LCMSNews/){
          print lcms $text;
      };
      print "WORKING $msgid\n";
#  } else { 
# print "$msgid\n"; 
#}
  }
  close (SCAN) or die "could not scan $outdir - error closing handle";
}



__END__


[Index of Archives]     [Bugtraq]     [Yosemite News]     [Mhonarc Home]