X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=lib%2FPackages%2FCGI.pm;h=beb4e255e9844bc68b4a32006db528e1354e9bd6;hp=66b442d79b4ec295e45020e31fb2732e95b79702;hb=0c1a44893f94f98deac8435e6ab235228880087f;hpb=f27f1fcc5bffc0696f694e962eb40dbb0c554855 diff --git a/lib/Packages/CGI.pm b/lib/Packages/CGI.pm index 66b442d..beb4e25 100644 --- a/lib/Packages/CGI.pm +++ b/lib/Packages/CGI.pm @@ -1,23 +1,42 @@ package Packages::CGI; +use strict; +use warnings; + use Exporter; + our @ISA = qw( Exporter ); -our @EXPORT = qw( fatal_error error hint debug msg note - print_errors print_hints print_debug print_msgs - print_notes DEBUG ); +our @EXPORT = qw( DEBUG debug fatal_error get_mime ); +our @EXPORT_OK = qw( error hint msg note get_all_messages + 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, @notes); +my %mime_types = ( + txt => 'text/plain', + 'txt.gz' => 'text/plain', + html => 'text/html', + rss => 'application/rss+xml', + rfc822 => 'text/plain', + ); + +sub get_mime { + return $mime_types{$_[0]} || $_[1] || 'text/html'; +} + +our (@fatal_errors, @errors, @debug, @hints); +our $http_code; sub reset { - @fatal_errors = @errors = @debug = @msgs = @hints = @notes = (); + @fatal_errors = @errors = @debug = @hints = (); + $http_code = 200; } sub fatal_error { push @fatal_errors, $_[0]; + $http_code = $_[1] if $_[1]; } sub error { push @errors, $_[0]; @@ -29,56 +48,399 @@ sub debug { my $lvl = $_[1] || 0; push(@debug, $_[0]) if $debug > $lvl; } -sub msg { - push @msgs, $_[0]; +sub get_errors { (@fatal_errors, @errors) } +sub get_debug { + return unless $debug && @debug; + return @debug; } -sub note { - push @notes, [ @_ ]; +sub get_hints { @hints }; +sub get_all_messages { + return { + errors => [ @fatal_errors, @errors ], + debugs => $debug ? \@debug : [], + hints => \@hints, + }; } -sub print_errors { - return unless @fatal_errors || @errors; - print '
'; - foreach ((@fatal_errors, @errors)) { - print "

ERROR: $_

"; + +our $USE_PAGED_MODE = 1; +use constant DEFAULT_PAGE => 1; +use constant DEFAULT_RES_PER_PAGE => 50; +our %page_params = ( page => { default => DEFAULT_PAGE, + match => '(\d+)' }, + number => { default => DEFAULT_RES_PER_PAGE, + match => '(\d+)' } ); + +sub parse_params { + my ( $cgi, $params_def, $opts ) = @_; + + my %params_ret = ( values => {}, errors => {} ); + my %params; + if ($USE_PAGED_MODE) { + debug( "Use PAGED_MODE", 2 ) if DEBUG; + %params = %$params_def; + foreach (keys %page_params) { + delete $params{$_}; + } + %params = ( %params, %page_params ); + } else { + %params = %$params_def; } - print '
'; + + foreach my $param ( keys %params ) { + + debug( "Param $param", 2 ) if DEBUG; + + my $p_value_orig = $cgi->param($param); + + if (!defined($p_value_orig) + && defined $params_def->{$param}{alias} + && defined $cgi->param($params_def->{$param}{alias})) { + $p_value_orig = $cgi->param($params_def->{$param}{alias}); + debug( "Used alias $params_def->{$param}{alias}", + 2 ); + } + + my @p_value = ($p_value_orig); + + debug( "Value (Orig) ".($p_value_orig||""), 2 ) if DEBUG; + + if ($params_def->{$param}{array} && defined $p_value_orig) { + @p_value = split /$params_def->{$param}{array}/, $p_value_orig; + debug( "Value (Array Split) ". join('##',@p_value), 2 ) if DEBUG; + } + + if ($params_def->{$param}{match} && defined $p_value_orig) { + @p_value = map + { $_ =~ m/$params_def->{$param}{match}/; $_ = $1 } + @p_value; + } + @p_value = grep { defined $_ } @p_value; + + debug( "Value (Match) ". join('##',@p_value), 2 ) if DEBUG; + + unless (@p_value) { + if (defined $params{$param}{default}) { + @p_value = ($params{$param}{default}); + } else { + @p_value = undef; + $params_ret{errors}{$param} = "undef"; + next; + } + } + + debug( "Value (Default) ". join('##',@p_value), 2 ) if DEBUG; + my @p_value_no_replace = @p_value; + + if ($params{$param}{replace} && @p_value) { + foreach my $pattern (keys %{$params{$param}{replace}}) { + my @p_value_tmp = @p_value; + @p_value = (); + foreach (@p_value_tmp) { + if ($_ eq $pattern) { + my $replacement = $params{$param}{replace}{$_}; + if (ref $replacement) { + push @p_value, @$replacement; + } else { + push @p_value, $replacement; + } + } else { + push @p_value, $_; + } + } + } + } + + debug( "Value (Final) ". join('##',@p_value), 2 ) if DEBUG; + + if ($params_def->{$param}{array}) { + $params_ret{values}{$param} = { + orig => $p_value_orig, + no_replace => \@p_value_no_replace, + final => \@p_value, + }; + @{$params_def->{$param}{var}} = @p_value + if $params_def->{$param}{var}; + } else { + $params_ret{values}{$param} = { + orig => $p_value_orig, + no_replace => $p_value_no_replace[0], + final => $p_value[0], + }; + ${$params_def->{$param}{var}} = $p_value[0] + if $params_def->{$param}{var}; + } + $opts->{$param} = $params_ret{values}{$param}{final} if $opts; + } + + if ($USE_PAGED_MODE) { + $cgi->delete( "page" ); + $cgi->delete( "number" ); + } + + return %params_ret; } -sub print_debug { - return unless $debug && @debug; - print '
'; - print '

Debugging:

';
-    foreach (@debug) {
-	print "$_\n";
+
+sub start { 
+    my $params = shift;
+
+    my $page = $params->{values}{page}{final}
+    || DEFAULT_PAGE;
+    my $res_per_page = $params->{values}{number}{final}
+    || DEFAULT_RES_PER_PAGE;
+
+    return 1 if $res_per_page =~ /^all$/i;
+    return $res_per_page * ($page - 1) + 1;
+}
+
+sub end {
+    my $params = shift;
+
+    use Data::Dumper;
+    debug( "end: ".Dumper($params) ) if DEBUG;
+    my $page = $params->{page}
+    || DEFAULT_PAGE;
+    my $res_per_page = $params->{number}
+    || DEFAULT_RES_PER_PAGE;
+
+    return $page * $res_per_page;
+}
+
+sub indexline {
+    my ($cgi, $params, $num_res) = @_;
+
+    my $index_line = "";
+    my $page = $params->{page}
+    || DEFAULT_PAGE;
+    my $res_per_page = $params->{number}
+    || DEFAULT_RES_PER_PAGE;
+    my $numpages = ceil($num_res /
+                        $res_per_page);
+    for (my $i = 1; $i <= $numpages; $i++) {
+        if ($i == $page) {
+            $index_line .= $i;
+        } else {
+            $index_line .= "self_url).
+                "&page=$i&number=$res_per_page\">".
+                "$i";
+        }
+	if ($i < $numpages) {
+	   $index_line .= " | ";
+	}
     }
-    print '
'; + return $index_line; } -sub print_hints { - return unless @hints; - print '
'; - foreach (@hints) { - print "

$_

"; + +sub nextlink { + my ($cgi, $params, $no_results ) = @_; + + my $page = $params->{page} + || DEFAULT_PAGE; + $page++; + my $res_per_page = $params->{number} + || DEFAULT_RES_PER_PAGE; + + if ((($page-1)*$res_per_page + 1) > $no_results) { + return ">>"; } - print '
'; + + return "self_url). + "&page=$page&number=$res_per_page\">>>"; } -sub print_msgs { - print '
'; - foreach (@msgs) { - print "

$_

"; + +sub prevlink { + my ($cgi, $params ) = @_; + + my $page = $params->{page} + || DEFAULT_PAGE; + $page--; + if (!$page) { + return "<<"; } - print '
'; + + my $res_per_page = $params->{number} + || DEFAULT_RES_PER_PAGE; + + return "self_url). + "&page=$page&number=$res_per_page\"><<"; } -sub print_notes { - foreach (@notes) { - my ( $title, $note ) = @$_; - print '
'; - if ($note) { - print "

$title

"; - } else { - $note = $title; +sub resperpagelink { + my ($cgi, $params, $res_per_page ) = @_; + + my $page; + if ($res_per_page =~ /^all$/i) { + $page = 1; + } else { + $page = ceil(start( $params ) / $res_per_page); + } + + return "self_url). + "&page=$page&number=$res_per_page\">$res_per_page"; +} + +sub printindexline { + my ( $input, $no_results, $opts ) = @_; + + my $index_line; + if ($no_results > $opts->{number}) { + + $index_line = prevlink( $input, $opts)." | ". + indexline( $input, $opts, $no_results)." | ". + nextlink( $input, $opts, $no_results); + + print "

$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 ); +#} + +sub string2id { + my $string = "@_"; + + $string =~ s/[^\w:.-]/_/g; + return $string; +} + +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; } - print "

$note

"; } + + 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; + my $override = {}; + if (ref $override[0]) { + $override = $override[0]; + } elsif (@override) { + $override = { @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; + my $override ||= {}; + if (ref $override[0]) { + $override = $override[0]; + } elsif (@override) { + $override = { @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;