package subs::parallel;

use warnings;
use strict;

use threads;
use vars qw/@ISA @EXPORT $AUTOLOAD/;
use Attribute::Handlers;
use Scalar::Util qw/set_prototype/;

=head1 NAME

subs::parallel - enables subroutines to seamlessly run in parallel

=head1 VERSION

Version 0.04

=cut

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(parallelyze parallelyze_sub parallelyze_coderef);

our $VERSION = '0.04';

use overload 
	'""'  => \&_deref,
	'0+'  => \&_deref,
	'bool'=> \&_deref,
	'${}' => \&_deref,
	'@{}' => \&_deref,
	'%{}' => \&_deref,
	'&{}' => \&_deref,
	'*{}' => \&_deref,
	fallback => 1;

=head1 SYNOPSIS

  use subs::parallel;
  
  sub foo : Parallel {
    # foo runs in parallel
  }
  
  parallelyze_sub('bar'); 
  # subroutine named bar now runs in parallel
  
  my $foo = foo(); # returns immediately
  my $bar = bar(); # also returns immediately
  
  # now it might block waiting for both to finish
  if ($foo == $bar) {
    ...
  }
  
  
  my $baz = parallelyze { ... code ... }; # returns immediately
  
  ...
  
  print "baz: $baz\n"; # if it's still running, blocks until it finishes
  
  
  # it can be done to anonymous subs or any other coderefs too
  my $anon = sub { ... more code ... };
  my $parallel_coderef = parallelyze_coderef($anon);

  my $foobar = $parallel_coderef->('arg'); # returns immediately
  
  ...
  
  # sub should return an object, no problem
  $foobar->do_something_else(); # blocks until it finishes running

=head1 DESCRIPTION

This module gives Perl programmers the ability to easily and conveniently 
create multi-threaded applications through B<parallel subroutines>.

Parallel subroutines are just plain old subroutines which happen to run in
another thread. When called, they return immediately to the calling thread but
keep running in another. When its return value is needed somewhere, the 
returned value is transparently fetched. If the thread is still running, the
code blocks waiting for it to finish (since the program can't go on without a 
value and keep being transparent).

