diff options
| -rw-r--r-- | perl/Curl_easy/Changes | 35 | ||||
| -rw-r--r-- | perl/Curl_easy/MANIFEST | 6 | ||||
| -rw-r--r-- | perl/Curl_easy/Makefile.PL | 14 | ||||
| -rw-r--r-- | perl/Curl_easy/README | 27 | ||||
| -rw-r--r-- | perl/Curl_easy/easy.pm | 139 | ||||
| -rw-r--r-- | perl/Curl_easy/easy.xs | 290 | ||||
| -rw-r--r-- | perl/Curl_easy/test.pl | 101 |
7 files changed, 612 insertions, 0 deletions
diff --git a/perl/Curl_easy/Changes b/perl/Curl_easy/Changes new file mode 100644 index 000000000..a38cc34a4 --- /dev/null +++ b/perl/Curl_easy/Changes @@ -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). + diff --git a/perl/Curl_easy/MANIFEST b/perl/Curl_easy/MANIFEST new file mode 100644 index 000000000..b106c934b --- /dev/null +++ b/perl/Curl_easy/MANIFEST @@ -0,0 +1,6 @@ +Changes +MANIFEST +Makefile.PL +easy.pm +easy.xs +test.pl diff --git a/perl/Curl_easy/Makefile.PL b/perl/Curl_easy/Makefile.PL new file mode 100644 index 000000000..58a8528ad --- /dev/null +++ b/perl/Curl_easy/Makefile.PL @@ -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"} +); diff --git a/perl/Curl_easy/README b/perl/Curl_easy/README new file mode 100644 index 000000000..2eee408a0 --- /dev/null +++ b/perl/Curl_easy/README @@ -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/ + diff --git a/perl/Curl_easy/easy.pm b/perl/Curl_easy/easy.pm new file mode 100644 index 000000000..126be14a9 --- /dev/null +++ b/perl/Curl_easy/easy.pm @@ -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 diff --git a/perl/Curl_easy/easy.xs b/perl/Curl_easy/easy.xs new file mode 100644 index 000000000..2fedd904d --- /dev/null +++ b/perl/Curl_easy/easy.xs @@ -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 + diff --git a/perl/Curl_easy/test.pl b/perl/Curl_easy/test.pl new file mode 100644 index 000000000..a93b05692 --- /dev/null +++ b/perl/Curl_easy/test.pl @@ -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 +#} + |