b15e9edc63162da758865f07f4607bc8a6cf90f7
[deb/packages.git] / lib / Packages / CGI.pm
1 package Packages::CGI;
2
3 use strict;
4 use warnings;
5
6 use Exporter;
7
8 our @ISA = qw( Exporter );
9 our @EXPORT = qw( DEBUG debug fatal_error get_mime );
10 our @EXPORT_OK = qw( error hint msg note get_all_messages
11                      make_url make_search_url );
12
13 # define this to 0 in production mode
14 use constant DEBUG => 1;
15 our $debug = 0;
16
17 my %mime_types = (
18                   txt => 'text/plain',
19                   'txt.gz' => 'text/plain',
20                   html => 'text/html',
21                   rss => 'application/rss+xml',
22                   rfc822 => 'text/plain',
23                   );
24
25 sub get_mime {
26     return $mime_types{$_[0]} || $_[1] || 'text/html';
27 }
28
29 our (@fatal_errors, @errors, @debug, @msgs, @hints, @notes);
30 our $http_code;
31
32 sub reset {
33     @fatal_errors = @errors = @debug = @msgs = @hints = @notes = ();
34     $http_code = 200;
35 }
36
37 sub fatal_error {
38     push @fatal_errors, $_[0];
39     $http_code = $_[1] if $_[1];
40 }
41 sub error {
42     push @errors, $_[0];
43 }
44 sub hint {
45     push @hints, $_[0];
46 }
47 sub debug {
48     my $lvl = $_[1] || 0;
49     push(@debug, $_[0]) if $debug > $lvl;
50 }
51 sub msg {
52     push @msgs, $_[0];
53 }
54 sub note {
55     push @notes, [ @_ ];
56 }
57 sub get_errors { (@fatal_errors, @errors) }
58 sub get_debug {
59     return unless $debug && @debug;
60     return @debug;
61 }
62 sub get_msgs { @msgs };
63 sub get_hints { @hints };
64 sub get_notes { @notes };
65 sub get_all_messages {
66     return {
67         errors => [ @fatal_errors, @errors ],
68         debugs => $debug ? \@debug : [],
69         msgs => \@msgs,
70         hints => \@hints,
71         notes => \@notes,
72     };
73 }
74
75 our $USE_PAGED_MODE = 1;
76 use constant DEFAULT_PAGE => 1;
77 use constant DEFAULT_RES_PER_PAGE => 50;
78 our %page_params = ( page => { default => DEFAULT_PAGE,
79                                match => '(\d+)' },
80                      number => { default => DEFAULT_RES_PER_PAGE,
81                                  match => '(\d+)' } );
82
83 sub parse_params {
84     my ( $cgi, $params_def, $opts ) = @_;
85
86     my %params_ret = ( values => {}, errors => {} );
87     my %params;
88     if ($USE_PAGED_MODE) {
89         debug( "Use PAGED_MODE", 2 ) if DEBUG;
90         %params = %$params_def;
91         foreach (keys %page_params) {
92             delete $params{$_};
93         }
94         %params = ( %params, %page_params );
95     } else {
96         %params = %$params_def;
97     }
98
99     foreach my $param ( keys %params ) {
100         
101         debug( "Param <strong>$param</strong>", 2 ) if DEBUG;
102
103         my $p_value_orig = $cgi->param($param);
104
105         if (!defined($p_value_orig)
106             && defined $params_def->{$param}{alias}
107             && defined $cgi->param($params_def->{$param}{alias})) {
108             $p_value_orig = $cgi->param($params_def->{$param}{alias});
109             debug( "Used alias <strong>$params_def->{$param}{alias}</strong>",
110                    2 );
111         }
112
113         my @p_value = ($p_value_orig);
114
115         debug( "Value (Orig) ".($p_value_orig||""), 2 ) if DEBUG;
116
117         if ($params_def->{$param}{array} && defined $p_value_orig) {
118             @p_value = split /$params_def->{$param}{array}/, $p_value_orig;
119             debug( "Value (Array Split) ". join('##',@p_value), 2 ) if DEBUG;
120         }
121
122         if ($params_def->{$param}{match} && defined $p_value_orig) {
123             @p_value = map
124             { $_ =~ m/$params_def->{$param}{match}/; $_ = $1 }
125             @p_value;
126         }
127         @p_value = grep { defined $_ } @p_value;
128
129         debug( "Value (Match) ". join('##',@p_value), 2 ) if DEBUG;
130
131         unless (@p_value) {
132             if (defined $params{$param}{default}) {
133                 @p_value = ($params{$param}{default});
134             } else {
135                 @p_value = undef;
136                 $params_ret{errors}{$param} = "undef";
137                 next;
138             }
139         }
140
141         debug( "Value (Default) ". join('##',@p_value), 2 ) if DEBUG;
142         my @p_value_no_replace = @p_value;
143
144         if ($params{$param}{replace} && @p_value) {
145             foreach my $pattern (keys %{$params{$param}{replace}}) {
146                 my @p_value_tmp = @p_value;
147                 @p_value = ();
148                 foreach (@p_value_tmp) {
149                     if ($_ eq $pattern) {
150                         my $replacement = $params{$param}{replace}{$_};
151                         if (ref $replacement) {
152                             push @p_value, @$replacement;
153                         } else {
154                             push @p_value, $replacement;
155                         }
156                     } else {
157                         push @p_value, $_;
158                     }
159                 }
160             }
161         }
162         
163         debug( "Value (Final) ". join('##',@p_value), 2 ) if DEBUG;
164
165         if ($params_def->{$param}{array}) {
166             $params_ret{values}{$param} = {
167                 orig => $p_value_orig,
168                 no_replace => \@p_value_no_replace,
169                 final => \@p_value,
170             };
171             @{$params_def->{$param}{var}} = @p_value
172                 if $params_def->{$param}{var};
173         } else {
174             $params_ret{values}{$param} = {
175                 orig => $p_value_orig,
176                 no_replace => $p_value_no_replace[0],
177                 final => $p_value[0],
178             };
179             ${$params_def->{$param}{var}} = $p_value[0]
180                 if $params_def->{$param}{var};
181         }
182         $opts->{$param} = $params_ret{values}{$param}{final} if $opts;
183     }
184
185     if ($USE_PAGED_MODE) {
186         $cgi->delete( "page" );
187         $cgi->delete( "number" );
188     }
189
190     return %params_ret;
191 }
192
193 sub start { 
194     my $params = shift;
195
196     my $page = $params->{values}{page}{final}
197     || DEFAULT_PAGE;
198     my $res_per_page = $params->{values}{number}{final}
199     || DEFAULT_RES_PER_PAGE;
200
201     return 1 if $res_per_page =~ /^all$/i;
202     return $res_per_page * ($page - 1) + 1;
203 }
204
205 sub end {
206     my $params = shift;
207
208     use Data::Dumper;
209     debug( "end: ".Dumper($params) ) if DEBUG;
210     my $page = $params->{page}
211     || DEFAULT_PAGE;
212     my $res_per_page = $params->{number}
213     || DEFAULT_RES_PER_PAGE;
214
215     return $page * $res_per_page;
216 }
217
218 sub indexline {
219     my ($cgi, $params, $num_res) = @_;
220
221     my $index_line = "";
222     my $page = $params->{page}
223     || DEFAULT_PAGE;
224     my $res_per_page = $params->{number}
225     || DEFAULT_RES_PER_PAGE;
226     my $numpages = ceil($num_res /
227                         $res_per_page);
228     for (my $i = 1; $i <= $numpages; $i++) {
229         if ($i == $page) {
230             $index_line .= $i;
231         } else {
232             $index_line .= "<a href=\"".encode_entities($cgi->self_url).
233                 "&amp;page=$i&amp;number=$res_per_page\">".
234                 "$i</a>";
235         }
236         if ($i < $numpages) {
237            $index_line .= " | ";
238         }
239     }
240     return $index_line;
241 }
242
243 sub nextlink {
244     my ($cgi, $params, $no_results ) = @_;
245
246     my $page = $params->{page}
247     || DEFAULT_PAGE;
248     $page++;
249     my $res_per_page = $params->{number}
250     || DEFAULT_RES_PER_PAGE;
251
252     if ((($page-1)*$res_per_page + 1) > $no_results) {
253         return "&gt;&gt;";
254     }
255
256     return "<a href=\"".encode_entities($cgi->self_url).
257         "&amp;page=$page&amp;number=$res_per_page\">&gt;&gt;</a>";
258 }
259
260 sub prevlink {
261     my ($cgi, $params ) = @_;
262
263     my $page = $params->{page}
264     || DEFAULT_PAGE;
265     $page--;
266     if (!$page) {
267         return "&lt;&lt;";
268     }
269
270     my $res_per_page = $params->{number}
271     || DEFAULT_RES_PER_PAGE;
272
273     return "<a href=\"".encode_entities($cgi->self_url).
274         "&amp;page=$page&amp;number=$res_per_page\">&lt;&lt;</a>";
275 }
276
277 sub resperpagelink {
278     my ($cgi, $params, $res_per_page ) = @_;
279
280     my $page;
281     if ($res_per_page =~ /^all$/i) {
282         $page = 1;
283     } else {
284         $page = ceil(start( $params ) / $res_per_page);
285     }
286
287     return "<a href=\"".encode_entities($cgi->self_url).
288         "&amp;page=$page&amp;number=$res_per_page\">$res_per_page</a>";
289 }
290
291 sub printindexline {
292     my ( $input, $no_results, $opts ) = @_;
293
294     my $index_line;
295     if ($no_results > $opts->{number}) {
296         
297         $index_line = prevlink( $input, $opts)." | ".
298             indexline( $input, $opts, $no_results)." | ".
299             nextlink( $input, $opts, $no_results);
300         
301         print "<p style=\"text-align:center\">$index_line</p>";
302     }
303 }
304
305 #sub multipageheader {
306 #    my ( $input, $no_results, $opts ) = @_;
307 #
308 #    my ($start, $end);
309 #    if ($opts->{number} =~ /^all$/i) {
310 #       $start = 1;
311 #       $end = $no_results;
312 #       $opts->{number} = $no_results;
313 #       $opts->{number_all}++;
314 #    } else {
315 #       $start = Packages::Search::start( $opts );
316 #       $end = Packages::Search::end( $opts );
317 #       if ($end > $no_results) { $end = $no_results; }
318 #    }
319 #
320 #       print "<p>Found <em>$no_results</em> matching packages,";
321 #    if ($end == $start) {
322 #       print " displaying package $end.</p>";
323 #    } else {
324 #       print " displaying packages $start to $end.</p>";
325 #    }
326 #
327 #    printindexline( $input, $no_results, $opts );
328 #
329 #    if ($no_results > 100) {
330 #       print "<p>Results per page: ";
331 #       my @resperpagelinks;
332 #       for (50, 100, 200) {
333 #           if ($opts->{number} == $_) {
334 #               push @resperpagelinks, $_;
335 #           } else {
336 #               push @resperpagelinks, resperpagelink($input,$opts,$_);
337 #           }
338 #       }
339 #       if ($opts->{number_all}) {
340 #           push @resperpagelinks, "all";
341 #       } else {
342 #           push @resperpagelinks, resperpagelink($input, $opts, "all");
343 #       }
344 #       print join( " | ", @resperpagelinks )."</p>";
345 #    }
346 #    return ( $start, $end );
347 #}
348
349 sub string2id {
350     my $string = "@_";
351
352     $string =~ s/[^\w:.-]/_/g;
353     return $string;
354 }
355
356 our ( %url_params, %query_params );
357
358 sub init_url {
359     my ($input, $params, $opts) = @_;
360
361     %url_params = ();
362     %query_params = ();
363
364     if ($params->{values}{lang}{orig} &&
365         (my $l = $params->{values}{lang}{no_replace})) {
366         $url_params{lang} = $l;
367     }
368     if ($params->{values}{source}{no_replace}) {
369         $url_params{source} = 'source';
370         $query_params{source} = 1;
371     }
372     foreach my $p (qw(suite arch)) {
373         if ($params->{values}{$p}{orig}
374             && (ref $params->{values}{$p}{final} eq 'ARRAY')
375             && @{$params->{values}{$p}{final}}) {
376             if (@{$params->{values}{$p}{final}} == 1) {
377                 $url_params{$p} = $params->{values}{$p}{final}[0];
378             } else {
379                 $url_params{$p} =
380                     join(",",@{$params->{values}{$p}{no_replace}});
381             }
382         }
383     }
384     foreach my $p (qw(format searchon mode exact debug)) {
385         if ($params->{values}{$p}{orig}
386             && (my $pv = $params->{values}{$p}{no_replace})) {
387             $url_params{$p} = $pv;
388         }
389     }
390
391     use Data::Dumper;
392     debug( join("\n",Dumper(\%url_params,\%query_params)), 2 ) if DEBUG;
393 }
394
395 sub make_url {
396     my ($add_path, $add_query, @override) = @_;
397     my (@path, @query_string) = ()x2;
398     my $override = {};
399     if (ref $override[0]) { 
400         $override = $override[0];
401     } elsif (@override) {
402         $override = { @override };
403     }
404
405     push @path, $Packages::Config::ROOT;
406     foreach my $p (qw(lang source suite archive arch)) {
407         my $val = $url_params{$p};
408         $val = $override->{$p} if exists $override->{$p};
409         push @path, $val if $val;
410     }
411     foreach my $p (qw(format debug)) {
412         my $val = $url_params{$p};
413         $val = $query_params{$p} if exists $query_params{$p};
414         $val = $override->{$p} if exists $override->{$p};
415         push @query_string, "$p=$val" if $val;
416     }
417     push @path, $add_path if $add_path and $add_path ne '/';
418     push @query_string, $add_query if $add_query;
419
420     my $path = join( '/', @path );
421     my $query_string = join( '&', @query_string );
422     $path .= '/' if $add_path and $add_path eq '/';
423     $path .= "?$query_string" if $query_string;
424
425     return $path;
426 }
427
428 sub make_search_url {
429     my ($add_path, $add_query, @override) = @_;
430     my (@path, @query_string) = ()x2;
431     my $override ||= {};
432     if (ref $override[0]) { 
433         $override = $override[0];
434     } elsif (@override) {
435         $override = { @override };
436     }
437
438     push @path, $Packages::Config::SEARCH_URL
439         if $Packages::Config::SEARCH_URL;
440     foreach my $p (qw(lang source suite archive section subsection
441                       arch exact mode searchon format debug)) {
442         my $val = $url_params{$p};
443         $val = $query_params{$p} if exists $query_params{$p};
444         $val = $override->{$p} if exists $override->{$p};
445         push @query_string, "$p=$val" if $val;
446     }
447     push @path, $add_path if $add_path;
448     push @query_string, $add_query if $add_query;
449
450     my $path = join( '/', @path );
451     my $query_string = join( '&amp;', @query_string );
452
453     return "$path?$query_string";
454 }
455
456 1;