]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/CGI.pm
Prefer "use Exporter qw(import)" to inheriting from it
[debbugs.git] / Debbugs / CGI.pm
index 1ba47996744eeb2ec4358db4da55910e30d9ba8e..d97dc2b940fa4a25390deb0c7ecee751fd413513 100644 (file)
@@ -34,19 +34,24 @@ None known.
 use warnings;
 use strict;
 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
+
 use Debbugs::URI;
 use HTML::Entities;
 use Debbugs::Common qw(getparsedaddrs make_list);
 use Params::Validate qw(validate_with :types);
+
 use Debbugs::Config qw(:config);
 use Debbugs::Status qw(splitpackages isstrongseverity);
+use Debbugs::User qw();
+
 use Mail::Address;
 use POSIX qw(ceil);
 use Storable qw(dclone);
 
 use List::Util qw(max);
-
+use File::stat;
+use Digest::MD5 qw(md5_hex);
 use Carp;
 
 use Debbugs::Text qw(fill_in_template);
@@ -70,8 +75,10 @@ BEGIN{
                     util   => [qw(cgi_parameters quitcgi),
                               ],
                     forms  => [qw(option_form form_options_and_normal_param)],
+                    usertags => [qw(add_user)],
                     misc   => [qw(maint_decode)],
                     package_search => [qw(@package_search_key_order %package_search_keys)],
+                    cache => [qw(calculate_etag etag_does_not_match)],
                     #status => [qw(getbugstatus)],
                    );
      @EXPORT_OK = ();
@@ -156,7 +163,9 @@ sub munge_url {
      while (my ($key,$value) = splice @old_param,0,2) {
          push @new_param,($key,$value) unless exists $params{$key};
      }
-     $new_url->query_form(@new_param,%params);
+     $new_url->query_form(@new_param,
+                         map {($_,$params{$_})}
+                         sort keys %params);
      return $new_url->as_string;
 }
 
