9 our @ISA = qw( Exporter );
10 our @EXPORT = qw( DEBUG debug fatal_error get_mime );
11 our @EXPORT_OK = qw( error hint msg note get_all_messages
12 make_url make_search_url );
14 # define this to 0 in production mode
15 use constant DEBUG => 1;
20 'txt.gz' => 'text/plain',
22 rss => 'application/rss+xml',
26 return $mime_types{$_[0]} || $_[1] || 'text/html';
29 our (@fatal_errors, @errors, @debug, @msgs, @hints, @notes);
32 @fatal_errors = @errors = @debug = @msgs = @hints = @notes = ();
36 push @fatal_errors, $_[0];
46 push(@debug, $_[0]) if $debug > $lvl;
54 sub get_errors { (@fatal_errors, @errors) }
56 return unless $debug && @debug;
59 sub get_msgs { @msgs };
60 sub get_hints { @hints };
61 sub get_notes { @notes };
62 sub get_all_messages {
64 errors => [ @fatal_errors, @errors ],
65 debugs => $debug ? \@debug : [],
72 our $USE_PAGED_MODE = 1;
73 use constant DEFAULT_PAGE => 1;
74 use constant DEFAULT_RES_PER_PAGE => 50;
75 our %page_params = ( page => { default => DEFAULT_PAGE,
77 number => { default => DEFAULT_RES_PER_PAGE,
81 my ( $cgi, $params_def, $opts ) = @_;
83 my %params_ret = ( values => {}, errors => {} );
85 if ($USE_PAGED_MODE) {
86 debug( "Use PAGED_MODE", 2 ) if DEBUG;
87 %params = %$params_def;
88 foreach (keys %page_params) {
91 %params = ( %params, %page_params );
93 %params = %$params_def;
96 foreach my $param ( keys %params ) {
98 debug( "Param <strong>$param</strong>", 2 ) if DEBUG;
100 my $p_value_orig = $cgi->param($param);
102 if (!defined($p_value_orig)
103 && defined $params_def->{$param}{alias}
104 && defined $cgi->param($params_def->{$param}{alias})) {
105 $p_value_orig = $cgi->param($params_def->{$param}{alias});
106 debug( "Used alias <strong>$params_def->{$param}{alias}</strong>",
110 my @p_value = ($p_value_orig);
112 debug( "Value (Orig) ".($p_value_orig||""), 2 ) if DEBUG;
114 if ($params_def->{$param}{array} && defined $p_value_orig) {
115 @p_value = split /$params_def->{$param}{array}/, $p_value_orig;
116 debug( "Value (Array Split) ". join('##',@p_value), 2 ) if DEBUG;
119 if ($params_def->{$param}{match} && defined $p_value_orig) {
121 { $_ =~ m/$params_def->{$param}{match}/; $_ = $1 }
124 @p_value = grep { defined $_ } @p_value;
126 debug( "Value (Match) ". join('##',@p_value), 2 ) if DEBUG;
129 if (defined $params{$param}{default}) {
130 @p_value = ($params{$param}{default});
133 $params_ret{errors}{$param} = "undef";
138 debug( "Value (Default) ". join('##',@p_value), 2 ) if DEBUG;
139 my @p_value_no_replace = @p_value;
141 if ($params{$param}{replace} && @p_value) {
142 foreach my $pattern (keys %{$params{$param}{replace}}) {
143 my @p_value_tmp = @p_value;
145 foreach (@p_value_tmp) {
146 if ($_ eq $pattern) {
147 my $replacement = $params{$param}{replace}{$_};
148 if (ref $replacement) {
149 push @p_value, @$replacement;
151 push @p_value, $replacement;
160 debug( "Value (Final) ". join('##',@p_value), 2 ) if DEBUG;
162 if ($params_def->{$param}{array}) {
163 $params_ret{values}{$param} = {
164 orig => $p_value_orig,
165 no_replace => \@p_value_no_replace,
168 @{$params_def->{$param}{var}} = @p_value
169 if $params_def->{$param}{var};
171 $params_ret{values}{$param} = {
172 orig => $p_value_orig,
173 no_replace => $p_value_no_replace[0],
174 final => $p_value[0],
176 ${$params_def->{$param}{var}} = $p_value[0]
177 if $params_def->{$param}{var};
179 $opts->{$param} = $params_ret{values}{$param}{final} if $opts;
182 if ($USE_PAGED_MODE) {
183 $cgi->delete( "page" );
184 $cgi->delete( "number" );
193 my $page = $params->{values}{page}{final}
195 my $res_per_page = $params->{values}{number}{final}
196 || DEFAULT_RES_PER_PAGE;
198 return 1 if $res_per_page =~ /^all$/i;
199 return $res_per_page * ($page - 1) + 1;
206 debug( "end: ".Dumper($params) ) if DEBUG;
207 my $page = $params->{page}
209 my $res_per_page = $params->{number}
210 || DEFAULT_RES_PER_PAGE;
212 return $page * $res_per_page;
216 my ($cgi, $params, $num_res) = @_;
219 my $page = $params->{page}
221 my $res_per_page = $params->{number}
222 || DEFAULT_RES_PER_PAGE;
223 my $numpages = ceil($num_res /
225 for (my $i = 1; $i <= $numpages; $i++) {
229 $index_line .= "<a href=\"".encode_entities($cgi->self_url).
230 "&page=$i&number=$res_per_page\">".
233 if ($i < $numpages) {
234 $index_line .= " | ";
241 my ($cgi, $params, $no_results ) = @_;
243 my $page = $params->{page}
246 my $res_per_page = $params->{number}
247 || DEFAULT_RES_PER_PAGE;
249 if ((($page-1)*$res_per_page + 1) > $no_results) {
253 return "<a href=\"".encode_entities($cgi->self_url).
254 "&page=$page&number=$res_per_page\">>></a>";
258 my ($cgi, $params ) = @_;
260 my $page = $params->{page}
267 my $res_per_page = $params->{number}
268 || DEFAULT_RES_PER_PAGE;
270 return "<a href=\"".encode_entities($cgi->self_url).
271 "&page=$page&number=$res_per_page\"><<</a>";
275 my ($cgi, $params, $res_per_page ) = @_;
278 if ($res_per_page =~ /^all$/i) {
281 $page = ceil(start( $params ) / $res_per_page);
284 return "<a href=\"".encode_entities($cgi->self_url).
285 "&page=$page&number=$res_per_page\">$res_per_page</a>";
289 my ( $input, $no_results, $opts ) = @_;
292 if ($no_results > $opts->{number}) {
294 $index_line = prevlink( $input, $opts)." | ".
295 indexline( $input, $opts, $no_results)." | ".
296 nextlink( $input, $opts, $no_results);
298 print "<p style=\"text-align:center\">$index_line</p>";
302 #sub multipageheader {
303 # my ( $input, $no_results, $opts ) = @_;
306 # if ($opts->{number} =~ /^all$/i) {
308 # $end = $no_results;
309 # $opts->{number} = $no_results;
310 # $opts->{number_all}++;
312 # $start = Packages::Search::start( $opts );
313 # $end = Packages::Search::end( $opts );
314 # if ($end > $no_results) { $end = $no_results; }
317 # print "<p>Found <em>$no_results</em> matching packages,";
318 # if ($end == $start) {
319 # print " displaying package $end.</p>";
321 # print " displaying packages $start to $end.</p>";
324 # printindexline( $input, $no_results, $opts );
326 # if ($no_results > 100) {
327 # print "<p>Results per page: ";
328 # my @resperpagelinks;
329 # for (50, 100, 200) {
330 # if ($opts->{number} == $_) {
331 # push @resperpagelinks, $_;
333 # push @resperpagelinks, resperpagelink($input,$opts,$_);
336 # if ($opts->{number_all}) {
337 # push @resperpagelinks, "all";
339 # push @resperpagelinks, resperpagelink($input, $opts, "all");
341 # print join( " | ", @resperpagelinks )."</p>";
343 # return ( $start, $end );
349 $string =~ s/[^\w]/_/g;
353 our ( %url_params, %query_params );
356 my ($input, $params, $opts) = @_;
361 if ($params->{values}{lang}{orig} &&
362 (my $l = $params->{values}{lang}{no_replace})) {
363 $url_params{lang} = $l;
365 if ($params->{values}{source}{no_replace}) {
366 $url_params{source} = 'source';
367 $query_params{source} = 1;
369 foreach my $p (qw(suite arch)) {
370 if ($params->{values}{$p}{orig}
371 && (ref $params->{values}{$p}{final} eq 'ARRAY')
372 && @{$params->{values}{$p}{final}}) {
373 if (@{$params->{values}{$p}{final}} == 1) {
374 $url_params{$p} = $params->{values}{$p}{final}[0];
377 join(",",@{$params->{values}{$p}{no_replace}});
381 foreach my $p (qw(format searchon mode exact debug)) {
382 if ($params->{values}{$p}{orig}
383 && (my $pv = $params->{values}{$p}{no_replace})) {
384 $url_params{$p} = $pv;
389 debug( join("\n",Dumper(\%url_params,\%query_params)), 2 ) if DEBUG;
393 my ($add_path, $add_query, @override) = @_;
394 my (@path, @query_string) = ()x2;
396 if (ref $override[0]) {
397 $override = $override[0];
398 } elsif (@override) {
399 $override = { @override };
402 push @path, $Packages::Config::ROOT;
403 foreach my $p (qw(lang source suite archive arch)) {
404 my $val = $url_params{$p};
405 $val = $override->{$p} if exists $override->{$p};
406 push @path, $val if $val;
408 foreach my $p (qw(format debug)) {
409 my $val = $url_params{$p};
410 $val = $query_params{$p} if exists $query_params{$p};
411 $val = $override->{$p} if exists $override->{$p};
412 push @query_string, "$p=$val" if $val;
414 push @path, $add_path if $add_path and $add_path ne '/';
415 push @query_string, $add_query if $add_query;
417 my $path = join( '/', @path );
418 my $query_string = join( '&', @query_string );
419 $path .= '/' if $add_path and $add_path eq '/';
420 $path .= "?$query_string" if $query_string;
425 sub make_search_url {
426 my ($add_path, $add_query, @override) = @_;
427 my (@path, @query_string) = ()x2;
429 if (ref $override[0]) {
430 $override = $override[0];
431 } elsif (@override) {
432 $override = { @override };
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;
444 push @path, $add_path if $add_path;
445 push @query_string, $add_query if $add_query;
447 my $path = join( '/', @path );
448 my $query_string = join( '&', @query_string );
450 return "$path?$query_string";