=head1 Share::Threads

This module shows how one can share http cookies and dns cache between multiple

=head2 Motivation

Threads are evil, but some people think they are not. I want to make them a
favor and show how bad threads really are.

=head2 Limitations


=item *

Net::Curl::Share is the only package that allows sharing between threads.
Others (Easy, Multi, Form) are usable only in their creating thread.

=item *

Share internals are always shared between threads, but you must mark your
base object as shared if you want to use the data elsewhere.

=item *

Shared Net::Curl::Share does not support lock and unlock callbacks.
However, locking is done internally, so no worries about corruption.

=item *

If we want to share the data, we cannot trigger all downloads at the same
time, because there would be no data to share at the time. This solution opts
to lock other downloads until headers from the server are fully received. It
assures cache coherency, but slows down overall application.

=item *

This method does not reuse persistent connections, it would be much faster
to get those 6 requests one after another than to doing all 6 in parallel.

=item *

If you share dns cache all connections for one domain will go to the same IP,
even if domain name resolves to multiple adresses.



package Share::Threads;
use threads;
use threads::shared;
use Thread::Semaphore;
use Net::Curl::Share qw(:constants);
use base qw(Net::Curl::Share);

sub new
	my $class = shift;

	# we want our private data to be shareable
	my %base :shared;

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

	# share both cookies and 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->{blocker} = threads->tid();

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


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

	# ok, now we can request
	eval {

	# 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.

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



Sample application using this module looks like this:

	use threads;
	use threads::shared;
	use strict;
	use warnings;
	use Share::Threads;
	use Easy::Threads;
package main;
use strict;
use warnings;

my $share :shared = Share::Threads->new();

my @uri = (

sub getone
	my $uri = shift;

	my $easy = Easy::Threads->new( $share );
	return $easy->get( $uri );

# start all threads
my @threads;
foreach my $uri ( @uri ) {
	push @threads, threads->create( \&getone, $uri );

# reap all threads
foreach my $t ( @threads ) {
	my $body = $t->join();
	my $len = length $body;
	print "DONE: [[[ $len ]]]\n";

# vim: ts=4:sw=4