r29350 - in /branches/upstream/libwww-mechanize-shell-perl/current: Changes MANIFEST.skip META.yml Makefile.PL lib/WWW/Mechanize/Shell.pm t/00-use.t t/04-history-invariant.t t/13-command-au.t t/14-command-identity.t t/401-server t/99-todo.t

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Mon Jan 5 17:28:00 UTC 2009


Author: gregoa
Date: Mon Jan  5 17:27:51 2009
New Revision: 29350

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

Modified:
    branches/upstream/libwww-mechanize-shell-perl/current/Changes
    branches/upstream/libwww-mechanize-shell-perl/current/MANIFEST.skip
    branches/upstream/libwww-mechanize-shell-perl/current/META.yml
    branches/upstream/libwww-mechanize-shell-perl/current/Makefile.PL
    branches/upstream/libwww-mechanize-shell-perl/current/lib/WWW/Mechanize/Shell.pm
    branches/upstream/libwww-mechanize-shell-perl/current/t/00-use.t
    branches/upstream/libwww-mechanize-shell-perl/current/t/04-history-invariant.t
    branches/upstream/libwww-mechanize-shell-perl/current/t/13-command-au.t
    branches/upstream/libwww-mechanize-shell-perl/current/t/14-command-identity.t
    branches/upstream/libwww-mechanize-shell-perl/current/t/401-server
    branches/upstream/libwww-mechanize-shell-perl/current/t/99-todo.t

