r45761 - in /branches/upstream/libwww-bugzilla-perl/current: META.yml WWW/Bugzilla.pm WWW/Bugzilla/Search.pm t/search.t t/www_bugzilla.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Wed Oct 14 01:58:08 UTC 2009


Author: jawnsy-guest
Date: Wed Oct 14 01:58:03 2009
New Revision: 45761

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45761
Log:
[svn-upgrade] Integrating new upstream version, libwww-bugzilla-perl (1.5)

Modified:
    branches/upstream/libwww-bugzilla-perl/current/META.yml
    branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla.pm
    branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla/Search.pm
    branches/upstream/libwww-bugzilla-perl/current/t/search.t
    branches/upstream/libwww-bugzilla-perl/current/t/www_bugzilla.t

Modified: branches/upstream/libwww-bugzilla-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-bugzilla-perl/current/META.yml?rev=45761&op=diff
==============================================================================
--- branches/upstream/libwww-bugzilla-perl/current/META.yml (original)
+++ branches/upstream/libwww-bugzilla-perl/current/META.yml Wed Oct 14 01:58:03 2009
@@ -1,15 +1,17 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         WWW-Bugzilla
-version:      1.3
-version_from: WWW/Bugzilla.pm
-installdirs:  site
-requires:
+--- #YAML:1.0
+name:                WWW-Bugzilla
+version:             1.5
+abstract:            ~
+license:             ~
+author:              ~
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
     Carp:                          0
     Class::MethodMaker:            1.08
     Crypt::SSLeay:                 0.57
     Params::Validate:              0.88
     WWW::Mechanize:                1.3
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla.pm?rev=45761&op=diff
==============================================================================
--- branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla.pm (original)
+++ branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla.pm Wed Oct 14 01:58:03 2009
@@ -1,13 +1,14 @@
 package WWW::Bugzilla;
 
-$WWW::Bugzilla::VERSION = '1.3';
+$WWW::Bugzilla::VERSION = '1.5';
 
 use strict;
 use warnings;
 use WWW::Mechanize;
+use Fatal qw(:void open opendir);
 use Carp qw(croak carp);
 
-use constant FIELDS => qw( bugzilla_version 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 );
+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 );
  
 my %new_field_map = (   product => 'product',
                         version => 'version',
@@ -21,6 +22,10 @@
                         priority => 'priority',
                         cc => 'cc',
                         url => 'bug_file_loc' );
+
+my %other_field_map = (
+    resolution => 'resolution_knob_5',
+    );
 
 my %update_field_map = (product => 'product',
 #                        bug_number => 'id', 	# this cannot be updated
@@ -223,6 +228,7 @@
         $self->_get_new_page();
     }
 
+    $self->check_error();
     return $self;
 }
 
@@ -243,19 +249,18 @@
     my $self = shift;
 
     my $mech = $self->{mech};
-
-    my $update_page = $self->{protocol}.'://'.$self->{server}.'/show_bug.cgi?id='.$self->{bug_number};
-    $mech->get($update_page);
+    $self->_get_form_by_field('quicksearch');
+    $mech->field('quicksearch', $self->{bug_number});
+    $mech->submit();
     $self->check_error();
-    $mech->form_name('changeform');
-
-    # bail unless OK or Redirect happens
-    croak("Cannot open page $update_page") unless ( ($mech->status == '200') or ($mech->status == '404') );
-
+    
+    $mech->form_name("changeform");
     # set fields to chosen values
     foreach my $field ( keys %update_field_map ) {
         if ($mech->current_form->find_input($update_field_map{$field})) {    
             $self->{$field} = $mech->current_form->value( $update_field_map{$field} );
+        } else {
+#            warn "# Couldn't find $field";
         }
     }
 }
@@ -294,15 +299,22 @@
     $mech->field('Bugzilla_login', $email);
     $mech->field('Bugzilla_password', $password);
     $mech->submit_form();
+
     
     $mech->get($self->{protocol}.'://'.$server.'/');
 
-    if ($mech->content() =~ /<span>Version (\d+)\.\d+(\.\d+)?\+?<\/span>/) {
+    if ($mech->content() =~ /<span>Version (\d+)\.(\d+)(\.\d+)?\+?<\/span>/) {
         $self->bugzilla_version($1);
+        $self->bugzilla_version_minor($2);
     } elsif ($mech->content() =~ /<p class="header_addl_info">version (\d+)\./smi) {
         $self->bugzilla_version($1);
     } else {
         croak("Unable to verify bugzilla version.");
+    }
+
+    if ($self->bugzilla_version > 2) {
+        $update_field_map{'status'} = 'bug_status';
+        $other_field_map{'resolution'} = 'resolution';
     }
 }
 
