ttxgettext: Fix to actually include comments into the .pot files
[deb/packages.git] / lib / Packages / DoDownload.pm
1 package Packages::DoDownload;
2
3 use strict;
4 use warnings;
5
6 use POSIX;
7 use CGI ();
8 use DB_File;
9 use Benchmark ':hireswallclock';
10 use Exporter;
11
12 use Deb::Versions;
13 use Packages::Search qw( :all );
14 use Packages::Config qw( $DBDIR @SUITES @ARCHIVES @SECTIONS @ARCHITECTURES );
15 use Packages::CGI;
16 use Packages::DB;
17
18 our @ISA = qw( Exporter );
19 our @EXPORT = qw( do_download );
20
21
22 sub do_download {
23     my ($params, $opts, $page_content) = @_;
24     my $cat = $opts->{cat};
25
26     if ($params->{errors}{package}) {
27         fatal_error( $cat->g( "package not valid or not specified" ) );
28     }
29     if ($params->{errors}{suite}) {
30         fatal_error( $cat->g( "suite not valid or not specified" ) );
31     }
32     if ($params->{errors}{arch}) {
33         fatal_error( $cat->g( "architecture not valid or not specified" ) );
34     }
35     if (@{$opts->{suite}} > 1) {
36         fatal_error( $cat->g( "more than one suite specified for download (%s)",
37                               "@{$opts->{suite}}" ) );
38     }
39     if (@{$opts->{arch}} > 1) {
40         fatal_error( $cat->g( "more than one architecture specified for download (%s)",
41                               "@{$opts->{arch}}" ) );
42     }
43
44     $opts->{h_sections} = { map { $_ => 1 } @SECTIONS };
45     my $pkg = $opts->{package};
46     my $suite = $opts->{suite}[0];
47     my $arch = $opts->{arch}[0] ||'';
48
49     our (%packages_all);
50     my (@results);
51     my ($final_result, $filename, $directory, @file_components, $archive) = ("")x5;
52
53     my $st0 = new Benchmark;
54     unless (@Packages::CGI::fatal_errors) {
55         tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
56         O_RDONLY, 0666, $DB_BTREE
57             or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
58         
59         read_entry( \%packages, $pkg, \@results, $opts );
60
61         @results = grep { $_->[7] ne 'v' } @results;
62         unless (@results) {
63 #           fatal_error( _g( "No such package." )."<br>".
64 #                        sprintf( _g( '<a href="%s">Search for the package</a>' ), "$SEARCH_URL/$pkg" ) );
65         } else {
66             my $final_result = shift @results;
67             foreach (@results) {
68                 if (version_cmp( $_->[7], $final_result->[7] ) > 0) {
69                     $final_result = $_;
70                 }
71             }
72             
73             debug( "final_result=@$final_result", 1 );
74             $archive = $final_result->[1];
75             my %data = split /\000/, $packages_all{"$pkg $arch $final_result->[7]"};
76             if (!%data && $arch ne 'all' && $final_result->[3] eq 'all') {
77                 %data = split /\000/, $packages_all{"$pkg all $final_result->[7]"};
78                 $arch = 'all';
79                 debug( "choosing arch 'all' instead of requested arch $arch", 1 );
80 #               fatal_error( _g( "No such package." )."<br>".
81 #                            sprintf( _g( '<a href="%s">Search for the package</a>' ), "$SEARCH_URL/$pkg" ) ) unless %data;
82             }
83             @file_components = split('/', $data{filename});
84             $filename = pop(@file_components);
85             $directory = join( '/', @file_components).'/';
86
87             $page_content->{archive} = $archive;
88             $page_content->{suite} = $suite;
89             $page_content->{pkg} = $pkg;
90             my $pkgsize = floor(($data{size}/102.4)+0.5)/10;
91             if ($pkgsize < 1024) {
92                 $page_content->{pkgsize} = sprintf( '%.1f', $pkgsize );
93                 $page_content->{pkgsize_unit} = $cat->g( 'kByte' );
94             } else {
95                 $page_content->{pkgsize} = sprintf( '%.1f', floor(($data{size}/(102.4*102.4))+0.5)/100 );
96                 $page_content->{pkgsize_unit} = $cat->g( 'MByte' );
97             }
98             $page_content->{architecture} = $arch;
99             foreach (keys %data) {
100                 $page_content->{$_} = $data{$_};
101             }
102             $page_content->{filename} = { file => $filename,
103                                           directory => $directory,
104                                           full => $data{filename},
105                                       };
106
107         }
108     }
109         
110 }
111
112 1;