Merge pull request #10 from ambs/master

Some extra minor tests
szbalint · Jun 30, 2015 · c09f532 · c09f532
2 parents 45d07f5 + 808b569
commit c09f532
Show file tree

Hide file tree

Showing 4 changed files with 107 additions and 86 deletions.
diff --git a/Changes b/Changes
@@ -1,4 +1,8 @@
 Revision history for the Perl binding of libcurl, WWW::Curl.
+
+    - Test if Curl object can be sent to callback as PROGRESSDTA [Alberto Simões];
+    - Test SPEED_DOWNLOAD and CONTENT_TYPE properties [Alberto Simões];
+
 4.17 Fri Feb 21 2014: - Balint Szilakszi <szbalint at cpan.org>
 
     - Fixing build process for old libcurl versions without CURLOPT_RESOLVE.

diff --git a/lib/WWW/Curl.pm b/lib/WWW/Curl.pm
@@ -43,73 +43,73 @@ in the sense normally used on CPAN.
 
 Here is a small snippet of making a request with WWW::Curl::Easy.
 
-	use strict;
-	use warnings;
-	use WWW::Curl::Easy;
-
-	my $curl = WWW::Curl::Easy->new;
-	
-	$curl->setopt(CURLOPT_HEADER,1);
-	$curl->setopt(CURLOPT_URL, 'http://example.com');
-
-	# A filehandle, reference to a scalar or reference to a typeglob can be used here.
-	my $response_body;
-	$curl->setopt(CURLOPT_WRITEDATA,\$response_body);
-
-	# Starts the actual request
-	my $retcode = $curl->perform;
-
-	# Looking at the results...
-	if ($retcode == 0) {
-		print("Transfer went ok\n");
-		my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE);
-		# judge result and next action based on $response_code
-		print("Received response: $response_body\n");
-	} else {
-		# Error code, type of error, error message
-		print("An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n");
-	}
+    use strict;
+    use warnings;
+    use WWW::Curl::Easy;
+
+    my $curl = WWW::Curl::Easy->new;
+    
+    $curl->setopt(CURLOPT_HEADER,1);
+    $curl->setopt(CURLOPT_URL, 'http://example.com');
+
+    # A filehandle, reference to a scalar or reference to a typeglob can be used here.
+    my $response_body;
+    $curl->setopt(CURLOPT_WRITEDATA,\$response_body);
+
+    # Starts the actual request
+    my $retcode = $curl->perform;
+
+    # Looking at the results...
+    if ($retcode == 0) {
+        print("Transfer went ok\n");
+        my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE);
+        # judge result and next action based on $response_code
+        print("Received response: $response_body\n");
+    } else {
+        # Error code, type of error, error message
+        print("An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n");
+    }
 
 See L<curl_easy_setopt(3)> for details of C<setopt()>.
 
 =head1 WWW::Curl::Multi
 
-	use strict;
-	use warnings;
-	use WWW::Curl::Easy;
-	use WWW::Curl::Multi;
-
-	my %easy;
-	my $curl = WWW::Curl::Easy->new;
-	my $curl_id = '13'; # This should be a handle unique id.
-	$easy{$curl_id} = $curl;
-	my $active_handles = 0;
-
-	$curl->setopt(CURLOPT_PRIVATE,$curl_id);
-	# do the usual configuration on the handle
-	...
-
-	my $curlm = WWW::Curl::Multi->new;
-	
-	# Add some easy handles
-	$curlm->add_handle($curl);
-	$active_handles++;
-
-	while ($active_handles) {
-		my $active_transfers = $curlm->perform;
-		if ($active_transfers != $active_handles) {
-			while (my ($id,$return_value) = $curlm->info_read) {
-				if ($id) {
-					$active_handles--;
-					my $actual_easy_handle = $easy{$id};
-					# do the usual result/error checking routine here
-					...
-					# letting the curl handle get garbage collected, or we leak memory.
-					delete $easy{$id};
-				}
-			}
-		}
-	}
+    use strict;
+    use warnings;
+    use WWW::Curl::Easy;
+    use WWW::Curl::Multi;
+
+    my %easy;
+    my $curl = WWW::Curl::Easy->new;
+    my $curl_id = '13'; # This should be a handle unique id.
+    $easy{$curl_id} = $curl;
+    my $active_handles = 0;
+
+    $curl->setopt(CURLOPT_PRIVATE,$curl_id);
+    # do the usual configuration on the handle
+    ...
+
+    my $curlm = WWW::Curl::Multi->new;
+    
+    # Add some easy handles
+    $curlm->add_handle($curl);
+    $active_handles++;
+
+    while ($active_handles) {
+        my $active_transfers = $curlm->perform;
+        if ($active_transfers != $active_handles) {
+            while (my ($id,$return_value) = $curlm->info_read) {
+                if ($id) {
+                    $active_handles--;
+                    my $actual_easy_handle = $easy{$id};
+                    # do the usual result/error checking routine here
+                    ...
+                    # letting the curl handle get garbage collected, or we leak memory.
+                    delete $easy{$id};
+                }
+            }
+        }
+    }
 
 This interface is different than what the C API does. $curlm->perform is non-blocking and performs
 requests in parallel. The method does a little work and then returns control, therefor it has to be called
@@ -133,37 +133,37 @@ a new batch of easy handles for processing.
 
 =head1 WWW::Curl::Share
 
