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 #
   6 #    This program is free software; you can redistribute it and/or
   7 #    modify it under the terms of the GNU General Public License
   8 #    version 2 as published by the Free Software Foundation.
   9 #
  10 #    This program is distributed in the hope that it will be useful,
  11 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 #    General Public License for more details.
  14 #
  15 #    You should have received a copy of the GNU General Public License
  16 #    along with this program; if not, write to the Free Software
  17 #    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 #    02111-1307 USA
  19
  20
  21 use strict;
  22 use warnings;
  23
  24 use MIME::Base64 qw(encode_base64);
  25 use XML::RSS;
  26 use POSIX qw(strftime);
  27 use CGI qw/:standard/;
  28
  29 open REMOVALS, "</srv/ftp.debian.org/web/removals.txt";
  30
  31 my @removals;
  32
  33 {
  34   local $/ = "=========================================================================\n=========================================================================";
  35   @removals = reverse <REMOVALS>;
  36 }
  37
  38 my $rss = new XML::RSS (version => '1.0');
  39 $rss->channel(
  40                           title        => "Removals from Debian",
  41                           link         => "http://ftp-master.debian.org/removals.txt",
  42                           description  => "List of all the removals from Debian's archives",
  43                           dc => {
  44                                          date       => POSIX::strftime ("%FT%R+00:00",gmtime()),
  45                                          subject    => "Removals from Debian",
  46                                          creator    => 'tfheen@debian.org',
  47                                          publisher  => 'joerg@debian.org',
  48                                          rights     => 'Copyright 2005, Tollef Fog Heen',
  49                                          language   => 'en-us',
  50                                         },
  51                           syn => {
  52                                           updatePeriod     => "hourly",
  53                                           updateFrequency  => "1",
  54                                           updateBase       => "1901-01-01T00:00+00:00",
  55                                          }
  56                          );
  57
  58 my $num_to_display = 16;
  59 for my $removal (@removals ) {
  60   my ($null, $date, $ftpmaster, $body, $reason);
  61   $removal =~ s/=========================================================================//g;
  62   $removal =~ m/\[Date: ([^]]+)\] \[ftpmaster: ([^]]+)\]/;
  63   $date = $1;
  64   $ftpmaster = $2;
  65   ($null, $body) = split /\n/, $removal, 2;
  66   chomp $body;
  67   $body =~ m/---- Reason ---.*\n(.*)/;
  68   $reason = $1;
  69   my $link =  encode_base64($date . $ftpmaster);
  70   chomp($link);
  71
  72   $rss->add_item(title       => "$reason",
  73                                  link        => "http://ftp-master.debian.org/removals.txt?" . $link,
  74                                  description => qq[<pre>$body</pre>],
  75                                  dc => {
  76                                                 creator => "$ftpmaster",
  77                                            }
  78                                 );
  79
  80   $num_to_display -= 1;
  81   last unless $num_to_display;
  82 }
  83 print $rss->as_string;