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