X-Git-Url: https://git.deb.at/?a=blobdiff_plain;f=lib%2FPackages%2FCGI.pm;h=beb4e255e9844bc68b4a32006db528e1354e9bd6;hb=17913bc92f23cb3cd03978f24825f4f8823dfb8f;hp=cac499fbc45658ddcf32663f9b20fc46592b2d01;hpb=08852aab550de858d4e4956ea357dbc3ae713a26;p=deb%2Fpackages.git diff --git a/lib/Packages/CGI.pm b/lib/Packages/CGI.pm index cac499f..beb4e25 100644 --- a/lib/Packages/CGI.pm +++ b/lib/Packages/CGI.pm @@ -1,21 +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 ); +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]; @@ -27,55 +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 notes { - 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 '
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 (@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 '
$_
"; + +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 '$_
"; + +sub prevlink { + my ($cgi, $params ) = @_; + + my $page = $params->{page} + || DEFAULT_PAGE; + $page--; + if (!$page) { + return "<<"; } + + 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 ) = @$_; - my $str = ""; - if ($note) { - $str .= "$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; } - $str .= "$note
"; - return $str; } + + 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;