Fixing dependencies

Fixing other people code is not easy - but this is what we need to do if we want to clean our dependencies. In answer to John's invitation here is what I did.

I wanted to write some code using Catalyst::Authentication::Credential::OpenID unfortunately one of it's dependencies fails it's tests. Here I'll document how I analysed that and produced a patch, it's not yet approved by the author - but the tests pass.

Step first - checkout the ParanoidAged from it's repository (I had the repository address from an email to the Catalyst mailing list). If you don't have access to the repository of your failing dependency - then just download the source from CPAN unpack it and work from there. Then run the tests:

zby@zby:~/progs/pa$ perl -Ilib t/00-all.t
.
.
.
ok 27
5 second tarpit (tolerance 2)...
not ok 28
# Failed test at t/00-all.t line 180.
3 second tarpit (tolerance 4)...
ok 29
Killing child pid: 7669
# Looks like you failed 1 test of 29.

OK - the failing test is at line 180. Let's see what is there:

	# dying in a tarpit
	print "5 second tarpit (tolerance 2)...\n";
	$ua->timeout(2);
	$res = $ua->get("$HELPER_SERVER/1.5");
	ok(! $res->is_success);

view raw gistfile1.pl hosted with ❤ by GitHub

I changed that to:

	# dying in a tarpit
	print "5 second tarpit (tolerance 2)...\n";
	$ua->timeout(2);
	$res = $ua->get("$HELPER_SERVER/1.5");
	ok(! $res->is_success) or warn Dumper( $res ); use Data::Dumper;

view raw gistfile1.pl hosted with ❤ by GitHub

ran the tests and save my debug output:
zby@zby:~/progs/pa$ perl t/00-all.t 2>debug.
What I got there is:

	$VAR1 = bless(
	{
	'_protocol' => 'HTTP/1.0',
	'_content' => '[1/5]
	[2/5]
	',
	'_rc' => 200,
	'_headers' => bless(
	{
	'client-date' => 'Fri, 31 Jul 2009 08:56:17 GMT',
	'x-died' =>
	'read timeout at lib/LWPx/Protocol/http_paranoid.pm line 394.',
	'content-type' => 'text/plain',
	'client-response-num' => 1,
	'client-peer' => '127.66.74.70:9001',
	'client-aborted' => 'die'
	},
	'HTTP::Headers'
	),
	'_msg' => 'OK',
	'handlers' => {
	'response_data' => [
	{
	'callback' => sub { "DUMMY" }
	}
	]
	},
	'_request' => bless(
	{
	'_time_begin' => 1249030575,
	'_content' => '',
	'_uri' => bless(
	do { \( my $o = 'http://127.66.74.70:9001/1.5' ) },
	'URI::http'
	),
	'_headers' => bless(
	{ 'user-agent' => 'libwww-perl/5.825' },
	'HTTP::Headers'
	),
	'_method' => 'GET',
	'_uri_canonical' => $VAR1->{'_request'}{'_uri'}
	},
	'HTTP::Request'
	)
	},
	'HTTP::Response'
	);
	Killing child pid : 7731

view raw gistfile1.pl hosted with ❤ by GitHub

Now the info is there - but of course I did not spot it at once. I did a lot of more debugging and testing other hypothesis before I focused on: 'x-died' => 'read timeout at lib/LWPx/Protocol/http_paranoid.pm line 394.'. Yeah interesting - something died, but no error was reported. The line in question is:

die "read timeout" unless $self->can_read($timeout);

view raw gistfile1.pl hosted with ❤ by GitHub

To get some more evidence I changed that to:

confess( "read timeout" ) unless $self->can_read($timeout); use Carp 'confess';

view raw gistfile1.pl hosted with ❤ by GitHub

