generic-library/curl
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Georg Horn's Curl::easy interface for perl

Browse Source
This commit is contained in:
Daniel Stenberg 2001-03-16 13:05:39 +00:00
parent 71b4b2ffa9
commit d538241a58
7 changed files with 612 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
perl/Curl_easy/Changes Normal file
View File

@ -0,0 +1,35 @@
Revision history for Perl extension Curl::easy.
Check out the file README for more info.
1.0.2 Tue Oct 10 2000:
- runs with libcurl 7.4
- modified curl_easy_getinfo(). It now calls curl_getinfo() that has
been added to libcurl in version 7.4.
1.0.1 Tue Oct 10 2000:
- Added some missing features of curl_easy_setopt():
- CURLOPT_ERRORBUFFER now works by passing the name of a perl
variable that shall be crated and the errormessage (if any)
be stored to.
- Passing filehandles (Options FILE, INFILE and WRITEHEADER) now works.
Have a look at test.pl to see how it works...
- Added a new function, curl_easy_getinfo(), that for now always
returns the number of bytes that where written to disk during the last
download. If the curl_easy_getinfo() function is included in libcurl,
(as promised by Daniel ;-)) i will turn this into just a call to this
function.
1.0 Thu Oct 5 2000:
- first released version
- runs with libcurl 7.3
- some features of curl_easy_setopt() are still missing:
- passing function pointers doesn't work (options WRITEFUNCTION,
READFUNCTION and PROGRESSFUNCTION).
- passing FILE * pointers doesn't work (options FILE, INFILE and
WRITEHEADER).
- passing linked lists doesn't work (options HTTPHEADER and
HTTPPOST).
- setting the buffer where to store error messages in doesn't work
(option ERRORBUFFER).

6
perl/Curl_easy/MANIFEST Normal file
View File

@ -0,0 +1,6 @@
Changes
MANIFEST
Makefile.PL
easy.pm
easy.xs
test.pl

14
perl/Curl_easy/Makefile.PL Normal file
View File

@ -0,0 +1,14 @@
# Makefile.PL for Perl extension Curl::easy.
# Check out the file README for more info.
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Curl::easy',
'VERSION_FROM' => 'easy.pm', # finds $VERSION
'LIBS' => ['-lcurl '], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
'clean' => {FILES => "head.out body.out"}
);

27
perl/Curl_easy/README Normal file
View File

@ -0,0 +1,27 @@
README for Perl extension Curl::easy.
The perl module Curl::easy provides an interface to the cURL library "libcurl".
See http://curl.haxx.se/ for more information on cURL and libcurl.
This module requires libcurl and the corresponding headerfiles to be
installed. You then may install this module via the usual way:
perl Makefile.PL
make
make test
make install
The module provides the same functionality as libcurl provides to C programs,
please refer to the documentation of libcurl.
A short example how to use the module may be found in test.pl.
This Software is distributed AS IS, WITHOUT WARRANTY OF ANY KIND,
either express or implied. Send praise, patches, money, beer and
pizza to the author. Send complaints to /dev/null. ;-)
The author of this module is Georg Horn <horn@koblenz-net.de>
The latest version of this module can be dowloaded from
http://koblenz-net.de/~horn/export/

139
perl/Curl_easy/easy.pm Normal file
View File

