Net::Curl::Simple::examples - sample modules for Net::Curl::Simple
examples/download-accelerator.pl
Simple downloader capable to download a file using multiple connections.
#!/usr/bin/perl # use strict; use warnings; use Net::Curl::Simple::UserAgent; use IO::Handle; # for STDOUT->flush my $width = 80; my $uri = shift @ARGV or die "Usage: $0 URI [num connections]\n"; my $threads = shift @ARGV || 0; $threads = $threads >= 1 ? int $threads : 3; # we'll disguise as chrome my $chrome = Net::Curl::Simple::UserAgent->new( useragent => 'Mozilla/5.0 (Windows NT 5.1) AppleWebKit/534.24 (KHTML, like Gecko) Chrome/11.0.696.60 Safari/534.24', httpheader => [ 'Connection: keep-alive', 'Cache-Control: max-age=0', 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8', 'Accept-Language: en-US,en;q=0.8', 'Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.3', ], connecttimeout => 30, ); # get some basic information about the download my $size; my $fulluri; my $filename; { # test this uri my $curl = $chrome->curl->head( $uri, # check whether server supports resume resume_from_large => 1, # no callback here so it will block undef ); # make sure there were no errors die "HEAD failed: ${ \$curl->code }: ${ \$curl->error }\n" if $curl->code; ( $size, $fulluri, my $code ) = $curl->getinfos( 'content_length_download', 'effective_url', 'response_code', ); # 206 -- partial content (http) # 350 -- Restarting at (ftp) die "Cannot download, code $code\n" unless $code == 206 or $code == 350; # we started at 1, so the reported size is wrong $size += 1; # extract output file name # decoding Content-Disposition to complicated to bother $fulluri =~ m#.*/(.*)#; $filename = $1; } # align sizes, optional my $alignsize = 1024; my $maxthreads = 1 + int ( $size / $alignsize / 4 ); $threads = $maxthreads if $threads > $maxthreads; my $partsize = $alignsize * int ( $size / ( $alignsize * $threads ) ); # progress display information my $partwidth = int ( $width / $threads ); my @display = ( 0 ) x $threads; my $lastupdate = 0; print "Downloading $filename ($size bytes, $threads connections):\n"; die "ERROR: File exists\n" if -f $filename; foreach my $part ( 0 .. ( $threads - 1 ) ) { my $resume_from = $part * $partsize; open my $fout, '+>', $filename or die "Cannot save to $filename: $!\n"; seek $fout, $resume_from, 0; my $easy = $chrome->curl; $easy->{file} = $fout; $easy->{part} = $part; # last part may be larger $easy->{partsize} = $part != $threads - 1 ? $partsize : $size - $resume_from; $easy->get( $uri, # where we want to resume resume_from_large => $resume_from, # header will tell us where we really have to resume headerfunction => \&cb_header, # write to file handle directly writedata => $fout, # enable progress callback noprogress => 0, progressfunction => \&cb_progress, sub { update_display( $_[0]->{part}, 1 ) } ); } # start download and wait for all threads to finish 1 while Net::Curl::Simple->join; # update display one last time $lastupdate = 0; update_display( 0, 1 ); print "\nFinished\n"; exit 0; sub cb_header { my ( $easy, $data, $uservar ) = @_; push @{ $easy->{headers} }, $data; if ( $data =~ /^Content-Range:\s*bytes\s+(\d+)/ ) { # HTTP seek $easy->{file}, $1, 0; } elsif ( $data =~ /^350 Restarting at (\d+)/ ) { # FTP seek $easy->{file}, $1, 0; } return length $data; } sub update_display { $display[ $_[0] ] = $_[1]; my $time = time; return if $time == $lastupdate; $lastupdate = $time; print join '', "\r", map { $_ >= $partwidth ? "*" x $partwidth : "#" x $_ . "_" x ($partwidth - $_) } map { int $_ * $partwidth } @display; STDOUT->flush; } sub cb_progress { my $curl = $_[0]; update_display( $curl->{part}, $_[2] / $curl->{partsize} ); # abort if we've got what we wanted return 1 if $_[2] > $curl->{partsize}; return 0; } # vim: ts=4:sw=4
examples/irssi-cpan-search.pl
This example searches modules on CPAN.
use strict; use warnings; use Irssi; use URI::Escape; use Net::Curl::Simple; my $max_pages = 5; sub got_body { my ( $window, $easy ) = @_; if ( my $result = $easy->code ) { warn "Could not download $easy->{uri}: $result\n"; return; } my @found; while ( $easy->{body} =~ s#<h2 class=sr><a href="(.*?)"><b>(.*?)</b></a></h2>## ) { my $uri = $1; $_ = $2; s/&#(\d+);/chr $1/eg; chomp; push @found, $_; } @found = "no results" unless @found; my $msg = "CPAN search %9$easy->{args}%n $easy->{page}%9:%n " . (join "%9;%n ", @found); if ( $window ) { $window->print( $msg ); } else { Irssi::print( $msg ); } return if ++$easy->{page} > $max_pages; $easy->{body} =~ m#<a href="(.*?)">Next >></a>#; return unless $1; $easy->get( $1, sub { got_body( $window, @_ ) } ); } sub cpan_search { my ( $args, $server, $window ) = @_; my $query = uri_escape( $args ); my $uri = "http://search.cpan.org/search?query=${query}&mode=all&n=20"; my $easy = Net::Curl::Simple->new(); $easy->{args} = $args; $easy->{page} = 1; $easy->get( $uri, sub { got_body( $window, @_ ) } ); } Irssi::command_bind( 'cpan', \&cpan_search ); # vim: ts=4:sw=4
To install Net::Curl::Simple, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Net::Curl::Simple
CPAN shell
perl -MCPAN -e shell install Net::Curl::Simple
For more information on module installation, please visit the detailed CPAN module installation guide.