X-Git-Url: https://git.deb.at/w?a=blobdiff_plain;f=lib%2FPackages%2FCGI.pm;h=beb4e255e9844bc68b4a32006db528e1354e9bd6;hb=a27d9febd751f81ad7d48ce64a15ba68f36ff049;hp=e15e510f017edd512b27cb53426825844a524be4;hpb=e6999b858367d9d83e0fa2c32cddfd31b4416486;p=deb%2Fpackages.git diff --git a/lib/Packages/CGI.pm b/lib/Packages/CGI.pm index e15e510..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,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 '
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 "<<"; } - 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