lib/WWW/Bugzilla/Search.pm

   1 package WWW::Bugzilla::Search;
   2
   3 $WWW::Bugzilla::Search::VERSION = '0.2';
   4
   5 use strict;
   6 use warnings;
   7 use WWW::Mechanize;
   8 use Carp qw(croak carp);
   9 use Params::Validate;
  10 use vars qw($VERSION @ISA @EXPORT);
  11 use WWW::Bugzilla;
  12
  13 =head1 NAME
  14
  15 WWW::Bugzilla::Search - Handles searching bugzilla bugs via WWW::Mechanize.
  16
  17 =head1 SYNOPSIS
  18
  19     use WWW::Bugzilla::Search;
  20
  21     # Login
  22     my $search = WWW::Bugzilla::Search->new(
  23         server => 'bugs.example.com',
  24         email => 'user@example.com',
  25         password => 'my_passwd',
  26     );
  27
  28     $search->summary('This is my summary');
  29     my @bugs = $search->search();
  30
  31 =head1 DESCRIPTION
  32
  33 WWW::Bugzilla::Search provides an API to search for bugs in a Bugzilla database.  Any resulting bugs will be returned as instances of WWW::Bugzilla bugs.
  34
  35 =head1 INTERFACE
  36
  37 =head2 Multiple choice search criteria
  38
  39 The following fields are multiple choice fields:
  40
  41 classification, component, op_sys, priority, product, resolution, bug_severity, bug_status, target_milestone, version, hardware, rep_platform
  42
  43 Available options can be retrieved via:
  44
  45     $search->field();
  46
  47 To choose a given value, use:
  48
  49     $search->field('value');
  50
  51 =head2 Text search criteria
  52
  53 The following fields are avaiilable for text searching:
  54
  55 assigned_to, reporter, summary
  56
  57 To searc using a given field, use:
  58
  59     $search->field('value');
  60
  61 =head2 Methods
  62
  63 =head3 search()
  64
  65 Searches Bugzilla with the defined criteria.  Returns a list of bugs that match the criteria.  Each bug is a seperate instance of WWW::Bugzilla
  66
  67 =head3 reset()
  68
  69 Resets all search criteria.
  70
  71 =over
  72
  73 =back
  74
  75 =cut
  76
  77
  78 #sub AUTOLOAD {
  79 #    my $self = shift;
  80 #    my $name = $AUTOLOAD;
  81 #
  82 #    warn Dumper($self->{'_fields'});
  83 #    if ($self->{'_fields'}{$name}) {
  84 #        $name =~ s/^WWW::Bugzilla::Search:://;
  85 #        my $out =$self->_field_values($name);
  86 #    #    warn Dumper($out);
  87 #    }
  88 #
  89 #    if (@_) {
  90 #        return $self->{$name} = shift;
  91 #    } else {
  92 #        if (defined($self->{$name})) {
  93 #            return $self->{$name};
  94 #        } else {
  95 #            return;
  96 #        }
  97 #    }
  98 #}
  99
 100 my $_SETUP;
 101
 102 sub new {
 103     my $that  = shift;
 104     my $class = ref($that) || $that;
 105     my $self  = {
 106         search_keys => {},
 107         protocol => '',
 108         server=> '',
 109     };
 110     bless $self, $class;
 111
 112     if (!$_SETUP) {
 113         no strict 'refs';
 114         # accessors
 115         foreach my $field (qw(mech protocol server email password)) {
 116             *{ $class . '::' . $field } = sub { my ($self, $value) = @_; if (defined $value) { $self->{$field} = $value; } return $self->{$field} }
 117         }
 118
 119         # search fields
 120         foreach my $field (qw(classification component op_sys priority product resolution bug_severity bug_status target_milestone version hardware rep_platform)) {
 121             *{ $class . '::' . $field } = sub {
 122                 my ($self, $value) = @_;
 123                 if (defined $value) {
 124                     $self->{'search_keys'}{$field} = $value;
 125                     return $value;
 126                 } else {
 127                     return $self->_field_values($field);
 128                 }
 129             }
 130         }
 131
 132         # search fields that are used as accessors
 133         foreach my $field (qw(assigned_to reporter summary)) {
 134             *{ $class . '::' . $field } = sub { my ($self, $value) = @_; if (defined $value) { $self->{'search_keys'}{$field} = $value; } return $self->{'search_keys'}{$field} }
 135         }
 136         $_SETUP++;
 137     }
 138
 139     if (@_) {
 140         my %conf = @_;
 141         while (my ($k, $v) = each %conf) {
 142             $self->$k($v);
 143         }
 144     }
 145
 146     $self->protocol('http') if !$self->protocol();
 147
 148     $self->{'mech'} = WWW::Mechanize->new();
 149     $self->_login();
 150
 151     return $self;
 152 }
 153
 154 sub _field_values {
 155     my ($self, $name) = @_;
 156     my $url = $self->protocol().'://'.$self->server().'/query.cgi?format=advanced';
 157     my $mech = $self->{'mech'};
 158     if ($mech->{'uri'} ne $url) {
 159         $mech->get( $url);
 160     }
 161     $mech->form_name('queryform');
 162
 163     my @values;
 164
 165     my $form = $mech->current_form();
 166     foreach my $field ($form->inputs()) {
 167         if ($field->name && $field->name eq $name) {
 168             push (@values, grep { defined $_ }$field->possible_values());
 169         }
 170     }
 171     if (@values) {
 172         return grep { defined $_ } @values;
 173     }
 174     warn "no values for $name";
 175     return;
 176 }
 177
 178 sub reset {
 179     my ($self) = @_;
 180
 181     $self->{'search_keys'} = {};
 182 }
 183
 184 sub search {
 185     my ($self) = @_;
 186     my $mech = $self->{'mech'};
 187     my $login_page = $self->protocol().'://'.$self->server().'/query.cgi?format=advanced';
 188     $mech->get( $login_page );
 189     $mech->form_name('queryform');
 190
 191     foreach my $key (keys %{ $self->{'search_keys'} }) {
 192         my $value =  $self->{'search_keys'}{$key};
 193         if ($key eq 'summary') {
 194             $mech->field('short_desc', $value, 1);
 195         } elsif ($key eq 'assigned_to') {
 196             $mech->field('email1', $value);
 197             $mech->field('emailtype1', 'regexp') if (ref($value) eq 'Regexp');
 198         } elsif ($key eq 'reporter') {
 199             $mech->field('email2', $value);
 200             $mech->field('emailtype2', 'regexp') if (ref($value) eq 'Regexp');
 201             $mech->tick('emailreporter2', 1);
 202             map($mech->untick($_, 1), qw(emailqa_contact2 emailassigned_to2 emailcc2));
 203         } else {
 204             if ($self->_field_values($key)) {
 205                 # ghetto hack.  Grr, Mechanize is making each of the form elements a seperate entry.
 206                 my $i = 1;
 207                 foreach my $input ($mech->current_form()->inputs()) {
 208                     next if (defined $input->name && $input->name ne $key);
 209                     foreach my $val ($input->possible_values) {
 210                         next if !defined $val;
 211                         if ($value eq $val) {
 212                             $input->value($value);
 213                            # $mech->field($key, $value, $i);
 214                         }
 215                     }
 216                     $i++;
 217                 }
 218             } else {
 219                 $mech->field($key, $self->{'search_keys'}{$key});
 220             }
 221         }
 222     }
 223
 224     $mech->submit();
 225     my @bugs;
 226     foreach my $link ($mech->links()) {
 227         if ($link->url() =~ /^show_bug\.cgi\?id=(\d+)$/) {
 228             push (@bugs, WWW::Bugzilla->new( 'server' => $self->{'server'}, 'email' => $self->{'email'}, 'password' => $self->{'password'}, 'bug_number' => $1, 'use_ssl' => ($self->protocol() eq 'https') ? 1 : 0));
 229         }
 230     }
 231     return @bugs;
 232 }
 233
 234 # based on the current page, set the current form to the first form with a specified field
 235 sub _get_form_by_field {
 236     my ($self, $field) = @_;
 237     croak("invalid field") if !$field;
 238
 239     my $mech = $self->{'mech'};
 240     my $i = 1;
 241     foreach my $form ($mech->forms()) {
 242         if ($form->find_input($field)) {
 243             $mech->form_number($i);
 244             return 1;
 245         }
 246         $i++;
 247     }
 248     return;
 249 }
 250
 251 sub _login {
 252     my $self = shift;
 253     my $mech = $self->{'mech'};
 254     my $login_page = $self->protocol().'://'.$self->server().'/query.cgi?GoAheadAndLogIn=1';
 255     $mech->get( $login_page );
 256
 257     # bail unless OK or Redirect happens
 258     croak("Cannot open page $login_page") unless ( ($mech->status == '200') or ($mech->status == '404') );
 259     croak("Login form is missing") if !$self->_get_form_by_field('Bugzilla_login');
 260     $mech->field('Bugzilla_login', $self->email());
 261     $mech->field('Bugzilla_password', $self->password());
 262     $mech->submit_form();
 263     $mech->get( $login_page );
 264     croak("Login failed") if $self->_get_form_by_field('Bugzilla_login');
 265 }
 266
 267 =head1 BUGS, IMPROVEMENTS
 268
 269 There may well be bugs in this module.  Using it as I have, I just have not run
 270 into any.  In addition, this module does not support ALL of Bugzilla's
 271 features.  I will consider any patches or improvements, just send me an email
 272 at the address listed below.
 273
 274 =head1 AUTHOR
 275
 276 Written by:
 277     Brian Caswell (bmc@shmoo.com)
 278
 279 Portions taken from WWW::Bugzilla, originally written by:
 280     Matthew C. Vella (the_mcv@yahoo.com)
 281
 282 =head1 LICENSE
 283
 284   WWW::Bugzilla::Search - Module providing API to search Bugzilla bugs.
 285   Copyright (C) 2006 Brian Caswell (bmc@shmoo.com)
 286
 287   Portions Copyright (C) 2003 Matthew C. Vella (the_mcv@yahoo.com)
 288
 289   This module is free software; you can redistribute it and/or modify it
 290   under the terms of either:
 291
 292   a) the GNU General Public License as published by the Free Software
 293   Foundation; either version 1, or (at your option) any later version,
 294   or
 295
 296   b) the "Artistic License" which comes with this module.
 297
 298   This program is distributed in the hope that it will be useful,
 299   but WITHOUT ANY WARRANTY; without even the implied warranty of
 300   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
 301   the GNU General Public License or the Artistic License for more details.
 302
 303   You should have received a copy of the Artistic License with this
 304   module, in the file ARTISTIC.  If not, I'll be glad to provide one.
 305
 306   You should have received a copy of the GNU General Public License
 307   along with this program; if not, write to the Free Software
 308   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 309   USA
 310
 311 =cut
 312
 313 1;