@ -0,0 +1,139 @@
# Perl interface for libcurl. Check out the file README for more info.
package Curl::easy;
use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
require Exporter;
require DynaLoader;
require AutoLoader;
@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
CURLOPT_AUTOREFERER
CURLOPT_COOKIE
CURLOPT_COOKIEFILE
CURLOPT_CRLF
CURLOPT_CUSTOMREQUEST
CURLOPT_ERRORBUFFER
CURLOPT_FAILONERROR
CURLOPT_FILE
CURLOPT_FOLLOWLOCATION
CURLOPT_FTPAPPEND
CURLOPT_FTPASCII
CURLOPT_FTPLISTONLY
CURLOPT_FTPPORT
CURLOPT_HEADER
CURLOPT_HTTPHEADER
CURLOPT_HTTPPOST
CURLOPT_HTTPPROXYTUNNEL
CURLOPT_HTTPREQUEST
CURLOPT_INFILE
CURLOPT_INFILESIZE
CURLOPT_INTERFACE
CURLOPT_KRB4LEVEL
CURLOPT_LOW_SPEED_LIMIT
CURLOPT_LOW_SPEED_TIME
CURLOPT_MUTE
CURLOPT_NETRC
CURLOPT_NOBODY
CURLOPT_NOPROGRESS
CURLOPT_NOTHING
CURLOPT_PORT
CURLOPT_POST
CURLOPT_POSTFIELDS
CURLOPT_POSTFIELDSIZE
CURLOPT_POSTQUOTE
CURLOPT_PROGRESSDATA
CURLOPT_PROGRESSFUNCTION
CURLOPT_PROXY
CURLOPT_PROXYPORT
CURLOPT_PROXYUSERPWD
CURLOPT_PUT
CURLOPT_QUOTE
CURLOPT_RANGE
CURLOPT_READFUNCTION
CURLOPT_REFERER
CURLOPT_RESUME_FROM
CURLOPT_SSLCERT
CURLOPT_SSLCERTPASSWD
CURLOPT_SSLVERSION
CURLOPT_STDERR
CURLOPT_TIMECONDITION
CURLOPT_TIMEOUT
CURLOPT_TIMEVALUE
CURLOPT_TRANSFERTEXT
CURLOPT_UPLOAD
CURLOPT_URL
CURLOPT_USERAGENT
CURLOPT_USERPWD
CURLOPT_VERBOSE
CURLOPT_WRITEFUNCTION
CURLOPT_WRITEHEADER
CURLINFO_EFFECTIVE_URL
CURLINFO_HTTP_CODE
CURLINFO_TOTAL_TIME
CURLINFO_NAMELOOKUP_TIME
CURLINFO_CONNECT_TIME
CURLINFO_PRETRANSFER_TIME
CURLINFO_SIZE_UPLOAD
CURLINFO_SIZE_DOWNLOAD
CURLINFO_SPEED_DOWNLOAD
CURLINFO_SPEED_UPLOAD
CURLINFO_HEADER_SIZE
CURLINFO_REQUEST_SIZE
);
$VERSION = '1.0.1';
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function.
(my $constname = $AUTOLOAD) =~ s/.*:://;
return constant($constname, 0);
}
bootstrap Curl::easy $VERSION;
# Preloaded methods go here.
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
__END__
# Below is the stub of documentation for your module. You better edit it!
=head1 NAME
Curl::easy - Perl extension for libcurl
=head1 SYNOPSIS
use Curl::easy;
$CURL = curl_easy_init();
$CURLcode = curl_easy_setopt($CURL, CURLoption, Value);
$CURLcode = curl_easy_perform($CURL);
curl_easy_cleanup($CURL);
=head1 DESCRIPTION
This perl module provides an interface to the libcurl C library. See
http://curl.haxx.se/ for more information on cURL and libcurl.
=head1 AUTHOR
Georg Horn <horn@koblenz-net.de>
=head1 SEE ALSO
http://curl.haxx.se/
=cut

290
perl/Curl_easy/easy.xs Normal file
View File

