Net-Curl

 view release on metacpan or  search on metacpan

lib/Net/Curl/examples.pod  view on Meta::CPAN

     $self->SUPER::add_handle( $easy );
 }

 # perform until some handle finishes, does all the magic needed
 # to make it efficient (check as soon as there is some data)
 # without overusing the cpu.
 sub get_one($)
 {
     my $self = shift;

     if ( my @result = $self->info_read() ) {
         $self->remove_handle( $result[ 1 ] );
         return @result;
     }

     while ( $$self ) {
         my $t = $self->timeout;
         if ( $t != 0 ) {
             $t = 10000 if $t < 0;
             my ( $r, $w, $e ) = $self->fdset;

             select $r, $w, $e, $t / 1000;
         }

         my $ret = $self->perform();
         if ( $$self != $ret ) {
             $$self = $ret;
             if ( my @result = $self->info_read() ) {
                 $self->remove_handle( $result[ 1 ] );
                 return @result;
             }
         }
     };

     return ();
 }

 1;

=head2 TEST APPLICATION

Sample application using this module looks like this:

 #!perl
 use strict;
 use warnings;
 use Multi::Simple;
 use Net::Curl::Share qw(:constants);


 sub easy
 {
     my $uri = shift;
     my $share = shift;

     require Net::Curl::Easy;

     my $easy = Net::Curl::Easy->new( { uri => $uri, body => '' } );
     $easy->setopt( Net::Curl::Easy::CURLOPT_VERBOSE(), 1 );
     $easy->setopt( Net::Curl::Easy::CURLOPT_URL(), $uri );
     $easy->setopt( Net::Curl::Easy::CURLOPT_WRITEHEADER(),
         \$easy->{headers} );
     $easy->setopt( Net::Curl::Easy::CURLOPT_FILE(),
         \$easy->{body} );
     $easy->setopt( Net::Curl::Easy::CURLOPT_SHARE(), $share );

     # This wasn't needed prior to curl 7.67, which changed the interface
     # so that an easy that uses a cookie-share now requires an explicit
     # cookie-engine enable to use cookies. Previously the easy's use of
     # a cookie-share implicitly enabled the easy's cookie engine.
     $easy->setopt( Net::Curl::Easy::CURLOPT_COOKIEFILE(), q<> );

     return $easy;
 }

 my $multi = Multi::Simple->new();

 my @uri = (
     "http://www.google.com/search?q=perl",
     "http://www.google.com/search?q=curl",
     "http://www.google.com/search?q=perl+curl",
 );

 {
     # share cookies between all handles
     my $share = Net::Curl::Share->new();
     $share->setopt( CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE );
     $multi->add_handle( easy( shift ( @uri ), $share ) );
 }

 my $ret = 0;
 while ( my ( $msg, $easy, $result ) = $multi->get_one() ) {
     print "\nFinished downloading $easy->{uri}: $result:\n";
     printf "Body is %d bytes long\n", length $easy->{body};
     print "=" x 80 . "\n";

     $ret = 1 if $result;

     $multi->add_handle( easy( shift ( @uri ), $easy->share ) )
         if @uri;
 }

 exit $ret;

=cut
=head1 Multi::Event

=head4 I<Extracted from C<examples/03-multi-event.pl>>

This module shows how to use Net::Curl::Multi interface with an event
library, AnyEvent in this case.

=head2 Motivation

This is the most efficient method for using Net::Curl::Multi interface,
but it requires a really good understanding of it. This code tries to show
the quirks found when using event-based programming.

=head2 MODULE CODE

 package Multi::Event;

lib/Net/Curl/examples.pod  view on Meta::CPAN

     # Calling socket_action with default arguments will trigger
     # socket callback and register IO events.
     #
     # It _must_ be called _after_ add_handle(); AE will take care
     # of that.
     #
     # We are delaying the call because in some cases socket_action
     # may finish inmediatelly (i.e. there was some error or we used
     # persistent connections and server returned data right away)
     # and it could confuse our application -- it would appear to
     # have finished before it started.
     AE::timer 0, 0, sub {
         $multi->socket_action();
     };

     $multi->SUPER::add_handle( $easy );
 }

 # perform and call any callbacks that have finished
 sub socket_action
 {
     my $multi = shift;

     my $active = $multi->SUPER::socket_action( @_ );
     return if $multi->{active} == $active;

     $multi->{active} = $active;

     while ( my ( $msg, $easy, $result ) = $multi->info_read() ) {
         if ( $msg == Net::Curl::Multi::CURLMSG_DONE ) {
             $multi->remove_handle( $easy );
             $easy->finish( $result );
         } else {
             die "I don't know what to do with message $msg.\n";
         }
     }
 }

 1;

