lib/Packages/CGI.pm

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