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