Add text version of allpackages
authorFrank Lichtenheld <frank@lichtenheld.de>
Tue, 28 Feb 2006 23:35:02 +0000 (23:35 +0000)
committerFrank Lichtenheld <frank@lichtenheld.de>
Tue, 28 Feb 2006 23:35:02 +0000 (23:35 +0000)
TODO
bin/create_index_pages
cgi-bin/dispatcher.pl
lib/Packages/DoIndex.pm
lib/Packages/DoNewPkg.pm
lib/Packages/DoShow.pm

diff --git a/TODO b/TODO
index ad903fc1ef69d6a8623cf4c2e62c6e20a27f1176..d197162c487b24089cb0c4c8b04958d8d871495f 100644 (file)
--- a/TODO
+++ b/TODO
@@ -53,7 +53,6 @@ General:
 
 
 Missing pieces from old code:
- - txt version of all packages list
  - DDTP support (but without a working DDTP I will not invest any time
    in that)
  - search_packages compatibility (we should at least ensure we don't break
index 55e9f47b68a64dd78850d18bc76ca664dd83c7ce..aa40f3c0702f49f9719c8c6b7f9f4b783a63a664 100755 (executable)
@@ -9,6 +9,7 @@ use DB_File;
 use Storable;
 use HTML::Entities;
 use Locale::gettext;
+use Compress::Zlib;
 
 use lib './lib';
 
@@ -77,7 +78,7 @@ foreach my $s (@SUITES) {
        
        print {$pages{$key}{$lang}{index}{fh}} '</dl></div>',
        "<p class=\"psmallcenter\"><a href=\"allpackages\" title=\""._g( "List of all packages" )."\">".
-           _g( "All packages" ) ."</a><br>(<a href=\"allpackages.en.txt.gz\">".
+           _g( "All packages" ) ."</a><br>(<a href=\"allpackages?format=txt.gz\">".
            _g( "compact compressed textlist" )."</a>)</p>\n";
        print {$pages{$key}{$lang}{index}{fh}} trailer( "../", 'index', $lang, @LANGUAGES );
        close $pages{$key}{$lang}{index}{fh} or
@@ -95,6 +96,9 @@ foreach my $s (@SUITES) {
     mkpath ( "$wwwdir/$key" );
     open $pages{$key}{fh}, '>', "$wwwdir/$key/allpackages.en.html.new"
        or die "can't open index file for output: $!";
+    $pages{$key}{textgz} = gzopen("$wwwdir/$key/allpackages.en.txt.gz.new",
+                                 'wb9')
+       or die "can't open text index file for output: $!";
 
     my $title = sprintf( _g( "Software Packages in \"%s\"" ),
                         $key );
@@ -103,6 +107,11 @@ foreach my $s (@SUITES) {
                                     desc => encode_entities( $title, '"' ),
                                     lang => 'en' ),
     title( $title ), '<dl>';
+    my $title_txt = sprintf( _g( "All Debian Packages in \"%s\"" ),
+                            $key )."\n\n";
+    $title_txt .= _g( "Last Modified: " ).gmtime()."\n".
+       sprintf(_g( "Copyright (C) 1997-%d SPI;\nSee <URL:http://www.debian.org/license> for the license terms."), (gmtime)[5]+1900 )."\n\n";
+   $pages{$key}{textgz}->gzwrite($title_txt);
 
     foreach my $sec (keys %{$sections->{$s}}) {
        mkpath ( "$wwwdir/$key/$sec" );
@@ -149,7 +158,7 @@ while (my ($pkg, $data) = each %packages) {
     my (%pkg,%virt);
     my ($virt, $p_data) = split /\000/o, $data, 2;
     %virt = split /\01/o, $virt; 
-    foreach (split /\000/o, $p_data) {
+    foreach (split /\000/o, $p_data||'') {
        my @data = split ( /\s/o, $_, 8 );
        $pkg{$data[1]} ||= new Packages::Page( $pkg );
        $pkg{$data[1]}->merge_package( { package => $pkg,
@@ -200,6 +209,8 @@ while (my ($pkg, $data) = each %packages) {
        $txt_str .= " $short_desc_txt\n";
        print {$pages{$key}{fh}} $str
            or die "couldn't write to output file: $!";
+       $pages{$key}{textgz}->gzwrite($txt_str)
+           or die "couldn't write to output file: ".$pages{$key}{textgz}->gzerror;
        print {$pages{$key}{$section}{fh}} $str
            or die "couldn't write to output file: $!";
        if ($subsection ne '-') {
@@ -217,10 +228,14 @@ print "closing files ...\n";
 foreach my $s (@SUITES) {
     my $key = $s;
     print {$pages{$key}{fh}} '</dl>', trailer( "../" );
+    $pages{$key}{textgz}->gzclose or
+       warn "can't close text index file $wwwdir/$key/allpackages.en.txt.gz.new: ".$pages{$key}{textgz}->gzerror;
     close $pages{$key}{fh} or
        warn "can't close index file $wwwdir/$key/allpackages.en.html.new: $!";
     rename( "$wwwdir/$key/allpackages.en.html.new",
            "$wwwdir/$key/allpackages.en.html" );
+    rename( "$wwwdir/$key/allpackages.en.txt.gz.new",
+           "$wwwdir/$key/allpackages.en.txt.gz" );
     foreach my $sec (keys %{$sections->{$s}{'us'}}) {
        print {$pages{$key}{$sec}{fh}} '</dl>', trailer( "../../" );
        close $pages{$key}{$sec}{fh} or
index 22fc691c84dd33185ccb8bb69d5cacc805462aea..5f0b0ef4d5c5daa2a83afb0bd0a497bbe610092d 100755 (executable)
@@ -192,7 +192,7 @@ my %params_def = ( keywords => { default => undef,
                   arch => { default => 'any', match => '^([\w-]+)$',
                             array => ',', var => \@archs, replace =>
                             { any => \@ARCHITECTURES } },
-                  format => { default => 'html', match => '^(\w+)$',  },
+                  format => { default => 'html', match => '^([\w.]+)$',  },
                   mode => { default => undef, match => '^(\w+)$',  },
                   );
 my %opts;
index 8ca34f5a0097a2a235be92465f0260a1441dce26..064a18ad2aa4b386c336dccc3d01af144ca25a0e 100644 (file)
@@ -21,6 +21,15 @@ sub do_allpackages {
     return send_file( 'allpackages', @_ );
 }
 
+# no real need for more flexibility here, I think...
+my %mime_types = (
+                 txt => 'text/plain',
+                 'txt.gz' => 'text/plain',
+                 html => 'text/html',
+                 );
+my %encoding = (
+               'txt.gz' => 'x-gzip',
+               );
 sub send_file {
     my ($file, $params, $opts, $html_header) = @_;
 
@@ -39,14 +48,17 @@ sub send_file {
     $path .= "$opts->{archive}[0]/" if @{$opts->{archive}} == 1;
     $path .= "$opts->{subsection}[0]/" if @{$opts->{subsection}};
     # we don't have translated index pages for subsections yet
-    $opts->{lang} = 'en' if @{$opts->{subsection}};
+    $opts->{lang} = 'en' if @{$opts->{subsection}} or $file eq 'allpackages';
     $path .= "$file.$opts->{lang}.$opts->{format}";
 
     unless (@Packages::CGI::fatal_errors) {
        my $buffer;
        if (open( INDEX, '<', "$wwwdir/$path" )) {
-           my $charset = get_charset( $opts->{lang} );
-           print header( -charset => $charset );
+           my %headers;
+           $headers{'-charset'} = get_charset( $opts->{lang} );
+           $headers{'-type'} = $mime_types{$opts->{format}} || 'text/plain';
+           $headers{'-content-encoding'} = $encoding{$opts->{format}} if exists $encoding{$opts->{format}};
+           print header( %headers );
 
            binmode INDEX;
            while (read INDEX, $buffer, 4096) {
index 015d0559b49577d2348c8dc4cce3d71d6e7747f4..73cd981a0a36261d244a0eaec419c6055e5e227e 100644 (file)
@@ -103,7 +103,7 @@ sub do_newpkg {
 
        $$page_content .= '<p class="psmallcenter"><a href="$ROOT/$suite/allpackages" title="'.
            _g( "List of all packages" ) ."\">".
-           _g( "All packages" ) ."</a><br>(<a href=\"$ROOT/$suite/allpackages?format=txt\">".
+           _g( "All packages" ) ."</a><br>(<a href=\"$ROOT/$suite/allpackages?format=txt.gz\">".
            _g( "compact compressed textlist" )."</a>)<br>".
            ($slist ? sprintf(_g( "New packages in %s" ), $slist ):'').
            "</p>\n";
index e3e1945b6b7cc7123e4705a47f681e79f16106f1..1261544a0ecebc4d9dac6603607741ed7781d253 100644 (file)
@@ -152,7 +152,6 @@ sub do_show {
                                       _g( "All packages in this section" ),
                                       make_url("$subsection/",''),
                                       $subsection ], );
-                       my $source = $page->get_src('package');
                        push @menu, [ _g( "Source:" ),
                                      _g( "Source package building this package" ),
                                      make_url($source,'',{source=>'source'}),