Now the debug output changes to:

	'x-died' => 'read timeout at lib/LWPx/Protocol/http_paranoid.pm line 394
	LWPx::Protocol::http_paranoid::SocketMethods::sysread(\'LWPx::Protocol::http_paranoid::Socket=GLOB(0x8a22d4c)\', \'\', 4096) called at /usr/local/share/perl/5.8.8/Net/HTTP/Methods.pm line 236
	Net::HTTP::Methods::my_read(\'LWPx::Protocol::http_paranoid::Socket=GLOB(0x8a22d4c)\', \'\', 4096) called at /usr/local/share/perl/5.8.8/Net/HTTP/Methods.pm line 541
	Net::HTTP::Methods::read_entity_body(\'LWPx::Protocol::http_paranoid::Socket=GLOB(0x8a22d4c)\', \'\', 4096) called at lib/LWPx/Protocol/http_paranoid.pm line 352
	LWPx::Protocol::http_paranoid::__ANON__ called at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 157
	eval {...} called at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 99
	LWP::Protocol::collect(\'LWPx::Protocol::http_paranoid=HASH(0x8a227dc)\', \'undef\', \'HTTP::Response=HASH(0x8a2fdc0)\', \'CODE(0x8a324b4)\') called at lib/LWPx/Protocol/http_paranoid.pm line 358
	LWPx::Protocol::http_paranoid::request(\'LWPx::Protocol::http_paranoid=HASH(0x8a227dc)\', \'HTTP::Request=HASH(0x8a22548)\', \'undef\', \'undef\', \'undef\', 2) called at lib/LWPx/ParanoidAgent.pm line 314
	eval {...} called at lib/LWPx/ParanoidAgent.pm line 313
	LWPx::ParanoidAgent::send_request(\'LWPx::ParanoidAgent=HASH(0x8645148)\', \'HTTP::Request=HASH(0x8a22548)\', \'undef\', \'undef\') called at /usr/local/share/perl/5.8.8/LWP/UserAgent.pm line 255
	LWP::UserAgent::simple_request(\'LWPx::ParanoidAgent=HASH(0x8645148)\', \'HTTP::Request=HASH(0x8a22548)\', \'undef\', \'undef\') called at /usr/local/share/perl/5.8.8/LWP/UserAgent.pm line 263
	LWP::UserAgent::request(\'LWPx::ParanoidAgent=HASH(0x8645148)\', \'HTTP::Request=HASH(0x8a22548)\', \'undef\', \'undef\', \'undef\') called at lib/LWPx/ParanoidAgent.pm line 219
	LWPx::ParanoidAgent::request(\'LWPx::ParanoidAgent=HASH(0x8645148)\', \'HTTP::Request=HASH(0x8a22548)\') called at /usr/local/share/perl/5.8.8/LWP/UserAgent.pm line 391
	LWP::UserAgent::get(\'LWPx::ParanoidAgent=HASH(0x8645148)\', \'http://127.66.74.70:9001/1.5\') called at t/00-all.t line 179',

view raw gistfile1.pl hosted with ❤ by GitHub

And again - it is there - but to spot it I had to play with the debugger first. I don't remember what exactly I did - but finally I sow it - there are two evals in this stack trace, the first one is in LWP::Protocol and the second in lib/LWPx/ParanoidAgent.pm line 313. I checked that second eval - and yeah - it tried to retrieve the error already catched by the first one. So when there was a timeout the agent was aborting the retrieval - but the error was being cleared and not reported. I wrote following patch:

	--- lib/LWPx/ParanoidAgent.pm (revision 18)
	+++ lib/LWPx/ParanoidAgent.pm (working copy)
	@@ -314,11 +314,12 @@
	$response = $protocol->request($request, $proxy,
	$arg, $size, $timeout);
	};
	- if ($@) {
	- $@ =~ s/ at .* line \d+.*//s; # remove file/line number
	+ my $error = $@ || $response->header( 'x-died' );
	+ if ($error) {
	+ $error =~ s/ at .* line \d+.*//s; # remove file/line number
	$response = _new_response($request,
	&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
	- $@);
	+ $error);
	}
	}
	else {

view raw gistfile1.diff hosted with ❤ by GitHub

and now all the tests pass. Finally I uploaded the patch to RT.