view release on metacpan or  search on metacpan

examples/04-share-threads.pl  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.

=cut
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;