@ -0,0 +1,290 @@
/* Perl interface for libcurl. Check out the file README for more info. */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <curl/curl.h>
#include <curl/easy.h>
/* Buffer and varname for option CURLOPT_ERRORBUFFER */
static char errbuf[CURL_ERROR_SIZE];
static char *errbufvarname = NULL;
static int
constant(char *name, int arg)
{
errno = 0;
if (strncmp(name, "CURLINFO_", 9) == 0) {
name += 9;
switch (*name) {
case 'A':
case 'B':
case 'C':
case 'D':
if (strEQ(name, "CONNECT_TIME")) return CURLINFO_CONNECT_TIME;
break;
case 'E':
case 'F':
if (strEQ(name, "EFFECTIVE_URL")) return CURLINFO_EFFECTIVE_URL;
break;
case 'G':
case 'H':
if (strEQ(name, "HEADER_SIZE")) return CURLINFO_HEADER_SIZE;
if (strEQ(name, "HTTP_CODE")) return CURLINFO_HTTP_CODE;
break;
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
if (strEQ(name, "NAMELOOKUP_TIME")) return CURLINFO_NAMELOOKUP_TIME;
break;
case 'O':
case 'P':
if (strEQ(name, "PRETRANSFER_TIME")) return CURLINFO_PRETRANSFER_TIME;
break;
case 'Q':
case 'R':
if (strEQ(name, "REQUEST_SIZE")) return CURLINFO_REQUEST_SIZE;
break;
case 'S':
case 'T':
if (strEQ(name, "SIZE_DOWNLOAD")) return CURLINFO_SIZE_DOWNLOAD;
if (strEQ(name, "SIZE_UPLOAD")) return CURLINFO_SIZE_UPLOAD;
if (strEQ(name, "SPEED_DOWNLOAD")) return CURLINFO_SPEED_DOWNLOAD;
if (strEQ(name, "SPEED_UPLOAD")) return CURLINFO_SPEED_UPLOAD;
if (strEQ(name, "TOTAL_TIME")) return CURLINFO_TOTAL_TIME;
break;
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
break;
}
}
if (strncmp(name, "CURLOPT_", 8) == 0) {
name += 8;
switch (*name) {
case 'A':
case 'B':
if (strEQ(name, "AUTOREFERER")) return CURLOPT_AUTOREFERER;
break;
case 'C':
case 'D':
if (strEQ(name, "COOKIE")) return CURLOPT_COOKIE;
if (strEQ(name, "COOKIEFILE")) return CURLOPT_COOKIEFILE;
if (strEQ(name, "CRLF")) return CURLOPT_CRLF;
if (strEQ(name, "CUSTOMREQUEST")) return CURLOPT_CUSTOMREQUEST;
break;
case 'E':
case 'F':
if (strEQ(name, "ERRORBUFFER")) return CURLOPT_ERRORBUFFER;
if (strEQ(name, "FAILONERROR")) return CURLOPT_FAILONERROR;
if (strEQ(name, "FILE")) return CURLOPT_FILE;
if (strEQ(name, "FOLLOWLOCATION")) return CURLOPT_FOLLOWLOCATION;
if (strEQ(name, "FTPAPPEND")) return CURLOPT_FTPAPPEND;
if (strEQ(name, "FTPASCII")) return CURLOPT_FTPASCII;
if (strEQ(name, "FTPLISTONLY")) return CURLOPT_FTPLISTONLY;
if (strEQ(name, "FTPPORT")) return CURLOPT_FTPPORT;
break;
case 'G':
case 'H':
if (strEQ(name, "HEADER")) return CURLOPT_HEADER;
if (strEQ(name, "HTTPHEADER")) return CURLOPT_HTTPHEADER;
if (strEQ(name, "HTTPPOST")) return CURLOPT_HTTPPOST;
if (strEQ(name, "HTTPPROXYTUNNEL")) return CURLOPT_HTTPPROXYTUNNEL;
if (strEQ(name, "HTTPREQUEST")) return CURLOPT_HTTPREQUEST;
break;
case 'I':
case 'J':
if (strEQ(name, "INFILE")) return CURLOPT_INFILE;
if (strEQ(name, "INFILESIZE")) return CURLOPT_INFILESIZE;
if (strEQ(name, "INTERFACE")) return CURLOPT_INTERFACE;
break;
case 'K':
case 'L':
if (strEQ(name, "KRB4LEVEL")) return CURLOPT_KRB4LEVEL;
if (strEQ(name, "LOW_SPEED_LIMIT")) return CURLOPT_LOW_SPEED_LIMIT;
if (strEQ(name, "LOW_SPEED_TIME")) return CURLOPT_LOW_SPEED_TIME;
break;
case 'M':
case 'N':
if (strEQ(name, "MUTE")) return CURLOPT_MUTE;
if (strEQ(name, "NETRC")) return CURLOPT_NETRC;
if (strEQ(name, "NOBODY")) return CURLOPT_NOBODY;
if (strEQ(name, "NOPROGRESS")) return CURLOPT_NOPROGRESS;
if (strEQ(name, "NOTHING")) return CURLOPT_NOTHING;
break;
case 'O':
case 'P':
if (strEQ(name, "PORT")) return CURLOPT_PORT;
if (strEQ(name, "POST")) return CURLOPT_POST;
if (strEQ(name, "POSTFIELDS")) return CURLOPT_POSTFIELDS;
if (strEQ(name, "POSTFIELDSIZE")) return CURLOPT_POSTFIELDSIZE;
if (strEQ(name, "POSTQUOTE")) return CURLOPT_POSTQUOTE;
if (strEQ(name, "PROGRESSDATA")) return CURLOPT_PROGRESSDATA;
if (strEQ(name, "PROGRESSFUNCTION")) return CURLOPT_PROGRESSFUNCTION;
if (strEQ(name, "PROXY")) return CURLOPT_PROXY;
if (strEQ(name, "PROXYPORT")) return CURLOPT_PROXYPORT;
if (strEQ(name, "PROXYUSERPWD")) return CURLOPT_PROXYUSERPWD;
if (strEQ(name, "PUT")) return CURLOPT_PUT;
break;
case 'Q':
case 'R':
if (strEQ(name, "QUOTE")) return CURLOPT_QUOTE;
if (strEQ(name, "RANGE")) return CURLOPT_RANGE;
if (strEQ(name, "READFUNCTION")) return CURLOPT_READFUNCTION;
if (strEQ(name, "REFERER")) return CURLOPT_REFERER;
if (strEQ(name, "RESUME_FROM")) return CURLOPT_RESUME_FROM;
break;
case 'S':
case 'T':
if (strEQ(name, "SSLCERT")) return CURLOPT_SSLCERT;
if (strEQ(name, "SSLCERTPASSWD")) return CURLOPT_SSLCERTPASSWD;
if (strEQ(name, "SSLVERSION")) return CURLOPT_SSLVERSION;
if (strEQ(name, "STDERR")) return CURLOPT_STDERR;
if (strEQ(name, "TIMECONDITION")) return CURLOPT_TIMECONDITION;
if (strEQ(name, "TIMEOUT")) return CURLOPT_TIMEOUT;
if (strEQ(name, "TIMEVALUE")) return CURLOPT_TIMEVALUE;
if (strEQ(name, "TRANSFERTEXT")) return CURLOPT_TRANSFERTEXT;
break;
case 'U':
case 'V':
if (strEQ(name, "UPLOAD")) return CURLOPT_UPLOAD;
if (strEQ(name, "URL")) return CURLOPT_URL;
if (strEQ(name, "USERAGENT")) return CURLOPT_USERAGENT;
if (strEQ(name, "USERPWD")) return CURLOPT_USERPWD;
if (strEQ(name, "VERBOSE")) return CURLOPT_VERBOSE;
break;
case 'W':
case 'X':
case 'Y':
case 'Z':
if (strEQ(name, "WRITEFUNCTION")) return CURLOPT_WRITEFUNCTION;
if (strEQ(name, "WRITEHEADER")) return CURLOPT_WRITEHEADER;
if (strEQ(name, "WRITEINFO")) return CURLOPT_WRITEINFO;
break;
}
}
errno = EINVAL;
return 0;
}
MODULE = Curl::easy PACKAGE = Curl::easy
int
constant(name,arg)
char * name
int arg
void *
curl_easy_init()
CODE:
if (errbufvarname) free(errbufvarname);
errbufvarname = NULL;
RETVAL = curl_easy_init();
OUTPUT:
RETVAL
int
curl_easy_setopt(curl, option, value)
void * curl
int option
char * value
CODE:
if (option < CURLOPTTYPE_OBJECTPOINT) {
/* This is an option specifying an integer value: */
long value = (long)SvIV(ST(2));
RETVAL = curl_setopt(curl, option, value);
} else if (option == CURLOPT_FILE || option == CURLOPT_INFILE ||
option == CURLOPT_WRITEHEADER) {
/* This is an option specifying a FILE * value: */
FILE * value = IoIFP(sv_2io(ST(2)));
RETVAL = curl_setopt(curl, option, value);
} else if (option == CURLOPT_ERRORBUFFER) {
SV *sv;
RETVAL = curl_setopt(curl, option, errbuf);
if (errbufvarname) free(errbufvarname);
errbufvarname = strdup(value);
sv = perl_get_sv(errbufvarname, TRUE | GV_ADDMULTI);
} else if (option == CURLOPT_WRITEFUNCTION || option ==
CURLOPT_READFUNCTION || option == CURLOPT_PROGRESSFUNCTION) {
/* This is an option specifying a callback function */
/* not yet implemented */
RETVAL = -1;
} else {
/* default, option specifying a char * value: */
RETVAL = curl_setopt(curl, option, value);
}
OUTPUT:
RETVAL
int
curl_easy_perform(curl)
void * curl
CODE:
RETVAL = curl_easy_perform(curl);
if (RETVAL && errbufvarname) {
SV *sv = perl_get_sv(errbufvarname, TRUE | GV_ADDMULTI);
sv_setpv(sv, errbuf);
}
OUTPUT:
RETVAL
int
curl_easy_getinfo(curl, option, value)
void * curl
int option
double value
CODE:
switch (option & CURLINFO_TYPEMASK) {
case CURLINFO_STRING: {
char * value = (char *)SvPV(ST(2), PL_na);
RETVAL = curl_getinfo(curl, option, &value);
sv_setpv(ST(2), value);
break;
}
case CURLINFO_LONG: {
long value = (long)SvIV(ST(2));
RETVAL = curl_getinfo(curl, option, &value);
sv_setiv(ST(2), value);
break;
}
case CURLINFO_DOUBLE: {
double value = (double)SvNV(ST(2));
RETVAL = curl_getinfo(curl, option, &value);
sv_setnv(ST(2), value);
break;
}
default: {
RETVAL = CURLE_BAD_FUNCTION_ARGUMENT;
break;
}
}
OUTPUT:
RETVAL
int
curl_easy_cleanup(curl)
void * curl
CODE:
curl_easy_cleanup(curl);
if (errbufvarname) free(errbufvarname);
errbufvarname = NULL;
RETVAL = 0;
OUTPUT:
RETVAL

