lib/Packages/DoNewPkg.pm

   1 package Packages::DoNewPkg;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Benchmark ':hireswallclock';
   7 use HTML::Entities;
   8 use POSIX;
   9 use XML::RSS;
  10 use CGI ();
  11 use Exporter;
  12 our @ISA = qw( Exporter );
  13 our @EXPORT = qw( do_newpkg );
  14
  15 use Packages::I18N::Locale;
  16 use Packages::Search qw( :all );
  17 use Packages::CGI;
  18 use Packages::DB;
  19 use Packages::Config qw( $TOPDIR @SECTIONS $HOSTNAME $ROOT );
  20
  21 sub do_newpkg {
  22     my ($params, $opts, $html_header, $menu, $page_content) = @_;
  23
  24     if ($params->{errors}{suite}) {
  25         fatal_error( _g( "suite not valid or not specified" ) );
  26     }
  27     if (@{$opts->{suite}} > 1) {
  28         fatal_error( sprintf( _g( "more than one suite specified for show (%s)" ), "@{$opts->{suite}}" ) );
  29     }
  30
  31     my $sort_func = sub { $_[0][0] cmp $_[1][0] };
  32     $sort_func = sub { $_[0][1] <=> $_[1][1] or $_[0][0] cmp $_[1][0] }
  33     if $opts->{mode} eq 'byage';
  34
  35     my $suite = $opts->{suite}[0];
  36     my $one_archive = @{$opts->{archive}} == 1 ?
  37         $opts->{archive}[0] : undef;
  38     my $one_section = @{$opts->{section}} == 1 ?
  39         $opts->{section}[0] : undef;
  40
  41     my @full_path = ($HOSTNAME, $ROOT, $suite);
  42     push @full_path, $one_archive if $one_archive;
  43     my $full_path = join( '/', @full_path );
  44
  45     my @new_pkgs;
  46     #FIXME: move to Packages::DB?
  47     open NEWPKG, '<', "$TOPDIR/files/packages/newpkg_info"
  48         or die "can't read newpkg_info file: $!";
  49     while (<NEWPKG>) {
  50         chomp;
  51         my @data = split /\s/, $_, 10;
  52
  53         next unless $data[3] eq $suite;
  54         next if $one_archive and $data[2] ne $one_archive;
  55         next if $one_section and $data[5] ne $one_section;
  56
  57         debug( "new pkg: @data", 1 ) if DEBUG;
  58         push @new_pkgs, \@data;
  59     }
  60     close NEWPKG;
  61
  62     (my @date)= gmtime();
  63     my $now_time = strftime ("%B %d, %Y", @date);
  64     my $rss_time = strftime ("%Y-%m-%dT%H:%M+00:00", @date);
  65
  66     unless ($opts->{format} eq 'rss') {
  67         my $title = sprintf( _g( "New Packages in \"%s\"" ),
  68                              $suite );
  69         %$html_header = ( title => $title,
  70                           title_keywords => "debian, "._g('new packages').", $suite, @{$opts->{section}}",
  71                           meta => "<link rel=\"alternate\" type=\"application/rss+xml\" title=\"RSS\" href=\"newpkg?format=rss\">",
  72                           lang => $opts->{lang},
  73                           print_title => 1 );
  74
  75         $$page_content .= "<p>"
  76             . sprintf(_g( "The following packages were added to suite <em>%s</em>%s in the Debian archive during the last 7 days."), $suite,
  77                       $one_section ? sprintf(_g(" (section %s)"),$one_section):'')."</p>"
  78             . "<p>".sprintf( _g( "This information is also available as an <a href=\"%s\">RSS feed</a>." ), "newpkg?format=rss" )
  79             ." <a href=\"newpkg?format=rss\"><img src=\"http://planet.debian.org/rss10.png\" alt=\"[RSS 1.0 Feed]\"></a></p>";
  80
  81         if (@new_pkgs) {
  82             $$page_content .= "\n<ul>\n";
  83
  84             foreach my $pkg (sort { &$sort_func($a,$b) } @new_pkgs) {
  85                 $$page_content .= sprintf ("<li><a href=\"%s\">%s</a>\n    -- %s%s",
  86                                            $pkg->[0], $pkg->[0],
  87                                            encode_entities($pkg->[-1], '"&<>'),
  88                                            $pkg->[1] ?
  89                                            sprintf(_g(" <em>(%s days old)</em>"),$pkg->[1]):
  90                                            '');
  91             }
  92             $$page_content .= "\n</ul>\n" if @new_pkgs;
  93         }
  94
  95         my $slist = '';
  96         if ($one_section) {
  97             foreach my $s (@SECTIONS) {
  98                 $slist .= ", " if $slist;
  99                 $slist .= $one_section eq $s ? $s :
 100                     "<a href=\"../$s/newpkg\">$s</a>";
 101             }
 102         }
 103
 104         $$page_content .= '<p class="psmallcenter"><a href="$ROOT/$suite/allpackages" title="'.
 105             _g( "List of all packages" ) ."\">".
 106             _g( "All packages" ) ."</a><br>(<a href=\"$ROOT/$suite/allpackages?format=txt\">".
 107             _g( "compact compressed textlist" )."</a>)<br>".
 108             ($slist ? sprintf(_g( "New packages in %s" ), $slist ):'').
 109             "</p>\n";
 110
 111     } else { # unless ($opts->{format} eq 'rss')
 112         my ( $rss_link, $rss_description, $rss_date );
 113
 114         $rss_description = sprintf(_g( "The following packages were added to suite %s%s in the Debian archive during the last 7 days."), $suite,
 115                                    $one_section ? sprintf(_g(" (section %s)"),$one_section):'');
 116
 117         my $rss = new XML::RSS (version => '1.0');
 118         $rss_link = "$full_path".($one_section?"$one_section/":'')."/newpkg?format=rss";
 119         $rss->channel(
 120                       title        => _g("New Debian Packages"),
 121                       link         => $rss_link,
 122                       description  => $rss_description,
 123                       dc => {
 124                           date       => $rss_time,
 125                           publisher  => 'debian-www@lists.debian.org',
 126                           rights     => 'Copyright '.($date[5]+1900).', SPI Inc.',
 127                           language   => $opts->{lang},
 128                       },
 129                       syn => {
 130                           updatePeriod     => "daily",
 131                           updateFrequency  => "2",
 132 #                     updateBase       => "1901-01-01T00:00+00:00",
 133                       } );
 134
 135         foreach my $pkg (sort { &$sort_func($a,$b) } @new_pkgs) {
 136             $rss->add_item(
 137                            title       => $pkg->[0],
 138                            link        => "$full_path/$pkg->[0]",
 139                            description => $pkg->[-1],
 140                            dc => {
 141                                subject  => $pkg->[6],
 142                            } );
 143         }
 144         print &CGI::header( -type => 'application/rss+xml' );
 145         print $rss->as_string;
 146         exit;
 147     }
 148 }
 149
 150 1;