41a9c695784336c876f6c87771d2abd5a116b8c5
[git-perl-utils.git] / lib / WWW / Bugzilla.pm
1 package WWW::Bugzilla;
2
3 $WWW::Bugzilla::VERSION = '1.5';
4
5 use strict;
6 use warnings;
7 use WWW::Mechanize;
8 use Fatal qw(:void open opendir);
9 use Carp qw(croak carp);
10
11 use constant FIELDS => qw( bugzilla_version bugzilla_version_minor version component status resolution dup_id assigned_to summary bug_number description os platform severity priority cc url add_cc target_milestone status_whiteboard keywords depends_on blocks additional_comments );
12  
13 my %new_field_map = (   product => 'product',
14                         version => 'version',
15                         component => 'component',
16                         assigned_to => 'assigned_to',
17                         summary => 'short_desc',
18                         description => 'comment',
19                         os => 'op_sys',
20                         platform => 'rep_platform',
21                         severity => 'bug_severity',
22                         priority => 'priority',
23                         cc => 'cc',
24                         url => 'bug_file_loc' );
25
26 my %other_field_map = (
27     resolution => 'resolution_knob_5',
28     );
29
30 my %update_field_map = (product => 'product',
31 #                        bug_number => 'id',    # this cannot be updated
32                         platform => 'rep_platform',
33                         os => 'op_sys',
34                         add_cc => 'newcc',
35                         component => 'component',
36                         version => 'version',
37 #                        cc => 'cc',    # this field should not be updated, use add_cc
38                         status => 'knob',
39                         priority => 'priority',
40                         severity => 'bug_severity',
41                         target_milestone => 'target_milestone',
42                         url => 'bug_file_loc',
43                         summary => 'short_desc',
44                         status_whiteboard => 'status_whiteboard',
45                         keywords => 'keywords',
46                         depends_on => 'dependson',
47                         blocks => 'blocked',
48                         additional_comments => 'comment' );
49
50 =head1 NAME
51
52 WWW::Bugzilla - Handles submission/update of bugzilla bugs via WWW::Mechanize.
53
54 =head1 SYNOPSIS
55
56     use WWW::Bugzilla;
57
58     # create new bug
59     my $bz = WWW::Bugzilla->new(    server => 'www.mybugzilla.com', 
60                                     email => 'buguser@bug.com',
61                                     password => 'mypassword' );
62
63     # enter info into some fields and save new bug
64
65     # get list of available version choices
66     my @versions = $bz->available('version');
67
68     # set version
69     $bz->version( $versions[0] );
70
71     # get list of available products
72     my @products = $bz->available('product');
73
74     # set product
75     $bz->product( $products[0] );
76
77     # get list of components available
78     my @components = $bz->available('component');
79
80     # set component
81     $bz->component( $components[0] );
82
83     # optionally do the same for platform, os, priority, severity.
84
85     $bz->assigned_to( 'joeschmoe@whatever.com' );
86     $bz->summary( $some_text );
87     $bz->description( $some_more_text );
88
89     # submit bug, returning new bug number
90     my $bug_number = $bz->commit;
91
92     # all of the above could have been done in a much easier
93     # way, had we known what values to use. See below:
94
95     my $bz = WWW::Bugzilla->new(    server => 'www.mybugzilla.com',
96                                     email => 'buguser@bug.com',
97                                     password => 'mypassword' 
98                                     version => 'Alpha',
99                                     product => 'MyProduct',
100                                     component => 'API',
101                                     assigned_to => 'joeschmoe@whatever.com',
102                                     summary => $some_text,
103                                     description => $some_more_text);
104
105     my $bug_number = $bz->commit;
106
107     # Below is an example of how one would update a bug.
108
109     my $bz = WWW::Bugzilla->new(    server => 'www.mybugzilla.com',
110                                     email => 'buguser@bug.com',
111                                     password => 'mypassword' 
112                                     bug_number => 46 );
113
114     # show me the chosen component
115     my $component = $bz->component;
116
117     # change component
118     $bz->component( 'Test Failures' );
119
120     $bz->add_cc( 'me@me.org' );
121
122     $bz->add_attachment(    filepath => '/home/me/file.txt',
123                             description => 'description text',
124                             is_patch => 0,
125                             comment => 'comment text here' );
126
127     $bz->additional_comments( "comments here");
128
129     # below are examples of changing bug status
130     $bz->change_status("assigned");
131     $bz->change_status("fixed");
132     $bz->change_status("later");
133     $bz->mark_as_duplicate("12");
134     $bz->reassign("someone@else.com");
135
136     $bz->commit;
137
138 =head1 DESCRIPTION
139
140 WWW::Bugzilla currently provides an API to posting new Bugzilla
141 bugs, as well as updating existing Bugzilla bugs.
142
143 =head1 INTERFACE
144
145 =head2 METHODS
146
147 =over
148
149 =item new()
150
151 Initialize WWW::Bugzilla object.  If bug_number is passed in, 
152 will initialize as existing bug. Will croak() unless the 
153 Bugzilla login page on server specified returns a 200 or 404.
154 new() supports the following name-value parameters.
155
156 =over
157
158 =item server (required)
159
160 URL of the bugzilla server you wish to interface with. Do not 
161 place http:// or https:// in front of the url (see 'use_ssl' option
162 below)
163
164 =item email (required)
165
166 Your email address used by bugzilla, in other words your
167 bugzilla login.
168
169 =item password (required)
170
171 Bugzilla password.
172
173 =item use_ssl (optional)
174
175 If set, will use https:// protocol, defaults to http://.  
176
177 NOTE: This option requires Crypt::SSLeay.
178
179 =item product
180
181 Bugzilla product name, required if entering new bug
182 (not updating).
183
184 =item bug_number (optional)
185
186 If you mean to update an existing bug (not create a new one)
187 include a valid bug number here.
188
189 =item version component status assigned_to resolution dup_id assigned_to summary bug_number description os platform severity priority cc url add_cc target_milestone status_whiteboard keywords depends_on blocks additional_comments
190
191 These are fields that can be initialized on new(), useful for new bugs.
192 Please note that some of these fields apply only to bugs being updated,
193 and if you set them here, they will be overridden if the value is already
194 set in the actual bug on the server.  These fields also have thier own
195 get/set methods (see below).
196
197 =back
198
199 =cut 
200
201 use Class::MethodMaker
202     new_with_init => 'new',
203     new_hash_init => 'hash_init',
204     get_set       => [ FIELDS ];
205
206 sub init {
207     my $self = shift;
208     my %args = @_;
209    
210     croak("'server', 'email', and 'password' are all required arguments.") if ( (not $args{server}) or (not $args{email}) or (not $args{password}) ); 
211
212 #    croak("'product' required for new bug.") if ( (not $args{product}) and (not $args{bug_number}) );
213     $self->{'product'} = $args{'product'} if (defined($args{'product'}));
214
215     $self->{mech} =  WWW::Mechanize->new();
216
217     $self->{protocol} = delete($args{use_ssl}) ? 'https' : 'http';
218
219     $self->{server} = $args{server};                                                                              
220     $self->_login( delete $args{server}, delete $args{email}, delete $args{password});
221     
222     # finish the object
223     $self->hash_init(%args);
224
225     if ($self->{bug_number}) {
226         $self->_get_update_page();
227     } elsif ($self->{product}) {
228         $self->_get_new_page();
229     }
230
231     $self->check_error();
232     return $self;
233 }
234
235 sub _get_new_page {
236     my $self = shift;
237                                                                   
238     my $mech = $self->{mech};
239     my $new_page = $self->{protocol}.'://'.$self->{server}.'/enter_bug.cgi?product='.$self->{product};
240     $mech->get($new_page);
241     $self->check_error();
242     $mech->form_name('Create') if ($self->bugzilla_version == 3);
243
244     # bail unless OK or Redirect happens
245     croak("Cannot open page $new_page") unless ( ($mech->status == '200') or ($mech->status == '404') );
246 }
247
248 sub _get_update_page {
249     my $self = shift;
250
251     my $mech = $self->{mech};
252     $self->_get_form_by_field('quicksearch');
253     $mech->field('quicksearch', $self->{bug_number});
254     $mech->submit();
255     $self->check_error();
256     
257     $mech->form_name("changeform");
258     # set fields to chosen values
259     foreach my $field ( keys %update_field_map ) {
260         if ($mech->current_form->find_input($update_field_map{$field})) {    
261             $self->{$field} = $mech->current_form->value( $update_field_map{$field} );
262         } else {
263 #            warn "# Couldn't find $field";
264         }
265     }
266 }
267
268 # based on the current page, set the current form to the first form with a specified field
269 sub _get_form_by_field {
270     my ($self, $field) = @_;
271     croak("invalid field") if !$field;
272
273     my $mech = $self->{mech};
274     my $i = 1;
275     foreach my $form ($mech->forms()) {
276         if ($form->find_input($field)) {
277             $mech->form_number($i);
278             return;
279         }
280         $i++;
281     }
282     croak("No form with the field $field available");
283 }
284
285 sub _login {
286     my $self = shift;
287     my ($server, $email, $password) = @_;
288
289     my $mech = $self->{mech};
290
291     my $login_page = $self->{protocol}.'://'.$server.'/query.cgi?GoAheadAndLogIn=1';
292     
293     $mech->get( $login_page ); 
294
295     # bail unless OK or Redirect happens
296     croak("Cannot open page $login_page") unless ( ($mech->status == '200') or ($mech->status == '404') );
297
298     $self->_get_form_by_field('Bugzilla_login');
299     $mech->field('Bugzilla_login', $email);
300     $mech->field('Bugzilla_password', $password);
301     $mech->submit_form();
302
303     
304     $mech->get($self->{protocol}.'://'.$server.'/');
305
306     if ($mech->content() =~ /<span>Version (\d+)\.(\d+)(\.\d+)?\+?<\/span>/) {
307         $self->bugzilla_version($1);
308         $self->bugzilla_version_minor($2);
309     } elsif ($mech->content() =~ /<p class="header_addl_info">version (\d+)\./smi) {
310         $self->bugzilla_version($1);
311     } else {
312         croak("Unable to verify bugzilla version.");
313     }
314
315     if ($self->bugzilla_version > 2) {
316         $update_field_map{'status'} = 'bug_status';
317         $other_field_map{'resolution'} = 'resolution';
318     }
319 }
320
321 =item product() version() component() status() assigned_to() resolution() dup_id() assigned_to() summary() bug_number() description() os() platform() severity() priority() cc() url() add_cc() target_milestone() status_whiteboard() keywords() depends_on() blocks() additional_comments()
322
323 get/set the value of these bug fields.  Some apply only to new bugs, some 
324 only to bugs being updated. commit() must be called to save these 
325 permanently.
326
327 =item available() 
328
329 Returns list of available options for field requested. Below are known
330 valid fields:
331
332 product
333 platform
334 os
335 version
336 priority
337 severity
338 component
339 target_milestone
340
341 =cut
342
343 sub available {
344     my $self = shift;
345     my $field_choice = shift;
346     my $mech = $self->{mech};
347
348     # we handle product seperately because bugzilla requires it to be handled 
349     # seperately on bug creation
350     if ('product' eq lc($field_choice)) {
351         return $self->get_products();
352     }
353
354     # make sure that we've set a product before we do any of the other stuff
355     croak("available() needs a valid product to be specified") if not $self->{'product'};
356  
357     # note that we are using %new_field map regardless if this is a new bug
358     # or not.  this should work, as these fields should be the same for
359     # both new and old, but look here if problems occur!
360     
361     if (my $item = $mech->current_form->find_input( $new_field_map{$field_choice} )) {
362         return $item->possible_values();
363     } else {
364         return undef;
365     }
366 }
367
368 =item product()
369
370 Set the Product for the bug
371
372 =cut
373
374 sub product {
375     my ($self, $product) = @_;
376
377     if ($product) {
378         $self->{'product'} = $product;
379         if ($self->{bug_number}) {
380             $self->_get_update_page();
381         } elsif ($self->{'product'}) {
382             $self->_get_new_page();
383         }
384     }
385     return ($self->{'product'});
386 }
387
388
389 =item reassign() 
390
391 Mark bug being updated as reassigned to another user. Takes email 
392 address as parameter.  Status/resolution will not be updated 
393 until commit() is called.
394
395 =cut
396
397 sub reassign {
398     my $self = shift;
399     my $email = shift;
400    
401      croak("reassign() needs a bug number passed in as a parameter") if not $email;
402                                                                              
403     croak("reassign() may not be called until the bug is committed for the first time") if not $self->{bug_number};
404
405     $self->{status} = 'reassign';
406     $self->{assigned_to} = $email;  
407 }
408
409 =item mark_as_duplicate() 
410
411 Mark bug being updated as duplicate of another bug number.
412 Takes bug number as argument.
413 Status/resolution will not be updated until commit() is called.
414
415 =cut 
416
417 sub mark_as_duplicate {
418     my $self = shift;
419     my $dup_id = shift;
420
421     croak("mark_as_duplicate() needs a bug number passed in as a parameter") if not $dup_id;
422     
423     croak("mark_as_duplicate() may not be called until the bug is committed for the first time") if not $self->{bug_number};
424
425     $self->{status} = 'RESOLVED';
426     $self->{resolution} = 'DUPLICATE';
427     $self->{dup_id} = $dup_id;    
428 }
429
430 =item change_status()
431
432 Change status of bug being updated.  Status/resolution will not
433 be updated until commit() is called.  The following are valid 
434 options (case-insensitive):
435
436 assigned
437 fixed
438 invalid
439 wontfix
440 later
441 remind
442 worksforme
443 reopen
444 verified
445 closed
446
447 =cut
448
449 sub change_status {
450     my ($self, $status) = @_;
451
452     croak("change_status() may not be called until the bug is committed for the first time") if not $self->{bug_number};
453
454     $status = uc($status);
455
456     my %status = (
457             'ASSIGNED'  => 'accept', 
458             'REOPENED'    => 'reopen',
459             'VERIFIED'  => 'verify',
460             'CLOSED'    => 'close'
461             );
462
463     my %resolution = (
464             'FIXED'     => 1,
465             'INVALID'   => 1,
466             'WONTFIX'   => 1,
467             'LATER'     => 1,
468             'REMIND'    => 1,
469             'DUPLICATE' => 1,
470             'WORKSFORME' => 1   
471             );
472
473     croak ("$status is not a valid status.") if not ($resolution{$status} or $status{$status});
474
475     if ($status{$status}) {
476         $self->{status} = $status;
477         $self->{resolution} = '';
478         # $status{$status};
479     } else {
480         $self->{status} = "resolve";
481         $self->{resolution} = $status;
482     }
483
484     return 1;
485 }
486
487 =item add_attachment()
488
489 Adds attachment to existing bug - will not work for new 
490 bugs.  Below are available params:
491
492 =over
493
494 =item *
495
496 filepath (required)
497
498 =item *
499
500 description (required)
501
502 =item *
503
504 is_patch (optional boolean)
505
506 =item *
507
508 content_type - Autodetected if not defined.
509
510 =item *
511
512 comment (optional)
513
514 =item *
515
516 finished - will not return object to update form if set (optional boolean) 
517
518 =back
519
520 =cut
521
522 sub add_attachment {
523     my $self = shift;
524     my %args = @_;
525     my $mech = $self->{mech};
526     
527     croak("add_attachment() may not be called until the bug is committed for the first time") if not $self->{bug_number};
528
529     croak("You must include a filepath and description.") unless ($args{filepath} and $args{description});
530  
531     my $attach_page = $self->{protocol}.'://'.$self->{server}.'/attachment.cgi?bugid='.$self->{bug_number}.'&action=enter';
532     
533     $mech->get( $attach_page );
534     $self->check_error();
535     $mech->form_name('entryform');
536     $mech->field( 'data', $args{'filepath'} );
537     $mech->field( 'description', $args{description} );
538     $mech->field( 'comment', $args{comment} ) if $args{comment};
539     $mech->field( 'ispatch', 1 ) if $args{'is_patch'};
540
541     if ($args{'bigfile'}) {
542         if ($mech->current_form->find_input('bigfile', 'checkbox', 0)) {
543             $mech->tick('bigfile', 'bigfile');
544         } else {
545             croak('Bigfile support is not available');
546         }
547     }
548     if ( $args{content_type} ) {
549         $mech->field( 'contenttypemethod', 'manual' );
550         $mech->field( 'contenttypeentry', $args{content_type} );
551     } else {
552         $mech->field( 'contenttypemethod', 'autodetect' );
553     }
554
555     $mech->submit_form(); 
556     $self->check_error();
557     my $id;
558     if ($mech->content =~ /created/i) {
559         my $link = $mech->find_link(text_regex => qr/^Attachment #\d+$/);
560         my $title = $link->attrs()->{'title'};
561         
562         if ($title ne "'" . $args{'description'} . "'" && $title ne $args{'description'}) {
563             croak('attachment not created');
564         }
565         if ($link->text =~ /^Attachment #(\d+)$/) {
566             $id = $1;
567         } else {
568             croak('attachment not created');
569         }
570     }
571
572     $self->_get_update_page() unless ($args{finished});
573     return $id;
574 }
575
576 =item list_attachments()
577
578 Lists attachments that are attached to an existing bug - will not work for new bugs.
579
580 =cut
581
582 sub list_attachments {
583     my $self = shift;
584     my $mech = $self->{mech};
585     
586     croak("list_attachments() may not be called until the bug is committed for the first time") if not $self->{bug_number};
587     
588     my $bug_page = $self->{protocol}.'://'.$self->{server}.'/show_bug.cgi?id='.$self->{bug_number};
589     $mech->get($bug_page);
590     $self->check_error();
591     
592     my (@attachments);
593     my %seen;
594     foreach my $link ($mech->find_all_links(url_regex => qr/attachment\.cgi\?id=\d+$/)) {
595         if ($link->url() =~ /^attachment.cgi\?id=(\d+)$/) {
596             my $id = $1;
597             next if ($seen{$id});
598             $seen{$id}++;
599             my $i = $link->url();
600             $i =~ s/\?/\\?/g;
601             my $re = '<a(?: name="a\d+")? href="' . $i . '"(?:\s*title="View the content of the attachment">\s*<b>|>)?<span class="(bz_obsolete)">';
602             my $obsolete = ($mech->content() =~ /$re/smi) ? 1 : 0;
603             push (@attachments, { id => $id, name => $link->text(), obsolete => $obsolete });
604         } else {
605             croak("WWW::Mechanize find_all_links gave us a bogus URL");
606         }
607     }
608     return (@attachments);
609 }
610
611 =item get_attachment()
612
613 Get the specified attachment from an existing bug - will not work for new bugs.
614
615 =cut
616
617 sub get_attachment {
618     my $self = shift;
619     my %args = @_;
620     my $mech = $self->{mech};
621     
622     croak("get_attachment() may not be called until the bug is committed for the first time") if not $self->{bug_number};
623     
624     croak("You must provide either the 'id' or 'name' of the attachment you wish to retreive") unless ($args{id} || $args{name});
625     
626     my $bug_page = $self->{protocol}.'://'.$self->{server}.'/show_bug.cgi?id='.$self->{bug_number};
627     $mech->get($bug_page);
628     $self->check_error();
629  
630     my @links;
631     if ($args{'id'}) {
632         @links = $mech->find_all_links( url => 'attachment.cgi?id=' . $args{'id'} );
633     } elsif ($args{'name'}) {
634         @links = $mech->find_all_links( text => $args{'name'} );
635         if (scalar(@links) > 1) {
636             carp('multiple attachments have the same name, returning the first one');
637         }
638     }
639
640     croak('No such attachment') if (!@links);
641     $mech->get($links[0]);
642     return $mech->content();
643 }
644
645 =item obsolete_attachment()
646
647 Mark the specified attachment obsolete.  - will not work for new bugs.
648
649 =cut
650
651 sub obsolete_attachment {
652     my $self = shift;
653     my %args = @_;
654     my $mech = $self->{mech};
655     
656     croak("obsolete_attachment() may not be called until the bug is committed for the first time") if not $self->{bug_number};
657     
658     croak("You must provide either the 'id' or 'name' of the attachment you wish to obsolete") unless ($args{id} || $args{name});
659     
660     my $bug_page = $self->{protocol}.'://'.$self->{server}.'/show_bug.cgi?id='.$self->{bug_number};
661     $mech->get($bug_page);
662     $self->check_error();
663  
664     my @links;
665     if ($args{'id'}) {
666         @links = $mech->find_all_links( url => 'attachment.cgi?id=' . $args{'id'} );
667     } elsif ($args{'name'}) {
668         @links = $mech->find_all_links( text => $args{'name'} );
669         if (scalar(@links) > 1) {
670             carp('multiple attachments have the same name, returning the first one');
671         }
672     }
673     croak('No such attachment') if (!@links);
674     $links[0]->[0] = $links[0]->[0] . '&action=edit';
675     $links[0]->[5]->{'href'} = $links[0]->[5]->{'href'} . '&action=edit';
676     $mech->get($links[0]);
677     $mech->form_with_fields('id', 'action', 'contenttypemethod');
678     $mech->tick("isobsolete", 1);
679     $mech->submit();
680     return $mech->content();
681 }
682
683
684 =item commit()
685
686 Submits bugzilla new or update form. Returns bug_number. Optionally
687 takes parameter finished- if set will you are done updating the bug,
688 and wil not return you to the update page.
689
690 =cut 
691
692 sub commit {
693     my $self = shift;
694     my %args = @_;
695     my $mech = $self->{mech};
696  
697 #    print $mech->uri() . "\n";
698     unless ( ( $mech->content() =~ /a href="index\.cgi\?logout=1">/ ) or ( $mech->content() =~ /a href="relogin.cgi">/ ) ) {
699         croak("should be logged in to commit bugs");
700     }
701
702     if ($self->{bug_number}) {
703         # bugzilla > 3.0
704         if ($self->bugzilla_version() > 2) {
705             if ($self->{resolution}) {
706                 $mech->field($update_field_map{'status'}, $self->{'status'});
707                 $mech->field($other_field_map{'resolution'}, $self->{resolution});
708                 $self->{resolution} = undef;
709                 $self->{status} = undef;
710             } elsif ($self->{status}) {
711                 $mech->field('bug_status', $self->{'status'});
712                 $self->{resolution} = undef;
713                 $self->{status} = undef;
714             }
715         } else {
716             if ($self->{resolution}) {
717                 $mech->field($update_field_map{'status'}, 'resolve');
718                 $mech->field($other_field_map{'resolution'}, $self->{resolution});
719                 $self->{resolution} = undef;
720                 $self->{status} = undef;
721             } elsif ($self->{status}) {
722                 $mech->field($update_field_map{'status'}, $self->{status});
723                 $self->{status} = undef;
724             }
725         }
726         
727         if ($self->{dup_id}) {
728             $mech->field('dup_id', $self->{dup_id});
729             $self->{dup_id} = undef;
730         }
731         if ($self->{assigned_to}) {
732             $mech->field('assigned_to', $self->{assigned_to});
733             $self->{assigned_to} = undef;
734         }
735         foreach my $field ( keys %update_field_map ) {
736             # field is missing
737             if (!$mech->current_form->find_input($update_field_map{$field})) {
738 #                warn "# $field is missing";
739                 next;
740             }
741             
742             # field is hidden 
743             next if $mech->current_form->find_input($update_field_map{$field})->type eq 'hidden';
744             $mech->field( $update_field_map{$field}, $self->{$field} ) if defined($self->{$field});
745         }
746     } else {
747         foreach my $field ( keys %new_field_map ) {
748             if ($mech->current_form->find_input($new_field_map{$field})) {
749                 # if field is defined and it has changed
750                 if ( defined($self->{$field}) ) {
751                     $mech->field( $new_field_map{$field}, $self->{$field} ) if ($mech->current_form->value($new_field_map{$field}) ne $self->{$field});
752                 }
753             } 
754         }
755     }
756
757     # delete the comment such that we don't reuse the same comment again accidentally.
758     delete($self->{'comment'});
759
760     $mech->submit_form();
761         
762     # 3.3+ token checking
763     if ($mech->content() =~ /You submitted changes to process_bug\.cgi with an invalid/) {
764         $mech->form_name('check');
765         $mech->submit_form();
766     }
767
768
769     $self->check_error();
770     if (!$self->{bug_number}) {
771         if ($mech->content() =~ /<h2>Bug (\d+) has been added to the database/) {
772             $self->{bug_number} = $1;
773         } elsif ($mech->content() =~ />Bug (\d+)<\/a><\/i> has been added to the database<\/dt>/) {
774             $self->{bug_number} = $1;
775         } elsif ($mech->content() =~ /Bug (\d+) Submitted</) {
776             $self->{bug_number} = $1;
777         } elsif ($mech->content() =~ /Bug&nbsp;(\d+) Submitted</) {
778             $self->{bug_number} = $1;
779         } else {
780 #           warn $mech->content();
781             croak("bug was not saved");
782         }
783     }
784     $self->_get_update_page() unless ($args{finished});
785
786     return $self->{bug_number};
787 }
788
789 =item check_error ()
790
791 Checks if an error was given, croaking if it did.
792
793 =cut 
794
795 sub check_error {
796     my ($self) = @_;
797     my $mech = $self->{mech};
798     
799     if ($mech->content() =~ /<td bgcolor="#ff0000">[\s\r\n]*<font size="\+2">[\s\r\n]*(.*?)[\s\r\n]*<\/font>[\s\r\n]*<\/td>/smi) {
800         croak("error : $1");
801     } elsif ($mech->content() =~ /<td id="error_msg" class="throw_error">\s*(.*?)\s*<\/td>/smi) {
802         croak("error : $1");
803     } elsif ($mech->content() =~ /<div class="throw_error">\s*(.*?)<\/div>/smi) {
804         croak("error : $1");
805     }
806 }
807
808 =item get_products ()
809
810 Gets a list of products
811
812 =cut 
813
814 sub get_products {
815     my ($self) = @_;
816     my $mech = $self->{mech};
817     
818     my $url = $self->{protocol}.'://'.$self->{server}.'/enter_bug.cgi';
819     # version >= 3.0
820     if ($self->bugzilla_version == 3) {
821         $url .= '?classification=__all';
822     }
823     $mech->get($url);
824     $self->check_error();
825
826     my @products;
827     foreach my $product ($mech->find_all_links( url_regex => qr/enter_bug.cgi\?product=/)) {
828         push (@products, $product->text());
829     }
830
831     return (@products);
832 }
833
834
835 =item get_comments()
836
837 Lists comments made on an existing bug - will not work for new bugs.
838
839 =cut
840
841 sub get_comments {
842     my ($self) = @_;
843     croak("get_comments() may not be called until the bug is committed for the first time") if not $self->{bug_number};
844     
845     my $mech = $self->{mech};
846     my $bug_page = $self->{protocol}.'://'.$self->{server}.'/show_bug.cgi?id='.$self->{bug_number};
847     $mech->get($bug_page);
848     $self->check_error(); 
849
850     my @comments;
851     my $content = $mech->content();
852     while ($content =~ m/<pre id="comment_text_\d+">(.*?)<\/pre>/smg) {
853         my $comment = $1;
854         chomp($comment);
855         push (@comments, $comment);
856     }
857
858     # 3.3+
859     while ($content =~ m/<pre class="bz_comment_text"  id="comment_text_\d+">\s*(.*?)<\/pre>/smg) {
860         my $comment = $1;
861         chomp($comment);
862         push (@comments, $comment);
863     }
864
865     return (@comments);
866 }
867
868 =back
869
870 =head1 BUGS, IMPROVEMENTS
871
872 There may well be bugs in this module.  Using it as I have, I just have not run
873 into any.  In addition, this module does not support ALL of Bugzilla's
874 features.  I will consider any patches or improvements, just send me an email
875 at the address listed below.
876  
877 =head1 AUTHOR
878
879 Maintained by:
880     Brian Caswell, bmc@shmoo.com
881
882 Originally written by:
883     Matthew C. Vella, the_mcv@yahoo.com
884
885 =head1 LICENSE
886                                                                       
887   WWW::Bugzilla - Module providing API to create or update Bugzilla bugs.
888   Copyright (C) 2003 Matthew C. Vella (the_mcv@yahoo.com)
889
890   Portions Copyright (C) 2006 Brian Caswell (bmc@shmoo.com)
891                                                                       
892   This module is free software; you can redistribute it and/or modify it
893   under the terms of either:
894                                                                       
895   a) the GNU General Public License as published by the Free Software
896   Foundation; either version 1, or (at your option) any later version,                                                                      
897   or
898                                                                       
899   b) the "Artistic License" which comes with this module.
900                                                                       
901   This program is distributed in the hope that it will be useful,
902   but WITHOUT ANY WARRANTY; without even the implied warranty of
903   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
904   the GNU General Public License or the Artistic License for more details.
905                                                                       
906   You should have received a copy of the Artistic License with this
907   module, in the file ARTISTIC.  If not, I'll be glad to provide one.
908                                                                       
909   You should have received a copy of the GNU General Public License
910   along with this program; if not, write to the Free Software
911   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
912   USA
913
914 =cut
915
916 1;