Modified: branches/upstream/libwww-mechanize-shell-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/Changes?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/Changes (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/Changes Mon Jan  5 17:27:51 2009
@@ -9,6 +9,22 @@
   + Think how to add other (Xpath) extractions to conveniently
     display stuff via CSS selectors or XPath selectors. Steal
     from Web::Scraper.
+  + There is a memory leak between ::FormFiller and ::Shell
+
+0.48 20081109
+  + More test fixes for incompatibilities between LWP and Mechanize 1.34+
+  + Removed way to set up authentication for more than one site
+  . WWW::Mechanize monkeypatches LWP::UserAgent and thus you can only ever
+    have one set of user/password in your script.
+
+0.47 20081102
+  + Fix tests to work with libwww 5.815+ which automatically retries
+    with empty user/password
+  + WWW::Mechanize 1.34+ breaks Basic authentication with LWP 5.815+
+    so all auth tests are skipped until Andy Lester and Gisle Aas
+    work out who has to fix their stuff.
+  . Hook::LexWrap is subject to bug [perl #46217], this might
+    cause problems if you're running Perl 5.10.0. All tests pass.
 
 0.46 20071003
   + Bump version because of borked CPAN upload, retrying

Modified: branches/upstream/libwww-mechanize-shell-perl/current/MANIFEST.skip
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/MANIFEST.skip?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/MANIFEST.skip (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/MANIFEST.skip Mon Jan  5 17:27:51 2009
@@ -11,3 +11,5 @@
 Makefile
 cover_db/
 blibdirs.ts
+perlbug.rep
+t/hook*

Modified: branches/upstream/libwww-mechanize-shell-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/META.yml?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/META.yml (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/META.yml Mon Jan  5 17:27:51 2009
@@ -1,10 +1,13 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         WWW-Mechanize-Shell
-version:      0.46
-version_from: lib/WWW/Mechanize/Shell.pm
-installdirs:  site
-requires:
+--- #YAML:1.0
+name:                WWW-Mechanize-Shell
+version:             0.48
+abstract:            An interactive shell for WWW::Mechanize
+license:             ~
+author:              
+    - Max Maischein <corion at cpan.org>
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
     Hook::LexWrap:                 0.2
     HTML::Display:                 0
     HTML::TokeParser::Simple:      2
@@ -14,6 +17,6 @@
     URI::URL:                      0
     WWW::Mechanize:                1.2
     WWW::Mechanize::FormFiller:    0.05
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: branches/upstream/libwww-mechanize-shell-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/Makefile.PL?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/Makefile.PL (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/Makefile.PL Mon Jan  5 17:27:51 2009
@@ -19,59 +19,5 @@
        AUTHOR     => 'Max Maischein <corion at cpan.org>') : ()),
 );
 
-use vars qw($have_test_inline);
-BEGIN {
-  eval { require Test::Inline;
-         $have_test_inline = $Test::Inline::VERSION ge '0.15_001'; };
-  undef $@;
-  if ($have_test_inline) {
-    print "Good - you have a patched Test::Inline\n";
-  } else {
-    print "Test::Inline 0.15_001 is nice for testing the examples, but not necessary\n"
-  };
-};
-
-# Autocreate the synopsis test from the pod of every module
-# (if we have Test::Inline)
-if (0) { eval q{
-    package MY;
-    use strict;
-    sub top_targets {
-
-        my($self) = @_;
-        my $out = "POD2TEST_EXE = pod2test\n";
-
-        $out .= $self->SUPER::top_targets(@_);
-        return $out unless $main::have_test_inline;
-
-        $out =~ s/^(pure_all\b.*)/$1 testifypods/m;
-
-        $out .= "\n\ntestifypods : \n";
-
-        foreach my $pod (keys %{$self->{MAN1PODS}},
-                         keys %{$self->{MAN3PODS}})
-        {
-            (my $test = $pod) =~ s/\.(pm|pod)$//;
-            $test =~ s|/|-|g;
-            $test =~ s/^lib\W//;
-            $test =~ s/\W/-/;
-            $test = "embedded-$test.t";
-            $out .= "\t$self->{NOECHO}\$(POD2TEST_EXE) ".
-                    "$pod t/$test\n";
-        }
-
-        return $out;
-    }
-
-		sub postamble {
-    	return <<EOF
-cover:
-\trm -rf cover_db
-\tHARNESS_PERL_SWITCHES=-MDevel::Cover=-coverage,statement,branch,-silent,1,-select,^blib/lib,+inc,Win32,-summary,0 \$(MAKE) test || true
-\t/usr/bin/cover cover_db -report html
-EOF
-		}
-}};
-
 # To make Test::Prereq happy
 1;

Modified: branches/upstream/libwww-mechanize-shell-perl/current/lib/WWW/Mechanize/Shell.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/lib/WWW/Mechanize/Shell.pm?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/lib/WWW/Mechanize/Shell.pm (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/lib/WWW/Mechanize/Shell.pm Mon Jan  5 17:27:51 2009
@@ -15,7 +15,7 @@
 use B::Deparse;
 
 use vars qw( $VERSION @EXPORT %munge_map );
-$VERSION = '0.46';
+$VERSION = '0.48';
 @EXPORT = qw( &shell );
 
 =head1 NAME
@@ -108,7 +108,8 @@
 		verbose => 0,
   };
   # Install the request dumper :
-  $self->{request_wrapper} = wrap *LWP::UserAgent::request,
+  $self->{request_wrapper} = wrap 'LWP::UserAgent::request',
+      #pre => sub { printf STDERR "Dumping? %s\n",$self->option("dumprequests"); $self->request_dumper($_[1]) if $self->option("dumprequests"); },
       pre => sub { $self->request_dumper($_[1]) if $self->option("dumprequests"); },
       post => sub {
                     $self->response_dumper($_[-1]) if $self->option("dumpresponses");
@@ -163,7 +164,10 @@
 
 sub release_agent {
   my ($self) = @_;
+  use Data::Dumper;
+  warn Dumper $self;
   undef $self->{request_wrapper};
+  undef $self->{redirect_ok_wrapper};
   $self->{agent} = undef;
 };
 
@@ -1322,23 +1326,12 @@
 
 Syntax:
 
-  auth [authority realm] user password
-
-If you get back a 401, you can simply supply the matching
-user and password, as the authority and realm are already
-known :
-
-	>get http://www.example.com
-	Retrieving http://www.example.com(401)
-	http://www.example.com>auth corion secret
-	http://www.example.com>get http://www.example.com
-	Retrieving http://www.example.com(200)
-	http://www.example.com>
+  auth user password
 
 If you know the authority and the realm in advance, you can
 presupply the credentials, for example at the start of the script :
 
-	>auth www.example.com:80 secure_realm corion secret
+	>auth corion secret
 	>get http://www.example.com
 	Retrieving http://www.example.com(200)
 	http://www.example.com>
@@ -1347,36 +1340,23 @@
 
 sub run_auth {
     my ($self) = shift;
-    my ($authority, $realm, $user, $password);
+    my ($user, $password);
     if (scalar @_ == 2) {
-      unless ($self->agent->res) {
-        print "Can't guess authentification elements without a request.";
-        print "Use the four parameter version instead.";
-        return;
-      };
-
       ($user,$password) = @_;
+      $password = "" if not defined $password;
+
       my $code = sub {
-          if ($self->agent->res->www_authenticate =~ /\brealm=(['"]?)(.*)\1/) {
-            $realm = $2
-          } else {
-            #$self->warn_user();
-            $realm = "";
-          };
-          $authority = $self->agent->{req}->uri->authority();
-          $self->agent->credentials($authority,$realm,$user => $password);
+          $self->agent->credentials($user => $password);
       };
       $code->();
       my $body = $self->munge_code($code);
 
       $self->add_history(
-          sprintf( q{my ($user,$password) = ('%s','%s')}, $user, $password),
+          sprintf( q{my ($user,$password) = ('%s','%s');}, $user, $password),
           $body,
       );
     } else {
-      ($authority, $realm, $user, $password) = @_;
-      $self->add_history( sprintf q{$agent->credentials('%s','%s','%s','%s');}, $authority,$realm,$user,$password);
-      $self->agent->credentials($authority,$realm,$user => $password);
+        $self->display_user_warning("Authentication only supports the two-argument form");
     };
 };
 
@@ -2054,7 +2034,7 @@
 
 This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 
-Copyright (C) 2002,2003 Max Maischein
+Copyright (C) 2002,2008 Max Maischein
 
 =head1 AUTHOR
 

Modified: branches/upstream/libwww-mechanize-shell-perl/current/t/00-use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/t/00-use.t?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/t/00-use.t (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/t/00-use.t Mon Jan  5 17:27:51 2009
@@ -7,6 +7,11 @@
 $ENV{LINES} = 24;
 
 use_ok("WWW::Mechanize::Shell");
+
+diag "Running under $]";
+for (qw(WWW::Mechanize LWP::UserAgent)) {
+    diag "Using '$_' version " . $_->VERSION;
+};
 
 my $s = do {
   WWW::Mechanize::Shell->new("shell",rcfile => undef, warnings => undef);

Modified: branches/upstream/libwww-mechanize-shell-perl/current/t/04-history-invariant.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/t/04-history-invariant.t?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/t/04-history-invariant.t (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/t/04-history-invariant.t Mon Jan  5 17:27:51 2009
@@ -12,6 +12,8 @@
 BEGIN {
   # Disable all ReadLine functionality
   $ENV{PERL_RL} = 0;
+
+  # Also disable the paged output of Term::Shell
 
   @history_invariant = qw(
       browse
@@ -60,6 +62,9 @@
   );
 };
 
+# For testing the "versions" command
+sub WWW::Mechanize::Shell::print_pairs {};
+
 use Test::More tests => scalar @history_invariant +1;
 SKIP: {
 

Modified: branches/upstream/libwww-mechanize-shell-perl/current/t/13-command-au.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/t/13-command-au.t?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/t/13-command-au.t (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/t/13-command-au.t Mon Jan  5 17:27:51 2009
@@ -12,7 +12,7 @@
 # Disable all ReadLine functionality
 $ENV{PERL_RL} = 0;
 
-use Test::More tests => 8;
+use Test::More tests => 6;
 SKIP: {
 
 use_ok('WWW::Mechanize::Shell');
@@ -24,36 +24,90 @@
 # We want to be safe from non-resolving local host names
 delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)};
 
+my $user = 'foo';
+my $pass = 'bar';
+
 # Now start a fake webserver, fork, and connect to ourselves
-open SERVER, qq'"$^X" "$FindBin::Bin/401-server" |'
+open SERVER, qq{"$^X" "$FindBin::Bin/401-server" $user $pass |}
   or die "Couldn't spawn fake server : $!";
 sleep 1; # give the child some time
 my $url = <SERVER>;
 chomp $url;
-die unless $url =~ m!^http://([^/]+)/!;
+die "Couldn't decipher host/port from '$url'"
+    unless $url =~ m!^http://([^/]+)/!;
 my $host = $1;
 
 my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
 
 # First try with an inline username/password
 my $pwd_url = $url;
-$pwd_url =~ s!^http://!http://foo:bar@!;
+$pwd_url =~ s!^http://!http://$user:$pass\@!;
+$pwd_url .= 'thisshouldpass';
+diag "get $pwd_url";
 $s->cmd( "get $pwd_url" );
 diag $s->agent->res->message
   unless is($s->agent->res->code, 200, "Request with inline credentials gives 200");
 is($s->agent->content, "user = 'foo' pass = 'bar'", "Credentials are good");
 
-$s->cmd( "get $url" );
-is($s->agent->res->code, 401, "Request without credentials gives 401");
-is($s->agent->content, "auth required", "Content requests authentication");
+# Now try without credentials
+my $bare_url = $url . "thisshouldfail";
+diag "get $bare_url";
+$s->cmd( "get $bare_url" );
 
+my $code = $s->agent->response->code;
+my $got_url = $s->agent->uri;
+
+if (! ok $code == 401 || $got_url ne $bare_url, "Request without credentials gives 401 (or is hidden by a WWW::Mechanize bug)") {
+    diag "Page location : " . $s->agent->uri;
+    diag $s->agent->res->as_string;
+};
+
+SKIP: {
+if ($got_url ne $url) {
+    skip "WWW::Mechanize 1.50 has a bug that doesn't give you a 401 page", 1;
+} else {
+    like($s->agent->content, '/^auth required /', "Content requests authentication")
+        or diag $s->agent->res->as_string;
+};
+};
+
+# Now try the shell command for authentication
 $s->cmd( "auth foo bar" );
-is_deeply( $s->agent->{'basic_authentication'}{$host}{"testing realm"}, ["foo","bar"],"UA stored the authentification");
 
-$s->cmd( "get $url" );
-diag $s->agent->res->message
-  unless is($s->agent->res->code, 200, "Request with credentials gives 200");
-is($s->agent->content, "user = 'foo' pass = 'bar'", "Credentials are good");
+# WWW::Mechanize breaks the LWP::UserAgent API in a bad, bad way
+# it even monkeypatches LWP::UserAgent so we have no better way
+# than to hope for the best :-(((
+
+# If it didn't return our expected credentials, we're a victim of
+# WWW::Mechanize's monkeypatch :-(
+my @credentials = $s->agent->get_basic_credentials();
+
+if ($credentials[0] ne 'foo') {
+    SKIP: { 
+        skip "WWW::Mechanize $WWW::Mechanize::VERSION has buggy implementation/override of ->credentials", 1;
+    };
+} else {
+    diag "Credentials are @credentials";
+    use Data::Dumper;
+    my $a = $s->agent;
+    @credentials = $a->get_basic_credentials();
+    diag "Credentials are @credentials";
+
+    my @real_credentials = LWP::UserAgent::credentials($a,$host,'testing realm');
+    SKIP: {
+        if ($real_credentials[0] ne $credentials[0]) {
+            skip "WWW::Mechanize credentials() patch breaks LWP::UserAgent credentials()", 1;
+        } else {
+            $s->cmd( "get $url" );
+            diag $s->agent->res->message
+                unless is($s->agent->res->code, 200, "Request with credentials gives 200");
+            is($s->agent->content, "user = 'foo' pass = 'bar'", "Credentials are good");
+        };
+    };
+};
+
+diag "Shutting down test server at $url";
+$s->agent->get("${url}exit"); # shut down server
 
 };
 

Modified: branches/upstream/libwww-mechanize-shell-perl/current/t/14-command-identity.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/t/14-command-identity.t?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/t/14-command-identity.t (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/t/14-command-identity.t Mon Jan  5 17:27:51 2009
@@ -12,7 +12,7 @@
 # Catch output:
 $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
 tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
-tie *STDERR, 'IO::Catch', '_STDERR_' or die $!;
+#tie *STDERR, 'IO::Catch', '_STDERR_' or die $!;
 
 # Make HTML::Display do nothing:
 BEGIN {
@@ -28,7 +28,7 @@
                                             'autofill cat Keep',
                                             'fillout',
                                             'submit' ], location => qr'^%s/formsubmit\?session=1&query=foo&cat=cat_foo&cat=cat_bar$'},
-    auth => { requests => 1, lines => [ 'auth localhost:80 realm user password', 'get %s' ], location => qr'^%s/$' },
+    auth => { requests => 1, lines => [ 'auth user password', 'get %s' ], location => qr'^%s/$' },
     back => { requests => 2, lines => [ 'get %s','open 0','back' ], location => qr'^%s/$' },
     content_save => { requests => 1, lines => [ 'get %s','content tmp.content','eval unlink "tmp.content"'], location => qr'^%s/$' },
     comment => { requests => 1, lines => [ '# a comment','get %s','# another comment' ], location => qr'^%s/$' },
@@ -169,6 +169,10 @@
 BEGIN {
   # Disable all ReadLine functionality
   $ENV{PERL_RL} = 0;
+  require LWP::UserAgent;
+  #my $old = \&LWP::UserAgent::request;
+  #print STDERR $old;
+  #*LWP::UserAgent::request = sub {print STDERR "LWP::UserAgent::request\n"; goto &$old };
   use_ok('WWW::Mechanize::Shell');
 };
 
@@ -193,12 +197,20 @@
   };
 
   *WWW::Mechanize::Shell::status = sub {};
-  *WWW::Mechanize::Shell::request_dumper = sub { $dumped_requests++ };
+  *WWW::Mechanize::Shell::request_dumper = sub { $dumped_requests++; return 1 };
+
+  #*Hook::LexWrap::Cleanup::DESTROY = sub {
+      #print STDERR "Disabling hook.\n";
+      #$_[0]->();
+  #};
 };
 
 diag "Spawning local test server";
 my $server = Test::HTTP::LocalServer->spawn();
 diag sprintf "on port %s", $server->port;
+
+require LWP::UserAgent;
+my $lwp_useragent_request = *LWP::UserAgent::request{CODE};
 for my $name (sort keys %tests) {
   $_STDOUT_ = '';
   undef $_STDERR_;
@@ -213,6 +225,10 @@
   $url =~ s!/$!!;
   my $result_location = sprintf $tests{$name}->{location}, $url;
   $result_location = qr{$result_location};
+  {
+      no warnings 'redefine';
+      *LWP::UserAgent::request = $lwp_useragent_request;
+  };
   my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
   $s->option("dumprequests",1);
   my @commands;
@@ -240,6 +256,13 @@
   # Modify the generated Perl script to match the new? port
   my $script = join "\n", $s->script;
   s!\b$code_port\b!$script_port!smg for ($script, $code_output);
+  #print STDERR "Releasing hook";
+  undef $s->{request_wrapper};
+  {
+    local *WWW::Mechanize::Shell::request_dumper = sub { die };
+    use HTTP::Request::Common;
+    $s->agent->request(GET 'http://google.de/');
+  };
   $s->release_agent;
   undef $s;
 

Modified: branches/upstream/libwww-mechanize-shell-perl/current/t/401-server
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/t/401-server?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/t/401-server (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/t/401-server Mon Jan  5 17:27:51 2009
@@ -1,29 +1,48 @@
 # Thanks to merlyn for nudging me and giving me this snippet!
 use strict;
 use HTTP::Daemon;
+use LWP::UserAgent;
 
 $|++;
 
 my $d = HTTP::Daemon->new or die;
 print $d->url, "\n";
 
-my $counter = 4;
-while ($counter-- and my $c = $d->accept) {
+# How many requests do we expect?
+my ($ex_user,$ex_pass) = @ARGV;
+
+my $verbose = $ENV{TEST_HTTP_VERBOSE};
+
+my $done = 0;
+while (! $done and my $c = $d->accept) {
   while (my $req = $c->get_request) {
-    if ($ENV{TEST_HTTP_VERBOSE}) {
+    if ($verbose) {
+      warn "# Request URI: " . $req->url->path;
       my @lines = split "\n",$req->as_string;
       warn "# $_\n" for @lines;
     };
+
     my $res;
-    if (my ($user, $pass) = $req->authorization_basic) {
-      $res = HTTP::Response->new(200, "OK", undef,
-					    "user = '$user' pass = '$pass'");
+    my ($user,$pass);
+    if ($req->url->path eq '/exit') {
+        $done = 1;
+        $res = HTTP::Response->new(200, "OK", undef, "done");
+
+    } elsif (    ($user, $pass) = $req->authorization_basic
+        and $user eq $ex_user
+        and $pass eq $ex_pass) {
+          $res = HTTP::Response->new(200, "OK", undef,
+              "user = '$user' pass = '$pass'");
+
     } else {
+      warn "# User : '$user' Password : '$pass'\n"
+          if $verbose;
       $res = HTTP::Response->new(401, "Auth Required", undef,
-				    "auth required");
+                                 "auth required ($user/$pass)");
       $res->www_authenticate("Basic realm=\"testing realm\"");
-    }
-    if ($ENV{TEST_HTTP_VERBOSE}) {
+    };
+
+    if ($verbose) {
       warn "---\n";
       my @lines = split "\n",$res->as_string;
       warn "# $_\n" for @lines;
@@ -32,4 +51,4 @@
   }
   $c->close;
   undef($c);
-}
+};

Modified: branches/upstream/libwww-mechanize-shell-perl/current/t/99-todo.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-shell-perl/current/t/99-todo.t?rev=29350&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-shell-perl/current/t/99-todo.t (original)
+++ branches/upstream/libwww-mechanize-shell-perl/current/t/99-todo.t Mon Jan  5 17:27:51 2009
@@ -24,7 +24,7 @@
 sub source_file_ok {
     my $file = shift;
 
-    open( my $fh, "<", $file ) or die "Can't open $file: $!";
+    open( my $fh, "<$file" ) or die "Can't open $file: $!";
     my @lines = <$fh>;
     close $fh;
 




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