r1640 - in packages/libwww-curl-perl/branches/upstream/current: .
lib lib/WWW lib/WWW/Curl t t/new
Niko Tyni
ntyni-guest at costa.debian.org
Fri Dec 16 20:08:40 UTC 2005
Author: ntyni-guest
Date: 2005-12-16 20:07:12 +0000 (Fri, 16 Dec 2005)
New Revision: 1640
Added:
packages/libwww-curl-perl/branches/upstream/current/META.yml
packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Multi.pm
packages/libwww-curl-perl/branches/upstream/current/t/20basic-back-func.t
packages/libwww-curl-perl/branches/upstream/current/t/21basic-back-easy.t
packages/libwww-curl-perl/branches/upstream/current/t/new/
packages/libwww-curl-perl/branches/upstream/current/t/new/00constants.t
packages/libwww-curl-perl/branches/upstream/current/t/new/01basic.t
packages/libwww-curl-perl/branches/upstream/current/t/new/02header-callback.t
packages/libwww-curl-perl/branches/upstream/current/t/new/03body-callback.t
packages/libwww-curl-perl/branches/upstream/current/t/new/04abort.t
packages/libwww-curl-perl/branches/upstream/current/t/new/05progress.t
packages/libwww-curl-perl/branches/upstream/current/t/new/06http-post.t
packages/libwww-curl-perl/branches/upstream/current/t/new/07errbuf.t
packages/libwww-curl-perl/branches/upstream/current/t/new/08duphandle.t
packages/libwww-curl-perl/branches/upstream/current/t/new/09duphandle-callback.t
packages/libwww-curl-perl/branches/upstream/current/t/new/10multi-callback.t
packages/libwww-curl-perl/branches/upstream/current/t/new/README
Removed:
packages/libwww-curl-perl/branches/upstream/current/lib/Curl/
Modified:
packages/libwww-curl-perl/branches/upstream/current/Changes
packages/libwww-curl-perl/branches/upstream/current/Curl.xs
packages/libwww-curl-perl/branches/upstream/current/Easy.pm.in
packages/libwww-curl-perl/branches/upstream/current/MANIFEST
packages/libwww-curl-perl/branches/upstream/current/Makefile.PL
packages/libwww-curl-perl/branches/upstream/current/README
packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl.pm
packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Form.pm
packages/libwww-curl-perl/branches/upstream/current/t/00constants.t
packages/libwww-curl-perl/branches/upstream/current/t/01basic.t
packages/libwww-curl-perl/branches/upstream/current/t/02header-callback.t
packages/libwww-curl-perl/branches/upstream/current/t/03body-callback.t
packages/libwww-curl-perl/branches/upstream/current/t/04abort-test.t
packages/libwww-curl-perl/branches/upstream/current/t/05progress.t
packages/libwww-curl-perl/branches/upstream/current/t/06http-post.t
packages/libwww-curl-perl/branches/upstream/current/t/07ftp-upload.t
packages/libwww-curl-perl/branches/upstream/current/t/08ssl.t
packages/libwww-curl-perl/branches/upstream/current/t/09times.t
packages/libwww-curl-perl/branches/upstream/current/t/10errbuf.t
packages/libwww-curl-perl/branches/upstream/current/t/11oldstyle1.t
packages/libwww-curl-perl/branches/upstream/current/t/12oldstyle2.t
packages/libwww-curl-perl/branches/upstream/current/t/13slowleak.t
packages/libwww-curl-perl/branches/upstream/current/t/14duphandle.t
packages/libwww-curl-perl/branches/upstream/current/t/15duphandle-callback.t
packages/libwww-curl-perl/branches/upstream/current/t/16formpost.t
packages/libwww-curl-perl/branches/upstream/current/t/17slist.t
packages/libwww-curl-perl/branches/upstream/current/t/18twinhandles.t
packages/libwww-curl-perl/branches/upstream/current/t/19basic-back.t
packages/libwww-curl-perl/branches/upstream/current/typemap
Log:
Load /tmp/tmp.Q7W7ca/libwww-curl-perl-3.02 into
packages/libwww-curl-perl/branches/upstream/current.
Modified: packages/libwww-curl-perl/branches/upstream/current/Changes
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/Changes 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/Changes 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,6 +1,29 @@
-Revision history for Perl extension Curl::easy.
-Check out the file README for more info.
+Revision history for Perl extension WWW::Curl.
+3.02_00 Fri Sep 16 2005: - Cris Bailiff <c.bailiff+curl at devsecure.com>
+ - Workaround case-sensitive filename issues by making equivalent Easy
+ names in easy namespace
+ - Test scripts - Fixup ssl tests and remove leftover MUTE option
+ - NOTE: That due to namespace changes (easy->Easy) you must change any existing
+ code to 'use WWW::Curl::Easy' instead of 'use WWW::Curl::easy', but
+ you can still use the WWW::Curl::easy function names until they
+ are removed in a future release.
+ - Tested on Redhat EL3 (curl 7.10.6) and Mandrake 10.1 (curl 7.13.1)
+3.01 Thu Apr 20 2004: - Cris Bailiff <c.bailiff+curl at devsecure.com>
+ - Merged Sebastians changes into CVS
+ - Updated remaining tests to Test::Simple
+ - Added backwards compatability to V2 names (WWW::Curl::easy etc)
+ - Dropped backwards compatability to V1.x names
+
+3.00 Thu Feb 12 2004: - Sebastian Riedel <sri at oook.de>
+ - Added multi support
+ - New module names
+ - New tests
+ - New documentation
+ - New examples
+ - Big cleanup!!!
+ - Too much to tell, it's worth an upgrade
+
2.00 Tue Apr 22 2003: - Cris Bailiff <c.bailiff+curl at devsecure.com>
- New top level package name of WWW::Curl in preparation for
entry to CPAN
@@ -99,15 +122,15 @@
becomes Curl::easy::setopt etc. This requires minor changes to existing
scripts....
- Added callback function support to pass arbitrary SV * (including
- FILE globs) from perl through libcurl to the perl callback.
- - Make callbacks still work with existing scripts which use STDIO
- - Initial support for libcurl 7.7.2 HEADERFUNCTION callback feature
- - Minor API cleanups/changes in the callback function signatures
- - Added Curl::easy::version function to return curl version string
- - Callback documentation added in easy.pm
+ FILE globs) from perl through libcurl to the perl callback.
+ - Make callbacks still work with existing scripts which use STDIO
+ - Initial support for libcurl 7.7.2 HEADERFUNCTION callback feature
+ - Minor API cleanups/changes in the callback function signatures
+ - Added Curl::easy::version function to return curl version string
+ - Callback documentation added in easy.pm
- More tests in test.pl
-1.1.2 Mon Apr 16 2001: - Georg Horn <horn at koblenz-net.de>
+1.1.2 Mon Apr 16 2001: - Georg Horn <horn at koblenz-net.de>
- Added support for callback functions. This is for the curl_easy_setopt()
options WRITEFUNCTION, READFUNCTION, PROGRESSFUNCTION and PASSWDFUNCTION.
Still missing, but not really neccessary: Passing a FILE * pointer,
@@ -137,7 +160,7 @@
- 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.
+ be stored to.
- Passing filehandles (Options FILE, INFILE and WRITEHEADER) now works.
Have a look at test.pl to see how it works...
@@ -152,11 +175,11 @@
- 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).
+ READFUNCTION and PROGRESSFUNCTION).
- passing FILE * pointers doesn't work (options FILE, INFILE and
- WRITEHEADER).
+ WRITEHEADER).
- passing linked lists doesn't work (options HTTPHEADER and
- HTTPPOST).
+ HTTPPOST).
- setting the buffer where to store error messages in doesn't work
- (option ERRORBUFFER).
+ (option ERRORBUFFER).
Modified: packages/libwww-curl-perl/branches/upstream/current/Curl.xs
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/Curl.xs 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/Curl.xs 2005-12-16 20:07:12 UTC (rev 1640)
@@ -18,6 +18,11 @@
#include <curl/curl.h>
#include <curl/easy.h>
+/* Multi only available since 7.9.6 */
+#if (LIBCURL_VERSION_NUM>0x070905)
+#include <curl/multi.h>
+#endif
+
#if (LIBCURL_VERSION_NUM<0x070702)
#define CURLOPT_HEADERFUNCTION 20079
#define header_callback_func write_callback_func
@@ -41,6 +46,7 @@
SLIST_LAST
} perl_curl_easy_slist_code;
+
typedef struct {
/* The main curl handle */
struct CURL *curl;
@@ -54,86 +60,91 @@
char errbuf[CURL_ERROR_SIZE+1];
char *errbufvarname;
-#ifdef WITH_INTERNAL_VARS
-#define USE_INTERNAL_VARS 0x01
- /* Internal content storing */
- char *contbuf;
- char *bufptr;
- size_t bufsize;
- size_t contlen;
- int internal_options;
-#endif
-
} perl_curl_easy;
+
+typedef struct {
#if LIBCURL_VERSION_NUM >= 0x070900
-typedef struct {
struct HttpPost * post;
struct HttpPost * last;
-} perl_curl_form;
#else
-typedef struct {
void * post;
void * last;
+#endif
} perl_curl_form;
+
+
+typedef struct {
+#ifdef __CURL_MULTI_H
+ struct CURLM *curlm;
+#else
+ struct void *curlm;
#endif
+} perl_curl_multi;
+
/* switch from curl option codes to the relevant callback index */
-static perl_curl_easy_callback_code callback_index(int option) {
+static perl_curl_easy_callback_code callback_index(int option)
+{
switch(option) {
- case CURLOPT_WRITEFUNCTION:
- case CURLOPT_FILE:
- return CALLBACK_WRITE;
- break;
+ case CURLOPT_WRITEFUNCTION:
+ case CURLOPT_FILE:
+ return CALLBACK_WRITE;
+ break;
- case CURLOPT_READFUNCTION:
- case CURLOPT_INFILE:
- return CALLBACK_READ;
- break;
+ case CURLOPT_READFUNCTION:
+ case CURLOPT_INFILE:
+ return CALLBACK_READ;
+ break;
- case CURLOPT_HEADERFUNCTION:
- case CURLOPT_WRITEHEADER:
- return CALLBACK_HEADER;
- break;
+ case CURLOPT_HEADERFUNCTION:
+ case CURLOPT_WRITEHEADER:
+ return CALLBACK_HEADER;
+ break;
- case CURLOPT_PROGRESSFUNCTION:
- case CURLOPT_PROGRESSDATA:
- return CALLBACK_PROGRESS;
- break;
+ case CURLOPT_PROGRESSFUNCTION:
+ case CURLOPT_PROGRESSDATA:
+ return CALLBACK_PROGRESS;
+ break;
- case CURLOPT_PASSWDFUNCTION:
- case CURLOPT_PASSWDDATA:
- return CALLBACK_PASSWD;
- break;
+/* PASSWD callback dropped in 7.10.8 */
+#if (LIBCURL_VERSION_NUM<0x070A08)
+
+ case CURLOPT_PASSWDFUNCTION:
+ case CURLOPT_PASSWDDATA:
+ return CALLBACK_PASSWD;
+ break;
+#endif
+
}
croak("Bad callback index requested\n");
return CALLBACK_LAST;
}
/* switch from curl slist names to an slist index */
-static perl_curl_easy_slist_code slist_index(int option) {
+static perl_curl_easy_slist_code slist_index(int option)
+{
switch(option) {
- case CURLOPT_HTTPHEADER:
- return SLIST_HTTPHEADER;
- break;
- case CURLOPT_QUOTE:
- return SLIST_QUOTE;
- break;
- case CURLOPT_POSTQUOTE:
- return SLIST_POSTQUOTE;
- break;
+ case CURLOPT_HTTPHEADER:
+ return SLIST_HTTPHEADER;
+ break;
+ case CURLOPT_QUOTE:
+ return SLIST_QUOTE;
+ break;
+ case CURLOPT_POSTQUOTE:
+ return SLIST_POSTQUOTE;
+ break;
}
croak("Bad slist index requested\n");
return SLIST_LAST;
}
-/* Setup these global vars */
static perl_curl_easy * perl_curl_easy_new()
{
perl_curl_easy *self;
Newz(1, self, 1, perl_curl_easy);
if (!self)
- croak("out of memory");
+ croak("out of memory");
self->curl=curl_easy_init();
return self;
}
@@ -143,7 +154,7 @@
perl_curl_easy *self;
Newz(1, self, 1, perl_curl_easy);
if (!self)
- croak("out of memory");
+ croak("out of memory");
self->curl=curl_easy_duphandle(orig->curl);
return self;
}
@@ -155,16 +166,12 @@
curl_easy_cleanup(self->curl);
for (index=0;index<SLIST_LAST;index++) {
- if (self->slist[index]) curl_slist_free_all(self->slist[index]);
+ if (self->slist[index]) curl_slist_free_all(self->slist[index]);
};
- if (self->errbufvarname) free(self->errbufvarname);
+ if (self->errbufvarname)
+ free(self->errbufvarname);
-#ifdef WITH_INTERNAL_VARS
- if (self->contbuf) free(self->contbuf);
- self->bufptr = self->contbuf = NULL;
-#endif
-
Safefree(self);
}
@@ -175,18 +182,19 @@
{
/* FIXME: need to check the ref-counts here */
if (*callback == NULL) {
- *callback = newSVsv(function);
+ *callback = newSVsv(function);
} else {
- SvSetSV(*callback, function);
+ SvSetSV(*callback, function);
}
}
+/* start of form functions - very un-finished! */
static perl_curl_form * perl_curl_form_new()
{
perl_curl_form *self;
Newz(1, self, 1, perl_curl_form);
if (!self)
- croak("out of memory");
+ croak("out of memory");
self->post=NULL;
self->last=NULL;
return self;
@@ -194,81 +202,112 @@
static void perl_curl_form_delete(perl_curl_form *self)
{
-#if LIBCURL_VERSION_NUM >= 0x070900
+#if 0
+#if (LIBCURL_VERSION_NUM >= 0x070900)
if (self->post) {
- curl_formfree(self->post);
+ curl_formfree(self->post);
}
#endif
+#endif
Safefree(self);
}
+/* make a new multi */
+static perl_curl_multi * perl_curl_multi_new()
+{
+ perl_curl_multi *self;
+ Newz(1, self, 1, perl_curl_multi);
+ if (!self)
+ croak("out of memory");
+#ifdef __CURL_MULTI_H
+ self->curlm=curl_multi_init();
+#else
+ croak("curl version too old to support curl_multi_init()");
+#endif
+ return self;
+}
+
+/* delete the multi */
+static void perl_curl_multi_delete(perl_curl_multi *self)
+{
+#ifdef __CURL_MULTI_H
+ if (self->curlm)
+ curl_multi_cleanup(self->curlm);
+ Safefree(self);
+#endif
+
+}
+
+
/* generic fwrite callback, which decides which callback to call */
static size_t
-fwrite_wrapper (const void *ptr,
- size_t size,
- size_t nmemb,
- perl_curl_easy *self,
- void *call_function,
- void *call_ctx)
+fwrite_wrapper (
+ const void *ptr,
+ size_t size,
+ size_t nmemb,
+ perl_curl_easy *self,
+ void *call_function,
+ void *call_ctx)
{
dSP;
if (call_function) { /* We are doing a callback to perl */
- int count, status;
- SV *sv;
+ int count, status;
+ SV *sv;
- ENTER;
- SAVETMPS;
+ ENTER;
+ SAVETMPS;
- PUSHMARK(SP);
+ PUSHMARK(SP);
- if (ptr) {
- XPUSHs(sv_2mortal(newSVpvn((char *)ptr, (STRLEN)(size * nmemb))));
- } else { /* just in case */
- XPUSHs(&PL_sv_undef);
- }
+ if (ptr) {
+ XPUSHs(sv_2mortal(newSVpvn((char *)ptr, (STRLEN)(size * nmemb))));
+ } else { /* just in case */
+ XPUSHs(&PL_sv_undef);
+ }
- if (call_ctx) {
- XPUSHs(sv_2mortal(newSVsv(call_ctx)));
+ if (call_ctx) {
+ XPUSHs(sv_2mortal(newSVsv(call_ctx)));
} else { /* should be a stdio glob ? */
- XPUSHs(&PL_sv_undef);
- }
+ XPUSHs(&PL_sv_undef);
+ }
- PUTBACK;
- count = perl_call_sv((SV *) call_function, G_SCALAR);
- SPAGAIN;
+ PUTBACK;
+ count = perl_call_sv((SV *) call_function, G_SCALAR);
+ SPAGAIN;
- if (count != 1)
+ if (count != 1)
croak("callback for CURLOPT_WRITEFUNCTION didn't return a status\n");
- status = POPi;
+ status = POPi;
- PUTBACK;
- FREETMPS;
- LEAVE;
- return status;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return status;
} else {
- /* perform write directly, via PerlIO */
+ /* perform write directly, via PerlIO */
- PerlIO *handle;
- if (call_ctx) { /* Assume the context is a GLOB */
- handle = IoOFP(sv_2io(call_ctx));
- } else { /* punt to stdout */
- handle = PerlIO_stdout();
- }
- return PerlIO_write(handle,ptr,size*nmemb);
+ PerlIO *handle;
+ if (call_ctx) { /* Assume the context is a GLOB */
+ handle = IoOFP(sv_2io(call_ctx));
+
+ } else { /* punt to stdout */
+ handle = PerlIO_stdout();
+ }
+ return PerlIO_write(handle,ptr,size*nmemb);
}
}
/* Write callback for calling a perl callback */
size_t
-write_callback_func( const void *ptr, size_t size, size_t nmemb, void *stream)
+write_callback_func(const void *ptr, size_t size, size_t nmemb, void *stream)
{
perl_curl_easy *self;
self=(perl_curl_easy *)stream;
return fwrite_wrapper(ptr,size,nmemb,self,
- self->callback[CALLBACK_WRITE],self->callback_ctx[CALLBACK_WRITE]);
+ self->callback[CALLBACK_WRITE],self->callback_ctx[CALLBACK_WRITE]);
}
/* header callback for calling a perl callback */
@@ -279,7 +318,7 @@
self=(perl_curl_easy *)stream;
return fwrite_wrapper(ptr,size,nmemb,self,
- self->callback[CALLBACK_HEADER],self->callback_ctx[CALLBACK_HEADER]);
+ self->callback[CALLBACK_HEADER],self->callback_ctx[CALLBACK_HEADER]);
}
/* read callback for calling a perl callback */
@@ -295,22 +334,22 @@
maxlen = size*nmemb;
if (self->callback[CALLBACK_READ]) { /* We are doing a callback to perl */
- char *data;
- int count;
- SV *sv;
- STRLEN len;
+ char *data;
+ int count;
+ SV *sv;
+ STRLEN len;
ENTER ;
SAVETMPS ;
PUSHMARK(SP) ;
- if (self->callback_ctx[CALLBACK_READ]) {
+ if (self->callback_ctx[CALLBACK_READ]) {
sv = self->callback_ctx[CALLBACK_READ];
} else {
sv = &PL_sv_undef;
}
-
+
XPUSHs(sv_2mortal(newSViv(maxlen)));
XPUSHs(sv_2mortal(newSVsv(sv)));
@@ -335,14 +374,14 @@
return (size_t) (len/size);
} else {
- /* read input directly */
- PerlIO *f;
- if (self->callback_ctx[CALLBACK_READ]) { /* hope its a GLOB! */
- f = IoIFP(sv_2io(self->callback_ctx[CALLBACK_READ]));
- } else { /* punt to stdin */
- f = PerlIO_stdin();
- }
- return PerlIO_read(f,ptr,maxlen);
+ /* read input directly */
+ PerlIO *f;
+ if (self->callback_ctx[CALLBACK_READ]) { /* hope its a GLOB! */
+ f = IoIFP(sv_2io(self->callback_ctx[CALLBACK_READ]));
+ } else { /* punt to stdin */
+ f = PerlIO_stdin();
+ }
+ return PerlIO_read(f,ptr,maxlen);
}
}
@@ -361,9 +400,9 @@
SAVETMPS;
PUSHMARK(sp);
if (self->callback_ctx[CALLBACK_PROGRESS]) {
- XPUSHs(sv_2mortal(newSVsv(self->callback_ctx[CALLBACK_PROGRESS])));
+ XPUSHs(sv_2mortal(newSVsv(self->callback_ctx[CALLBACK_PROGRESS])));
} else {
- XPUSHs(&PL_sv_undef);
+ XPUSHs(&PL_sv_undef);
}
XPUSHs(sv_2mortal(newSVnv(dltotal)));
XPUSHs(sv_2mortal(newSVnv(dlnow)));
@@ -375,7 +414,7 @@
SPAGAIN;
if (count != 1)
- croak("callback for CURLOPT_PROGRESSFUNCTION didn't return 1\n");
+ croak("callback for CURLOPT_PROGRESSFUNCTION didn't return 1\n");
count = POPi;
@@ -405,7 +444,7 @@
if (self->callback_ctx[CALLBACK_PASSWD]) {
XPUSHs(sv_2mortal(newSVsv(self->callback_ctx[CALLBACK_PASSWD])));
} else {
- XPUSHs(&PL_sv_undef);
+ XPUSHs(&PL_sv_undef);
}
XPUSHs(sv_2mortal(newSVpv(prompt, 0)));
XPUSHs(sv_2mortal(newSViv(buflen)));
@@ -413,7 +452,7 @@
count = perl_call_sv(self->callback[CALLBACK_PASSWD], G_ARRAY);
SPAGAIN;
if (count != 2)
- croak("callback for CURLOPT_PASSWDFUNCTION didn't return status + data\n");
+ croak("callback for CURLOPT_PASSWDFUNCTION didn't return status + data\n");
sv = POPs;
count = POPi;
@@ -464,42 +503,16 @@
}
#endif
+#include "curlopt-constants.c"
-/* FIXME: should do this in the perl layer */
-/* Internal write callback. Only used if USE_INTERNAL_VARS was specified */
+typedef perl_curl_easy * WWW__Curl__Easy;
-#ifdef WITH_INTERNAL_VARS
-static size_t internal_write_callback(const void *ptr, size_t size, size_t num, void *stream)
-{
- perl_curl_easy *self;
- self=(perl_curl_easy *)stream;
-
- size *= num;
- if ((self->contlen + size) >= self->bufsize) {
- if (self->bufsize) {
- self->bufsize *= 2; /* grow */
- } else {
- self->bufsize = 32768; /* initial size */
- }
- self->contbuf = realloc(self->contbuf, self->bufsize + 1);
- self->bufptr = self->contbuf + self->contlen;
- }
- self->contlen += size;
- memcpy(self->bufptr, ptr, size);
- self->bufptr += size;
- *(self->bufptr) = '\0';
- return size;
-}
-#endif
+typedef perl_curl_form * WWW__Curl__Form;
-#include "curlopt-constants.c"
+typedef perl_curl_multi * WWW__Curl__Multi;
-typedef perl_curl_easy * WWW__Curl__easy;
+MODULE = WWW::Curl PACKAGE = WWW::Curl::Easy PREFIX = curl_easy_
-typedef perl_curl_form * WWW__Curl__form;
-
-MODULE = WWW::Curl PACKAGE = WWW::Curl::easy PREFIX = curl_easy_
-
BOOT:
curl_global_init(CURL_GLOBAL_ALL); /* FIXME: does this need a mutex for ithreads? */
@@ -515,399 +528,435 @@
void
curl_easy_init(...)
ALIAS:
- new = 1
+ new = 1
PREINIT:
- perl_curl_easy *self;
- char *sclass = "WWW::Curl::easy";
+ perl_curl_easy *self;
+ char *sclass = "WWW::Curl::Easy";
+
PPCODE:
- if (items>0 && !SvROK(ST(0))) {
- STRLEN dummy;
- sclass = SvPV(ST(0),dummy);
- }
+ if (items>0 && !SvROK(ST(0))) {
+ STRLEN dummy;
+ sclass = SvPV(ST(0),dummy);
+ }
- self=perl_curl_easy_new(); /* curl handle created by this point */
+ self=perl_curl_easy_new(); /* curl handle created by this point */
- ST(0) = sv_newmortal();
- sv_setref_pv(ST(0), sclass, (void*)self);
- SvREADONLY_on(SvRV(ST(0)));
+ ST(0) = sv_newmortal();
+ sv_setref_pv(ST(0), sclass, (void*)self);
+ SvREADONLY_on(SvRV(ST(0)));
- /* configure curl to always callback to the XS interface layer */
- curl_easy_setopt(self->curl, CURLOPT_WRITEFUNCTION, write_callback_func);
- curl_easy_setopt(self->curl, CURLOPT_READFUNCTION, read_callback_func);
- curl_easy_setopt(self->curl, CURLOPT_HEADERFUNCTION, header_callback_func);
- curl_easy_setopt(self->curl, CURLOPT_PROGRESSFUNCTION, progress_callback_func);
- curl_easy_setopt(self->curl, CURLOPT_PASSWDFUNCTION, passwd_callback_func);
+ /* configure curl to always callback to the XS interface layer */
+ curl_easy_setopt(self->curl, CURLOPT_WRITEFUNCTION, write_callback_func);
+ curl_easy_setopt(self->curl, CURLOPT_READFUNCTION, read_callback_func);
+ curl_easy_setopt(self->curl, CURLOPT_HEADERFUNCTION, header_callback_func);
+ curl_easy_setopt(self->curl, CURLOPT_PROGRESSFUNCTION, progress_callback_func);
+#if (LIBCURL_VERSION_NUM<0x070A08)
+ curl_easy_setopt(self->curl, CURLOPT_PASSWDFUNCTION, passwd_callback_func);
+#endif
- /* set our own object as the context for all curl callbacks */
- curl_easy_setopt(self->curl, CURLOPT_FILE, self);
- curl_easy_setopt(self->curl, CURLOPT_INFILE, self);
- curl_easy_setopt(self->curl, CURLOPT_WRITEHEADER, self);
- curl_easy_setopt(self->curl, CURLOPT_PROGRESSDATA, self);
- curl_easy_setopt(self->curl, CURLOPT_PASSWDDATA, self);
+ /* set our own object as the context for all curl callbacks */
+ curl_easy_setopt(self->curl, CURLOPT_FILE, self);
+ curl_easy_setopt(self->curl, CURLOPT_INFILE, self);
+ curl_easy_setopt(self->curl, CURLOPT_WRITEHEADER, self);
+ curl_easy_setopt(self->curl, CURLOPT_PROGRESSDATA, self);
+#if (LIBCURL_VERSION_NUM<0x070A08)
+ curl_easy_setopt(self->curl, CURLOPT_PASSWDDATA, self);
+#endif
+ /* we always collect this, in case it's wanted */
+ curl_easy_setopt(self->curl, CURLOPT_ERRORBUFFER, self->errbuf);
- /* we always collect this, in case it's wanted */
- curl_easy_setopt(self->curl, CURLOPT_ERRORBUFFER, self->errbuf);
+ XSRETURN(1);
- XSRETURN(1);
-
void
curl_easy_duphandle(self)
- WWW::Curl::easy self
+ WWW::Curl::Easy self
PREINIT:
- perl_curl_easy *clone;
- char *sclass = "WWW::Curl::easy";
- perl_curl_easy_callback_code i;
+ perl_curl_easy *clone;
+ char *sclass = "WWW::Curl::Easy";
+ perl_curl_easy_callback_code i;
+
PPCODE:
- clone=perl_curl_easy_duphandle(self);
+ clone=perl_curl_easy_duphandle(self);
- ST(0) = sv_newmortal();
- sv_setref_pv(ST(0), sclass, (void*)clone);
- SvREADONLY_on(SvRV(ST(0)));
+ ST(0) = sv_newmortal();
+ sv_setref_pv(ST(0), sclass, (void*)clone);
+ SvREADONLY_on(SvRV(ST(0)));
- /* configure curl to always callback to the XS interface layer */
- /*
- * FIXME: This needs more testing before turning on...
-
- curl_easy_setopt(clone->curl, CURLOPT_WRITEFUNCTION, write_callback_func);
- curl_easy_setopt(clone->curl, CURLOPT_READFUNCTION, read_callback_func);
- curl_easy_setopt(clone->curl, CURLOPT_HEADERFUNCTION, header_callback_func);
- curl_easy_setopt(clone->curl, CURLOPT_PROGRESSFUNCTION, progress_callback_func);
- curl_easy_setopt(clone->curl, CURLOPT_PASSWDFUNCTION, passwd_callback_func);
- */
+ /* configure curl to always callback to the XS interface layer */
+ /*
+ * FIXME: This needs more testing before turning on...
- /* set our own object as the context for all curl callbacks */
- curl_easy_setopt(clone->curl, CURLOPT_FILE, clone);
- curl_easy_setopt(clone->curl, CURLOPT_INFILE, clone);
- curl_easy_setopt(clone->curl, CURLOPT_WRITEHEADER, clone);
- curl_easy_setopt(clone->curl, CURLOPT_PROGRESSDATA, clone);
- curl_easy_setopt(clone->curl, CURLOPT_PASSWDDATA, clone);
+ curl_easy_setopt(clone->curl, CURLOPT_WRITEFUNCTION, write_callback_func);
+ curl_easy_setopt(clone->curl, CURLOPT_READFUNCTION, read_callback_func);
+ curl_easy_setopt(clone->curl, CURLOPT_HEADERFUNCTION, header_callback_func);
+ curl_easy_setopt(clone->curl, CURLOPT_PROGRESSFUNCTION, progress_callback_func);
+ curl_easy_setopt(clone->curl, CURLOPT_PASSWDFUNCTION, passwd_callback_func);
+ */
- /* we always collect this, in case it's wanted */
- curl_easy_setopt(clone->curl, CURLOPT_ERRORBUFFER, clone->errbuf);
+ /* set our own object as the context for all curl callbacks */
+ curl_easy_setopt(clone->curl, CURLOPT_FILE, clone);
+ curl_easy_setopt(clone->curl, CURLOPT_INFILE, clone);
+ curl_easy_setopt(clone->curl, CURLOPT_WRITEHEADER, clone);
+ curl_easy_setopt(clone->curl, CURLOPT_PROGRESSDATA, clone);
+#if (LIBCURL_VERSION_NUM<0x070A08)
+ curl_easy_setopt(clone->curl, CURLOPT_PASSWDDATA, clone);
+#endif
+ /* we always collect this, in case it's wanted */
+ curl_easy_setopt(clone->curl, CURLOPT_ERRORBUFFER, clone->errbuf);
- for(i=0;i<CALLBACK_LAST;i++) {
- clone->callback[i]=self->callback[i];
- clone->callback_ctx[i]=self->callback_ctx[i];
- /*
- * FIXME:
- perl_curl_easy_register_callback(clone,&(clone->callback[i]), self->callback[i]);
- perl_curl_easy_register_callback(clone,&(clone->callback_ctx[i]), self->callback_ctx[i]);
- */
- };
+ for(i=0;i<CALLBACK_LAST;i++) {
+ clone->callback[i]=self->callback[i];
+ clone->callback_ctx[i]=self->callback_ctx[i];
+ /*
+ * FIXME:
+ perl_curl_easy_register_callback(clone,&(clone->callback[i]), self->callback[i]);
+ perl_curl_easy_register_callback(clone,&(clone->callback_ctx[i]), self->callback_ctx[i]);
+ */
+ };
- XSRETURN(1);
+ XSRETURN(1);
char *
curl_easy_version(...)
CODE:
- RETVAL=curl_version();
+ RETVAL=curl_version();
OUTPUT:
- RETVAL
+ RETVAL
int
curl_easy_setopt(self, option, value)
- WWW::Curl::easy self
- int option
- SV * value
+ WWW::Curl::Easy self
+ int option
+ SV * value
CODE:
- RETVAL=CURLE_OK;
- switch(option) {
- /* SV * to user contexts for callbacks - any SV (glob,scalar,ref) */
- case CURLOPT_FILE:
- case CURLOPT_INFILE:
- case CURLOPT_WRITEHEADER:
- case CURLOPT_PROGRESSDATA:
- case CURLOPT_PASSWDDATA:
- perl_curl_easy_register_callback(self,&(self->callback_ctx[callback_index(option)]),value);
- break;
+ RETVAL=CURLE_OK;
+ switch(option) {
+ /* SV * to user contexts for callbacks - any SV (glob,scalar,ref) */
+ case CURLOPT_FILE:
+ case CURLOPT_INFILE:
+ case CURLOPT_WRITEHEADER:
+ case CURLOPT_PROGRESSDATA:
+#if (LIBCURL_VERSION_NUM<0x070A08)
+ case CURLOPT_PASSWDDATA:
+#endif
+ perl_curl_easy_register_callback(self,
+ &(self->callback_ctx[callback_index(option)]),value);
+ break;
- /* SV * to a subroutine ref */
- case CURLOPT_WRITEFUNCTION:
- case CURLOPT_READFUNCTION:
- case CURLOPT_HEADERFUNCTION:
- case CURLOPT_PROGRESSFUNCTION:
- case CURLOPT_PASSWDFUNCTION:
- perl_curl_easy_register_callback(self,&(self->callback[callback_index(option)]),value);
- break;
+ /* SV * to a subroutine ref */
+ case CURLOPT_WRITEFUNCTION:
+ case CURLOPT_READFUNCTION:
+ case CURLOPT_HEADERFUNCTION:
+ case CURLOPT_PROGRESSFUNCTION:
+#if (LIBCURL_VERSION_NUM<0x070A08)
+ case CURLOPT_PASSWDFUNCTION:
+#endif
+ perl_curl_easy_register_callback(self,
+ &(self->callback[callback_index(option)]),value);
+ break;
- /* slist cases */
- case CURLOPT_HTTPHEADER:
- case CURLOPT_QUOTE:
- case CURLOPT_POSTQUOTE:
- {
- /* This is an option specifying a list, which we put in a curl_slist struct */
- AV *array = (AV *)SvRV(value);
- struct curl_slist **slist = NULL;
- int last = av_len(array);
- int i;
+ /* slist cases */
+ case CURLOPT_HTTPHEADER:
+ case CURLOPT_QUOTE:
+ case CURLOPT_POSTQUOTE:
+ {
+ /* This is an option specifying a list, which we put in a curl_slist struct */
+ AV *array = (AV *)SvRV(value);
+ struct curl_slist **slist = NULL;
+ int last = av_len(array);
+ int i;
- /* We have to find out which list to use... */
- slist = &(self->slist[slist_index(option)]);
+ /* We have to find out which list to use... */
+ slist = &(self->slist[slist_index(option)]);
- /* free any previous list */
- if (*slist) {
- curl_slist_free_all(*slist);
- *slist=NULL;
- }
- /* copy perl values into this slist */
- for (i=0;i<=last;i++) {
- SV **sv = av_fetch(array,i,0);
- int len = 0;
- char *string = SvPV(*sv, len);
- if (len == 0) /* FIXME: is this correct? */
- break;
- *slist = curl_slist_append(*slist, string);
- }
- /* pass the list into curl_easy_setopt() */
- RETVAL = curl_easy_setopt(self->curl, option, *slist);
- };
- break;
+ /* free any previous list */
+ if (*slist) {
+ curl_slist_free_all(*slist);
+ *slist=NULL;
+ }
+ /* copy perl values into this slist */
+ for (i=0;i<=last;i++) {
+ SV **sv = av_fetch(array,i,0);
+ int len = 0;
+ char *string = SvPV(*sv, len);
+ if (len == 0) /* FIXME: is this correct? */
+ break;
+ *slist = curl_slist_append(*slist, string);
+ }
+ /* pass the list into curl_easy_setopt() */
+ RETVAL = curl_easy_setopt(self->curl, option, *slist);
+ };
+ break;
- /* Pass in variable name for storing error messages. Yuck. */
- case CURLOPT_ERRORBUFFER:
- {
- STRLEN dummy;
- if (self->errbufvarname) free(self->errbufvarname);
- self->errbufvarname = strdup((char *)SvPV(value, dummy));
- };
- break;
+ /* Pass in variable name for storing error messages. Yuck. */
+ case CURLOPT_ERRORBUFFER:
+ {
+ STRLEN dummy;
+ if (self->errbufvarname)
+ free(self->errbufvarname);
+ self->errbufvarname = strdup((char *)SvPV(value, dummy));
+ };
+ break;
- /* tell curl to redirect STDERR - value should be a glob */
- case CURLOPT_STDERR:
- RETVAL = curl_easy_setopt(self->curl, option, IoOFP(sv_2io(value)) );
- break;
+ /* tell curl to redirect STDERR - value should be a glob */
+ case CURLOPT_STDERR:
+ RETVAL = curl_easy_setopt(self->curl, option, IoOFP(sv_2io(value)) );
+ break;
- /* not working yet...
- case CURLOPT_HTTPPOST:
- if (sv_derived_from(value, "WWW::Curl::form")) {
- WWW__Curl__form wrapper;
- IV tmp = SvIV((SV*)SvRV(value));
- wrapper = INT2PTR(WWW__Curl__form,tmp);
- RETVAL = curl_easy_setopt(self->curl, option, wrapper->post);
- } else
- croak("value is not of type WWW::Curl::form");
- break;
- */
+ /* not working yet...
+ case CURLOPT_HTTPPOST:
+ if (sv_derived_from(value, "WWW::Curl::Form")) {
+ WWW__Curl__form wrapper;
+ IV tmp = SvIV((SV*)SvRV(value));
+ wrapper = INT2PTR(WWW__Curl__form,tmp);
+ RETVAL = curl_easy_setopt(self->curl, option, wrapper->post);
+ } else
+ croak("value is not of type WWW::Curl::Form");
+ break;
+ */
- /* default cases */
- default:
- if (option < CURLOPTTYPE_OBJECTPOINT) { /* An integer value: */
- RETVAL = curl_easy_setopt(self->curl, option, (long)SvIV(value));
- } else { /* A char * value: */
- /* FIXME: Does curl really want NULL for empty stings? */
- STRLEN dummy;
- char *pv = SvPV(value, dummy);
- RETVAL = curl_easy_setopt(self->curl, option, *pv ? pv : NULL);
- };
- break;
- };
+ /* default cases */
+ default:
+ if (option < CURLOPTTYPE_OBJECTPOINT) { /* An integer value: */
+ RETVAL = curl_easy_setopt(self->curl, option, (long)SvIV(value));
+ } else { /* A char * value: */
+ /* FIXME: Does curl really want NULL for empty strings? */
+ STRLEN dummy;
+ char *pv = SvPV(value, dummy);
+ RETVAL = curl_easy_setopt(self->curl, option, *pv ? pv : NULL);
+ };
+ break;
+ };
OUTPUT:
- RETVAL
+ RETVAL
int
internal_setopt(self, option, value)
- WWW::Curl::easy self
- int option
- int value
+ WWW::Curl::Easy self
+ int option
+ int value
CODE:
-#ifdef WITH_INTERNAL_VARS
- if (value == 1) {
- self->internal_options |= option;
- } else {
- self->internal_options &= !option;
- }
-#else
- croak("internal_setopt deprecated - recompile with -DWITH_INTERNAL_VARS for support\n");
-#endif
- RETVAL = 0;
+ croak("internal_setopt no longer supported - use a callback\n");
+ RETVAL = 0;
OUTPUT:
- RETVAL
+ RETVAL
int
curl_easy_perform(self)
- WWW::Curl::easy self
+ WWW::Curl::Easy self
CODE:
- /* perform the actual curl fetch */
-#ifdef WITH_INTERNAL_VARS
- if (self->internal_options & USE_INTERNAL_VARS) {
- /* Use internal callback which just stores the content into a buffer. */
- self->bufptr = self->contbuf;
- self->contlen = 0;
- curl_easy_setopt(self->curl, CURLOPT_WRITEFUNCTION, internal_write_callback);
- curl_easy_setopt(self->curl, CURLOPT_HEADER, 1);
- }
-#endif
- RETVAL = curl_easy_perform(self->curl);
+ /* perform the actual curl fetch */
+ RETVAL = curl_easy_perform(self->curl);
- if (RETVAL && self->errbufvarname) {
- /* If an error occurred and a varname for error messages has been
- specified, store the error message. */
- SV *sv = perl_get_sv(self->errbufvarname, TRUE | GV_ADDMULTI);
- sv_setpv(sv, self->errbuf);
- }
- /* Better to use plain perl for this - should work, but I have no scripts
- * using this to test with. */
-#ifdef WITH_INTERNAL_VARS
- if ((!RETVAL || (RETVAL == CURLE_PARTIAL_FILE)) &&
- (self->internal_options & USE_INTERNAL_VARS)) {
- /* No error and internal variable for the content are to be used:
- Split the data into headers and content and store them into
- perl variables. */
- /* Note these are globals, and therefore are not safe between handles
- * or threads */
- SV *head_sv = perl_get_sv("WWW::Curl::easy::headers", TRUE | GV_ADDMULTI);
- SV *cont_sv = perl_get_sv("WWW::Curl::easy::content", TRUE | GV_ADDMULTI);
- char *p = self->contbuf;
- int nl = 0, found = 0;
- while (p < self->bufptr) {
- if (nl && (*p == '\n' || *p == '\r')) {
- /* found empty line, end of headers */
- *p++ = '\0';
- sv_setpv(head_sv, self->contbuf);
- while (*p == '\n' || *p == '\r') {
- p++;
- }
- sv_setpvn(cont_sv, p, self->bufptr - p);
- found = 1;
- break;
- }
- nl = (*p == '\n');
- p++;
- }
- if (!found) {
- sv_setpv(head_sv, "");
- sv_setpvn(cont_sv, self->contbuf, self->contlen);
- }
- }
- /* reset */
- self->bufptr = self->contbuf;
- self->contlen = 0;
-#endif
+ if (RETVAL && self->errbufvarname) {
+ /* If an error occurred and a varname for error messages has been
+ specified, store the error message. */
+ SV *sv = perl_get_sv(self->errbufvarname, TRUE | GV_ADDMULTI);
+ sv_setpv(sv, self->errbuf);
+ }
OUTPUT:
- RETVAL
+ RETVAL
SV *
curl_easy_getinfo(self, option, ... )
- WWW::Curl::easy self
- int option
+ WWW::Curl::Easy self
+ int option
CODE:
- switch (option & CURLINFO_TYPEMASK) {
- case CURLINFO_STRING:
- {
- char * vchar;
- curl_easy_getinfo(self->curl, option, &vchar);
- RETVAL = newSVpv(vchar,0);
- break;
- }
- case CURLINFO_LONG:
- {
- long vlong;
- curl_easy_getinfo(self->curl, option, &vlong);
- RETVAL = newSViv(vlong);
- break;
- }
- case CURLINFO_DOUBLE:
- {
- double vdouble;
- curl_easy_getinfo(self->curl, option, &vdouble);
- RETVAL = newSVnv(vdouble);
- break;
- }
- default: {
- RETVAL = newSViv(CURLE_BAD_FUNCTION_ARGUMENT);
- break;
- }
- }
- if (items > 2)
- sv_setsv(ST(2),RETVAL);
+ switch (option & CURLINFO_TYPEMASK) {
+ case CURLINFO_STRING:
+ {
+ char * vchar;
+ curl_easy_getinfo(self->curl, option, &vchar);
+ RETVAL = newSVpv(vchar,0);
+ break;
+ }
+ case CURLINFO_LONG:
+ {
+ long vlong;
+ curl_easy_getinfo(self->curl, option, &vlong);
+ RETVAL = newSViv(vlong);
+ break;
+ }
+ case CURLINFO_DOUBLE:
+ {
+ double vdouble;
+ curl_easy_getinfo(self->curl, option, &vdouble);
+ RETVAL = newSVnv(vdouble);
+ break;
+ }
+ default: {
+ RETVAL = newSViv(CURLE_BAD_FUNCTION_ARGUMENT);
+ break;
+ }
+ }
+ if (items > 2)
+ sv_setsv(ST(2),RETVAL);
OUTPUT:
- RETVAL
+ RETVAL
char *
curl_easy_errbuf(self)
- WWW::Curl::easy self
+ WWW::Curl::Easy self
CODE:
- RETVAL = self->errbuf;
+ RETVAL = self->errbuf;
OUTPUT:
- RETVAL
+ RETVAL
int
curl_easy_cleanup(self)
- WWW::Curl::easy self
+ WWW::Curl::Easy self
CODE:
- /* does nothing anymore - cleanup is automatic when a curl handle goes out of scope */
- RETVAL = 0;
+ /* does nothing anymore - cleanup is automatic when a curl handle goes out of scope */
+ RETVAL = 0;
OUTPUT:
- RETVAL
+ RETVAL
void
curl_easy_DESTROY(self)
- WWW::Curl::easy self
+ WWW::Curl::Easy self
CODE:
perl_curl_easy_delete(self);
void
curl_easy_global_cleanup()
CODE:
- curl_global_cleanup();
+ curl_global_cleanup();
-MODULE = WWW::Curl PACKAGE = WWW::Curl::form PREFIX = curl_form_
+MODULE = WWW::Curl PACKAGE = WWW::Curl::Form PREFIX = curl_form_
void
curl_form_new(...)
PREINIT:
- perl_curl_form *self;
- char *sclass = "WWW::Curl::form";
+ perl_curl_form *self;
+ char *sclass = "WWW::Curl::Form";
PPCODE:
- if (items>0 && !SvROK(ST(0))) {
- STRLEN dummy;
- sclass = SvPV(ST(0),dummy);
- }
+ if (items>0 && !SvROK(ST(0))) {
+ STRLEN dummy;
+ sclass = SvPV(ST(0),dummy);
+ }
- self=perl_curl_form_new();
+ self=perl_curl_form_new();
- ST(0) = sv_newmortal();
- sv_setref_pv(ST(0), sclass, (void*)self);
- SvREADONLY_on(SvRV(ST(0)));
+ ST(0) = sv_newmortal();
+ sv_setref_pv(ST(0), sclass, (void*)self);
+ SvREADONLY_on(SvRV(ST(0)));
- XSRETURN(1);
+ XSRETURN(1);
void
curl_form_add(self,name,value)
- WWW::Curl::form self
+ WWW::Curl::Form self
char *name
char *value
CODE:
#if LIBCURL_VERSION_NUM >= 0x070900
#if 0
- curl_formadd(&(self->post),&(self->last),
- CURLFORM_COPYNAME,name,
- CURLFORM_COPYCONTENTS,value,
- CURLFORM_END);
+ curl_formadd(&(self->post),&(self->last),
+ CURLFORM_COPYNAME,name,
+ CURLFORM_COPYCONTENTS,value,
+ CURLFORM_END);
#endif
#endif
void
curl_form_addfile(self,filename,description,type)
- WWW::Curl::form self
+ WWW::Curl::Form self
char *filename
char *description
char *type
CODE:
#if LIBCURL_VERSION_NUM >= 0x070900
#if 0
- curl_formadd(&(self->post),&(self->last),
- CURLFORM_FILE,filename,
- CURLFORM_COPYNAME,description,
- CURLFORM_CONTENTTYPE,type,
- CURLFORM_END);
+ curl_formadd(&(self->post),&(self->last),
+ CURLFORM_FILE,filename,
+ CURLFORM_COPYNAME,description,
+ CURLFORM_CONTENTTYPE,type,
+ CURLFORM_END);
#endif
#endif
void
curl_form_DESTROY(self)
- WWW::Curl::form self
+ WWW::Curl::Form self
CODE:
perl_curl_form_delete(self);
+
+MODULE = WWW::Curl PACKAGE = WWW::Curl::Multi PREFIX = curl_multi_
+
+void
+curl_multi_new(...)
+ PREINIT:
+ perl_curl_multi *self;
+ char *sclass = "WWW::Curl::Multi";
+ PPCODE:
+ if (items>0 && !SvROK(ST(0))) {
+ STRLEN dummy;
+ sclass = SvPV(ST(0),dummy);
+ }
+
+ self=perl_curl_multi_new();
+
+ ST(0) = sv_newmortal();
+ sv_setref_pv(ST(0), sclass, (void*)self);
+ SvREADONLY_on(SvRV(ST(0)));
+
+ XSRETURN(1);
+
+void
+curl_multi_add_handle(curlm, curl)
+ WWW::Curl::Multi curlm
+ WWW::Curl::Easy curl
+ CODE:
+#ifdef __CURL_MULTI_H
+ curl_multi_add_handle(curlm->curlm, curl->curl);
+#endif
+
+void
+curl_multi_remove_handle(curlm, curl)
+ WWW::Curl::Multi curlm
+ WWW::Curl::Easy curl
+ CODE:
+#ifdef __CURL_MULTI_H
+ curl_multi_remove_handle(curlm->curlm, curl->curl);
+#endif
+
+void
+curl_multi_perform(self)
+ WWW::Curl::Multi self
+ CODE:
+#ifdef __CURL_MULTI_H
+ int remaining;
+ while(CURLM_CALL_MULTI_PERFORM ==
+ curl_multi_perform(self->curlm, &remaining));
+ while(remaining) {
+ struct timeval timeout;
+ int rc;
+ fd_set fdread;
+ fd_set fdwrite;
+ fd_set fdexcep;
+ int maxfd;
+ FD_ZERO(&fdread);
+ FD_ZERO(&fdwrite);
+ FD_ZERO(&fdexcep);
+ timeout.tv_sec = 1;
+ timeout.tv_usec = 0;
+ curl_multi_fdset(self->curlm, &fdread, &fdwrite, &fdexcep, &maxfd);
+ rc = select(maxfd+1, &fdread, &fdwrite, &fdexcep, &timeout);
+ switch(rc) {
+ case -1:
+ break;
+ default:
+ while(CURLM_CALL_MULTI_PERFORM ==
+ curl_multi_perform(self->curlm, &remaining));
+ break;
+ }
+ }
+#endif
+
+void
+curl_multi_DESTROY(self)
+ WWW::Curl::Multi self
+ CODE:
+ perl_curl_multi_delete(self);
Modified: packages/libwww-curl-perl/branches/upstream/current/Easy.pm.in
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/Easy.pm.in 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/Easy.pm.in 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,300 +1,186 @@
-# Perl interface for libcurl. Check out the file README for more info.
+package WWW::Curl::Easy;
-package WWW::Curl::easy;
-
use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
-require WWW::Curl;
+$VERSION = '3.01';
+require WWW::Curl;
require Exporter;
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_INCLUDE@
-USE_INTERNAL_VARS
);
-$VERSION = '2.0';
+$WWW::Curl::Easy::headers = "";
+$WWW::Curl::Easy::content = "";
-
-$WWW::Curl::easy::headers = "";
-$WWW::Curl::easy::content = "";
-
sub AUTOLOAD {
+
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function.
- (my $constname = $AUTOLOAD) =~ s/.*:://;
- return constant($constname, 0);
+ ( my $constname = $AUTOLOAD ) =~ s/.*:://;
+ return constant( $constname, 0 );
}
-# bootstrap WWW::Curl::easy $VERSION;
+#
+# Backwards compatability package for WWW::Curl::Easy
+#
-# Preloaded methods go here.
+$WWW::Curl::easy::VERSION=$WWW::Curl::Easy::VERSION;
-# Autoload methods go after __END__, and are processed by the autosplit program.
+sub WWW::Curl::easy::init
+{
+ return WWW::Curl::Easy::init(@_);
+}
-1;
-__END__
-# Below is the documentation.
+sub WWW::Curl::easy::version
+{
+ return WWW::Curl::Easy::version(@_);
+}
-=cut
+sub WWW::Curl::easy::setopt
+{
+ return WWW::Curl::Easy::setopt(@_);
+}
-=head1 NAME
+sub WWW::Curl::easy::perform
+{
+ return WWW::Curl::Easy::perform(@_);
+}
-WWW::Curl::easy - Perl extension interface for libcurl
+sub WWW::Curl::easy::getinfo
+{
+ return WWW::Curl::Easy::getinfo(@_);
+}
-=head1 SYNOPSIS
+sub WWW::Curl::easy::cleanup
+{
+ return WWW::Curl::Easy::cleanup(@_);
+}
- use WWW::Curl::easy;
-
- my $curl = WWW::Curl::easy->new(); # an alias for WWW::Curl::easy::init
- my $code = $curl->setopt(CURLOPT_option, ....);
- $code = $curl->perform($curl);
- my $err = $curl->errbuf; # report any error message
- my $info = $curl->getinfo(CURLINFO_option);
+sub WWW::Curl::easy::global_cleanup
+{
+ return WWW::Curl::Easy::global_cleanup(@_);
+}
- $curl->cleanup(); # optional
+1;
- WWW::Curl::easy::global_cleanup(); # optional cleanup at exit
+__END__
-Read the curl man pages, curl_easy_setopt(3) and curl_easy_getinfo(3) for details of CURLOPT_option and CURLINFO_option values.
+=head1 AUTHOR
-=head1 DESCRIPTION
-
-B<WWW::Curl::easy> provides an interface to the libcurl C library. See
-http://curl.haxx.se/ for more information on cURL and libcurl.
+Version 3.00 of WWW::Curl::Easy is a renaming of the previous version, named WWW::Curl::easy.
-Before v2.0, this modules was called 'Curl::easy'. The name has changed to 'WWW::Curl::easy' (to better suit
-CPAN naming guidelines). The new version includes a compatability package, so existing scripts
-using the 'Curl::easy' name will continue to work as before. New scripts should use the
-'WWW::Curl::easy' name.
+=head1 Copyright
-From v1.30, this interface supports the perl OO style of creating
-$curl handles, and calling methods to get and set curl parameters. Previous
-versions of this interface only supported the straight 'subroutine' call style
-of accessing curl. Scripts using the older style are still compatible (but see
-COMPATABILITY, below), but this documentation and the test scripts have been
-updated to the OO style.
+Copyright (C) 2003,2004 Cris Bailiff
+
+You may opt to use, copy, modify, merge, publish, distribute and/or sell
+copies of the Software, and permit persons to whom the Software is furnished
+to do so, under the terms of the MPL or the MIT/X-derivate licenses. You may
+pick one of these licenses.
-=head2 FILES and CALLBACKS
+=head1 SEE ALSO
-WWW::Curl::easy supports the various options of curl_easy_setopt which require either a FILE * or
-a callback (subroutine) reference.
+http://curl.haxx.se/
-Callback to perl subroutines are handled by this XS interface through a wrapper which takes
-care of converting from C to perl variables and back again. This wrapper also simplifies some
-'C' style arguments to make them behave in a more 'perl' like manner. In particular, the
-read and write callbacks do not look just like the 'fread' and 'fwrite' C functions -
-perl variables do not need separate length parameters, and perl functions can return a list of
-variables, instead of needing a pointer to modify. The details are described below.
-=head2 C<FILE *> handles (GLOBS)
-
-Curl options which take a C<FILE *>, such as C<CURLOPT_FILE>, C<CURLOPT_WRITEHEADER>,
-C<CURLOPT_INFILE>
-can be passed a perl file handle:
-
- open BODY,">body.out";
- $code = $curl->setopt(CURLOPT_FILE, *BODY);
+1;
+__END__
-=head2 WRITE callback
+=head1 NAME
-The C<CUROPT_WRITEFUNCTION> option may be set which will cause libcurl to call back to
-the referenced perl subroutine:
+WWW::Curl::Easy - Perl extension interface for libcurl
- sub chunk { my ($data,$pointer)=@_; ...do something...; return length($data) }
+=head1 SYNOPSIS
- # call the above routine from curl:
- $code = $curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
- $code = $curl->setopt(CURLOPT_FILE, \$variable );
- $curl->perform();
+ use WWW::Curl::Easy;
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt(CURLOPT_URL, 'http://oook.de');
+ $curl->perform;
+ my $err = $curl->errbuf;
+ my $info = $curl->getinfo(CURLINFO_HTTP_CODE);
-The subroutine will be passed whatever is defined by C<CURLOPT_FILE>. This can be
-a reference to a regular variable (as above), or a glob or anything else you like.
+=head1 DESCRIPTION
-The callback function must return the number of bytes 'handled' ( C<length($data)> ) or
-the transfer will abort. A transfer can be aborted by returning a value of 0, for example.
+WWW::Curl::Easy is a Perl extension interface for libcurl.
-The option C<CURLOPT_WRITEHEADER> can be set to pass a different C<$pointer> into the
-CURLOPT_WRITEFUNCTION for header values. This lets you collect the headers and body separately, as
-shown in the example below:
+=head1 METHODS
- use WWW::Curl::easy;
- my $headers="";
- my $body="";
- sub chunk { my ($data,$pointer)=@_; ${$pointer}.=$data; return length($data) }
+ $curl = new WWW::Curl::Easy
+ This method constructs a new WWW::Curl::Easy object.
- my $curl=WWW::Curl::easy->new;
- ...
- my $code = $curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
- $code = $curl->setopt(CURLOPT_WRITEHEADER, \$headers );
- $code = $curl->setopt(CURLOPT_FILE, \$body );
- $curl->perform();
- print $body;
+ $curl->setopt( CURLOPT_OPTION, $option )
+ This method sets a curl option in the object.
-If you have libcurl > 7.7.1, then you could instead set C<CURLOPT_HEADERFUNCTION> to a different
-callback, and have the header collected that way.
+ $curl->perform
+ This method performs the object.
-=head2 READ callback
+ $curl->errbuf
+ This method returns all errors from the buffer of the object.
-WWW::Curl::easy supports C<CURLOPT_READFUNCTION>. This function should follow this prototype:
+ $curl->getinfo( CURLINFO_OPTION )
+ This method returns the requested info from the object.
- sub read_callback {
- my ($maxlength,$pointer)=@_;
- ....
- return $data;
- }
+Aliases for these methods have also been created in the WWW::Curl::easy namespace,
+to provide some backwards compatability for existing scripts - you must still
+'use WWW:Curl::Easy', but you can keep calling the functions by the lower case name
+for now. This will go away in a future release.
-The subroutine must return an empty string "" at the end of the data. Note that this function
-isn't told how much data to provide - $maxlength is just the maximum size of the buffer
-provided by libcurl. If you are doing an HTTP POST or PUT for example, it is important that this
-function only returns (in total) as much data as the 'Content-Length' header specifies, followed by
-a an empty (0 length) buffer.
+=head1 CONSTANTS
-=head2 PROGRESS callback
+ These are some short descriptions of the most common constants.
+ A full list with descriptions can be found in the libcurl
+ manpages, curl_easy_setopt(3) and curl_easy_getinfo(3).
+ This binding resembles the C one, so it should be OK to study the
+ regular libcurl C/C++ API documentation.
-WWW::Curl::easy supports C<CURLOPT_PROGRESSFUNCTION>. This function should follow this prototype:
+ CURLOPT_URL
+ The actual URL to deal with. The parameter should be a scalar.
+ NOTE: this option is (the only one) required to be set before
+ perform() is called.
- sub progress_callback {
- my ($clientp,$dltotal,$dlnow,$ultotal,$ulnow)=@_;
- ....
- return 0;
- }
+ This is a list of all available constants.
-The function should return 0 normally, or -1 which will abort/cancel the
-transfer. C<$clientp> is whatever is set using the C<CURLOPT_PROGRESSDATA> option.
+ @CURLOPT_INCLUDE@
-=head2 PASSWD callback
+=head1 AUTHOR
-WWW::Curl::easy supports C<CURLOPT_PASSWDFUNCTION>. This function should look something like this:
+Don't use this module for new scripts - use 'WWW::Curl::Easy' instead.
- sub passwd_callback {
- my ($clientp,$prompt,$buflen)=@_;
- ...
- return (0,$data);
- }
+Version 3.02 has some backwards compatibility to v2
-C<$clientp> is whatever scalar is set using the C<CURLOPT_PASSWDDATA> option.
-C<$prompt> is a text string which can be used to prompt for a password.
-C<$buflen> is the maximum length of the accepted password reply.
+Version 3.01 added some support for pre-multi versions of libcurl
-The function must return 0 (for 'OK') and the password data as a list.
-Return (-1,"") to indicate an error.
+Version 3.00 has many new features, new module names and a better
+documentation, by Sebastian Riedel.
-=head2 STDERR redirection
+Version 2.00 of WWW::Curl::easy is a renaming of the previous version
+(named Curl::easy), to follow CPAN naming guidelines, by Cris Bailiff.
-You can use set the option C<CURLOPT_STDERR> to an alternate file handle glob
-to redirect stderr messages from libcurl, if your libcurl version has this option.
+Versions 1.30, a (hopefully) threadable, object-oriented,
+multiple-callback compatible version of Curl::easy was substantially
+reworked from the previous Curl::easy release (1.21) by Cris Bailiff.
- open(OTHERFILE,">/dev/null") or die;
- $curl->setopt(CURLOPT_STDERR,*OTHERFILE);
+Original Author Georg Horn <horn at koblenz-net.de>, with additional callback,
+pod and test work by Cris Bailiff <c.bailiff+curl at devsecure.com> and
+Forrest Cahoon <forrest.cahoon at merrillcorp.com>
-=head1 COMPATABILITY NOTES
-
-As noted in the introduction, this module was previously called 'Curl::easy', and has
-been renamed for upload to CPAN as 'WWW::Curl'. Scripts should use the 'WWW:Curl::easy' functions
-for access basic libcurl functions. At some point, a 'higher level' perl interface is intended to become
-'WWW::Curl', and act as a wrapper around WWW::Curl::easy, with more perl-like defaults and interface
-syntax.
-
-=item *
-
-=over 4
-
-Early releases of this module didn't reliably deal with more than a single
-curl handle per process, because of the use of a number of global 'glue' variables
-in various places. This should now be fixed, but certain interface features could not
-be made reliably forward compatible if you intend to use multiple handles or threading:
-
-=over 4
-
-=item *
-
-The (largely undocumented) USE_INTERNAL_VARS feature, which previously collected data in a
-static global buffer, has been ported to use the new threadable structure, but
-the method by which it returns it's output (directly into specific global variables)
-cannot be made safe without destroying backwards compatibility. The interface is considered
-DEPRECATED in this release, and will be removed *VERY SOON* - instead, use a perl subroutine
-callback to collect output into a string (as shown in the example above), which should be safe
-across multiple threads/handles.
-
-=item *
-
-You can build this module without the USE_INTERNAL_VARS interface by compiling with
--UWITH_INTERNAL_VARS. This will become the default in a future release.
-
-=back
-
-=item *
-
-Returning the error buffer by passing the name of a perl variable through C<$curl-E<gt>setopt>
-is ugly. It is still supported, but instead, you can get the information by calling the new method
-C<$curl->errbuf> directly.
-
-=item *
-
-Returning CURLINFO variables by passing the output variable to C<$curl-E<gt>getinfo> is ugly.
-It is still supported, but instead, you can get the information as the return value from
-getinfo. Instead of:
-
- my $bytes;
- WWW::Curl::easy::getinfo($curl, CURLINFO_SIZE_DOWNLOAD, $bytes);
-
-use:
- my $bytes=$curl->getinfo(CURLINFO_SIZE_DOWNLOAD);
-
-
-=item *
-
-C<$curl-E<gt>cleanup> ( WWW::Curl::easy::cleanup($curl) ) no longer actually does anything. Curl
-handles will be automatically cleaned up by perl when they are no longer used.
-
-=item *
-
-curl_global_init is now explicitly called when the module is first loaded, rather than relying on
-it hapenning during the first call to curl_easy_init. This should eliminate the chance of a race if
-creating two handles simultaneously. (E.g. using perl ithreads).
-
-=item *
-
-curl_global_cleanup is not called automatically when perl or the module shuts down, as there
-doesn't seem an easy way to arrange this in perl-XS (suggestions welcome). You can call curl
-global cleanup explicitly (if you care) by calling the class method WWW::Curl::easy::global_cleanup .
-Don't call any other curl functions afterwards!
-
-=head1 KNOWN BUGS
-
-There seems to be a slow leak of a few bytes each time a WWW::Curl::easy handle is created and
-destroyed (despite careful cleanup efforts) at least when testing with libcurl-7.9.8.
-Hopefully this will be fixed in a future release.
-
-Also note the above problems with the USE_INTERNAL_VARS interface.
-
-=head1 AUTHOR
-
-Version 2.00 of WWW::Curl::easy is a renaming of the previous version (named Curl::easy),
-to follow CPAN naming guidelines, by Cris Bailiff.
-
-Versions 1.30, a (hopefully) threadable, object-oriented, multiple-callback compatible
-version of Curl::easy was substantially reworked from the previous Curl::easy
-release (1.21) by Cris Bailiff.
-
-Original Author Georg Horn <horn at koblenz-net.de>, with additional callback, pod
-and test work by Cris Bailiff <c.bailiff+curl at devsecure.com> and Forrest Cahoon
-<forrest.cahoon at merrillcorp.com>
-
Currently maintained by Cris Bailiff <c.bailiff+curl at devsecure.com>
-=head1 Copyright
+=head1 COPYRIGHT
-Copyright (C) 2000,2001,2002,2003 Daniel Stenberg, Cris Bailiff, et al.
+Copyright (C) 2000,2001,2002,2003,2004 Daniel Stenberg, Cris Bailiff,
+Sebastian Riedel, et al.
You may opt to use, copy, modify, merge, publish, distribute and/or sell
copies of the Software, and permit persons to whom the Software is furnished
@@ -303,6 +189,5 @@
=head1 SEE ALSO
+WWW::Curl, WWW::Curl::Multi, curl_easy_setopt(3), curl_easy_getinfo(3),
http://curl.haxx.se/
-
-
Modified: packages/libwww-curl-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/MANIFEST 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/MANIFEST 2005-12-16 20:07:12 UTC (rev 1640)
@@ -4,10 +4,10 @@
README
Curl.xs
typemap
-easy.pm.in
-lib/Curl/easy.pm
+Easy.pm.in
lib/WWW/Curl.pm
-lib/WWW/Curl/form.pm
+lib/WWW/Curl/Form.pm
+lib/WWW/Curl/Multi.pm
t/00constants.t
t/01basic.t
t/02header-callback.t
@@ -28,3 +28,19 @@
t/17slist.t
t/18twinhandles.t
t/19basic-back.t
+t/19basic-back.t
+t/20basic-back-func.t
+t/21basic-back-easy.t
+t/new/00constants.t
+t/new/01basic.t
+t/new/02header-callback.t
+t/new/03body-callback.t
+t/new/04abort.t
+t/new/05progress.t
+t/new/06http-post.t
+t/new/07errbuf.t
+t/new/08duphandle.t
+t/new/09duphandle-callback.t
+t/new/10multi-callback.t
+t/new/README
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libwww-curl-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/META.yml 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/META.yml 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: WWW-Curl
+version: 3.02
+version_from: lib/WWW/Curl.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Modified: packages/libwww-curl-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/Makefile.PL 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/Makefile.PL 2005-12-16 20:07:12 UTC (rev 1640)
@@ -42,7 +42,7 @@
$lflags="-lcurl";
# Windows version of libcurl - not tested, feedback welcome!
if ($^O eq 'MSWin32') {
- $lflags="libcurl.lib";
+ $lflags="libcurl.lib";
}
print "Guessing your linker flags as: $lflags\n";
}
@@ -110,7 +110,7 @@
{
errno = 0;
if (strncmp(name, "CURLINFO_", 9) == 0) {
- name += 9;
+ name += 9;
switch (*name) {
HERE
;
@@ -128,7 +128,7 @@
$count++;
}
}
- if ($count or $next_initial eq 'Z') {
+ if ($count or $next_initial eq 'Z') {
print CURL_XS " break;\n";
}
}
@@ -138,8 +138,8 @@
print CURL_XS <<HERE2
if (strncmp(name, "CURLOPT_", 8) == 0) {
- name += 8;
- switch (*name) {
+ name += 8;
+ switch (*name) {
HERE2
;
@@ -156,7 +156,7 @@
$count++;
}
}
- if ($count or $next_initial eq 'Z') {
+ if ($count or $next_initial eq 'Z') {
print CURL_XS " break;\n";
}
}
@@ -165,9 +165,6 @@
print CURL_XS " }\n";
print CURL_XS <<HERE
-#ifdef WITH_INTERNAL_VARS
- if (strEQ(name, "USE_INTERNAL_VARS")) return USE_INTERNAL_VARS;
-#endif
errno = EINVAL;
return 0;
}
@@ -176,15 +173,16 @@
close(CURL_XS);
- print "Building easy.pm constants for your libcurl version\n";
+ print "Building Easy.pm constants for your libcurl version\n";
- open(EASY_PM, ">lib/WWW/Curl/easy.pm") or die "Can't create lib/WWW/Curl/easy.pm\n";
- open(EASY_PM_IN, "easy.pm.in") or die "Can't read easy.pm.in\n";
+ open(EASY_PM, ">lib/WWW/Curl/Easy.pm") or die "Can't create lib/WWW/Curl/Easy.pm\n";
+ open(EASY_PM_IN, "Easy.pm.in") or die "Can't read Easy.pm.in\n";
while (my $line = <EASY_PM_IN>) {
if ($line !~ m/^\@CURLOPT_INCLUDE\@/) {
print EASY_PM $line;
} else {
foreach my $option (sort keys %cinit_types) {
+ next unless $option; # an empty CURLOPT_
print EASY_PM "CURLOPT_$option\n";
}
foreach my $option (sort @curlinfo) {
@@ -203,7 +201,6 @@
'NAME' => 'WWW::Curl',
'VERSION_FROM' => 'lib/WWW/Curl.pm', # finds $VERSION
'LIBS' => $lflags, # e.g., '-lm'
- 'DEFINE' => '-DHAVE_INTERNAL_VARS', # e.g., '-DHAVE_SOMETHING'
'INC' => $curl_d, # e.g., '-I/usr/include/other'
'clean' => { FILES => "head.out body.out" }
);
Modified: packages/libwww-curl-perl/branches/upstream/current/README
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/README 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/README 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,6 +1,6 @@
-README for Perl extension WWW::Curl::easy.
+README for Perl extension WWW::Curl
-The perl module WWW::Curl::easy provides an interface to the cURL library "libcurl".
+The perl module WWW::Curl 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
@@ -8,7 +8,7 @@
perl Makefile.PL
make
- make test # see note below
+ make test # NEEDS CONFIGURATION - see note below
make install
The Makefile.PL script will try to use the 'curl-config' command to find
@@ -25,10 +25,11 @@
'make test' will only run if you have a suitable test web server somewhere -
the 'printenv' script commonly distributed with apache on linux is useable, for
example. You need to set the environment variable CURL_TEST_URL to the URL
-of such a script for 'make test' to work automatically.
+of such a script and set the environment variable PERL_MM_USE_DEFAULT=1 for 'make test'
+to work automatically.
-Test 08ssl.t will only work properly if you have a list of well
-known CA certificates in the file 'ca-bundle.crt' in the current directory.
+Test 08ssl.t will only work well if you have a list of "well-known"
+CA certificates in the file 'ca-bundle.crt' in the current directory.
This file can be obtained from most distributions of mod_ssl (www.modssl.org) -
it isn't supplied here, as its currently >250Kbytes.
@@ -40,20 +41,24 @@
express or implied. Send praise, patches, money, beer and pizza to the author.
Send complaints to /dev/null. ;-)
-The original author of this software is Georg Horn <horn at koblenz-net.de>
+The author of the original relase of this software is Georg Horn <horn at koblenz-net.de>
-Parts of the callback support have been added Forrest Cahoon
-<forrest.cahoon at merrillcorp.com>
+Parts of the callback support were added Forrest Cahoon
+<forrest.cahoon at merrillcorp.com>
More callback support, many tests additional documentation and Makefile
-features have been added by Cris Bailiff <c.bailiff+curl at devsecure.com>
+features have been added by Cris Bailiff <c.bailiff+curl at devsecure.com>
-The current maintainer is Cris Bailiff <c.bailiff+curl at devsecure.com>
+Curl multi support has been added by Sebastian Riedel <sri at oook.de>
-The latest version can be downloaded from http://curl.haxx.se/libcurl/perl/
+The current maintainer is Cris Bailiff <c.bailiff+curl at devsecure.com>
+
+The latest version can be downloaded from http://curl.haxx.se/libcurl/perl/ or
+found on CPAN as the module WWW::Curl
-Copyright (C) 2000, Daniel Stenberg, , et al.
+Copyright (C) 2000-2005, Daniel Stenberg, Cris Bailiff , et al.
You may opt to use, copy, modify, merge, publish, distribute and/or sell
copies of the Software, and permit persons to whom the Software is
furnished to do so, under the terms of the MPL or the MIT/X-derivate
-licenses. You may pick one of these licenses.
+licenses. You may pick one of these licenses.
+
Modified: packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Form.pm
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Form.pm 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Form.pm 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,12 +1,9 @@
-#
-# $Id: form.pm,v 1.1 2003/04/22 12:45:27 crisb Exp $
-#
-
-package WWW::Curl::form;
+package WWW::Curl::Form;
use strict;
-require WWW::Curl;
-
+# In development!
+#
+#require WWW::Curl;
#use vars qw(@ISA @EXPORT_OK);
#require Exporter;
#require AutoLoader;
Added: packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Multi.pm
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Multi.pm 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl/Multi.pm 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,63 @@
+package WWW::Curl::Multi;
+
+use strict;
+use WWW::Curl;
+
+1;
+__END__
+
+=head1 NAME
+
+WWW::Curl::Multi - Perl extension interface for libcurl
+
+=head1 SYNOPSIS
+
+ use WWW::CURL::Multi;
+ my $curlm = new WWW::Curl::Multi;
+ $curlm->add_handler($curl);
+ $curlm->perform;
+ $curlm->remove_handler($curl);
+
+=head1 DESCRIPTION
+
+WWW::Curl::Multi is an extension to WWW::Curl::Easy
+which makes it possible to process multiple easy
+handles parallel.
+
+=head1 METHODS
+
+ $curlm = new WWW::Curl::Multi
+ This method constructs a new WWW::Curl::Multi object.
+
+ $curlm->add_handler( $curl )
+ This method adds a WWW::Curl::Easy object to the multi stack.
+
+ $curlm->perform
+ This method parallel perlforms all WWW::Curl::Easy objects
+ on the stack.
+
+ *Warning* - this does not perform exactly the
+ same functions as the direct libcurl function - for example,
+ there's no opportunity to get the fdset back at any time, so
+ this interface could change in future as those functions
+ are added.
+
+ $curl->remove_handler( $curl )
+ This method removes a WWW::Curl::Easy object from the stack.
+
+=head1 AUTHOR
+
+Sebastian Riedel (sri at cpan.org)
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004 Sebastian Riedel, et al.
+
+You may opt to use, copy, modify, merge, publish, distribute and/or sell
+copies of the Software, and permit persons to whom the Software is furnished
+to do so, under the terms of the MPL or the MIT/X-derivate licenses. You may
+pick one of these licenses.
+
+=head1 SEE ALSO
+
+WWW::Curl, WWW::Curl::Easy, http://curl.haxx.se/
Modified: packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl.pm
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl.pm 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/lib/WWW/Curl.pm 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,19 +1,15 @@
-#
-# $Id: Curl.pm,v 1.3 2003/04/22 13:39:26 crisb Exp $
-#
-
package WWW::Curl;
use strict;
use vars qw(@ISA $VERSION);
use DynaLoader;
- at ISA = qw(DynaLoader);
+BEGIN {
+ $VERSION = '3.02';
+ @ISA = qw(DynaLoader);
+ __PACKAGE__->bootstrap;
+}
-$VERSION = '2.0';
-
-bootstrap WWW::Curl $VERSION;
-
1;
__END__
@@ -26,22 +22,31 @@
=head1 SYNOPSIS
- use WWW::Curl::easy;
+ use WWW::Curl;
+ print $WWW::Curl::VERSION;
=head1 DESCRIPTION
-This module is a namespace placeholder for a future high level perl-oriented interface to
-libcurl. Currently, you need to use the direct libcurl 'easy' interface, by
-using the 'WWW::Curl::easy' module.
-
+WWW::Curl is a Perl extension interface for libcurl.
+See WWW::Curl::Easy and WWW::Curl::Multi for more documentation.
+
=head1 AUTHOR
-Version 2.00 of WWW::Curl::easy is a renaming of the previous version, named Curl::easy,
-(also with additional features) to follow CPAN naming guidelines, by Cris Bailiff.
+Version 3.02 adds some backwards compatibility for scripts still using
+'WWW::Curl::easy' names.
-=head1 Copyright
+Version 3.00 adds WWW::Curl::Multi interface, and a new module names
+following perl conventions (WWW::Curl::Easy rather than WWW::Curl::easy),
+by Sebastian Riedel <sri at cpan.org>
-Copyright (C) 2003 Cris Bailiff
+Version 2.00 of WWW::Curl::easy is a renaming of the previous version
+(named Curl::easy), to follow CPAN naming guidelines, by Cris Bailiff.
+
+Currently maintained by Cris Bailiff <c.bailiff+curl at devsecure.com>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003,2004,2005 Cris Bailiff
You may opt to use, copy, modify, merge, publish, distribute and/or sell
copies of the Software, and permit persons to whom the Software is furnished
@@ -50,4 +55,4 @@
=head1 SEE ALSO
-http://curl.haxx.se/
+WWW::Curl::Easy, WWW::Curl::Multi, http://curl.haxx.se
Modified: packages/libwww-curl-perl/branches/upstream/current/t/00constants.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/00constants.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/00constants.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,5 +1,6 @@
+#!perl
-# Test script for Perl extension WWW::Curl::easy.
+# Test script for Perl extension WWW::Curl::Easy.
# Check out the file README for more info.
# Before `make install' is performed this script should be runnable with
@@ -7,31 +8,28 @@
######################### 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.)
use Benchmark;
use strict;
-BEGIN { $| = 1; print "1..2\n"; }
+BEGIN { $| = 1; print "1..3\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
+print "ok ".++$count."\n";
-my $count=1;
+my $version=&WWW::Curl::Easy::version();
-print STDERR "\nTesting curl version ",&WWW::Curl::easy::version(),"\n";
+print "ok ".++$count." testing curl version $version\n";
+# test constants are loaded OK
if (CURLOPT_URL != 10000+2) {
- print "not ";
-}
+ print "not ";
+}
print "ok ".++$count."\n";
Modified: packages/libwww-curl-perl/branches/upstream/current/t/01basic.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/01basic.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/01basic.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,39 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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;
+use ExtUtils::MakeMaker qw(prompt);
-BEGIN { $| = 1; print "1..6\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..6\n";
+print "ok ".++$count."\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
@@ -81,5 +68,4 @@
print "not ";
}
print "ok ".++$count."\n";
-
exit;
Modified: packages/libwww-curl-perl/branches/upstream/current/t/02header-callback.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/02header-callback.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/02header-callback.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,40 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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;
+use ExtUtils::MakeMaker qw(prompt);
-BEGIN { $| = 1; print "1..8\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..8\n";
+print "ok ".++$count."\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
@@ -81,7 +69,7 @@
};
print "ok ".++$count."\n";
-print STDERR "\nnext test will fail on libcurl < 7.7.2\n";
+print "# next test will fail on libcurl < 7.7.2\n";
print "not " if (!$header_called); # ok if you have a libcurl <7.7.2
print "ok ".++$count."\n";
Modified: packages/libwww-curl-perl/branches/upstream/current/t/03body-callback.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/03body-callback.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/03body-callback.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,41 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..8\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-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;
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..8\n";
+print "ok ".++$count."\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
@@ -96,7 +85,7 @@
print "ok ".++$count."\n";
-print STDERR "\nnext test will fail on libcurl < 7.7.2\n";
+print "# next test will fail on libcurl < 7.7.2\n";
print "not " if (!$header_called); # ok if you have a libcurl <7.7.2
print "ok ".++$count."\n";
Modified: packages/libwww-curl-perl/branches/upstream/current/t/04abort-test.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/04abort-test.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/04abort-test.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,40 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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;
+use ExtUtils::MakeMaker qw(prompt);
-BEGIN { $| = 1; print "1..7\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..7\n";
+
+print "ok ".++$count."\n";
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/05progress.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/05progress.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/05progress.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,41 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..9\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-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;
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..9\n";
+
+print "ok ".++$count."\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/06http-post.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/06http-post.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/06http-post.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,42 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..6\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-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;
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..6\n";
+
+print "ok ".++$count."\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/07ftp-upload.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/07ftp-upload.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/07ftp-upload.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,39 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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;
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
-
my $count=1;
-# Read URL to get
-my $defurl = "ftp://ftp\@ftp.perl.org/pub/incoming/curl-easy-test.".time.".".$$;
-my $url;
-if (defined ($ENV{CURL_TEST_URL_FTP})) {
- $url=$ENV{CURL_TEST_URL_FTP};
-};
+use ExtUtils::MakeMaker qw(prompt);
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL_FTP} || "";
+my $url = prompt("# Please enter an ftp URL to fetch",$defurl);
if (!$url) {
- print STDERR "Skipping ftp test - need ftp upload server\n";
- print "1..2\n";
- print "ok 2\n";
- exit;
+ print "1..0 # No test ftp URL supplied - skipping test\n";
+ exit;
}
print "1..8\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
@@ -62,26 +49,8 @@
print "ok ".++$count."\n";
-sub passwd_callb
-{
- my ($clientp,$prompt,$buflen)=@_;
- print STDERR "\nperl passwd_callback has been called!\n";
- print STDERR "clientp: $clientp, prompt: $prompt, buflen: $buflen\n";
- my $data;
- if (defined($ENV{CURL_TEST_URL_FTP})) {
- print STDERR "\nEnter max $buflen characters for $prompt ";
- $data = <STDIN>;
- chomp($data);
- } else {
- print STDERR "\nReplying to $prompt\n";
- $data = "ftp\@";
- }
- return (0,$data);
-}
-
# Now do an ftp upload:
-
$curl->setopt(CURLOPT_UPLOAD, 1);
@@ -92,13 +61,13 @@
sub read_callb
{
my ($maxlen,$sv)=@_;
- print STDERR "\nperl read_callback has been called!\n";
- print STDERR "max data size: $maxlen - $read_max bytes needed\n";
+ print "# perl read_callback has been called!\n";
+ print "# max data size: $maxlen - $read_max bytes needed\n";
if ($read_max > 0) {
my $len=int($read_max/3)+1;
my $data = chr(ord('A')+rand(26))x$len;
- print STDERR "generated max/3=", int($read_max/3)+1, " characters to be uploaded - $data.\n";
+ print "# generated max/3=", int($read_max/3)+1, " characters to be uploaded - $data.\n";
$read_max=$read_max-length($data);
return $data;
} else {
@@ -110,7 +79,7 @@
$curl->setopt(CURLOPT_READFUNCTION, \&read_callb);
# Use perl passwd callback to read password for login to ftp server
-$curl->setopt(CURLOPT_PASSWDFUNCTION, \&passwd_callb);
+$curl->setopt(CURLOPT_USERPWD, "ftp\@");
print "ok ".++$count."\n";
@@ -118,10 +87,8 @@
my $code;
if (($code=$curl->perform()) == 0) {
my $bytes=$curl->getinfo(CURLINFO_SIZE_UPLOAD);
- print STDERR "$bytes bytes transferred\n";
+ print "ok ".++$count." $bytes bytes transferred\n";
} else {
# We can acces the error message in $errbuf here
- print STDERR "ftpcode= $code, errbuf='.$curl->errbuf.'\n";
- print "not ";
+ print "not ok ".++$count." ftpcode= $code, errbuf=".$curl->errbuf."\n";
}
-print "ok ".++$count."\n";
Modified: packages/libwww-curl-perl/branches/upstream/current/t/08ssl.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/08ssl.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/08ssl.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,27 +1,23 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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;
-use WWW::Curl::easy;
+use WWW::Curl::Easy;
-
######################### 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):
-
my $count=1;
+if (&WWW::Curl::Easy::version() !~ /ssl/i) {
+ print "1..0 # libcurl not compiled with ssl support - skipping ssl tests\n";
+ exit;
+}
+
my $sslversion95=0;
-$sslversion95++ if (&WWW::Curl::easy::version() =~ m/SSL 0.9.5/); # 0.9.5 has buggy connect with some ssl sites
+$sslversion95++ if (&WWW::Curl::Easy::version() =~ m/SSL 0.9.5/); # 0.9.5 has buggy connect with some ssl sites
my $haveca=0;
if (-f "ca-bundle.crt") {
@@ -29,10 +25,15 @@
}
# list of tests
-# site-url, verifypeer(0,1), verifyhost(0,2), result(0=ok, 1=fail), result-openssl0.9.5
+# site-url, verifypeer(0,1), verifyhost(0,2), result(0=ok, 1=fail), result-openssl0.9.5
my $url_list=[
- [ 'https://207.46.134.190/', 0, 0, 0 , 0 ], # www.microsoft.com
- [ 'https://207.46.249.222/', 0, 2, 1 , 1 ], # www.microsoft.com
+
+# Microsoft is akamied, so it moves around too much for a reliable test, commented out
+# [ 'https://207.46.134.190/', 0, 0, 0 , 0 ], # www.microsoft.com
+# [ 'https://207.46.249.222/', 0, 2, 1 , 1 ], # www.microsoft.com
+
+ [ 'https://65.205.248.243/', 0, 0, 0 , 0 ], # www.thawte.com
+ [ 'https://65.205.248.243/', 0, 2, 1 , 1 ], # www.thawte.com
[ 'https://65.205.249.60/', 0, 0, 0 , 0 ], # www.verisign.com
[ 'https://65.205.249.60/', 0, 2, 1 , 1 ], # www.verisign.com
[ 'https://www.microsoft.com/', 0, 0, 0 , 0 ],
@@ -41,23 +42,26 @@
[ 'https://www.verisign.com/', 0, 0, 0 , 0 ],
[ 'https://www.verisign.com/', 0, 0, 0 , 0 ],
[ 'https://www.verisign.com/', 0, 2, 0 , 0 ],
- [ 'https://lc2.law13.hotmail.passport.com/', 0, 0, 0 , 0 ],
- [ 'https://lc2.law13.hotmail.passport.com/', 0, 2, 0 , 0 ],
- [ 'https://lc2.law13.hotmail.passport.com/', 1, 2, 0 , 1 ], # fail on 0.9.5
- [ 'https://lc2.law13.hotmail.passport.com/', 1, 2, 0 , 1 ], # fail on 0.9.5
+ [ 'https://www.thawte.com/', 0, 0, 0 , 0 ], # www.thawte.com
+ [ 'https://www.thawte.com/', 0, 2, 0 , 0 ], # www.thawte.com
+ [ 'https://www.passport.net/', 0, 0, 0 , 0 ],
+ [ 'https://www.passport.net/', 0, 2, 0 , 0 ],
+ [ 'https://www.passport.net/', 1, 2, 0 , 1 ], # fail on 0.9.5
+ [ 'https://www.passport.net/', 1, 2, 0 , 1 ], # fail on 0.9.5
# libcurl < 7.9.3 crashes with more than 5 ssl hosts per handle.
- [ 'https://www.modssl.org/', 0, 0, 0 , 0],
- [ 'https://www.modssl.org/', 0, 2, 0 , 0],
- [ 'https://www.modssl.org/', 1, 0, 1 , 0],
- [ 'https://www.modssl.org/', 1, 2, 1 , 0],
+
+ [ 'https://rt.perl.org/', 0, 0, 0 , 0],
+ [ 'https://rt.perl.org/', 0, 2, 0 , 0],
+ [ 'https://rt.perl.org/', 1, 0, 1 , 0],
+ [ 'https://rt.perl.org/', 1, 2, 1 , 0],
];
print "1..".($#$url_list+6)."\n";
print "ok 1\n";
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
@@ -65,7 +69,6 @@
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 0);
#$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
@@ -89,13 +92,11 @@
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_CAINFO,"ca-bundle.crt");
-print STDERR "\n";
foreach my $test_list (@$url_list) {
my ($url,$verifypeer,$verifyhost,$result,$result95)=@{$test_list};
if ($verifypeer && !$haveca) { $result=1 } # expect to fail if no ca-bundle file
if ($sslversion95) { $result=$result95 }; # change expectation
- print STDERR "testing $url verify=$verifypeer at level $verifyhost expect ".($result?"fail":"pass")."\n";
$curl->setopt(CURLOPT_SSL_VERIFYPEER,$verifypeer); # do verify
$curl->setopt(CURLOPT_SSL_VERIFYHOST,$verifyhost); # check name
@@ -105,9 +106,9 @@
$retcode=$curl->perform();
if ( ($retcode != 0) != $result) {
- print STDERR "error $retcode ".$curl->errbuf."\n";
print "not ";
};
- print "ok ".++$count."\n";
+ print "ok ".++$count." ";
+ print "test $url verify=$verifypeer/level=$verifyhost expected ".($result?"fail":"pass")." - $retcode\n";
}
Modified: packages/libwww-curl-perl/branches/upstream/current/t/09times.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/09times.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/09times.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,53 +1,44 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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 WWW::Curl::easy ;
+use WWW::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;
+print "# transfer times test will only compile/run on curl >= 7.9.1\n";
+my $count=0;
-# 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;
+
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..7\n";
+
+print "ok ".++$count."\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
@@ -72,13 +63,13 @@
my $retcode=$curl->perform();
if ($retcode == 0) {
my $bytes=$curl->getinfo(CURLINFO_SIZE_DOWNLOAD);
- print STDERR "$bytes bytes read ";
+ print "# $bytes bytes read ";
my $realurl=$curl->getinfo(CURLINFO_EFFECTIVE_URL);
my $httpcode=$curl->getinfo(CURLINFO_HTTP_CODE);
- print STDERR "effective fetched url (http code: $httpcode) was: $url ";
+ print "# effective fetched url (http code: $httpcode) was: $url\n";
} else {
# We can acces the error message in errbuf here
- print STDERR "$retcode / ".$curl->errbuf."\n";
+ print "# $retcode / ".$curl->errbuf."\n";
print "not ";
}
print "ok ".++$count."\n";
@@ -88,7 +79,7 @@
my $dns=$curl->getinfo(CURLINFO_NAMELOOKUP_TIME);
my $conn=$curl->getinfo(CURLINFO_CONNECT_TIME);
my $pre=$curl->getinfo(CURLINFO_PRETRANSFER_TIME);
-print STDERR "times are: dns: $dns, connect: $conn, pretransfer: $pre, starttransfer: $start, total: $total.\n";
+print "# times are: dns: $dns, connect: $conn, pretransfer: $pre, starttransfer: $start, total: $total.\n";
print "ok ".++$count."\n";
Modified: packages/libwww-curl-perl/branches/upstream/current/t/10errbuf.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/10errbuf.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/10errbuf.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,41 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..5\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-my $count=1;
+use ExtUtils::MakeMaker qw(prompt);
-# 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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..5\n";
+
+print "ok ".++$count."\n";
+
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
open NEW_ERROR,">error.out" or die;
$curl->setopt(CURLOPT_STDERR, *NEW_ERROR);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/11oldstyle1.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/11oldstyle1.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/11oldstyle1.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,20 +1,14 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..6\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::Curl::Easy;
$::loaded = 1;
-print "ok 1\n";
######################### End of black magic.
@@ -23,24 +17,28 @@
# of the test code):
#
-# Test backwards compatability of the easy interface
+# Test backwards compatability of the Easy interface with the
+# non-OO 'easy' interface version
#
+# NOTE: You still need to 'use' the new module name WWW::Curl::Easy (note upper case)
+# but you don't have to change all the rest of the code, although support for the old
+# names will go away in a future version.
+#
-my $count=1;
+my $count=0;
-# 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;
+
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..6\n";
+print "ok ".++$count."\n";
# Init the curl session
my $curl = WWW::Curl::easy::init();
@@ -50,7 +48,6 @@
print "ok ".++$count."\n";
WWW::Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1);
-WWW::Curl::easy::setopt($curl, CURLOPT_MUTE, 1);
WWW::Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1);
WWW::Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/12oldstyle2.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/12oldstyle2.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/12oldstyle2.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,46 +1,35 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..8\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy ;
+use WWW::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):
-
#
# Test backwards compatability of the interface
#
-my $count=1;
+my $count=0;
-# 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;
+
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..8\n";
+print "ok ".++$count."\n";
# Init the curl session
my $curl = WWW::Curl::easy::init();
@@ -50,7 +39,6 @@
print "ok ".++$count."\n";
WWW::Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1);
-WWW::Curl::easy::setopt($curl, CURLOPT_MUTE, 1);
WWW::Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1);
WWW::Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30);
@@ -62,7 +50,10 @@
WWW::Curl::easy::setopt($curl, CURLOPT_FILE,*BODY);
print "ok ".++$count."\n";
+# avoid single use warning
$::errbuf="";
+$::errbuf="";
+
WWW::Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "::errbuf");
print "ok ".++$count."\n";
@@ -83,13 +74,10 @@
my $retcode=$curl->perform();
if ($retcode == 0) {
WWW::Curl::easy::getinfo($curl, CURLINFO_SIZE_DOWNLOAD, $bytes);
-# print STDERR "$bytes bytes read ";
WWW::Curl::easy::getinfo($curl, CURLINFO_EFFECTIVE_URL, $realurl);
WWW::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";
@@ -100,7 +88,7 @@
WWW::Curl::easy::getinfo($curl, CURLINFO_NAMELOOKUP_TIME, $dns);
WWW::Curl::easy::getinfo($curl, CURLINFO_CONNECT_TIME, $conn);
WWW::Curl::easy::getinfo($curl, CURLINFO_PRETRANSFER_TIME, $pre);
-print STDERR "\ntimes are: dns: $dns, connect: $conn, pretransfer: $pre, starttransfer: $start, total: $total.\n";
+print "# times are: dns: $dns, connect: $conn, pretransfer: $pre, starttransfer: $start, total: $total.\n";
print "ok ".++$count."\n";
Modified: packages/libwww-curl-perl/branches/upstream/current/t/13slowleak.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/13slowleak.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/13slowleak.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,42 +1,30 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..2\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-my $count=1;
+use ExtUtils::MakeMaker qw(prompt);
-# 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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..2\n";
+print "ok ".++$count."\n";
#
# There is a slow leak per curl handle init/cleanup
@@ -45,16 +33,16 @@
foreach my $j (1..200) {
# Init the curl session
-my $curl = WWW::Curl::easy->new() or die "cannot curl";
+my $curl = WWW::Curl::Easy->new() or die "cannot curl";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
open HEAD, ">head.out";
-WWW::Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD);
+WWW::Curl::Easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD);
open BODY, ">body.out";
-WWW::Curl::easy::setopt($curl, CURLOPT_FILE,*BODY);
+WWW::Curl::Easy::setopt($curl, CURLOPT_FILE,*BODY);
$curl->setopt(CURLOPT_URL, $url);
@@ -77,11 +65,10 @@
my $realurl=$curl->getinfo(CURLINFO_EFFECTIVE_URL);
my $httpcode=$curl->getinfo(CURLINFO_HTTP_CODE);
} else {
- print STDERR "$retcode / ".$curl->errbuf."\n";
- print "not ";
- }
+ print "not ok $retcode / ".$curl->errbuf."\n";
+ }
}
print "ok 2\n";
-WWW::Curl::easy::global_cleanup;
+WWW::Curl::Easy::global_cleanup;
exit;
Modified: packages/libwww-curl-perl/branches/upstream/current/t/14duphandle.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/14duphandle.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/14duphandle.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,39 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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 WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-my $count=1;
+use ExtUtils::MakeMaker qw(prompt);
-# 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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..7\n";
+print "ok ".++$count."\n";
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/15duphandle-callback.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/15duphandle-callback.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/15duphandle-callback.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,40 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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 WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-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;
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..7\n";
+print "ok ".++$count."\n";
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/16formpost.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/16formpost.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/16formpost.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,52 +1,39 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..6\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-my $count=1;
+use ExtUtils::MakeMaker qw(prompt);
-# 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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..6\n";
+print "ok ".++$count."\n";
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
Modified: packages/libwww-curl-perl/branches/upstream/current/t/17slist.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/17slist.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/17slist.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,58 +1,48 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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;
-use WWW::Curl::easy;
+use WWW::Curl::Easy;
######################### 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):
+my $count=0;
-my $count=1;
+use ExtUtils::MakeMaker qw(prompt);
-# 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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
# we need the real printenv cgi for these tests, so skip if
-# our test URL is not a printenv
+# our test URL is not a printenv variant (or test.cgi from
+# mdk apache2). We basically need something which will echo
+# back sent headers in the output
#
-if ($url !~ m/printenv/) {
- print "1..1\nok 1\n";
+
+if ($url !~ m/printenv|test.cgi/) {
+ print "1..0 # need a real 'printenv' cgi script for this test";
exit;
}
-print "1..6\n";
+print "1..5\n";
# Init the curl session
-my $curl = WWW::Curl::easy->new();
+my $curl = WWW::Curl::Easy->new();
if ($curl == 0) {
print "not ";
}
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
@@ -86,7 +76,7 @@
# Go get it
my $retcode=$curl->perform();
if ($retcode == 0) {
- if ($body !~ m/FOO="bar"/) {
+ if ($body !~ m/FOO\s*=\s*"?bar"?/) {
print "not ";
}
} else {
Modified: packages/libwww-curl-perl/branches/upstream/current/t/18twinhandles.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/18twinhandles.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/18twinhandles.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,42 +1,30 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# 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..8\n"; }
END {print "not ok 1\n" unless $::loaded;}
-use WWW::Curl::easy;
+use WWW::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):
+my $count=0;
-my $count=1;
+use ExtUtils::MakeMaker qw(prompt);
-# 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;
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..8\n";
+print "ok ".++$count."\n";
my $header_called=0;
sub header_callback {
@@ -46,21 +34,19 @@
my $body_called=0;
sub body_callback {
my ($chunk,$handle)=@_;
-# print STDERR "body callback called with ",length($chunk)," bytes\n";
-# print STDERR "data=$chunk\n";
$body_called++;
return length($chunk); # OK
}
# Init the curl session
-my $curl1 = WWW::Curl::easy->new();
+my $curl1 = WWW::Curl::Easy->new();
if ($curl1 == 0) {
print "not ";
}
print "ok ".++$count."\n";
-my $curl2 = WWW::Curl::easy->new();
+my $curl2 = WWW::Curl::Easy->new();
if ($curl2 == 0) {
print "not ";
}
@@ -68,7 +54,6 @@
foreach my $handle ($curl1,$curl2) {
$handle->setopt(CURLOPT_NOPROGRESS, 1);
-$handle->setopt(CURLOPT_MUTE, 1);
$handle->setopt(CURLOPT_FOLLOWLOCATION, 1);
$handle->setopt(CURLOPT_TIMEOUT, 30);
@@ -97,7 +82,7 @@
print "ok ".++$count."\n";
-print STDERR "next test will fail on libcurl < 7.7.2\n";
+print "# next test will fail on libcurl < 7.7.2\n";
print "not " if (!$header_called); # ok if you have a libcurl <7.7.2
print "ok ".++$count."\n";
Modified: packages/libwww-curl-perl/branches/upstream/current/t/19basic-back.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/19basic-back.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/19basic-back.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,44 +1,36 @@
-# Test script for Perl extension WWW::Curl::easy.
-# Check out the file README for more info.
+#!perl
-# Test backwards compatibility namespace 'Curl::easy'
-
-# 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..6\n"; }
-END {print "not ok 1\n" unless $::loaded;}
+print "1..0 # TODO skipping broken backwards namespace test\n";
+exit;
+
+__END__;
+
use Curl::easy;
+END {print "not ok 1\n" unless $::loaded;}
$::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):
+my $count=0;
-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;
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
}
-}
+print "1..6\n";
+print "ok ".++$count."\n";
# Init the curl session
my $curl = Curl::easy->new();
@@ -48,7 +40,6 @@
print "ok ".++$count."\n";
$curl->setopt(CURLOPT_NOPROGRESS, 1);
-$curl->setopt(CURLOPT_MUTE, 1);
$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
$curl->setopt(CURLOPT_TIMEOUT, 30);
Added: packages/libwww-curl-perl/branches/upstream/current/t/20basic-back-func.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/20basic-back-func.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/20basic-back-func.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,82 @@
+#!perl
+
+#
+# $Id: 20basic-back-func.t,v 1.3 2004/04/20 13:23:58 crisb Exp $
+#
+# Test script for back compatability for Curl::easy in WWW::Curl::easy
+# Test calling Curl::easy in the function style
+
+use strict;
+
+print "1..0 # TODO skipping broken backwards namespace test\n";
+exit;
+
+__END__;
+
+BEGIN { $| = 1; print "1..6\n"; }
+END {print "not ok 1\n" unless $::loaded;}
+use Curl::easy;
+
+$::loaded = 1;
+
+######################### End of black magic.
+
+
+my $count=0;
+
+# 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_VERBOSE, 0);
+
+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";
+
+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);
+
+# Go get it
+my $retcode=$curl->perform();
+if ($retcode == 0) {
+ my $bytes=Curl::easy::getinfo($curl,CURLINFO_SIZE_DOWNLOAD);
+# print STDERR "$bytes bytes read ";
+ my $realurl=Curl::easy::getinfo($curl,CURLINFO_EFFECTIVE_URL);
+ my $httpcode=Curl::easy::getinfo($curl,CURLINFO_HTTP_CODE);
+# print STDERR "effective fetched url (http code: $httpcode) was: $url ";
+print "ok ".++$count."\n";
+} else {
+ # We can acces the error message in $errbuf here
+ print "not ok ".++$count." $retcode / ".Curl::easy::errbuf($curl)."\n";
+}
+
+exit;
Added: packages/libwww-curl-perl/branches/upstream/current/t/21basic-back-easy.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/21basic-back-easy.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/21basic-back-easy.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,73 @@
+#!perl
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+use strict;
+
+use WWW::Curl::Easy;
+
+END {print "not ok 1\n" unless $::loaded;}
+$::loaded = 1;
+
+######################### End of black magic.
+
+my $count=0;
+
+
+use ExtUtils::MakeMaker qw(prompt);
+
+# Read URL to get, defaulting to environment variable if supplied
+my $defurl=$ENV{CURL_TEST_URL} || "";
+my $url = prompt("# Please enter an URL to fetch",$defurl);
+if (!$url) {
+ print "1..0 # No test URL supplied - skipping test\n";
+ exit;
+}
+print "1..6\n";
+print "ok ".++$count."\n";
+
+# Init the curl session
+my $curl = WWW::Curl::Easy->new();
+if ($curl == 0) {
+ print "not ";
+}
+print "ok ".++$count."\n";
+
+$curl->setopt(CURLOPT_NOPROGRESS, 1);
+$curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
+$curl->setopt(CURLOPT_TIMEOUT, 30);
+
+open HEAD, ">head.out";
+$curl->setopt(CURLOPT_WRITEHEADER, *HEAD);
+print "ok ".++$count."\n";
+
+open BODY, ">body.out";
+$curl->setopt(CURLOPT_FILE,*BODY);
+print "ok ".++$count."\n";
+
+$curl->setopt(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->setopt(CURLOPT_HTTPHEADER, \@myheaders);
+
+# Go get it
+my $retcode=$curl->perform();
+if ($retcode == 0) {
+ my $bytes=$curl->getinfo(CURLINFO_SIZE_DOWNLOAD);
+# print STDERR "$bytes bytes read ";
+ my $realurl=$curl->getinfo(CURLINFO_EFFECTIVE_URL);
+ my $httpcode=$curl->getinfo(CURLINFO_HTTP_CODE);
+# print STDERR "effective fetched url (http code: $httpcode) was: $url ";
+} else {
+ # We can acces the error message in $errbuf here
+# print STDERR "$retcode / ".$curl->errbuf."\n";
+ print "not ";
+}
+print "ok ".++$count."\n";
+
+exit;
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/00constants.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/00constants.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/00constants.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,5 @@
+use strict;
+use Test::Simple tests => 1;
+use WWW::Curl::Easy;
+
+ok( CURLOPT_URL == 10000 + 2 );
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/01basic.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/01basic.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/01basic.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,13 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ my @headers = ( 'Server: cURL', 'User-Agent: WWW::Curl/3.00' );
+ $curl->setopt( CURLOPT_HTTPHEADER, \@headers );
+ my $code = $curl->perform;
+ ok( $code == 0 );
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/02header-callback.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/02header-callback.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/02header-callback.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,20 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $header;
+
+sub header_callback {
+ my $chunk = shift;
+ $header .= $chunk;
+ return length $chunk;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_HEADERFUNCTION, \&header_callback );
+ $curl->perform;
+ ok($header);
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/03body-callback.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/03body-callback.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/03body-callback.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,20 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $body;
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ $body .= $chunk;
+ return length $chunk;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+ $curl->perform;
+ ok($body);
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/04abort.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/04abort.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/04abort.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,17 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ return -1;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+ my $code = $curl->perform;
+ ok($code);
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/05progress.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/05progress.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/05progress.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 3;
+use WWW::Curl::Easy;
+
+my ( $progress, $last );
+
+sub progress_callback {
+ my ( $clientp, $dltotal, $dlnow, $ultotal, $ulnow ) = @_;
+ $last = $dlnow;
+ $progress++;
+ return 0;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 3 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_NOPROGRESS, 1 );
+ $curl->setopt( CURLOPT_NOPROGRESS, 0 );
+ $curl->setopt( CURLOPT_PROGRESSFUNCTION, \&progress_callback );
+ my $code = $curl->perform;
+ ok( $code == 0 );
+ ok($progress);
+ ok($last);
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/06http-post.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/06http-post.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/06http-post.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,26 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $max = 1000;
+
+sub read_callback {
+ my ( $maxlen, $sv ) = @_;
+
+ # Create some random data
+ my $data = chr( ord('A') + rand(26) ) x ( int( $max / 3 ) + 1 );
+ $max = $max - length $data;
+ return $data;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_READFUNCTION, \&read_callback );
+ $curl->setopt( CURLOPT_INFILESIZE, $max );
+ $curl->setopt( CURLOPT_UPLOAD, 1 );
+ $curl->setopt( CURLOPT_CUSTOMREQUEST, 'POST' );
+ my $code = $curl->perform;
+ ok( $code == 0 );
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/07errbuf.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/07errbuf.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/07errbuf.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,9 @@
+use strict;
+use Test::Simple tests => 1;
+use WWW::Curl::Easy;
+
+my $curl = new WWW::Curl::Easy;
+$curl->setopt( CURLOPT_URL, 'badprotocol://127.0.0.1:2' );
+$curl->perform;
+my $err = $curl->errbuf;
+ok($err);
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/08duphandle.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/08duphandle.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/08duphandle.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,14 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ my @headers = ( 'Server: cURL', 'User-Agent: WWW::Curl/3.00' );
+ $curl->setopt( CURLOPT_HTTPHEADER, \@headers );
+ my $curl2 = $curl->duphandle;
+ my $code = $curl2->perform;
+ ok( $code == 0 );
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/09duphandle-callback.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/09duphandle-callback.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/09duphandle-callback.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,21 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $body;
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ $body .= $chunk;
+ return length $chunk;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+ my $curl2 = $curl->duphandle;
+ $curl2->perform;
+ ok($body);
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/10multi-callback.t
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/10multi-callback.t 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/10multi-callback.t 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,54 @@
+use strict;
+use Test::More tests => 4;
+use WWW::Curl::Easy;
+use WWW::Curl::Multi;
+
+my ( $header, $body, $header2, $body2 );
+
+sub header_callback {
+ my $chunk = shift;
+ $header .= $chunk;
+ return length($chunk);
+}
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ $body .= $chunk;
+ return length($chunk);
+}
+
+sub header_callback2 {
+ my $chunk = shift;
+ $header2 .= $chunk;
+ return length($chunk);
+}
+
+sub body_callback2 {
+ my ( $chunk, $handle ) = @_;
+ $body2 .= $chunk;
+ return length($chunk);
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 4 unless $ENV{CURL_TEST_URL};
+
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_HEADERFUNCTION, \&header_callback );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+
+ my $curl2 = new WWW::Curl::Easy;
+ $curl2->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl2->setopt( CURLOPT_HEADERFUNCTION, \&header_callback2 );
+ $curl2->setopt( CURLOPT_WRITEFUNCTION, \&body_callback2 );
+
+ my $curlm = new WWW::Curl::Multi;
+ $curlm->add_handle($curl);
+ $curlm->add_handle($curl2);
+ $curlm->perform;
+
+ ok($header);
+ ok($body);
+ ok($header2);
+ ok($body2);
+}
Added: packages/libwww-curl-perl/branches/upstream/current/t/new/README
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/t/new/README 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/t/new/README 2005-12-16 20:07:12 UTC (rev 1640)
@@ -0,0 +1,8 @@
+These test scripts have been updated by Sebastian Riedel to use modern
+features of the Test::Harness suite, such as Test::Simple and Test::More,
+which makes them cleaner and more maintainable, but which are unfortunately
+not natively supported by older perl versions. They are placed here reference,
+and will become the standard test scripts once we drop support for perl5.005.
+
+
+
Modified: packages/libwww-curl-perl/branches/upstream/current/typemap
===================================================================
--- packages/libwww-curl-perl/branches/upstream/current/typemap 2005-12-16 20:07:02 UTC (rev 1639)
+++ packages/libwww-curl-perl/branches/upstream/current/typemap 2005-12-16 20:07:12 UTC (rev 1640)
@@ -1,3 +1,4 @@
TYPEMAP
-WWW::Curl::easy T_PTROBJ
-WWW::Curl::form T_PTROBJ
+WWW::Curl::Easy T_PTROBJ
+WWW::Curl::Form T_PTROBJ
+WWW::Curl::Multi T_PTROBJ
More information about the Pkg-perl-cvs-commits
mailing list