lib/Packages/CGI.pm

   1 package Packages::CGI;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7
   8 our @ISA = qw( Exporter );
   9 our @EXPORT = qw( DEBUG debug fatal_error get_mime );
  10 our @EXPORT_OK = qw( error hint msg note get_all_messages
  11                      make_url make_search_url );
  12
  13 # define this to 0 in production mode
  14 use constant DEBUG => 1;
  15 our $debug = 0;
  16
  17 my %mime_types = (
  18                   txt => 'text/plain',
  19                   'txt.gz' => 'text/plain',
  20                   html => 'text/html',
  21                   rss => 'application/rss+xml',
  22                   rfc822 => 'text/plain',
  23                   );
  24
  25 sub get_mime {
  26     return $mime_types{$_[0]} || $_[1] || 'text/html';
  27 }
  28
  29 our (@fatal_errors, @errors, @debug, @hints);
  30 our $http_code;
  31
  32 sub reset {
  33     @fatal_errors = @errors = @debug = @hints = ();
  34     $http_code = 200;
  35 }
  36
  37 sub fatal_error {
  38     push @fatal_errors, $_[0];
  39     $http_code = $_[1] if $_[1];
  40 }
  41 sub error {
  42     push @errors, $_[0];
  43 }
  44 sub hint {
  45     push @hints, $_[0];
  46 }
  47 sub debug {
  48     my $lvl = $_[1] || 0;
  49     push(@debug, $_[0]) if $debug > $lvl;
  50 }
  51 sub get_errors { (@fatal_errors, @errors) }
  52 sub get_debug {
  53     return unless $debug && @debug;
  54     return @debug;
  55 }
  56 sub get_hints { @hints };
  57 sub get_all_messages {
  58     return {
  59         errors => [ @fatal_errors, @errors ],
  60         debugs => $debug ? \@debug : [],
  61         hints => \@hints,
  62     };
  63 }
  64
  65 our $USE_PAGED_MODE = 1;
  66 use constant DEFAULT_PAGE => 1;
  67 use constant DEFAULT_RES_PER_PAGE => 50;
  68 our %page_params = ( page => { default => DEFAULT_PAGE,
  69                                match => '(\d+)' },
  70                      number => { default => DEFAULT_RES_PER_PAGE,
  71                                  match => '(\d+)' } );
  72
  73 sub parse_params {
  74     my ( $cgi, $params_def, $opts ) = @_;
  75
  76     my %params_ret = ( values => {}, errors => {} );
  77     my %params;
  78     if ($USE_PAGED_MODE) {
  79         debug( "Use PAGED_MODE", 2 ) if DEBUG;
  80         %params = %$params_def;
  81         foreach (keys %page_params) {
  82             delete $params{$_};
  83         }
  84         %params = ( %params, %page_params );
  85     } else {
  86         %params = %$params_def;
  87     }
  88
  89     foreach my $param ( keys %params ) {
  90
  91         debug( "Param $param", 2 ) if DEBUG;
  92
  93         my $p_value_orig = $cgi->param($param);
  94
  95         if (!defined($p_value_orig)
  96             && defined $params_def->{$param}{alias}
  97             && defined $cgi->param($params_def->{$param}{alias})) {
  98             $p_value_orig = $cgi->param($params_def->{$param}{alias});
  99             debug( "Used alias <strong>$params_def->{$param}{alias}</strong>",
 100                    2 );
 101         }
 102
 103         my @p_value = ($p_value_orig);
 104
 105         debug( "Value (Orig) ".($p_value_orig||""), 2 ) if DEBUG;
 106
 107         if ($params_def->{$param}{array} && defined $p_value_orig) {
 108             @p_value = split /$params_def->{$param}{array}/, $p_value_orig;
 109             debug( "Value (Array Split) ". join('##',@p_value), 2 ) if DEBUG;
 110         }
 111
 112         if ($params_def->{$param}{match} && defined $p_value_orig) {
 113             @p_value = map
 114             { $_ =~ m/$params_def->{$param}{match}/; $_ = $1 }
 115             @p_value;
 116         }
 117         @p_value = grep { defined $_ } @p_value;
 118
 119         debug( "Value (Match) ". join('##',@p_value), 2 ) if DEBUG;
 120
 121         unless (@p_value) {
 122             if (defined $params{$param}{default}) {
 123                 @p_value = ($params{$param}{default});
 124             } else {
 125                 @p_value = undef;
 126                 $params_ret{errors}{$param} = "undef";
 127                 next;
 128             }
 129         }
 130
 131         debug( "Value (Default) ". join('##',@p_value), 2 ) if DEBUG;
 132         my @p_value_no_replace = @p_value;
 133
 134         if ($params{$param}{replace} && @p_value) {
 135             foreach my $pattern (keys %{$params{$param}{replace}}) {
 136                 my @p_value_tmp = @p_value;
 137                 @p_value = ();
 138                 foreach (@p_value_tmp) {
 139                     if ($_ eq $pattern) {
 140                         my $replacement = $params{$param}{replace}{$_};
 141                         if (ref $replacement) {
 142                             push @p_value, @$replacement;
 143                         } else {
 144                             push @p_value, $replacement;
 145                         }
 146                     } else {
 147                         push @p_value, $_;
 148                     }
 149                 }
 150             }
 151         }
 152
 153         debug( "Value (Final) ". join('##',@p_value), 2 ) if DEBUG;
 154
 155         if ($params_def->{$param}{array}) {
 156             $params_ret{values}{$param} = {
 157                 orig => $p_value_orig,
 158                 no_replace => \@p_value_no_replace,
 159                 final => \@p_value,
 160             };
 161             @{$params_def->{$param}{var}} = @p_value
 162                 if $params_def->{$param}{var};
 163         } else {
 164             $params_ret{values}{$param} = {
 165                 orig => $p_value_orig,
 166                 no_replace => $p_value_no_replace[0],
 167                 final => $p_value[0],
 168             };
 169             ${$params_def->{$param}{var}} = $p_value[0]
 170                 if $params_def->{$param}{var};
 171         }
 172         $opts->{$param} = $params_ret{values}{$param}{final} if $opts;
 173     }
 174
 175     if ($USE_PAGED_MODE) {
 176         $cgi->delete( "page" );
 177         $cgi->delete( "number" );
 178     }
 179
 180     return %params_ret;
 181 }
 182
 183 sub start {
 184     my $params = shift;
 185
 186     my $page = $params->{values}{page}{final}
 187     || DEFAULT_PAGE;
 188     my $res_per_page = $params->{values}{number}{final}
 189     || DEFAULT_RES_PER_PAGE;
 190
 191     return 1 if $res_per_page =~ /^all$/i;
 192     return $res_per_page * ($page - 1) + 1;
 193 }
 194
 195 sub end {
 196     my $params = shift;
 197
 198     use Data::Dumper;
 199     debug( "end: ".Dumper($params) ) if DEBUG;
 200     my $page = $params->{page}
 201     || DEFAULT_PAGE;
 202     my $res_per_page = $params->{number}
 203     || DEFAULT_RES_PER_PAGE;
 204
 205     return $page * $res_per_page;
 206 }
 207
 208 sub indexline {
 209     my ($cgi, $params, $num_res) = @_;
 210
 211     my $index_line = "";
 212     my $page = $params->{page}
 213     || DEFAULT_PAGE;
 214     my $res_per_page = $params->{number}
 215     || DEFAULT_RES_PER_PAGE;
 216     my $numpages = ceil($num_res /
 217                         $res_per_page);
 218     for (my $i = 1; $i <= $numpages; $i++) {
 219         if ($i == $page) {
 220             $index_line .= $i;
 221         } else {
 222             $index_line .= "<a href=\"".encode_entities($cgi->self_url).
 223                 "&amp;page=$i&amp;number=$res_per_page\">".
 224                 "$i</a>";
 225         }
 226         if ($i < $numpages) {
 227            $index_line .= " | ";
 228         }
 229     }
 230     return $index_line;
 231 }
 232
 233 sub nextlink {
 234     my ($cgi, $params, $no_results ) = @_;
 235
 236     my $page = $params->{page}
 237     || DEFAULT_PAGE;
 238     $page++;
 239     my $res_per_page = $params->{number}
 240     || DEFAULT_RES_PER_PAGE;
 241
 242     if ((($page-1)*$res_per_page + 1) > $no_results) {
 243         return "&gt;&gt;";
 244     }
 245
 246     return "<a href=\"".encode_entities($cgi->self_url).
 247         "&amp;page=$page&amp;number=$res_per_page\">&gt;&gt;</a>";
 248 }
 249
 250 sub prevlink {
 251     my ($cgi, $params ) = @_;
 252
 253     my $page = $params->{page}
 254     || DEFAULT_PAGE;
 255     $page--;
 256     if (!$page) {
 257         return "&lt;&lt;";
 258     }
 259
 260     my $res_per_page = $params->{number}
 261     || DEFAULT_RES_PER_PAGE;
 262
 263     return "<a href=\"".encode_entities($cgi->self_url).
 264         "&amp;page=$page&amp;number=$res_per_page\">&lt;&lt;</a>";
 265 }
 266
 267 sub resperpagelink {
 268     my ($cgi, $params, $res_per_page ) = @_;
 269
 270     my $page;
 271     if ($res_per_page =~ /^all$/i) {
 272         $page = 1;
 273     } else {
 274         $page = ceil(start( $params ) / $res_per_page);
 275     }
 276
 277     return "<a href=\"".encode_entities($cgi->self_url).
 278         "&amp;page=$page&amp;number=$res_per_page\">$res_per_page</a>";
 279 }
 280
 281 sub printindexline {
 282     my ( $input, $no_results, $opts ) = @_;
 283
 284     my $index_line;
 285     if ($no_results > $opts->{number}) {
 286
 287         $index_line = prevlink( $input, $opts)." | ".
 288             indexline( $input, $opts, $no_results)." | ".
 289             nextlink( $input, $opts, $no_results);
 290
 291         print "<p style=\"text-align:center\">$index_line</p>";
 292     }
 293 }
 294
 295 #sub multipageheader {
 296 #    my ( $input, $no_results, $opts ) = @_;
 297 #
 298 #    my ($start, $end);
 299 #    if ($opts->{number} =~ /^all$/i) {
 300 #       $start = 1;
 301 #       $end = $no_results;
 302 #       $opts->{number} = $no_results;
 303 #       $opts->{number_all}++;
 304 #    } else {
 305 #       $start = Packages::Search::start( $opts );
 306 #       $end = Packages::Search::end( $opts );
 307 #       if ($end > $no_results) { $end = $no_results; }
 308 #    }
 309 #
 310 #       print "<p>Found <em>$no_results</em> matching packages,";
 311 #    if ($end == $start) {
 312 #       print " displaying package $end.</p>";
 313 #    } else {
 314 #       print " displaying packages $start to $end.</p>";
 315 #    }
 316 #
 317 #    printindexline( $input, $no_results, $opts );
 318 #
 319 #    if ($no_results > 100) {
 320 #       print "<p>Results per page: ";
 321 #       my @resperpagelinks;
 322 #       for (50, 100, 200) {
 323 #           if ($opts->{number} == $_) {
 324 #               push @resperpagelinks, $_;
 325 #           } else {
 326 #               push @resperpagelinks, resperpagelink($input,$opts,$_);
 327 #           }
 328 #       }
 329 #       if ($opts->{number_all}) {
 330 #           push @resperpagelinks, "all";
 331 #       } else {
 332 #           push @resperpagelinks, resperpagelink($input, $opts, "all");
 333 #       }
 334 #       print join( " | ", @resperpagelinks )."</p>";
 335 #    }
 336 #    return ( $start, $end );
 337 #}
 338
 339 sub string2id {
 340     my $string = "@_";
 341
 342     $string =~ s/[^\w:.-]/_/g;
 343     return $string;
 344 }
 345
 346 our ( %url_params, %query_params );
 347
 348 sub init_url {
 349     my ($input, $params, $opts) = @_;
 350
 351     %url_params = ();
 352     %query_params = ();
 353
 354     if ($params->{values}{lang}{orig} &&
 355         (my $l = $params->{values}{lang}{no_replace})) {
 356         $url_params{lang} = $l;
 357     }
 358     if ($params->{values}{source}{no_replace}) {
 359         $url_params{source} = 'source';
 360         $query_params{source} = 1;
 361     }
 362     foreach my $p (qw(suite arch)) {
 363         if ($params->{values}{$p}{orig}
 364             && (ref $params->{values}{$p}{final} eq 'ARRAY')
 365             && @{$params->{values}{$p}{final}}) {
 366             if (@{$params->{values}{$p}{final}} == 1) {
 367                 $url_params{$p} = $params->{values}{$p}{final}[0];
 368             } else {
 369                 $url_params{$p} =
 370                     join(",",@{$params->{values}{$p}{no_replace}});
 371             }
 372         }
 373     }
 374     foreach my $p (qw(format searchon mode exact debug)) {
 375         if ($params->{values}{$p}{orig}
 376             && (my $pv = $params->{values}{$p}{no_replace})) {
 377             $url_params{$p} = $pv;
 378         }
 379     }
 380
 381     use Data::Dumper;
 382     debug( join("\n",Dumper(\%url_params,\%query_params)), 2 ) if DEBUG;
 383 }
 384
 385 sub make_url {
 386     my ($add_path, $add_query, @override) = @_;
 387     my (@path, @query_string) = ()x2;
 388     my $override = {};
 389     if (ref $override[0]) {
 390         $override = $override[0];
 391     } elsif (@override) {
 392         $override = { @override };
 393     }
 394
 395     push @path, $Packages::Config::ROOT;
 396     foreach my $p (qw(lang source suite archive arch)) {
 397         my $val = $url_params{$p};
 398         $val = $override->{$p} if exists $override->{$p};
 399         push @path, $val if $val;
 400     }
 401     foreach my $p (qw(format debug)) {
 402         my $val = $url_params{$p};
 403         $val = $query_params{$p} if exists $query_params{$p};
 404         $val = $override->{$p} if exists $override->{$p};
 405         push @query_string, "$p=$val" if $val;
 406     }
 407     push @path, $add_path if $add_path and $add_path ne '/';
 408     push @query_string, $add_query if $add_query;
 409
 410     my $path = join( '/', @path );
 411     my $query_string = join( '&', @query_string );
 412     $path .= '/' if $add_path and $add_path eq '/';
 413     $path .= "?$query_string" if $query_string;
 414
 415     return $path;
 416 }
 417
 418 sub make_search_url {
 419     my ($add_path, $add_query, @override) = @_;
 420     my (@path, @query_string) = ()x2;
 421     my $override ||= {};
 422     if (ref $override[0]) {
 423         $override = $override[0];
 424     } elsif (@override) {
 425         $override = { @override };
 426     }
 427
 428     push @path, $Packages::Config::SEARCH_URL
 429         if $Packages::Config::SEARCH_URL;
 430     foreach my $p (qw(lang source suite archive section subsection
 431                       arch exact mode searchon format debug)) {
 432         my $val = $url_params{$p};
 433         $val = $query_params{$p} if exists $query_params{$p};
 434         $val = $override->{$p} if exists $override->{$p};
 435         push @query_string, "$p=$val" if $val;
 436     }
 437     push @path, $add_path if $add_path;
 438     push @query_string, $add_query if $add_query;
 439
 440     my $path = join( '/', @path );
 441     my $query_string = join( '&amp;', @query_string );
 442
 443     return "$path?$query_string";
 444 }
 445
 446 1;