=head2 TEST Easy package

Multi::Event requires Easy object to provide finish() method.

 package Easy::Event;
 use strict;
 use warnings;
 use Net::Curl::Easy qw(/^CURLOPT_/);
 use base qw(Net::Curl::Easy);

 sub new
 {
     my $class = shift;
     my $uri = shift;
     my $cb = shift;

     my $easy = $class->SUPER::new(
         { uri => $uri, body => '', cb => $cb }
     );
     $easy->setopt( CURLOPT_URL, $uri );
     $easy->setopt( CURLOPT_WRITEHEADER, \$easy->{headers} );
     $easy->setopt( CURLOPT_FILE, \$easy->{body} );

     return $easy;
 }

 sub finish
 {
     my ( $easy, $result ) = @_;

     printf "\nFinished downloading %s: %s: %d bytes\n",
         $easy->{uri}, $result, length $easy->{body};

     $easy->{cb}->( $easy->{body} );
 }

 1;

=head2 TEST APPLICATION

 #!perl
 use strict;
 use warnings;
 use Easy::Event;
 use Multi::Event;
 use AnyEvent;

 my $multi = Multi::Event->new();
 my $cv = AE::cv;


 my @uris = (
     "http://www.google.com/search?q=perl",
     "http://www.google.com/search?q=curl",
     "http://www.google.com/search?q=perl+curl",
 );


 my $i = scalar @uris;
 sub done
 {
     my $body = shift;

     # process...

     unless ( --$i ) {
         $cv->send;
     }
 }

 my $timer;
 $timer = AE::timer 0, 0.1, sub {
     my $uri = shift @uris;
     $multi->add_handle( Easy::Event->new( $uri, \&done ) );

     unless ( @uris ) {
         undef $timer;
     }
 };

 $cv->recv;

lib/Net/Curl/examples.pod  view on Meta::CPAN

     # create a shared share object
     my $self :shared = $class->SUPER::new( \%base );

     # share both cookies and dns
     $self->setopt( CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE );
     $self->setopt( CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS );

     # Net::Curl::Share locks each datum automatically, this will
     # prevent memory corruption.
     #
     # we use semaphore to lock share completely
     $self->{sem} = Thread::Semaphore->new();

     return $self;
 }

 # this locks way too much, but works as expected
 sub lock
 {
     my $share = shift;
     $share->{sem}->down();
     $share->{blocker} = threads->tid();
 }

 sub unlock
 {
     my $share = shift;
     unless ( exists $share->{blocker} ) {
         warn "Tried to unlock share that wasn't locked\n";
         return;
     }
     unless ( $share->{blocker} == threads->tid() ) {
         warn "Tried to unlock share from another thread\n";
         return;
     }
     delete $share->{blocker};
     $share->{sem}->up();
 }

 1;

=head2 TEST Easy package

This Easy::Threads object will block whole share object for duration of dns
name resolution and until headers are completely received.

 package Easy::Threads;
 use strict;
 use warnings;
 use Net::Curl::Easy qw(/^CURLOPT_.*/);
 use base qw(Net::Curl::Easy);

 sub new
 {
     my $class = shift;
     my $share = shift;

     my $easy = $class->SUPER::new( { body => '', head => '' } );
     $easy->setopt( CURLOPT_VERBOSE, 1 );
     $easy->setopt( CURLOPT_WRITEHEADER, \$easy->{head} );
     $easy->setopt( CURLOPT_FILE, \$easy->{body} );
     $easy->setopt( CURLOPT_HEADERFUNCTION, \&cb_header );
     $easy->setopt( CURLOPT_SHARE, $share );

     return $easy;
 }

 sub cb_header {
     my ( $easy, $data, $uservar ) = @_;

     if ( $data eq "\r\n" ) {
         # we have all the headers now, allow other threads to run
         $easy->share->unlock()
             unless $easy->{unlocked};

         $easy->{unlocked} = 1;
     }

     $$uservar .= $data;

     return length $data;
 }

 sub get
 {
     my $easy = shift;
     my $uri = shift;

     $easy->setopt( CURLOPT_URL, $uri );
     $easy->{uri} = $uri;
     $easy->{body} = '';
     $easy->{head} = '';
     delete $easy->{unlocked};

     # lock share
     $easy->share->lock();

     # ok, now we can request
     eval {
         $easy->perform();
     };

     # There may have been some problem, make sure we unlock the share.
     # This should issue a warning, check $easy->{unlocked} to see
     # whether we really need to unlock.
     $easy->share->unlock();

     # return something
     return $easy->{body};
 }

 1;