101
perl/Curl_easy/test.pl Normal file
View File

@ -0,0 +1,101 @@
# 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 test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..5\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):
# Read URL to get
$defurl = "http://www/";
$url = "";
print "Please enter an URL to fetch [$defurl]: ";
$url = <STDIN>;
if ($url =~ /^\s*\n/) {
$url = $defurl;
}
# Use this for simple benchmarking
#for ($i=0; $i<1000; $i++) {
# Init the curl session
if (($curl = Curl::easy::curl_easy_init()) != 0) {
print "ok 2\n";
} else {
print "ko 2\n";
}
# Set URL to get
if (Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_URL, $url) == 0) {
print "ok 3\n";
} else {
print "ko 3\n";
}
# No progress meter please
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_NOPROGRESS, 1);
# Shut up completely
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_MUTE, 1);
# Follow location headers
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_FOLLOWLOCATION, 1);
# Set timeout
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_TIMEOUT, 30);
# Set file where to read cookies from
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_COOKIEFILE, "cookies");
# Set file where to store the header
open HEAD, ">head.out";
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_WRITEHEADER, HEAD);
# Set file where to store the body
open BODY, ">body.out";
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_FILE, BODY);
# Store error messages in variable $errbuf
# NOTE: The name of the variable is passed as a string!
# curl_easy_setopt() creates a perl variable with that name, and
# curl_easy_perform() stores the errormessage into it if an error occurs.
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_ERRORBUFFER, "errbuf");
# Go get it
if (Curl::easy::curl_easy_perform($curl) == 0) {
Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_SIZE_DOWNLOAD, $bytes);
print "ok 4: $bytes bytes read\n";
print "check out the files head.out and body.out\n";
print "for the headers and content of the URL you just fetched...\n";
Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_EFFECTIVE_URL, $realurl);
Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_HTTP_CODE, $httpcode);
print "effective fetched url (http code: $httpcode) was: $url\n";
} else {
# We can acces the error message in $errbuf here
print "ko 4: '$errbuf'\n";
}
# Cleanup
close HEAD;
close BODY;
Curl::easy::curl_easy_cleanup($curl);
print "ok 5\n";
# Use this for simple benchmarking
#}