So, as it's possible to notice, the module interface aims to be as simple 
as possible. In fact, it works in such a way that, aside from the 
I<parallelyzing> directives, you wouldn't be able to tell it's a multi-threaded 
application. All the thread handling (which isn't I<that> complicated, really) 
is done automagically.

It should work for anything that's thread safe - even for subroutines whose
return values are not usually available across thread boundaries (for example,
usually, you can't C<share> an object, but this module makes it possible to 
return them without any problems, provided they're thread safe).

=head1 MOTIVATION

The main reason behind this module was the fact that Perl threads are not 
widely used. Some could argue that this might happen because Perl threads are
not very practical to use. Others could say that the restrictions imposed by
the use of threads (you can't pass arbitrary data structures between threads).

The latter issue is out of my reach. But, through the use of already existing
features, it was possible to mask it a little bit. So you can return anything
from your parallelyzed subroutines, but this is just some maybe unknown feature
of C<threads->join>.

The first issue is the main aim of this module: provide an extremely simple way
to make multi-threaded applications. Along this near-future reality of a 
majority of dual-core computers, multi-threading might become the factor that
distiguishes good from bad software.

But I would be dishonest if I didn't note that some part of the effort was
driven by the will to prove it could be done in Perl.

=head1 ATTRIBUTE HANDLING

The most practical way of using this module's features is through attrubutes.
This snippet ilustrates how to do it:

  use subs::parallel;
  
  sub foobar : Parallel {
  	# do stuff
  }

That way, C<foobar> is declared as a B<parallel subroutine>. This should have 
exactly the same effect as using the C<parallelyze_sub> below, but is cleaner
and more convenient.

=head1 EXPORTS

The C<parallelyze>, C<parallelyze_sub> and C<parallelyze_coderef> subroutines
are exported. If you have problems with that, you're free to:

  use subs::parallel ();

=head1 FUNCTIONS

All the three functions available work similarly, implementing the idea of 
B<parallelyzed subroutines> as explained above. Nevertheless, here's a brief
explanation of each of them.

=head2 parallelyze { BLOCK }

Starts running the specified block of code in parallel B<immediately>.
The snippet below ilustrates this concept:

  use subs::parallel;

  my $foo = parallelyze {
    # do stuff here
  };

  my $bar = parallelyze {
    # do even more stuff
  };

  # now we wait for them to finish
  print "$foo, $bar\n";

=cut

# parallelyzes and runs a block of code / coderef
sub parallelyze (&) { parallelyze_coderef(shift)->() }

=head2 parallelyze_sub(STRING)

Transforms the named subroutine into a B<parallel subroutine>. After this 
modification, every it's called, it will run inside another thread and return
immediately to the caller.

The snippet below ilustrates this concept:

  use subs::parallel;

  sub blocking_stuff {
	  # do blocking stuff
  }

  blocking_stuff(); # this blocks

  parallelyze_sub('blocking_stuff');
  
  blocking_stuff();
  # now it returns immediately and the return values are discarded

Note that, you can I<parallelyze> named subroutines inside other packages:

  parallelyze_sub('Other::Package::function');

=cut

# parallelyzing subroutines by name
sub parallelyze_sub {
	my ($sub) = @_;
	
	# only prepend caller package if it's fully qualified
	# allows easy parallelyzing of subroutines inside other packages
	if ($sub !~ /::/) {
		my ($caller) = caller();
		$sub = join('::', $caller, $sub);
	}

	# we don't want nasty warnings - but don't try this at home
	no strict 'refs';
	no warnings 'redefine';

	croak("can't parallelyze non-existant subroutine") unless defined *{$sub}{CODE};
	
	# keeps the prototype
	*$sub = &set_prototype(parallelyze_coderef(\&$sub), prototype($sub));
}

=head2 parallelyze_coderef(CODEREF)

Returns a parallelyzed version of the given CODEREF. This function is used 
internally to implement the other two functions explained above.

  my $code = sub { ... }
  my $parallel = parallelyze_coderef($code);

  my $return = $parallel->(@args); # runs in another thread

=cut

# returns a new coderef: a parallelyzed version of the original coderef
# the original is *not* modified
sub parallelyze_coderef {
	my ($coderef) = @_;

	return sub {
		# this is the simple trick which makes this module work
		my $scalar = threads->create($coderef, @_);
		bless {thread => $scalar, caller => threads->tid}, __PACKAGE__;
	};
}

# support for parallelyzing through subroutine attributes
sub UNIVERSAL::Parallel : ATTR(CODE) {
	# for completeness sake, let's have the whole prototype
	my ($caller, $symtable, $coderef, $attr, $data, $phase) = @_;

	no warnings 'redefine';
	# keeps the prototype
	*$symtable = &set_prototype(parallelyze_coderef($coderef), prototype($coderef));
}

# the overload handler
sub _deref {
	my $class = CORE::ref $_[0];
	# work-around in order to support scalar refs - yes, it's kinda ugly
	# the alternative would be Acme::Damn but I feel kinda bad using Acme modules
	bless $_[0], "${class}::NoOverload";
	if (CORE::ref($_[0]->{thread}) eq 'threads') {
		$_[0] = $_[0]->{thread}->join;
	}
	else {
		# just in case - should never get here
		croak(__PACKAGE__ . " object doesn't reference a threads object - something really bad happened");
	}
	return $_[0];
}

# provide method calling support
sub AUTOLOAD {
	# make errors appear to come from the caller
	local $SIG{__DIE__} = sub { goto &croak };
	(my $sub = $AUTOLOAD) =~ s/.*:://;
	$_[0] = _deref($_[0]);
	# unfortunately, if we used goto CODEREF, the call wouldn't be made as a 
	# method and warnings wouldn't be transparent. so, we prefer messing up the
	# caller stack - which is not that used anyway, aside from instrospection
	# modules.
	shift->$sub(@_);
}

sub croak {
	# somehow, local $SIG handlers are not actually locally scoped
	# this makes sure we get other possibly fatal errors
	local $SIG{__DIE__} = '';
	(my $err = shift) =~ s/ at [^ ]+ line (?:\d+).?\n//;
	require Carp;
	Carp::croak($err);
}

# magic destructor!
# ok, ok... it just detaches the thread if we go out of scope.
# BUT ONLY IF we're the original caller of the thread
# this is a work-around for a strange behaviour of the perl threads implementation
sub DESTROY {
	my $class = CORE::ref($_[0]);
	bless $_[0], "${class}::NoOverload";
	if (CORE::ref($_[0]->{thread}) eq 'threads' && $_[0]->{caller} == threads->tid) {
		$_[0]->{thread}->detach;
	}
}

# provide overriden ref() function
sub ref {
	return CORE::ref($_[0]) if CORE::ref($_[0]) ne __PACKAGE__;
	return CORE::ref($_[0]->_deref);
}
*CORE::GLOBAL::ref = \&ref;

1;

# ok, i didn't tie anything. oh well, can't use them all...

=head1 CAVEATS

Currently, the parallel subroutines will always be called in scalar context. 
There are plans for changing this in the future but, for now, if multiple 
return values are needed, consider wrapping them around an array ref (this
feature would require adding the Want module as a dependency).

In order for objects to survice across threads, both the calling and the
executing thread must have its class properly included. This means that you
can't require a module only inside a subroutine and then return an object 
blessed into that class to the calling thread. 

You shouldn't pass to another thread/parallelyzed subroutines previous return
values from other parallelyzed subroutines without reading their values. And,
while you can get away with it, it's probably too much rope to hang yourself on
when things start to get ugly. This might be changed in the future, but would
require some sort of explicit synchronization through shared variables.

Also, there's no way to tell if a parallelyzed subroutine is still running or 
not. This probably will be changed in the future but, unfortunately, will 
require either a minimalistic approach using some simple shared variables or 
the use of Thread::Running, which would be another dependency and ends up using
shared variables anyway.

The caller stack may behave in a non expected manner. When calling returned 
object's methods, there will be an extra level in the stack, representing 
C<AUTOLOAD> magic - the third form of C<goto> couldn't be used since that way
if the user called a non-existant method, he wouldn't get the default warning.
In the future, maybe this will be configurable so that if you need to rely on
the caller stack, you can make this trade-off.

If the I<parallelyzed> subroutine dies, you won't get any warnings on notices
of any kind. It would be like it returned C<undef>. This might change in the 
future.

C<GLOBAL::CORE::ref> is overriden. This may be an issue if there are other 
modules in use which override it too. In the future, there may be a switch to
disable this.

=head1 BUGS

Besides the CAVEATS (which some people might consider to be bugs) there are no
known bugs.

Please report any bugs or feature requests to
C<bug-subs-parallel@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=subs-parallel-0.04>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 AUTHOR

Nilson Santos F. Jr., C<< <nilsonsfj@cpan.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005 Nilson Santos F. Jr., All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<threads>

=cut

1; # End of subs::parallel