-	use WWW::Curl::Share;
-	my $curlsh = new WWW::Curl::Share;
-	$curlsh->setopt(CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE);
-	$curlsh->setopt(CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS);
-	$curl->setopt(CURLOPT_SHARE, $curlsh);
-	$curlsh->setopt(CURLSHOPT_UNSHARE, CURL_LOCK_DATA_COOKIE);
-	$curlsh->setopt(CURLSHOPT_UNSHARE, CURL_LOCK_DATA_DNS);
+    use WWW::Curl::Share;
+    my $curlsh = new WWW::Curl::Share;
+    $curlsh->setopt(CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE);
+    $curlsh->setopt(CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS);
+    $curl->setopt(CURLOPT_SHARE, $curlsh);
+    $curlsh->setopt(CURLSHOPT_UNSHARE, CURL_LOCK_DATA_COOKIE);
+    $curlsh->setopt(CURLSHOPT_UNSHARE, CURL_LOCK_DATA_DNS);
 
 WWW::Curl::Share is an extension to WWW::Curl::Easy which makes it possible
 to use a single cookies/dns cache for several Easy handles.
 
 It's usable methods are:
-	
-	$curlsh = new WWW::Curl::Share
-		This method constructs a new WWW::Curl::Share object.
+    
+    $curlsh = new WWW::Curl::Share
+        This method constructs a new WWW::Curl::Share object.
 
-	$curlsh->setopt(CURLSHOPT_SHARE, $value );
-		Enables share for:
-			CURL_LOCK_DATA_COOKIE	use single cookies database
-			CURL_LOCK_DATA_DNS	use single DNS cache
-	$curlsh->setopt(CURLSHOPT_UNSHARE, $value );
-		Disable share for given $value (see CURLSHOPT_SHARE)
+    $curlsh->setopt(CURLSHOPT_SHARE, $value );
+        Enables share for:
+            CURL_LOCK_DATA_COOKIE    use single cookies database
+            CURL_LOCK_DATA_DNS       use single DNS cache
+    $curlsh->setopt(CURLSHOPT_UNSHARE, $value );
+        Disable share for given $value (see CURLSHOPT_SHARE)
 
-	$curlsh->strerror( ErrNo )
-		This method returns a string describing the CURLSHcode error 
-		code passed in the argument errornum.
+    $curlsh->strerror( ErrNo )
+        This method returns a string describing the CURLSHcode error 
+        code passed in the argument errornum.
 
 This is how you enable sharing for a specific WWW::Curl::Easy handle:
 
-	$curl->setopt(CURLOPT_SHARE, $curlsh)
-		Attach share object to WWW::Curl::Easy instance
+    $curl->setopt(CURLOPT_SHARE, $curlsh)
+        Attach share object to WWW::Curl::Easy instance
 
 =head1 WWW::Curl::Form
 

diff --git a/t/01basic.t b/t/01basic.t
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 19;
+use Test::More tests => 21;
 use File::Temp qw/tempfile/;
 
 BEGIN { use_ok( 'WWW::Curl::Easy' ); }
@@ -47,6 +47,9 @@ my $realurl = $curl->getinfo(CURLINFO_EFFECTIVE_URL);
 ok( $realurl, "getinfo returns CURLINFO_EFFECTIVE_URL");
 my $httpcode = $curl->getinfo(CURLINFO_HTTP_CODE);
 ok( $httpcode, "getinfo returns CURLINFO_HTTP_CODE");
+my $content_type = $curl->getinfo(CURLINFO_CONTENT_TYPE);
+ok ($content_type, "getinfo returns CURLINFO_CONTENT_TYPE");
+like ($content_type, qr!text/html!, "Content type looks like html");
 
 SKIP: {
     skip "Only testing cookies against google.com", 2 unless $url eq "http://www.google.com";

diff --git a/t/05progress.t b/t/05progress.t
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 16;
+use Test::More tests => 18;
 use File::Temp qw/tempfile/;
 
 BEGIN { use_ok( 'WWW::Curl::Easy' ); }
@@ -31,18 +31,27 @@ $myheaders[0] = "Server: www";
 $myheaders[1] = "User-Agent: Perl interface for libcURL";
 ok(! $curl->setopt(CURLOPT_HTTPHEADER, \@myheaders), "Setting CURLOPT_HTTPHEADER");
 
-ok(! $curl->setopt(CURLOPT_PROGRESSDATA,"making progress!"), "Setting CURLOPT_PROGRESSDATA");
+ok(! $curl->setopt(CURLOPT_PROGRESSDATA,$curl), "Setting CURLOPT_PROGRESSDATA");
 
 my $progress_called = 0;
 my $last_dlnow = 0;
+my $is_curl_obj = 0;
+my $speed_is_int = 1;
 sub prog_callb
 {
     my ($clientp,$dltotal,$dlnow,$ultotal,$ulnow)=@_;
+
+    $is_curl_obj++ if ref $clientp eq "WWW::Curl::Easy";
+
+    my $speed = $clientp->getinfo(CURLINFO_SPEED_DOWNLOAD);
+    $speed_is_int = 0 unless $speed =~ /^\d+$/;
+
     $last_dlnow=$dlnow;
     $progress_called++;
     return 0;
 }                        
 
+
 ok (! $curl->setopt(CURLOPT_PROGRESSFUNCTION, \&prog_callb), "Setting CURLOPT_PROGRESSFUNCTION");
 
 ok (! $curl->setopt(CURLOPT_NOPROGRESS, 0), "Turning progress meter back on");
@@ -52,3 +61,8 @@ ok (! $curl->perform(), "Performing perform");
 ok ($progress_called, "Progress callback called");
 
 ok ($last_dlnow, "Last downloaded chunk non-zero");
+
+ok ($is_curl_obj > 0, "Progress callback receives curl object");
+
+ok ($speed_is_int, "Obtained download speed in callback");
+