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