X-Git-Url: https://git.exim.org/git-perl-utils.git/blobdiff_plain/cf8716f934ab98c5632dabb5f72862ec40f67980..88022d08c91c5b9a303d3a29e42f36232b7b8153:/lib/WWW/Bugzilla/Search.pm

diff --git a/lib/WWW/Bugzilla/Search.pm b/lib/WWW/Bugzilla/Search.pm
new file mode 100644
index 0000000..14fef9e
--- /dev/null
+++ b/lib/WWW/Bugzilla/Search.pm
@@ -0,0 +1,313 @@
+package WWW::Bugzilla::Search;
+
+$WWW::Bugzilla::Search::VERSION = '0.2';
+
+use strict;
+use warnings;
+use WWW::Mechanize;
+use Carp qw(croak carp);
+use Params::Validate;
+use vars qw($VERSION @ISA @EXPORT);
+use WWW::Bugzilla;
+
+=head1 NAME
+
+WWW::Bugzilla::Search - Handles searching bugzilla bugs via WWW::Mechanize.
+
+=head1 SYNOPSIS
+
+    use WWW::Bugzilla::Search;
+
+    # Login
+    my $search = WWW::Bugzilla::Search->new(
+        server => 'bugs.example.com',
+        email => 'user@example.com',
+        password => 'my_passwd',
+    );
+
+    $search->summary('This is my summary');
+    my @bugs = $search->search();
+
+=head1 DESCRIPTION
+
+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.
+
+=head1 INTERFACE
+
+=head2 Multiple choice search criteria 
+
+The following fields are multiple choice fields: 
+
+classification, component, op_sys, priority, product, resolution, bug_severity, bug_status, target_milestone, version, hardware, rep_platform
+
+Available options can be retrieved via:
+    
+    $search->field();
+
+To choose a given value, use:
+    
+    $search->field('value');
+
+=head2 Text search criteria
+
+The following fields are avaiilable for text searching:
+
+assigned_to, reporter, summary
+
+To searc using a given field, use:
+
+    $search->field('value');
+
+=head2 Methods
+
+=head3 search()
+
+Searches Bugzilla with the defined criteria.  Returns a list of bugs that match the criteria.  Each bug is a seperate instance of WWW::Bugzilla
+
+=head3 reset()
+
+Resets all search criteria.
+
+=over
+
+=back
+
+=cut 
+
+
+#sub AUTOLOAD {
+#    my $self = shift;
+#    my $name = $AUTOLOAD;
+#
+#    warn Dumper($self->{'_fields'});
+#    if ($self->{'_fields'}{$name}) {
+#        $name =~ s/^WWW::Bugzilla::Search:://;
+#        my $out =$self->_field_values($name);
+#    #    warn Dumper($out);
+#    }
+#
+#    if (@_) {
+#        return $self->{$name} = shift;
+#    } else {
+#        if (defined($self->{$name})) {
+#            return $self->{$name};
+#        } else {
+#            return;
+#        }
+#    }
+#}
+
+my $_SETUP;
+
+sub new {
+    my $that  = shift;
+    my $class = ref($that) || $that;
+    my $self  = {
+        search_keys => {},
+        protocol => '',
+        server=> '',
+    };
+    bless $self, $class;
+
+    if (!$_SETUP) {
+        no strict 'refs';
+        # accessors
+        foreach my $field (qw(mech protocol server email password)) {
+            *{ $class . '::' . $field } = sub { my ($self, $value) = @_; if (defined $value) { $self->{$field} = $value; } return $self->{$field} }
+        }
+        
+        # search fields
+        foreach my $field (qw(classification component op_sys priority product resolution bug_severity bug_status target_milestone version hardware rep_platform)) {
+            *{ $class . '::' . $field } = sub {
+                my ($self, $value) = @_; 
+                if (defined $value) {
+                    $self->{'search_keys'}{$field} = $value;
+                    return $value;
+                } else {
+                    return $self->_field_values($field); 
+                }
+            }
+        }
+
+        # search fields that are used as accessors
+        foreach my $field (qw(assigned_to reporter summary)) {
+            *{ $class . '::' . $field } = sub { my ($self, $value) = @_; if (defined $value) { $self->{'search_keys'}{$field} = $value; } return $self->{'search_keys'}{$field} }
+        }
+        $_SETUP++;
+    }
+
+    if (@_) {
+        my %conf = @_;
+        while (my ($k, $v) = each %conf) {
+            $self->$k($v);
+        }
+    }
+
+    $self->protocol('http') if !$self->protocol();
+
+    $self->{'mech'} = WWW::Mechanize->new();
+    $self->_login();
+    
+    return $self;
+}
+
+sub _field_values {
+    my ($self, $name) = @_;
+    my $url = $self->protocol().'://'.$self->server().'/query.cgi?format=advanced';
+    my $mech = $self->{'mech'};
+    if ($mech->{'uri'} ne $url) {
+        $mech->get( $url); 
+    }
+    $mech->form_name('queryform');
+
+    my @values;
+
+    my $form = $mech->current_form();
+    foreach my $field ($form->inputs()) {
+        if ($field->name && $field->name eq $name) {
+            push (@values, grep { defined $_ }$field->possible_values());
+        }
+    }
+    if (@values) {
+        return grep { defined $_ } @values;
+    }
+    warn "no values for $name";
+    return;
+}
+
+sub reset {
+    my ($self) = @_;
+
+    $self->{'search_keys'} = {};
+}
+
+sub search {
+    my ($self) = @_;
+    my $mech = $self->{'mech'};
+    my $login_page = $self->protocol().'://'.$self->server().'/query.cgi?format=advanced';
+    $mech->get( $login_page ); 
+    $mech->form_name('queryform');
+
+    foreach my $key (keys %{ $self->{'search_keys'} }) {
+        my $value =  $self->{'search_keys'}{$key};
+        if ($key eq 'summary') {
+            $mech->field('short_desc', $value, 1);
+        } elsif ($key eq 'assigned_to') {
+            $mech->field('email1', $value);
+            $mech->field('emailtype1', 'regexp') if (ref($value) eq 'Regexp');
+        } elsif ($key eq 'reporter') {
+            $mech->field('email2', $value);
+            $mech->field('emailtype2', 'regexp') if (ref($value) eq 'Regexp');
+            $mech->tick('emailreporter2', 1);
+            map($mech->untick($_, 1), qw(emailqa_contact2 emailassigned_to2 emailcc2));
+        } else {
+            if ($self->_field_values($key)) {
+                # ghetto hack.  Grr, Mechanize is making each of the form elements a seperate entry.
+                my $i = 1;
+                foreach my $input ($mech->current_form()->inputs()) {
+                    next if (defined $input->name && $input->name ne $key);
+                    foreach my $val ($input->possible_values) {
+                        next if !defined $val;
+                        if ($value eq $val) {
+                            $input->value($value);
+                           # $mech->field($key, $value, $i);
+                        }
+                    }
+                    $i++;
+                }
+            } else {
+                $mech->field($key, $self->{'search_keys'}{$key});
+            }
+        }
+    }
+
+    $mech->submit();
+    my @bugs;
+    foreach my $link ($mech->links()) {
+        if ($link->url() =~ /^show_bug\.cgi\?id=(\d+)$/) {
+            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));
+        }
+    }
+    return @bugs;
+}
+
+# based on the current page, set the current form to the first form with a specified field
+sub _get_form_by_field {
+    my ($self, $field) = @_;
+    croak("invalid field") if !$field;
+
+    my $mech = $self->{'mech'};
+    my $i = 1;
+    foreach my $form ($mech->forms()) {
+        if ($form->find_input($field)) {
+            $mech->form_number($i);
+            return 1;
+        }
+        $i++;
+    }
+    return;
+}
+
+sub _login {
+    my $self = shift;
+    my $mech = $self->{'mech'};
+    my $login_page = $self->protocol().'://'.$self->server().'/query.cgi?GoAheadAndLogIn=1';
+    $mech->get( $login_page ); 
+
+    # bail unless OK or Redirect happens
+    croak("Cannot open page $login_page") unless ( ($mech->status == '200') or ($mech->status == '404') );
+    croak("Login form is missing") if !$self->_get_form_by_field('Bugzilla_login');
+    $mech->field('Bugzilla_login', $self->email());
+    $mech->field('Bugzilla_password', $self->password());
+    $mech->submit_form();
+    $mech->get( $login_page );
+    croak("Login failed") if $self->_get_form_by_field('Bugzilla_login');
+}
+
+=head1 BUGS, IMPROVEMENTS
+
+There may well be bugs in this module.  Using it as I have, I just have not run
+into any.  In addition, this module does not support ALL of Bugzilla's
+features.  I will consider any patches or improvements, just send me an email
+at the address listed below.
+ 
+=head1 AUTHOR
+
+Written by:
+    Brian Caswell (bmc@shmoo.com)
+
+Portions taken from WWW::Bugzilla, originally written by:
+    Matthew C. Vella (the_mcv@yahoo.com)
+
+=head1 LICENSE
+                                                                      
+  WWW::Bugzilla::Search - Module providing API to search Bugzilla bugs.
+  Copyright (C) 2006 Brian Caswell (bmc@shmoo.com)
+
+  Portions Copyright (C) 2003 Matthew C. Vella (the_mcv@yahoo.com)
+                                                                    
+  This module is free software; you can redistribute it and/or modify it
+  under the terms of either:
+                                                                      
+  a) the GNU General Public License as published by the Free Software
+  Foundation; either version 1, or (at your option) any later version,                                                                      
+  or
+                                                                      
+  b) the "Artistic License" which comes with this module.
+                                                                      
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
+  the GNU General Public License or the Artistic License for more details.
+                                                                      
+  You should have received a copy of the Artistic License with this
+  module, in the file ARTISTIC.  If not, I'll be glad to provide one.
+                                                                      
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+  USA
+
+=cut
+
+1;