X-Git-Url: https://git.deb.at/w?a=blobdiff_plain;f=lib%2FPackages%2FCGI.pm;h=0dded210ef0be99c43428de70fbf7444c217a41d;hb=a430a7f2c477de0e9952384e896e7c78cea3f32f;hp=e9d834cb16feffc43a17d2885e13457c7d4fb2ff;hpb=9c048903c83d44428f638e77df45daaf076362c6;p=deb%2Fpackages.git diff --git a/lib/Packages/CGI.pm b/lib/Packages/CGI.pm index e9d834c..0dded21 100644 --- a/lib/Packages/CGI.pm +++ b/lib/Packages/CGI.pm @@ -1,16 +1,24 @@ package Packages::CGI; +use strict; +use warnings; + use Exporter; +use Packages::Config; + our @ISA = qw( Exporter ); -our @EXPORT = qw( fatal_error error hint debug msg - print_errors print_hints print_debug print_msgs ); +our @EXPORT = qw( fatal_error error hint debug msg note + print_errors print_hints print_debug print_msgs + print_notes DEBUG make_url make_search_url ); +# define this to 0 in production mode +use constant DEBUG => 1; our $debug = 0; -our (@fatal_errors, @errors, @debug, @msgs, @hints); +our (@fatal_errors, @errors, @debug, @msgs, @hints, @notes); sub reset { - @fatal_errors = @errors = @debug = @msgs = @hints = (); + @fatal_errors = @errors = @debug = @msgs = @hints = @notes = (); } sub fatal_error { @@ -29,9 +37,12 @@ sub debug { sub msg { push @msgs, $_[0]; } +sub note { + push @notes, [ @_ ]; +} sub print_errors { return unless @fatal_errors || @errors; - print '
ERROR: $_
"; } @@ -39,26 +50,404 @@ sub print_errors { } sub print_debug { return unless $debug && @debug; - print ''; foreach (@debug) { print "$_\n"; } print '
$_
"; + print "$_
"; } print '$_
"; } + print '$note
$index_line
"; + } +} + +#sub multipageheader { +# my ( $input, $no_results, $opts ) = @_; +# +# my ($start, $end); +# if ($opts->{number} =~ /^all$/i) { +# $start = 1; +# $end = $no_results; +# $opts->{number} = $no_results; +# $opts->{number_all}++; +# } else { +# $start = Packages::Search::start( $opts ); +# $end = Packages::Search::end( $opts ); +# if ($end > $no_results) { $end = $no_results; } +# } +# +# print "Found $no_results matching packages,"; +# if ($end == $start) { +# print " displaying package $end.
"; +# } else { +# print " displaying packages $start to $end."; +# } +# +# printindexline( $input, $no_results, $opts ); +# +# if ($no_results > 100) { +# print "Results per page: "; +# my @resperpagelinks; +# for (50, 100, 200) { +# if ($opts->{number} == $_) { +# push @resperpagelinks, $_; +# } else { +# push @resperpagelinks, resperpagelink($input,$opts,$_); +# } +# } +# if ($opts->{number_all}) { +# push @resperpagelinks, "all"; +# } else { +# push @resperpagelinks, resperpagelink($input, $opts, "all"); +# } +# print join( " | ", @resperpagelinks )."
"; +# } +# return ( $start, $end ); +#} + +our ( %url_params, %query_params ); + +sub init_url { + my ($input, $params, $opts) = @_; + + %url_params = (); + %query_params = (); + + if ($params->{values}{lang}{orig} && + (my $l = $params->{values}{lang}{no_replace})) { + $url_params{lang} = $l; + } + if ($params->{values}{source}{no_replace}) { + $url_params{source} = 'source'; + $query_params{source} = 1; + } + foreach my $p (qw(suite arch)) { + if ($params->{values}{$p}{orig} + && (ref $params->{values}{$p}{final} eq 'ARRAY') + && @{$params->{values}{$p}{final}}) { + if (@{$params->{values}{$p}{final}} == 1) { + $url_params{$p} = $params->{values}{$p}{final}[0]; + } else { + $url_params{$p} = + join(",",@{$params->{values}{$p}{no_replace}}); + } + } + } + foreach my $p (qw(format searchon mode exact debug)) { + if ($params->{values}{$p}{orig} + && (my $pv = $params->{values}{$p}{no_replace})) { + $url_params{$p} = $pv; + } + } + + use Data::Dumper; + debug( join("\n",Dumper(\%url_params,\%query_params)), 2 ) if DEBUG; +} + +sub make_url { + my ($add_path, $add_query, $override) = @_; + my (@path, @query_string) = ()x2; + $override ||= {}; + + push @path, $Packages::Config::ROOT; + foreach my $p (qw(lang source suite archive arch)) { + my $val = $url_params{$p}; + $val = $override->{$p} if exists $override->{$p}; + push @path, $val if $val; + } + foreach my $p (qw(format debug)) { + my $val = $url_params{$p}; + $val = $query_params{$p} if exists $query_params{$p}; + $val = $override->{$p} if exists $override->{$p}; + push @query_string, "$p=$val" if $val; + } + push @path, $add_path if $add_path and $add_path ne '/'; + push @query_string, $add_query if $add_query; + + my $path = join( '/', @path ); + my $query_string = join( '&', @query_string ); + $path .= '/' if $add_path and $add_path eq '/'; + $path .= "?$query_string" if $query_string; + + return $path; +} + +sub make_search_url { + my ($add_path, $add_query, $override) = @_; + my (@path, @query_string) = ()x2; + $override ||= {}; + + push @path, $Packages::Config::SEARCH_URL + if $Packages::Config::SEARCH_URL; + foreach my $p (qw(lang source suite archive section subsection + arch exact mode searchon format debug)) { + my $val = $url_params{$p}; + $val = $query_params{$p} if exists $query_params{$p}; + $val = $override->{$p} if exists $override->{$p}; + push @query_string, "$p=$val" if $val; + } + push @path, $add_path if $add_path; + push @query_string, $add_query if $add_query; + + my $path = join( '/', @path ); + my $query_string = join( '&', @query_string ); + + return "$path?$query_string"; } 1;