X-Git-Url: https://git.deb.at/w?a=blobdiff_plain;f=lib%2FPackages%2FCGI.pm;h=beb4e255e9844bc68b4a32006db528e1354e9bd6;hb=cd80f50e4bba8ac28df7b3185ae94ce12520e2f2;hp=b8607c933781104bb4f70d3502460374b2b0ce7f;hpb=8d29452530e823cbcd07a30898e98abe565a046c;p=deb%2Fpackages.git
diff --git a/lib/Packages/CGI.pm b/lib/Packages/CGI.pm
index b8607c9..beb4e25 100644
--- a/lib/Packages/CGI.pm
+++ b/lib/Packages/CGI.pm
@@ -4,25 +4,39 @@ use strict;
use warnings;
use Exporter;
-use Packages::Config;
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 make_url make_search_url );
+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];
@@ -34,56 +48,18 @@ sub debug {
my $lvl = $_[1] || 0;
push(@debug, $_[0]) if $debug > $lvl;
}
-sub msg {
- push @msgs, $_[0];
-}
-sub note {
- push @notes, [ @_ ];
-}
-sub print_errors {
- return unless @fatal_errors || @errors;
- print '
';
- foreach ((@fatal_errors, @errors)) {
- print "
ERROR: $_
";
- }
- print '
';
-}
-sub print_debug {
+sub get_errors { (@fatal_errors, @errors) }
+sub get_debug {
return unless $debug && @debug;
- print '';
- print '
Debugging:
';
- foreach (@debug) {
- print "$_\n";
- }
- print '
';
-}
-sub print_hints {
- return unless @hints;
- print '';
- foreach (@hints) {
- print "
$_
";
- }
- print '
';
-}
-sub print_msgs {
- print '';
- foreach (@msgs) {
- print "
$_
";
- }
- print '
';
+ return @debug;
}
-sub print_notes {
- foreach (@notes) {
- my ( $title, $note ) = @$_;
-
- print '';
- if ($note) {
- print "
$title
";
- } else {
- $note = $title;
- }
- print "
$note
";
- }
+sub get_hints { @hints };
+sub get_all_messages {
+ return {
+ errors => [ @fatal_errors, @errors ],
+ debugs => $debug ? \@debug : [],
+ hints => \@hints,
+ };
}
our $USE_PAGED_MODE = 1;
@@ -112,7 +88,7 @@ sub parse_params {
foreach my $param ( keys %params ) {
- debug( "Param $param", 2 ) if DEBUG;
+ debug( "Param $param", 2 ) if DEBUG;
my $p_value_orig = $cgi->param($param);
@@ -360,6 +336,13 @@ sub printindexline {
# return ( $start, $end );
#}
+sub string2id {
+ my $string = "@_";
+
+ $string =~ s/[^\w:.-]/_/g;
+ return $string;
+}
+
our ( %url_params, %query_params );
sub init_url {
@@ -400,9 +383,14 @@ sub init_url {
}
sub make_url {
- my ($add_path, $add_query, $override) = @_;
+ my ($add_path, $add_query, @override) = @_;
my (@path, @query_string) = ()x2;
- $override ||= {};
+ 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)) {
@@ -428,14 +416,19 @@ sub make_url {
}
sub make_search_url {
- my ($add_path, $add_query, $override) = @_;
+ my ($add_path, $add_query, @override) = @_;
my (@path, @query_string) = ()x2;
- $override ||= {};
+ 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
- exact mode searchon format debug)) {
+ 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};
@@ -445,7 +438,7 @@ sub make_search_url {
push @query_string, $add_query if $add_query;
my $path = join( '/', @path );
- my $query_string = join( '&', @query_string );
+ my $query_string = join( '&', @query_string );
return "$path?$query_string";
}