@@ -410,7 +422,8 @@
     
     croak("mark_as_duplicate() may not be called until the bug is committed for the first time") if not $self->{bug_number};
 
-    $self->{status} = 'duplicate';
+    $self->{status} = 'RESOLVED';
+    $self->{resolution} = 'DUPLICATE';
     $self->{dup_id} = $dup_id;    
 }
 
@@ -440,26 +453,35 @@
 
     $status = uc($status);
 
-    my %status = (  'ASSIGNED'  => 'accept', 
-                    'REOPEN'    => 'reopen',
-                    'VERIFIED'  => 'verify',
-                    'CLOSED'    => 'close' );
-
-    my %resolution = (  'ASSIGNED'  => 1,
-                        'FIXED'     => 1,
-                        'INVALID'   => 1,
-                        'WONTFIX'   => 1,
-                        'LATER'     => 1,
-                        'REMIND'    => 1,
-                        'WORKSFORME' => 1   );
+    my %status = (
+            'ASSIGNED'  => 'accept', 
+            'REOPENED'    => 'reopen',
+            'VERIFIED'  => 'verify',
+            'CLOSED'    => 'close'
+            );
+
+    my %resolution = (
+            'FIXED'     => 1,
+            'INVALID'   => 1,
+            'WONTFIX'   => 1,
+            'LATER'     => 1,
+            'REMIND'    => 1,
+            'DUPLICATE' => 1,
+            'WORKSFORME' => 1   
+            );
 
     croak ("$status is not a valid status.") if not ($resolution{$status} or $status{$status});
 
     if ($status{$status}) {
-        $self->{status} = $status{$status};
+        $self->{status} = $status;
+        $self->{resolution} = '';
+        # $status{$status};
     } else {
+        $self->{status} = "RESOLVED";
         $self->{resolution} = $status;
     }
+
+    return 1;
 }
 
 =item add_attachment()
@@ -671,28 +693,33 @@
     my $self = shift;
     my %args = @_;
     my $mech = $self->{mech};
+ 
+#    print $mech->uri() . "\n";
+    if ($mech->content() !~ /a href="index\.cgi\?logout=1">/) {
+        croak("must be logged in to commit bugs");
+    }
 
     if ($self->{bug_number}) {
         # bugzilla > 3.0
         if ($self->bugzilla_version() > 2) {
             if ($self->{resolution}) {
-                $mech->field('knob', 'RESOLVED');
-                $mech->field('resolution_knob_5', $self->{resolution});
+                $mech->field($update_field_map{'status'}, $self->{'status'});
+                $mech->field($other_field_map{'resolution'}, $self->{resolution});
                 $self->{resolution} = undef;
+                $self->{status} = undef;
             } elsif ($self->{status}) {
-                my %status_map = ('reopen' => 'none', 'resolve' => 'RESOLVED', 'accept' => 'ASSIGNED'); # , 'none' => 'none', 'duplicate' => 'duplicate');
-                my $val = ($status_map{$self->{status}}) ? $status_map{$self->{status}} : $self->{status};
-                $mech->field('knob', $val);
+                $mech->field('bug_status', $self->{'status'});
+                $self->{resolution} = undef;
                 $self->{status} = undef;
             }
         } else {
             if ($self->{resolution}) {
-                $mech->field('knob', 'resolve');
-                $mech->field('resolution', $self->{resolution});
+                $mech->field($update_field_map{'status'}, 'resolve');
+                $mech->field($other_field_map{'resolution'}, $self->{resolution});
                 $self->{resolution} = undef;
                 $self->{status} = undef;
             } elsif ($self->{status}) {
-                $mech->field('knob', $self->{status});
+                $mech->field($update_field_map{'status'}, $self->{status});
                 $self->{status} = undef;
             }
         }
@@ -706,6 +733,13 @@
             $self->{assigned_to} = undef;
         }
         foreach my $field ( keys %update_field_map ) {
+            # field is missing
+            if (!$mech->current_form->find_input($update_field_map{$field})) {
+#                warn "# $field is missing";
+                next;
+            }
+            
+            # field is hidden 
             next if $mech->current_form->find_input($update_field_map{$field})->type eq 'hidden';
             $mech->field( $update_field_map{$field}, $self->{$field} ) if defined($self->{$field});
         }
@@ -720,7 +754,18 @@
         }
     }
 
+    # delete the comment such that we don't reuse the same comment again accidentally.
+    delete($self->{'comment'});
+
     $mech->submit_form();
