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',
23 rfc822 => 'text/plain',
27 return $mime_types{$_[0]} || $_[1] || 'text/html';
30 our (@fatal_errors, @errors, @debug, @msgs, @hints, @notes);
34 @fatal_errors = @errors = @debug = @msgs = @hints = @notes = ();
39 push @fatal_errors, $_[0];
40 $http_code = $_[1] if $_[1];
50 push(@debug, $_[0]) if $debug > $lvl;
58 sub get_errors { (@fatal_errors, @errors) }
60 return unless $debug && @debug;
63 sub get_msgs { @msgs };
64 sub get_hints { @hints };
65 sub get_notes { @notes };
66 sub get_all_messages {
68 errors => [ @fatal_errors, @errors ],
69 debugs => $debug ? \@debug : [],
76 our $USE_PAGED_MODE = 1;
77 use constant DEFAULT_PAGE => 1;
78 use constant DEFAULT_RES_PER_PAGE => 50;
79 our %page_params = ( page => { default => DEFAULT_PAGE,
81 number => { default => DEFAULT_RES_PER_PAGE,
85 my ( $cgi, $params_def, $opts ) = @_;
87 my %params_ret = ( values => {}, errors => {} );
89 if ($USE_PAGED_MODE) {
90 debug( "Use PAGED_MODE", 2 ) if DEBUG;
91 %params = %$params_def;
92 foreach (keys %page_params) {
95 %params = ( %params, %page_params );
97 %params = %$params_def;
100 foreach my $param ( keys %params ) {
102 debug( "Param <strong>$param</strong>", 2 ) if DEBUG;
104 my $p_value_orig = $cgi->param($param);
106 if (!defined($p_value_orig)
107 && defined $params_def->{$param}{alias}
108 && defined $cgi->param($params_def->{$param}{alias})) {
109 $p_value_orig = $cgi->param($params_def->{$param}{alias});
110 debug( "Used alias <strong>$params_def->{$param}{alias}</strong>",
114 my @p_value = ($p_value_orig);
116 debug( "Value (Orig) ".($p_value_orig||""), 2 ) if DEBUG;
118 if ($params_def->{$param}{array} && defined $p_value_orig) {
119 @p_value = split /$params_def->{$param}{array}/, $p_value_orig;
120 debug( "Value (Array Split) ". join('##',@p_value), 2 ) if DEBUG;
123 if ($params_def->{$param}{match} && defined $p_value_orig) {
125 { $_ =~ m/$params_def->{$param}{match}/; $_ = $1 }
128 @p_value = grep { defined $_ } @p_value;
130 debug( "Value (Match) ". join('##',@p_value), 2 ) if DEBUG;
133 if (defined $params{$param}{default}) {
134 @p_value = ($params{$param}{default});
137 $params_ret{errors}{$param} = "undef";
142 debug( "Value (Default) ". join('##',@p_value), 2 ) if DEBUG;
143 my @p_value_no_replace = @p_value;
145 if ($params{$param}{replace} && @p_value) {
146 foreach my $pattern (keys %{$params{$param}{replace}}) {
147 my @p_value_tmp = @p_value;
149 foreach (@p_value_tmp) {
150 if ($_ eq $pattern) {
151 my $replacement = $params{$param}{replace}{$_};
152 if (ref $replacement) {
153 push @p_value, @$replacement;
155 push @p_value, $replacement;
164 debug( "Value (Final) ". join('##',@p_value), 2 ) if DEBUG;
166 if ($params_def->{$param}{array}) {
167 $params_ret{values}{$param} = {
168 orig => $p_value_orig,
169 no_replace => \@p_value_no_replace,
172 @{$params_def->{$param}{var}} = @p_value
173 if $params_def->{$param}{var};
175 $params_ret{values}{$param} = {
176 orig => $p_value_orig,
177 no_replace => $p_value_no_replace[0],
178 final => $p_value[0],
180 ${$params_def->{$param}{var}} = $p_value[0]
181 if $params_def->{$param}{var};
183 $opts->{$param} = $params_ret{values}{$param}{final} if $opts;
186 if ($USE_PAGED_MODE) {
187 $cgi->delete( "page" );
188 $cgi->delete( "number" );
197 my $page = $params->{values}{page}{final}
199 my $res_per_page = $params->{values}{number}{final}
200 || DEFAULT_RES_PER_PAGE;
202 return 1 if $res_per_page =~ /^all$/i;
203 return $res_per_page * ($page - 1) + 1;
210 debug( "end: ".Dumper($params) ) if DEBUG;
211 my $page = $params->{page}
213 my $res_per_page = $params->{number}
214 || DEFAULT_RES_PER_PAGE;
216 return $page * $res_per_page;
220 my ($cgi, $params, $num_res) = @_;
223 my $page = $params->{page}
225 my $res_per_page = $params->{number}
226 || DEFAULT_RES_PER_PAGE;
227 my $numpages = ceil($num_res /
229 for (my $i = 1; $i <= $numpages; $i++) {
233 $index_line .= "<a href=\"".encode_entities($cgi->self_url).
234 "&page=$i&number=$res_per_page\">".
237 if ($i < $numpages) {
238 $index_line .= " | ";
245 my ($cgi, $params, $no_results ) = @_;
247 my $page = $params->{page}
250 my $res_per_page = $params->{number}
251 || DEFAULT_RES_PER_PAGE;
253 if ((($page-1)*$res_per_page + 1) > $no_results) {
257 return "<a href=\"".encode_entities($cgi->self_url).
258 "&page=$page&number=$res_per_page\">>></a>";
262 my ($cgi, $params ) = @_;
264 my $page = $params->{page}
271 my $res_per_page = $params->{number}
272 || DEFAULT_RES_PER_PAGE;
274 return "<a href=\"".encode_entities($cgi->self_url).
275 "&page=$page&number=$res_per_page\"><<</a>";
279 my ($cgi, $params, $res_per_page ) = @_;
282 if ($res_per_page =~ /^all$/i) {
285 $page = ceil(start( $params ) / $res_per_page);
288 return "<a href=\"".encode_entities($cgi->self_url).
289 "&page=$page&number=$res_per_page\">$res_per_page</a>";
293 my ( $input, $no_results, $opts ) = @_;
296 if ($no_results > $opts->{number}) {
298 $index_line = prevlink( $input, $opts)." | ".
299 indexline( $input, $opts, $no_results)." | ".
300 nextlink( $input, $opts, $no_results);
302 print "<p style=\"text-align:center\">$index_line</p>";
306 #sub multipageheader {
307 # my ( $input, $no_results, $opts ) = @_;
310 # if ($opts->{number} =~ /^all$/i) {
312 # $end = $no_results;
313 # $opts->{number} = $no_results;
314 # $opts->{number_all}++;
316 # $start = Packages::Search::start( $opts );
317 # $end = Packages::Search::end( $opts );
318 # if ($end > $no_results) { $end = $no_results; }
321 # print "<p>Found <em>$no_results</em> matching packages,";
322 # if ($end == $start) {
323 # print " displaying package $end.</p>";
325 # print " displaying packages $start to $end.</p>";
328 # printindexline( $input, $no_results, $opts );
330 # if ($no_results > 100) {
331 # print "<p>Results per page: ";
332 # my @resperpagelinks;
333 # for (50, 100, 200) {
334 # if ($opts->{number} == $_) {
335 # push @resperpagelinks, $_;
337 # push @resperpagelinks, resperpagelink($input,$opts,$_);
340 # if ($opts->{number_all}) {
341 # push @resperpagelinks, "all";
343 # push @resperpagelinks, resperpagelink($input, $opts, "all");
345 # print join( " | ", @resperpagelinks )."</p>";
347 # return ( $start, $end );
353 $string =~ s/[^\w]/_/g;
357 our ( %url_params, %query_params );
360 my ($input, $params, $opts) = @_;
365 if ($params->{values}{lang}{orig} &&
366 (my $l = $params->{values}{lang}{no_replace})) {
367 $url_params{lang} = $l;
369 if ($params->{values}{source}{no_replace}) {
370 $url_params{source} = 'source';
371 $query_params{source} = 1;
373 foreach my $p (qw(suite arch)) {
374 if ($params->{values}{$p}{orig}
375 && (ref $params->{values}{$p}{final} eq 'ARRAY')
376 && @{$params->{values}{$p}{final}}) {
377 if (@{$params->{values}{$p}{final}} == 1) {
378 $url_params{$p} = $params->{values}{$p}{final}[0];
381 join(",",@{$params->{values}{$p}{no_replace}});
385 foreach my $p (qw(format searchon mode exact debug)) {
386 if ($params->{values}{$p}{orig}
387 && (my $pv = $params->{values}{$p}{no_replace})) {
388 $url_params{$p} = $pv;
393 debug( join("\n",Dumper(\%url_params,\%query_params)), 2 ) if DEBUG;
397 my ($add_path, $add_query, @override) = @_;
398 my (@path, @query_string) = ()x2;
400 if (ref $override[0]) {
401 $override = $override[0];
402 } elsif (@override) {
403 $override = { @override };
406 push @path, $Packages::Config::ROOT;
407 foreach my $p (qw(lang source suite archive arch)) {
408 my $val = $url_params{$p};
409 $val = $override->{$p} if exists $override->{$p};
410 push @path, $val if $val;
412 foreach my $p (qw(format debug)) {
413 my $val = $url_params{$p};
414 $val = $query_params{$p} if exists $query_params{$p};
415 $val = $override->{$p} if exists $override->{$p};
416 push @query_string, "$p=$val" if $val;
418 push @path, $add_path if $add_path and $add_path ne '/';
419 push @query_string, $add_query if $add_query;
421 my $path = join( '/', @path );
422 my $query_string = join( '&', @query_string );
423 $path .= '/' if $add_path and $add_path eq '/';
424 $path .= "?$query_string" if $query_string;
429 sub make_search_url {
430 my ($add_path, $add_query, @override) = @_;
431 my (@path, @query_string) = ()x2;
433 if (ref $override[0]) {
434 $override = $override[0];
435 } elsif (@override) {
436 $override = { @override };
439 push @path, $Packages::Config::SEARCH_URL
440 if $Packages::Config::SEARCH_URL;
441 foreach my $p (qw(lang source suite archive section subsection
442 arch exact mode searchon format debug)) {
443 my $val = $url_params{$p};
444 $val = $query_params{$p} if exists $query_params{$p};
445 $val = $override->{$p} if exists $override->{$p};
446 push @query_string, "$p=$val" if $val;
448 push @path, $add_path if $add_path;
449 push @query_string, $add_query if $add_query;
451 my $path = join( '/', @path );
452 my $query_string = join( '&', @query_string );
454 return "$path?$query_string";