Peter,
        assuming you have a recent of Curl::easy (latest is 1.20, recommended),
you should be able to retrieve pretty much any information returned by
your version of libcurl.

You should aready have examples of using getinfo in the 't' (test)
directory of the perl source code. I've attached a copy of t/09times.t,
which runs a download test and return the various transfer times and rates.

If you don't have source installed, you can browse the CVS online at:

http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/curl/perl/

Peter M. Perchansky wrote:
> Greetings:
>
> Since I don't know C or C++, I don't know how to try it.
>
> Do you have any example Perl code using curl_easy_getinfo()?
>
> I do have the most recent versions (just installed yesterday).
>
> Thank you.
>
> "I just checked out the easy.xs code, and to me it looks as if
> curl_easy_getinfo() is supported in the perl interface.
>
>> Have you tried it? If so, how did you use it?
>>
>> Before we proceed, please make sure that you have a recent version of
>> both curl and the Curl::easy module."

# Test script for Perl extension Curl::easy.
# Check out the file README for more info.

# Before `make install' is performed this script should be runnable with
# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
use strict;

BEGIN { $| = 1; print "1..7\n"; }
END {print "not ok 1\n" unless $::loaded;}
use Curl::easy ;

$::loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

print STDERR "transfer times test will only compile/run on curl >= 7.9.1\n";
my $count=1;

# Read URL to get
my $defurl = "http://localhost/cgi-bin/printenv";
my $url;
if (defined ($ENV{CURL_TEST_URL})) {
        $url=$ENV{CURL_TEST_URL};
} else {
$url = "";
print "Please enter an URL to fetch [$defurl]: ";
$url = <STDIN>;
if ($url =~ /^\s*\n/) {
    $url = $defurl;
}
}

# Init the curl session
my $curl = Curl::easy::init();
if ($curl == 0) {
    print "not ";
}
print "ok ".++$count."\n";

Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1);
Curl::easy::setopt($curl, CURLOPT_MUTE, 1);
Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1);
Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30);

open HEAD, ">head.out";
Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD);
print "ok ".++$count."\n";

open BODY, ">body.out";
Curl::easy::setopt($curl, CURLOPT_FILE,*BODY);
print "ok ".++$count."\n";

$::errbuf="";
Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "::errbuf");
print "ok ".++$count."\n";

Curl::easy::setopt($curl, CURLOPT_URL, $url);

print "ok ".++$count."\n";
# Add some additional headers to the http-request:
my @myheaders=();
$myheaders[0] = "Server: www";
$myheaders[1] = "User-Agent: Perl interface for libcURL";
Curl::easy::setopt($curl, CURLOPT_HTTPHEADER, \@myheaders);
                                                                        
my $bytes=0;
my $realurl=0;
my $httpcode=0;

# Go get it
my $retcode=Curl::easy::perform($curl);
if ($retcode == 0) {
    Curl::easy::getinfo($curl, CURLINFO_SIZE_DOWNLOAD, $bytes);
    print STDERR "$bytes bytes read ";
    Curl::easy::getinfo($curl, CURLINFO_EFFECTIVE_URL, $realurl);
    Curl::easy::getinfo($curl, CURLINFO_HTTP_CODE, $httpcode);
    print STDERR "effective fetched url (http code: $httpcode) was: $url ";
} else {
   # We can acces the error message in $::errbuf here
    print STDERR "$retcode / $::errbuf\n";
    print "not ";
}
print "ok ".++$count."\n";

my ($total,$dns,$conn,$pre,$start)=(0,0,0,0,0);
#Curl::easy::getinfo($curl, CURLINFO_STARTTRANSFER_TIME, $start);
Curl::easy::getinfo($curl, CURLINFO_TOTAL_TIME, $total);
Curl::easy::getinfo($curl, CURLINFO_NAMELOOKUP_TIME, $dns);
Curl::easy::getinfo($curl, CURLINFO_CONNECT_TIME, $conn);
Curl::easy::getinfo($curl, CURLINFO_PRETRANSFER_TIME, $pre);
print STDERR "times are: dns: $dns, connect: $conn, pretransfer: $pre, starttransfer: $start, total: $total.\n";

exit;
Received on 2002-04-29