@@ -191,7 +200,7 @@ width and height are passed.
 
 sub version_url{
      my %params = validate_with(params => \@_,
-                               spec   => {package => {type => SCALAR,
+                               spec   => {package => {type => SCALAR|ARRAYREF,
                                                      },
                                           found   => {type => ARRAYREF,
                                                       default => [],
@@ -292,7 +301,7 @@ sub quitcgi {
 }
 
 
-=head HTML
+=head1 HTML
 
 =head2 htmlize_packagelinks
 
@@ -350,8 +359,10 @@ our @package_search_key_order = (package   => 'in package',
                                 submitter => 'submitted by',
                                 owner     => 'owned by',
                                 status    => 'with status',
+                                affects   => 'which affect package',
                                 correspondent => 'with mail from',
                                 newest        => 'newest bugs',
+                                bugs          => 'in bug',
                                );
 our %package_search_keys = @package_search_key_order;
 
@@ -393,11 +404,15 @@ sub package_links {
      }
      my @links = ();
      for my $type (qw(src package)) {
-         push @links, map {(munge_url('pkgreport.cgi?',
+         push @links, map {my $t_type = $type;
+                           if ($_ =~ s/^src://) {
+                               $t_type = 'src';
+                           }
+                           (munge_url('pkgreport.cgi?',
                                       %options,
-                                      $type => $_,
+                                      $t_type => $_,
                                      ),
-                            $_);
+                            ($t_type eq 'src'?'src:':'').$_);
                       } make_list($param{$type}) if exists $param{$type};
      }
      for my $type (qw(maint owner submitter correspondent)) {
@@ -528,6 +543,11 @@ the split links with commas and spaces.
 
 sub maybelink {
     my ($links,$regex,$join) = @_;
+    if (not defined $regex and not defined $join) {
+        $links =~ s{(.*?)((?:(?:ftp|http|https)://[\S~-]+?/?)?)([\)\'\:\.\,]?(?:\s|\.<|$))}
+                   {html_escape($1).(length $2?q(<a href=").html_escape($2).q(">).html_escape($2).q(</a>):'').html_escape($3)}geimo;
+        return $links;
+    }
     $join = ' ' if not defined $join;
     my @return;
     my @segments;
@@ -628,6 +648,38 @@ sub bug_linklist{
 }
 
 
+sub add_user {
+     my ($user,$usertags,$bug_usertags,$seen_users,$cats,$hidden) = @_;
+     $seen_users = {} if not defined $seen_users;
+     $bug_usertags = {} if not defined $bug_usertags;
+     $usertags = {} if not defined $usertags;
+     $cats = {} if not defined $cats;
+     $hidden = {} if not defined $hidden;
+     return if exists $seen_users->{$user};
+     $seen_users->{$user} = 1;
+
+     my $u = Debbugs::User::get_user($user);
+
+     my %vis = map { $_, 1 } @{$u->{"visible_cats"}};
+     for my $c (keys %{$u->{"categories"}}) {
+         $cats->{$c} = $u->{"categories"}->{$c};
+         $hidden->{$c} = 1 unless defined $vis{$c};
+     }
+     for my $t (keys %{$u->{"tags"}}) {
+         $usertags->{$t} = [] unless defined $usertags->{$t};
+         push @{$usertags->{$t}}, @{$u->{"tags"}->{$t}};
+     }
+
+     %{$bug_usertags} = ();
+     for my $t (keys %{$usertags}) {
+         for my $b (@{$usertags->{$t}}) {
+              $bug_usertags->{$b} = [] unless defined $bug_usertags->{$b};
+              push @{$bug_usertags->{$b}}, $t;
+         }
+     }
+}
+
+
 
 =head1 Forms
 
@@ -823,7 +875,8 @@ sub option_form{
               if (defined $value and $o_value eq $value) {
                    $selected = ' selected';
               }
-              $output .= qq(<option value="$o_value"$selected>$name</option>\n);
+              $output .= q(<option value=").html_escape($o_value).qq("$selected>).
+                  html_escape($name).qq(</option>\n);
          }
          return $output;
      };
@@ -833,6 +886,8 @@ sub option_form{
      return Debbugs::Text::fill_in_template(template=>$param{template},
                                            (exists $param{language}?(language=>$param{language}):()),
                                            variables => $variables,
+                                           hole_var  => {'&html_escape' => \&html_escape,
+                                                        },
                                           );
 }
 
@@ -883,6 +938,77 @@ sub maint_decode {
      wantarray ? @output : $output[0];
 }
 
+=head1 cache
+
+=head2 calculate_etags
+
+    calculate_etags(files => [qw(list of files)],additional_data => [qw(any additional data)]);
+
+=cut
+
+sub calculate_etags {
+    my %param =
+       validate_with(params => \@_,
+                     spec => {files => {type => ARRAYREF,
+                                        default => [],
+                                       },
+                              additional_data => {type => ARRAYREF,
+                                                  default => [],
+                                                 },
+                             },
+                    );
+    my @additional_data = @{$param{additional_data}};
+    for my $file (@{$param{files}}) {
+       my $st = stat($file) or warn "Unable to stat $file:: $!";
+       push @additional_data,$st->mtime;
+       push @additional_data,$st->size;
+    }
+    return(md5_hex(join('',sort @additional_data)));
+}
+
+=head2 etag_does_not_match
+
+     etag_does_not_match(cgi=>$q,files=>[qw(list of files)],
+         additional_data=>[qw(any additional data)])
+
+
+Checks to see if the CGI request contains an etag which matches the calculated
+etag.
+
+If there wasn't an etag given, or the etag given doesn't match, return the etag.
+
+If the etag does match, return 0.
+
+=cut
+
+sub etag_does_not_match {
+    my %param =
+       validate_with(params => \@_,
+                     spec => {files => {type => ARRAYREF,
+                                        default => [],
+                                       },
+                              additional_data => {type => ARRAYREF,
+                                                  default => [],
+                                                 },
+                              cgi => {type => OBJECT},
+                             },
+                    );
+    my $submitted_etag =
+       $param{cgi}->http('if-none-match');
+    my $etag =
+       calculate_etags(files=>$param{files},
+                       additional_data=>$param{additional_data});
+    if (not defined $submitted_etag or
+       length($submitted_etag) != 32
+       or $etag ne $submitted_etag
+       ) {
+       return $etag;
+    }
+    if ($etag eq $submitted_etag) {
+       return 0;
+    }
+}
+
 
 1;