view release on metacpan or  search on metacpan

examples/05-irssi-downloader.pl  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 );