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