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 $ROOT );
  20
  21 sub do_newpkg {
  22     my ($params, $opts, $html_header, $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 @new_pkgs;
  42     #FIXME: move to Packages::DB?
  43     open NEWPKG, '<', "$TOPDIR/files/packages/newpkg_info"
  44         or die "can't read newpkg_info file: $!";
  45     while (<NEWPKG>) {
  46         chomp;
  47         my @data = split /\s/, $_, 10;
  48
  49         next unless $data[3] eq $suite;
  50         next if $one_archive and $data[2] ne $one_archive;
  51         next if $one_section and $data[5] ne $one_section;
  52
  53         debug( "new pkg: @data", 1 ) if DEBUG;
  54         push @new_pkgs, \@data;
  55     }
  56     close NEWPKG;
  57
  58     (my @date)= gmtime();
  59     my $now_time = strftime ("%B %d, %Y", @date);
  60     my $rss_time = strftime ("%Y-%m-%dT%H:%M+00:00", @date);
  61
  62     $page_content->{make_url} = sub { return &Packages::CGI::make_url(@_) };
  63
  64     if (@new_pkgs) {
  65         $page_content->{new_packages} = [ sort { &$sort_func($a,$b) } @new_pkgs ];
  66     }
  67
  68     $page_content->{suite} = $suite;
  69     $page_content->{section} = $one_section if $one_section;
  70     $page_content->{archive} = $one_archive if $one_archive;
  71     $page_content->{sections} = \@SECTIONS;
  72
  73 #    my @full_path = ($HOSTNAME, $ROOT, $suite);
  74 #    push @full_path, $one_archive if $one_archive;
  75 #    my $full_path = join( '/', @full_path );
  76
  77 #     } else { # unless ($opts->{format} eq 'rss')
  78 #       my ( $rss_link, $rss_description, $rss_date );
  79
  80 #       $rss_description = sprintf(_g( "The following packages were added to suite %s%s in the Debian archive during the last 7 days."), $suite,
  81 #                                  $one_section ? sprintf(_g(" (section %s)"),$one_section):'');
  82
  83 #       my $rss = new XML::RSS (version => '1.0');
  84 #       $rss_link = "$full_path".($one_section?"$one_section/":'')."/newpkg?format=rss";
  85 #       $rss->channel(
  86 #                     title        => _g("New Debian Packages"),
  87 #                     link         => $rss_link,
  88 #                     description  => $rss_description,
  89 #                     dc => {
  90 #                         date       => $rss_time,
  91 #                         publisher  => 'debian-www@lists.debian.org',
  92 #                         rights     => 'Copyright '.($date[5]+1900).', SPI Inc.',
  93 #                         language   => $opts->{lang},
  94 #                     },
  95 #                     syn => {
  96 #                         updatePeriod     => "daily",
  97 #                         updateFrequency  => "2",
  98 # #                   updateBase       => "1901-01-01T00:00+00:00",
  99 #                     } );
 100
 101 #       foreach my $pkg (sort { &$sort_func($a,$b) } @new_pkgs) {
 102 #           $rss->add_item(
 103 #                          title       => $pkg->[0],
 104 #                          link        => "$full_path/$pkg->[0]",
 105 #                          description => $pkg->[-1],
 106 #                          dc => {
 107 #                              subject  => $pkg->[6],
 108 #                          } );
 109 #       }
 110 #       my $charset = get_charset( $opts->{lang} );
 111 #       print &CGI::header( -type => 'application/rss+xml',
 112 #                           -charset => $charset );
 113 #       print $rss->as_string;
 114 #       exit;
 115 #     }
 116 }
 117
 118 1;