tools/removals.pl

   1 #! /usr/bin/perl
   2
   3 #    removals - generate an RSS feed of removals from Debian
   4 #    (C) Copyright 2005 Tollef Fog Heen <tfheen@err.no>
   5 #    (C) Copyright 2010 Uli Martens <uli@youam.net>
   6 #
   7 #    This program is free software; you can redistribute it and/or
   8 #    modify it under the terms of the GNU General Public License
   9 #    version 2 as published by the Free Software Foundation.
  10 #
  11 #    This program is distributed in the hope that it will be useful,
  12 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 #    General Public License for more details.
  15 #
  16 #    You should have received a copy of the GNU General Public License
  17 #    along with this program; if not, write to the Free Software
  18 #    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  19 #    02111-1307 USA
  20
  21
  22 use strict;
  23 use warnings;
  24
  25 use MIME::Base64 qw(encode_base64);
  26 use XML::RSS;
  27 use POSIX qw(strftime);
  28 use CGI qw/:standard/;
  29
  30 die "usage: $0 <configfile>\n" unless scalar @ARGV;
  31
  32 my $config;
  33
  34 my $cfgfname = $ARGV[0];
  35 open my $cfgfile, "<", $cfgfname
  36         or die "config file $cfgfname not found: $!\n";
  37 while (<$cfgfile>){
  38         chomp;
  39         s/#.*//;
  40         next if m/^$/;
  41         my ($key, $val) = split ": ", $_, 2;
  42         warn "$0: warning: redefining config key $key\n" if defined $config->{$key};
  43         $config->{$key} = $val;
  44 }
  45 close $cfgfile;
  46
  47 for ( qw/input items title link description subject creator publisher rights language/ ) {
  48         die "config option '$_' missing in $cfgfname\n" unless $config->{$_};
  49 }
  50 open REMOVALS, "<", $config->{input};
  51
  52 my @removals;
  53
  54 {
  55   local $/ = "=========================================================================\n=========================================================================";
  56   @removals = reverse <REMOVALS>;
  57 }
  58
  59 my $rss = new XML::RSS (version => '1.0');
  60 $rss->channel(
  61                           title        => $config->{title},
  62                           link         => $config->{link},
  63                           description  => $config->{description},
  64                           dc => {
  65                                          date       => POSIX::strftime ("%FT%R+00:00",gmtime()),
  66                                          subject    => $config->{subject},
  67                                          creator    => $config->{creator},
  68                                          publisher  => $config->{publisher},
  69                                          rights     => $config->{rights},
  70                                          language   => $config->{language},
  71                                         },
  72                           syn => {
  73                                           updatePeriod     => "hourly",
  74                                           updateFrequency  => "1",
  75                                           updateBase       => "1901-01-01T00:00+00:00",
  76                                          }
  77                          );
  78
  79 my $num_to_display = $config->{items};
  80 for my $removal (@removals ) {
  81   my ($null, $date, $ftpmaster, $body, $packages, $reason);
  82   $removal =~ s/=========================================================================//g;
  83   $removal =~ m/\[Date: ([^]]+)\] \[ftpmaster: ([^]]+)\]/;
  84   $date = $1;
  85   $ftpmaster = $2;
  86   ($null, $body) = split /\n/, $removal, 2;
  87   chomp $body;
  88   $body =~ m/---- Reason ---.*\n(.*)/;
  89   $reason = $1;
  90   $packages = join( ", ",
  91     map { ( my $p = $_ ) =~ s/^\s*(.+?) \|.+/$1/; $p }
  92     grep {/.+\|.+\|.+/} split( /\n/, $body ) );
  93   $packages
  94     = ( substr $packages, 0,
  95     ( $config->{titlelength} - length($reason) - 6 ) )
  96     . " ..."
  97     if length("$packages: $reason") > $config->{titlelength};
  98   my $link =  encode_base64($date . $ftpmaster);
  99   chomp($link);
 100
 101   $rss->add_item(title       => "$packages: $reason",
 102                                  link        => $config->{link} . "?" . $link,
 103                                  description => qq[<pre>$body</pre>],
 104                                  dc => {
 105                                                 creator => "$ftpmaster",
 106                                            }
 107                                 );
 108
 109   $num_to_display -= 1;
 110   last unless $num_to_display;
 111 }
 112 print $rss->as_string;