+        
+    # 3.3+ token checking
+    if ($mech->content() =~ /You submitted changes to process_bug\.cgi with an invalid/) {
+        $mech->form_name('check');
+        $mech->submit_form();
+    }
+
+
     $self->check_error();
     if (!$self->{bug_number}) {
         if ($mech->content() =~ /<h2>Bug (\d+) has been added to the database/) {
@@ -729,8 +774,10 @@
             $self->{bug_number} = $1;
         } elsif ($mech->content() =~ /Bug (\d+) Submitted</) {
             $self->{bug_number} = $1;
+        } elsif ($mech->content() =~ /Bug&nbsp;(\d+) Submitted</) {
+            $self->{bug_number} = $1;
         } else {
-            # warn $mech->content();
+#           warn $mech->content();
             croak("bug was not saved");
         }
     }
@@ -750,6 +797,10 @@
     my $mech = $self->{mech};
     
     if ($mech->content() =~ /<td bgcolor="#ff0000">[\s\r\n]*<font size="\+2">[\s\r\n]*(.*?)[\s\r\n]*<\/font>[\s\r\n]*<\/td>/smi) {
+        croak("error : $1");
+    } elsif ($mech->content() =~ /<td id="error_msg" class="throw_error">\s*(.*?)\s*<\/td>/smi) {
+        croak("error : $1");
+    } elsif ($mech->content() =~ /<div class="throw_error">\s*(.*?)<\/div>/smi) {
         croak("error : $1");
     }
 }
@@ -779,6 +830,7 @@
 
     return (@products);
 }
+
 
 =item get_comments()
 
@@ -802,6 +854,14 @@
         chomp($comment);
         push (@comments, $comment);
     }
+
+    # 3.3+
+    while ($content =~ m/<pre class="bz_comment_text"  id="comment_text_\d+">\s*(.*?)<\/pre>/smg) {
+        my $comment = $1;
+        chomp($comment);
+        push (@comments, $comment);
+    }
+
     return (@comments);
 }
 

Modified: branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla/Search.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla/Search.pm?rev=45761&op=diff
==============================================================================
--- branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla/Search.pm (original)
+++ branches/upstream/libwww-bugzilla-perl/current/WWW/Bugzilla/Search.pm Wed Oct 14 01:58:03 2009
@@ -1,6 +1,6 @@
 package WWW::Bugzilla::Search;
 
-$WWW::Bugzilla::Search::VERSION = '0.1';
+$WWW::Bugzilla::Search::VERSION = '0.2';
 
 use strict;
 use warnings;
@@ -158,12 +158,14 @@
     if ($mech->{'uri'} ne $url) {
         $mech->get( $url); 
     }
+    $mech->form_name('queryform');
+
     my @values;
