X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=lib%2FPackages%2FCGI.pm;h=beb4e255e9844bc68b4a32006db528e1354e9bd6;hp=94986cba7a3c0860982ec3fce14b3f8a8daa5d26;hb=0c1a44893f94f98deac8435e6ab235228880087f;hpb=ab47ae363dddbc35743572c62fae6350dcb7cf96

diff --git a/lib/Packages/CGI.pm b/lib/Packages/CGI.pm
index 94986cb..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 '<div class="perror">';
-    foreach ((@fatal_errors, @errors)) {
-	print "<p>ERROR: $_</p>";
-    }
-    print '</div>';
-}
-sub print_debug {
+sub get_errors { (@fatal_errors, @errors) }
+sub get_debug {
     return unless $debug && @debug;
-    print '<div class="pdebug">';
-    print '<h2>Debugging:</h2><pre>';
-    foreach (@debug) {
-	print "$_\n";
-    }
-    print '</pre></div>';
-}
-sub print_hints {
-    return unless @hints;
-    print '<div class="phints">';
-    foreach (@hints) {
-	print "<p>$_</p>";
-    }
-    print '</div>';
-}
-sub print_msgs {
-    print '<div class="pmsgs">';
-    foreach (@msgs) {
-	print "<p>$_</p>";
-    }
-    print '</div>';
+    return @debug;
 }
-sub print_notes {
-    foreach (@notes) {
-	my ( $title, $note ) = @$_;
-
-	print '<div class="pnotes">';
-	if ($note) {
-	    print "<h2>$title</h2>";
-	} else {
-	    $note = $title;
-	}
-	print "<p>$note</p></div>";
-    }
+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 <strong>$param</strong>", 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)) {
@@ -416,24 +404,31 @@ sub make_url {
 	$val = $override->{$p} if exists $override->{$p};
 	push @query_string, "$p=$val" if $val;
     }
-    push @path, $add_path if $add_path;
+    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?$query_string";
+    return $path;
 }
 
 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};
@@ -443,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( '&amp;', @query_string );
 
     return "$path?$query_string";
 }