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;