The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

SYP / Net-Curl-0.57 / examples / 02-multi-simple.pl 

            

              
—
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
—
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148

              
=head1 Multi::Simple
This module shows how to use Net::Curl::Multi interface correctly in its
simpliest form. Uses perl builtin select(). A more advanced code would use
callbacks and some event library instead.
=head2 Motivation
Writing a proper multi wrapper code requires a rather good understainding
of libcurl multi interface. This code provides a recipie for those who just
need something that "simply works".
=head2 MODULE CODE
=cut
package Multi::Simple;
use strict;
use warnings;
use Net::Curl::Multi;
use base qw(Net::Curl::Multi);
# make new object, preset the data
sub new
{
        my $class = shift;
        my $active = 0;
        return $class->SUPER::new( \$active );
}
# add one handle and count it
sub add_handle($$)
{
        my $self = shift;
        my $easy = shift;
        $$self++;
        $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;
#nopod
=cut
package main;
use strict;
use warnings;
#endnopod
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;
#nopod
# vim: ts=4:sw=4