Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Merge pull request #5 from neilbowers/master

Changed get() method to check underlying server response code
  • Loading branch information...
commit be670734383dc1590ed8a0b4640da12de4373fd5 2 parents a49cb5e + 6694bd8
Lindolfo Rodrigues authored

Showing 3 changed files with 57 additions and 38 deletions. Show diff stats Hide diff stats

  1. +9 0 Changes
  2. +4 3 Makefile.PL
  3. +44 35 lib/LWP/Curl.pm
9 Changes
... ... @@ -1,5 +1,14 @@
1 1 Revision history for Perl module LWP::Curl
2 2
  3 +0.11 2012-06-??
  4 +
  5 + - The get() method now checks the underlying response code,
  6 + and only returns success if the request really was successful.
  7 + This makes all tests pass cleanly.
  8 + - In Makefile.PL the runtime required modules were listed as
  9 + build requirements. Changed them to be runtime requirements.
  10 + - Data::Dumper wasn't listed as a runtime requirement.
  11 +
3 12 0.10 2012-04-10
4 13
5 14 - removed cookie_jar method and doc for it,
7 Makefile.PL
@@ -7,9 +7,10 @@ author 'Lindolfo Rodrigues de Oliveira Neto <lorn@cpan.org>';
7 7 test_requires 'Test::More';
8 8 test_requires 'Test::Exception';
9 9 build_requires 'URI::file';
10   -build_requires 'WWW::Curl::Easy';
11   -build_requires 'Carp';
12   -build_requires 'URI::Escape';
  10 +requires 'WWW::Curl::Easy';
  11 +requires 'Carp';
  12 +requires 'URI::Escape';
  13 +requires 'Data::Dumper';
13 14 auto_install;
14 15
15 16 WriteAll;
79 lib/LWP/Curl.pm
@@ -13,23 +13,24 @@ LWP::Curl - LWP methods implementation with Curl engine
13 13
14 14 =head1 VERSION
15 15
16   -Version 0.10
  16 +Version 0.11
17 17
18 18 =cut
19 19
20   -our $VERSION = '0.10';
  20 +our $VERSION = '0.11';
21 21
22 22 =head1 SYNOPSIS
23 23
24   -Use libcurl like LWP, $lwpcurl->get($url), $lwpcurl->timeout(15) don't care about Curl API and don't care about html encode
25   -
26 24 use LWP::Curl;
27   -
  25 +
28 26 my $lwpcurl = LWP::Curl->new();
29 27 my $content = $lwpcurl->get('http://search.cpan.org','http://www.cpan.org');
30 28 # get the page http://search.cpan.org passing with referer http://www.cpan.org
31 29
32   -=cut
  30 +=head1 DESCRIPTION
  31 +
  32 +LWP::Curl provides an interface similar to the LWP library, but is built on top of the Curl library.
  33 +The simple LWP-style interface means you don't have to know anything about the underlying library.
33 34
34 35 =head1 Constructor
35 36
@@ -140,60 +141,68 @@ sub new {
140 141
141 142 =head2 $lwpcurl->get($url,$referer)
142 143
143   - Get content of $url, passando $referer se definido
  144 +Get content of $url, passing $referer if defined.
144 145
145 146 use LWP::Curl;
146 147 my $referer = 'http://www.example.com';
147 148 my $get_url = 'http://www.example.com/foo';
148 149 my $lwpcurl = LWP::Curl->new();
149 150 my $content = $lwpcurl->get($get_url, $referer);
  151 +
  152 +The C<get> method croak()'s if the request fails, so wrap an C<eval> around it if you want to
  153 +handle failure more elegantly.
  154 +
150 155 =cut
151 156
152 157 sub get {
153 158 my ( $self, $url, $referer ) = @_;
  159 + my $agent = $self->{agent};
154 160
155 161 if ( !$referer ) {
156 162 $referer = "";
157 163 }
158 164
159 165 $url = uri_escape($url,"[^:./]") if $self->{auto_encode};
160   - $self->{agent}->setopt( CURLOPT_REFERER, $referer );
161   - $self->{agent}->setopt( CURLOPT_URL, $url );
162   - $self->{agent}->setopt( CURLOPT_HTTPGET, 1 );
  166 + $agent->setopt( CURLOPT_REFERER, $referer );
  167 + $agent->setopt( CURLOPT_URL, $url );
  168 + $agent->setopt( CURLOPT_HTTPGET, 1 );
163 169
164 170 my $content = "";
165 171 open( my $fileb, ">", \$content );
166   - $self->{agent}->setopt( CURLOPT_WRITEDATA, $fileb );
167   - $self->{retcode} = $self->{agent}->perform;
  172 + $agent->setopt( CURLOPT_WRITEDATA, $fileb );
  173 + $self->{retcode} = $agent->perform;
168 174
169 175 if ( $self->{retcode} == 0 ) {
170   - print("\nTransfer went ok\n") if $self->{debug};
171   - return $content;
172   - } else {
173   - croak( "An error happened: Host $url "
  176 + my $response_code = $agent->getinfo(CURLINFO_HTTP_CODE);
  177 + if ($response_code == 200 || ($response_code == 0 && $url =~ m!^file:!)) {
  178 + print("\nTransfer went ok\n") if $self->{debug};
  179 + return $content;
  180 + }
  181 + }
  182 +
  183 + croak( "An error happened: Host $url "
174 184 . $self->{agent}->strerror( $self->{retcode} )
175 185 . " ($self->{retcode})\n" );
176   - return undef;
177   - }
  186 + return undef;
178 187 }
179 188
180 189 =head2 $lwpcurl->post($url,$hash_form,$referer)
181 190
182   - POST the $hash_form fields in $url, passing $referer if defined
183   -
184   - use LWP::Curl;
185   -
186   - my $lwpcurl = LWP::Curl->new();
187   -
188   - my $referer = 'http://www.examplesite.com/';
189   - my $post_url = 'http://www.examplesite.com/post/';
190   -
191   - my $hash_form = {
192   - 'field1' => 'value1',
193   - 'field2' => 'value2',
194   - }
  191 +POST the $hash_form fields in $url, passing $referer if defined:
195 192
196   - my $content = $lwpcurl->post($post_url, $hash_form, $referer);
  193 + use LWP::Curl;
  194 +
  195 + my $lwpcurl = LWP::Curl->new();
  196 +
  197 + my $referer = 'http://www.examplesite.com/';
  198 + my $post_url = 'http://www.examplesite.com/post/';
  199 +
  200 + my $hash_form = {
  201 + 'field1' => 'value1',
  202 + 'field2' => 'value2',
  203 + }
  204 +
  205 + my $content = $lwpcurl->post($post_url, $hash_form, $referer);
197 206
198 207 =cut
199 208
@@ -251,7 +260,8 @@ sub post {
251 260
252 261 =head2 $lwpcurl->timeout($sec)
253 262
254   - Set timeout, default 180
  263 +Set the timeout to use for all subsequent requests, in seconds.
  264 +Defaults to 180 seconds.
255 265
256 266 =cut
257 267
@@ -266,7 +276,7 @@ sub timeout {
266 276
267 277 =head2 $lwpcurl->auto_encode($value)
268 278
269   - Turn on/off auto_encode
  279 +Turn on/off auto_encode.
270 280
271 281 =cut
272 282
@@ -395,7 +405,6 @@ You can find documentation for this module with the perldoc command.
395 405
396 406 perldoc LWP::Curl
397 407
398   -
399 408 You can also look for information at:
400 409
401 410 =over 4

0 comments on commit be67073

Please sign in to comment.
Something went wrong with that request. Please try again.