=head2 TEST APPLICATION

Sample application using this module looks like this:

 #!perl
 use threads;
 use threads::shared;

lib/Net/Curl/examples.pod  view on Meta::CPAN

     }, '' );

     $multi->{active} = -1;
     $multi->SUPER::add_handle( $easy );
 }

 # perform and call any callbacks that have finished
 sub socket_action
 {
     my $multi = shift;

     my $active = $multi->SUPER::socket_action( @_ );
     return if $multi->{active} == $active;

     $multi->{active} = $active;

     while ( my ( $msg, $easy, $result ) = $multi->info_read() ) {
         if ( $msg == Net::Curl::Multi::CURLMSG_DONE ) {
             $multi->remove_handle( $easy );
             $easy->finish( $result );
         } else {
             die "I don't know what to do with message $msg.\n";
         }
     }
 }


 # we use just one global multi object
 my $multi;

 # put the add() function in some package we know
 sub Net::Curl::Multi::add($)
 {
     unless ( $multi ) {
         $multi = __PACKAGE__->new();
     }
     $multi->add_handle( shift );
 }


 package Irssi::Curl::Easy;
 use strict;
 use warnings;
 use Net::Curl;
 use Net::Curl::Easy qw(/^CURLOPT_/);
 use base qw(Net::Curl::Easy);

 my $has_zlib = ( Net::Curl::version_info()->{features}
     & Net::Curl::CURL_VERSION_LIBZ ) != 0;

 sub new
 {
     my $class = shift;
     my $uri = shift;
     my $cb = shift;

     my $easy = $class->SUPER::new(
         { body => '', headers => '' }
     );
     # some sane defaults
     $easy->setopt( CURLOPT_WRITEHEADER, \$easy->{headers} );
     $easy->setopt( CURLOPT_FILE, \$easy->{body} );
     $easy->setopt( CURLOPT_TIMEOUT, 300 );
     $easy->setopt( CURLOPT_CONNECTTIMEOUT, 60 );
     $easy->setopt( CURLOPT_MAXREDIRS, 20 );
     $easy->setopt( CURLOPT_FOLLOWLOCATION, 1 );
     $easy->setopt( CURLOPT_ENCODING, 'gzip,deflate' ) if $has_zlib;
     $easy->setopt( CURLOPT_SSL_VERIFYPEER, 0 );
     $easy->setopt( CURLOPT_COOKIEFILE, '' );
     $easy->setopt( CURLOPT_USERAGENT, 'Irssi + Net::Curl' );

     return $easy;
 }

 sub finish
 {
     my ( $easy, $result ) = @_;
     $easy->{referer} = $easy->getinfo(
         Net::Curl::Easy::CURLINFO_EFFECTIVE_URL
     );

     my $cb = $easy->{cb};
     $cb->( $easy, $result );
 }

 sub _common_add
 {
     my ( $easy, $uri, $cb ) = @_;
     if ( $easy->{referer} ) {
         $easy->setopt( CURLOPT_REFERER, $easy->{referer} );
     }
     $easy->setopt( CURLOPT_URL, $uri );
     $easy->{uri} = $uri;
     $easy->{cb} = $cb;
     $easy->{body} = '';
     $easy->{headers} = '';
     Net::Curl::Multi::add( $easy );
 }

 # get some uri
 sub get
 {
     my ( $easy, $uri, $cb ) = @_;
     $easy->setopt( CURLOPT_HTTPGET, 1 );
     $easy->_common_add( $uri, $cb );
 }

 # request head on some uri
 sub head
 {
     my ( $easy, $uri, $cb ) = @_;
     $easy->setopt( CURLOPT_NOBODY, 1 );
     $easy->_common_add( $uri, $cb );
 }

 # post data to some uri
 sub post
 {
     my ( $easy, $uri, $cb, $post ) = @_;
     $easy->setopt( CURLOPT_POST, 1 );
     $easy->setopt( CURLOPT_POSTFIELDS, $post );