-    foreach my $form ($mech->current_form()) {
-        foreach my $field ($form->inputs()) {
-            if ($field->name && $field->name eq $name) {
-                push (@values, grep { defined $_ }$field->possible_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) {

Modified: branches/upstream/libwww-bugzilla-perl/current/t/search.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-bugzilla-perl/current/t/search.t?rev=45761&op=diff
==============================================================================
--- branches/upstream/libwww-bugzilla-perl/current/t/search.t (original)
+++ branches/upstream/libwww-bugzilla-perl/current/t/search.t Wed Oct 14 01:58:03 2009
@@ -4,17 +4,15 @@
 use warnings;
 use Test::More;
 use File::Spec::Functions qw(catfile);
-use Data::Dumper;
 
-BEGIN { use_ok('WWW::Bugzilla::Search'); }
-
-verify_host();
-plan tests => 21;
-
-#my $server   = 'landfill.bugzilla.org/bugzilla-tip';
-my $server   = 'landfill.bugzilla.org/bugzilla-stable';
+my $server   = 'landfill.bugzilla.org/bugzilla-3.4-branch';
 my $email    = 'bmc at shmoo.com';
 my $password = 'pileofcrap';
+
+verify_host($server);
+
+plan tests => 22;
+use_ok('WWW::Bugzilla::Search');
 
 my $bz = WWW::Bugzilla::Search->new(
             server   => $server,
@@ -27,40 +25,36 @@
 
 
 my %fields = (
-    'classification' => ['Unclassified'],
-    'product' => [qw(5f746573742070726f64756374 416e6f746865722050726f64756374 44656c6574654d65 466f6f645265706c696361746f72 4d794f776e42616453656c66 50726f647563742077697468206e6f206465736372697074696f6e 5370696465722053c3a9c3a7726574c3adc3b86e73 576f726c64436f6e74726f6c)],
-    'component' => ["A Component", "Cleanup", "Comp1", "comp2", "Component 1", "Digestive Goo", "EconomicControl", "PoliticalBackStabbing", "renamed component", "Salt", "Salt II", "SaltSprinkler", "SpiceDispenser", "TheEnd", "Venom", "VoiceInterface", "WeatherControl", "Web"],
-    'version' => ['1.0', '1.0.1.0.1', 'unspecified'],
-    'target_milestone' => ['---', 'M1', "First Milestone", "Second Milestone", "Third Milestone", "Fourth Milestone", "Fifth Milestone"],
-    'bug_status' => [ "UNCONFIRMED", "NEW", "ASSIGNED", "REOPENED", "RESOLVED", "VERIFIED", "CLOSED" ],
+    'classification' => ['Unclassified', 'Widgets', 'Mercury'],
+    'product' => [          'FoodReplicator', 'LJL Test Product', 'MyOwnBadSelf', 'Sam\'s Widget', "Spider S\x{e9}\x{e7}ret\x{ed}\x{f8}ns", 'WorldControl'],
+    'component' => [ 'Comp1', 'Component 1', 'Component 2', 'Digestive Goo', 'EconomicControl', 'PoliticalBackStabbing', 'Salt', 'Salt II', 'SaltSprinkler', 'SpiceDispenser', 'Venom', 'VoiceInterface', 'WeatherControl', 'Web', 'Widget Gears', 'comp2', 'renamed component' ],
+    'version' => ['1.0', 'unspecified'],
+    'target_milestone' => [ '---', 'M1', 'World 2.0' ],
+    'bug_status' => [ 'UNCONFIRMED', 'NEW', 'ASSIGNED', 'REOPENED', 'RESOLVED', 'VERIFIED', 'CLOSED' ],
     'resolution' => [ "FIXED", "INVALID", "WONTFIX", "LATER", "REMIND", "DUPLICATE", "WORKSFORME", "MOVED", '---' ],
-    'bug_severity' => ["blocker", "critical", "major", "normal", "minor", "trivial", "enhancement" ],
+    'bug_severity' => [ 'blocker', 'critical', 'major', 'normal', 'minor', 'trivial', 'enhancement' ],
     'priority' => [ "P1", "P2", "P3", "P4", "P5" ],
     'rep_platform' => [ "All", "DEC", "HP", "Macintosh", "PC", "SGI", "Sun", "Other" ],
-    'op_sys' => [qw(416c6c 57696e646f777320332e31 57696e646f7773203935 57696e646f7773203938 57696e646f7773204d45 57696e646f77732032303030 57696e646f7773204e54 57696e646f7773205850 57696e646f7773205365727665722032303033 4d61632053797374656d2037 4d61632053797374656d20372e35 4d61632053797374656d20372e362e31 4d61632053797374656d20382e30 4d61632053797374656d20382e35 4d61632053797374656d20382e36 4d61632053797374656d20392e78 4d6163204f5320582031302e30 4d6163204f5320582031302e31 4d6163204f5320582031302e32 4c696e7578 4253442f4f53 46726565425344 4e6574425344 4f70656e425344 414958 42654f53 48502d5558 49524958 4e65757472696e6f 4f70656e564d53 4f532f32 4f53462f31 536f6c61726973 53756e4f53 4dc3a1c3a7c398c39f 4f74686572)],
+    'op_sys' => [ 'All', 'Windows 3.1', 'Windows 95', 'Windows 98', 'Windows ME', 'Windows 2000', 'Windows NT', 'Windows XP', 'Windows Server 2003', 'Mac System 7', 'Mac System 7.5', 'Mac System 7.6.1', 'Mac System 8.0', 'Mac System 8.5', 'Mac System 8.6', 'Mac System 9.x', 'Mac OS X 10.0', 'Mac OS X 10.1', 'Mac OS X 10.2', 'Linux', 'BSD/OS', 'FreeBSD', 'NetBSD', 'OpenBSD', 'AIX', 'BeOS', 'HP-UX', 'IRIX', 'Neutrino', 'OpenVMS', 'OS/2', 'OSF/1', 'Solaris', 'SunOS', "M\x{e1}\x{e7}\x{d8}\x{df}", 'Other']
     );
        
 
 foreach my $field (sort keys %fields) {
-    if ($field =~ /^op_sys|product$/) {
-        is_deeply([map(unpack('H*',$_), $bz->$field())], $fields{$field}, $field);
-    } else {
-        is_deeply([$bz->$field()], $fields{$field}, $field);
-    }
+    is_deeply([$bz->$field()], $fields{$field}, $field);
 }
 
 $bz->product('FoodReplicator');
 $bz->assigned_to('mybutt at inyourface.com');
 $bz->reporter('bmc at shmoo.com');
 
-my %searches = ( 'this was my summary' => [3035], 'this isnt my summary' => [3037, 3039] );
+my %searches = ( 'this was my summary' => [8505], 'this isnt my summary' => [8503, 8504] );
 foreach my $text (sort keys %searches) {
     $bz->summary($text);
     my @bugs = $bz->search();
     is(scalar(@bugs), scalar(@{$searches{$text}}), 'search count : ' . $text);
     map(isa_ok($_, 'WWW::Bugzilla'), @bugs);
     my @bug_ids = map($_->bug_number, @bugs);
-    is_deeply($searches{$text}, [@bug_ids], 'bug numbers : ' . $text);
+    is_deeply([@bug_ids], $searches{$text}, 'bug numbers : ' . $text);
 }
 
 $bz->reset();
@@ -68,9 +62,11 @@
 
 
 sub verify_host {
+    my ($server) = @_;
     use WWW::Mechanize;
     my $mech = WWW::Mechanize->new( autocheck => 0);
-    $mech->get('http://landfill.bugzilla.org/bugzilla-stable');
+    $mech->get("https://$server");
     return if ($mech->res()->is_success);
     plan skip_all => 'Cannot access remote host.  not testing';
+    exit;
 }

Modified: branches/upstream/libwww-bugzilla-perl/current/t/www_bugzilla.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-bugzilla-perl/current/t/www_bugzilla.t?rev=45761&op=diff
==============================================================================
--- branches/upstream/libwww-bugzilla-perl/current/t/www_bugzilla.t (original)
+++ branches/upstream/libwww-bugzilla-perl/current/t/www_bugzilla.t Wed Oct 14 01:58:03 2009
@@ -2,229 +2,181 @@
 
 use strict;
 use warnings;
-use Test::More; #  tests => 71;
+use Test::More;
 use File::Spec::Functions qw(catfile);
-use Data::Dumper;
 
-BEGIN { use_ok('WWW::Bugzilla'); }
-my $bug_number = 5731;
+my $server = 'landfill.bugzilla.org/bugzilla-3.4-branch';
 
-verify_host();
-plan tests => 70;
+verify_host($server);
+plan(tests => 35);
 
-#my $server   = 'landfill.bugzilla.org/bugzilla-tip';
-my $server   = 'landfill.bugzilla.org/bugzilla-stable';
+use_ok('WWW::Bugzilla');
+
+my $bug_number = 8515;
+
 my $email    = 'bmc at shmoo.com';
 my $password = 'pileofcrap';
 my $product  = 'FoodReplicator';
 
 my $summary     = 'this is my summary';
 my $description = "this is my description.\nthere are many like it, but this one is mine.";
-        
-#my @products = ( '_test product', 'FoodReplicator', 'MyOwnBadSelf', 'Pony', 'Product with no description', "Spider S\x{e9}\x{e7}ret\x{ed}\x{f8}ns", 'WorldControl' );
+my @products = ('FoodReplicator', 'LJL Test Product', "Spider S\x{e9}\x{e7}ret\x{ed}\x{f8}ns", 'Sam\'s Widget', 'MyOwnBadSelf', 'WorldControl');
+my @added_comments;
+my @added_files;
 
-# grr. LWP doesn not deal well with UTF-8, as such we have to cheat.  Sorry. 
-my @products_2 = qw(5f746573742070726f64756374 466f6f645265706c696361746f72 4d794f776e42616453656c66 506f6e79 50726f647563742077697468206e6f206465736372697074696f6e 5370696465722053c3a9c3a7726574c3adc3b86e73 576f726c64436f6e74726f6c);
-my @products_3 = qw(64756d70a0756e77616e746564a062756773a068657265 466f6f645265706c696361746f72 50726f64756374a077697468a06e6fa06465736372697074696f6e 537069646572a053c3a9c3a7726574c3adc3b86e73 5553493130 5f74657374a070726f64756374 495044 4d794f776e42616453656c66 576f726c64436f6e74726f6c);
+check_products();
+check_states();
+check_comments();
+check_create_by_product();
+check_file_attach();
+check_attached_files();
+exit;
 
-foreach my $server ('landfill.bugzilla.org/bugzilla-tip', 'landfill.bugzilla.org/bugzilla-stable') {
-    my @added_comments;
+sub check_products {
+    my $bz = WWW::Bugzilla->new(
+            use_ssl => 1,
+            server   => $server,
+            email    => $email,
+            password => $password,
+            );
+    ok($bz, 'new');
 
-    if (1) {
-        my $bz = WWW::Bugzilla->new(
-                server   => $server,
-                email    => $email,
-                password => $password,
-                );
-        ok($bz, 'new');
+    eval { $bz->available('component'); };
+    like($@, qr/available\(\) needs a valid product to be specified/, 'product first');
 
-        eval { $bz->available('component'); };
-        like($@, qr/available\(\) needs a valid product to be specified/, 'product first');
+    my @available = $bz->available('product');
+    is_deeply(\@available, \@products, 'expected: product');
 
-        my @available = map(unpack('H*', $_), $bz->available('product'));
-        if ($bz->bugzilla_version() == 2) {
-            is_deeply(\@available, \@products_2, 'expected: product');
-        } else {
-            is_deeply(\@available, \@products_3, 'expected: product');
-        }
+    eval { $bz->product('this_is_not_a_real_product'); };
+    like ($@, qr/error \: Sorry\, either the product/, 'invalid product');
 
-        eval { $bz->product('this is not a real product'); };
-        like ($@, qr/error \: Sorry\, either the product/, 'invalid product');
+    $bz->summary($summary);
+    $bz->description($description);
+    push (@added_comments, $description);
+    ok($bz->product($available[0]), 'set: product');
+    my $bugid = $bz->commit();
+    like ($bugid, qr/^\d+$/, "bugid : $bugid");
+    $bug_number = $bugid;
+}
+   
+sub check_states {
+    my $bz = WWW::Bugzilla->new(
+            use_ssl => 1,
+            server     => $server,
+            email      => $email,
+            password   => $password,
+            bug_number => $bug_number
+            );
 
-        $bz->summary($summary);
-        $bz->description($description);
-        push (@added_comments, $description);
-        ok($bz->product(pack('H*',$available[1])), 'set: product');
-        my $bugid = $bz->commit();
-        like ($bugid, qr/^\d+$/, "bugid : $bugid");
-        $bug_number = $bugid;
+
+    my $comment = 'comments here - 1';
+    is($bz->summary, $summary, 'summary');
+    ok($bz->additional_comments($comment), 'add comment');
+    ok($bz->commit, 'commit');
+    push (@added_comments, $comment);
+
+    ok($bz->change_status('fixed'), 'mark fixed');
+    ok($bz->commit, 'commit');
+
+    ok($bz->change_status('reopened'), 'reopened');
+    ok($bz->commit, 'commit');
+
+    ok($bz->mark_as_duplicate(2998), 'mark as duplicate');
+    ok($bz->commit, 'commit');
+    push (@added_comments, '*** This bug has been marked as a duplicate of <span class="bz_closed"><a href="show_bug.cgi?id=2998" title="RESOLVED FIXED - Hardlinks not created and the world is thence seriously out of control">bug 2998</a></span> ***');
+}
+
+sub check_comments {
+    my $bz = WWW::Bugzilla->new(
+            use_ssl => 1,
+            server     => $server,
+            email      => $email,
+            password   => $password,
+            bug_number => $bug_number
+            );
+
+
+    my @comments = $bz->get_comments();
+    is_deeply(\@comments, \@added_comments, 'comments');
+}
+
+sub check_create_by_product {
+    my $bz = WWW::Bugzilla->new(
+            use_ssl => 1,
+            server   => $server,
+            email    => $email,
+            password => $password,
+            product  => $product
+            );
+    ok($bz, 'new');
+
+    is($bz->product, $product, 'new bug, with setting product');
+
+    my %expected = (
+            'component' => [ 'renamed component', 'Salt', 'Salt II', 'SaltSprinkler', 'SpiceDispenser', 'VoiceInterface' ],
+            'version'  => [ '1.0' ],
+            'platform' => [ 'All', 'DEC', 'HP', 'Macintosh', 'PC', 'SGI', 'Sun', 'Other' ],
+            'os' => [ 'All', 'Windows 3.1', 'Windows 95', 'Windows 98', 'Windows ME', 'Windows 2000', 'Windows NT', 'Windows XP', 'Windows Server 2003', 'Mac System 7', 'Mac System 7.5', 'Mac System 7.6.1', 'Mac System 8.0', 'Mac System 8.5', 'Mac System 8.6', 'Mac System 9.x', 'Mac OS X 10.0', 'Mac OS X 10.1', 'Mac OS X 10.2', 'Linux', 'BSD/OS', 'FreeBSD', 'NetBSD', 'OpenBSD', 'AIX', 'BeOS', 'HP-UX', 'IRIX', 'Neutrino', 'OpenVMS', 'OS/2', 'OSF/1', 'Solaris', 'SunOS', "M\x{e1}\x{e7}\x{d8}\x{df}", 'Other' ]
+            );
+
+    foreach my $field (keys %expected) {
+        my @available = $bz->available($field);
+        is_deeply(\@available, $expected{$field}, "expected: $field");
+        eval { $bz->$field($available[1]); };
+        ok(!$@, "set: $field");
     }
 
-    if (1)
-    {
-        my $bz = WWW::Bugzilla->new(
-                server     => $server,
-                email      => $email,
-                password   => $password,
-                bug_number => $bug_number
-                );
+    $bz->assigned_to($email);
+    $bz->summary($summary);
+    $bz->description($description);
+    $bug_number = $bz->commit;
+    like($bug_number, qr/^\d+$/, "bugid: $bug_number");
+}
 
-        is($bz->summary, $summary, 'summary');
-        ok($bz->additional_comments("comments here"), 'add comment');
-        ok($bz->commit, 'commit');
-        push (@added_comments, 'comments here');
+sub check_file_attach {
+    my $bz = WWW::Bugzilla->new(
+            use_ssl => 1,
+            server     => $server,
+            email      => $email,
+            password   => $password,
+            bug_number => $bug_number
+            );
 
-        ok($bz->change_status('fixed'), 'mark fixed');
-        ok($bz->commit, 'commit');
+    my $filepath = './GPL';
+    my $name = 'Attaching the GPL, since everyone needs a copy of the GPL!';
+    my $id = $bz->add_attachment( filepath => $filepath, description => $name);
+    like($id, qr/^\d+$/, 'add attachment');
+    push (@added_files, { id => $id, name => $name, obsolete => 0 });
 
-        ok($bz->change_status('reopen'), 'reopen');
-        ok($bz->commit, 'commit');
+    $name .= ' but as a big file';   
+ 
+    $id = $bz->add_attachment( filepath => $filepath, description => $name );
+    like($id, qr/^\d+$/, 'add big attachment');
+    push (@added_files, { id => $id, name => $name, obsolete => 0 });
+}
 
-        ok($bz->mark_as_duplicate(2998), 'mark as duplicate');
-        ok($bz->commit, 'commit');
-        if ($bz->bugzilla_version() == 2) {
-            push (@added_comments, "\n\n" . '*** This bug has been marked as a duplicate of <span class="bz_closed"><a href="show_bug.cgi?id=2998" title="RESOLVED DUPLICATE - This is the summary">2998</a></span> ***');
-        } else {
-            push (@added_comments, "\n\n" . '*** This bug has been marked as a duplicate of <a href="show_bug.cgi?id=2998" title="ASSIGNED - Hardlinks not created and the world is thence seriously out of control">bug 2998</a> ***');
-        }
-    }
+sub check_attached_files {
+    my $bz = WWW::Bugzilla->new(
+            use_ssl => 1,
+            server     => $server,
+            email      => $email,
+            password   => $password,
+            bug_number => $bug_number
+            );
 
-    if (1)
-    {
-        my $bz = WWW::Bugzilla->new(
-                server     => $server,
-                email      => $email,
-                password   => $password,
-                bug_number => $bug_number
-                );
+    my @attachments = $bz->list_attachments();
 
+    is_deeply(\@added_files, \@attachments, 'attached files');
 
-        my @comments = $bz->get_comments();
-        is_deeply(\@comments, \@added_comments, 'comments');
-    }
+    my $file = slurp('./GPL');
+    is($file, $bz->get_attachment(id => $attachments[0]->{'id'}), 'get attachment by id');
+    is($file, $bz->get_attachment(name => $attachments[0]->{'name'}), 'get attachment by name');
+    eval { $bz->get_attachment(); };
+    like ($@, qr/You must provide either the 'id' or 'name' of the attachment you wish to retreive/, 'get attachment without arguments');
 
-    if (1) {
-        my $bz = WWW::Bugzilla->new(
-                server   => $server,
-                email    => $email,
-                password => $password,
-                product  => $product
-                );
-        ok($bz, 'new');
-
-        is($bz->product, $product, 'new bug, with setting product');
-
-        my %expected = (
-                'component' => [
-                'renamed component', 'Salt',
-                'Salt II',           'SaltSprinkler',
-                'SpiceDispenser',    'VoiceInterface'
-                ],
-                'version'  => ['1.0'],
-                'platform' =>
-                ['All', 'DEC', 'HP', 'Macintosh', 'PC', 'SGI', 'Sun', 'Other'],
-#        'os' => [
-#            'All',                 'Windows 3.1',
-#            'Windows 95',          'Windows 98',
-#            'Windows ME',          'Windows 2000',
-#            'Windows NT',          'Windows XP',
-#            'Windows Server 2003', 'Mac System 7',
-#            'Mac System 7.5',      'Mac System 7.6.1',
-#            'Mac System 8.0',      'Mac System 8.5',
-#            'Mac System 8.6',      'Mac System 9.x',
-#            'Mac OS X 10.0',       'Mac OS X 10.1',
-#            'Mac OS X 10.2',       'Linux',
-#            'BSD/OS',              'FreeBSD',
-#            'NetBSD',              'OpenBSD',
-#            'AIX',                 'BeOS',
-#            'HP-UX',               'IRIX',
-#            'Neutrino',            'OpenVMS',
-#            'OS/2',                'OSF/1',
-#            'Solaris',             'SunOS',
-#            "M\x{e1}\x{e7}\x{d8}\x{df}", 'Other'
-#        ]
-        );
-
-        foreach my $field (keys %expected) {
-            my @available = $bz->available($field);
-            is_deeply(\@available, $expected{$field}, "expected: $field");
-            eval { $bz->$field($available[1]); };
-            ok(!$@, "set: $field");
-        }
-
-# grr.  LWP does not deal with UTF-8.  cheating here too
-        {
-            my @os = qw(416c6c 57696e646f777320332e31 57696e646f7773203935 57696e646f7773203938 57696e646f7773204d45 57696e646f77732032303030 57696e646f7773204e54 57696e646f7773205850 57696e646f7773205365727665722032303033 4d61632053797374656d2037 4d61632053797374656d20372e35 4d61632053797374656d20372e362e31 4d61632053797374656d20382e30 4d61632053797374656d20382e35 4d61632053797374656d20382e36 4d61632053797374656d20392e78 4d6163204f5320582031302e30 4d6163204f5320582031302e31 4d6163204f5320582031302e32 4c696e7578 4253442f4f53 46726565425344 4e6574425344 4f70656e425344 414958 42654f53 48502d5558 49524958 4e65757472696e6f 4f70656e564d53 4f532f32 4f53462f31 536f6c61726973 53756e4f53 4dc3a1c3a7c398c39f 4f74686572);
-            my @available = map(unpack('H*',$_),$bz->available('os'));
-            is_deeply(\@available, \@os, "expected: os");
-            eval { $bz->os(pack('H*', $available[0])); };
-            ok(!$@, "set: os");
-        }
-
-
-
-        $bz->assigned_to($email);
-        $bz->summary($summary);
-        $bz->description($description);
-        $bug_number = $bz->commit;
-        like($bug_number, qr/^\d+$/, "bugid: $bug_number");
-    }
-
-    my @added_files;
-
-    if (1)
-    {
-        my $bz = WWW::Bugzilla->new(
-                server     => $server,
-                email      => $email,
-                password   => $password,
-                bug_number => $bug_number
-                );
-
-        my $filepath = './GPL';
-        {
-            my $name = 'Attaching the GPL, since everyone needs a copy of the GPL!';
-            my $id = $bz->add_attachment( filepath => $filepath, description => $name);
-            like($id, qr/^\d+$/, 'add attachment');
-            push (@added_files, { id => $id, name => $name, obsolete => 0 });
-        }
-
-SKIP: 
-        {
-            eval {
-                my $name = 'Attaching the GPL, but as a big file!';
-                my $id = $bz->add_attachment( filepath => $filepath, description => $name);
-                like($id, qr/^\d+$/, 'add big attachment');
-                push (@added_files, { id => $id, name => $name, obsolete => 0 });
-            };
-            skip 'bigfile support missing in target bugzilla', 1 if ($@ && $@ =~ /Bigfile support is not available/);
-            pass('attach big file');
-        }
-    }
-
-    if (1)
-    {
-        my $bz = WWW::Bugzilla->new(
-                server     => $server,
-                email      => $email,
-                password   => $password,
-                bug_number => $bug_number
-                );
-
-        my @attachments = $bz->list_attachments();
-
-        is_deeply(\@added_files, \@attachments, 'attached files');
-
-        my $file = slurp('./GPL');
-        is($file, $bz->get_attachment(id => $attachments[0]->{'id'}), 'get attachment by id');
-        is($file, $bz->get_attachment(name => $attachments[0]->{'name'}), 'get attachment by name');
-        eval { $bz->get_attachment(); };
-        like ($@, qr/You must provide either the 'id' or 'name' of the attachment you wish to retreive/, 'get attachment without arguments');
-
-        $bz->obsolete_attachment(id => $attachments[0]->{'id'});
-        @attachments = $bz->list_attachments();
-        is ($attachments[0]{'obsolete'}, 1, 'obsolete_attachment');
-    }
+    $bz->obsolete_attachment(id => $attachments[0]->{'id'});
+    @attachments = $bz->list_attachments();
+    is ($attachments[0]{'obsolete'}, 1, 'obsolete_attachment');
 }
 
 sub slurp {
@@ -235,9 +187,12 @@
 }
 
 sub verify_host {
+    my ($server) = @_;
     use WWW::Mechanize;
     my $mech = WWW::Mechanize->new( autocheck => 0);
-    $mech->get('http://landfill.bugzilla.org/bugzilla-stable');
-    return if ($mech->res()->is_success);
-    plan skip_all => 'Cannot access remote host.  not testing';
+    $mech->get("https://$server");
+    return if ($mech->res()->is_success && $mech->content() !~ /The site you are currently accessing is temporarily down for its hourly update from CVS/);
+    plan skip_all => "Cannot access remote host.  not testing";
+    exit;
 }
+




More information about the Pkg-perl-cvs-commits mailing list