r34841 - in /branches/upstream/libasync-mergepoint-perl: ./ current/ current/Build.PL current/Changes current/MANIFEST current/META.yml current/Makefile.PL current/lib/ current/lib/Async/ current/lib/Async/MergePoint.pm current/t/ current/t/01mergepoint.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed May 6 04:22:25 UTC 2009
Author: jawnsy-guest
Date: Wed May 6 04:22:11 2009
New Revision: 34841
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34841
Log:
[svn-inject] Installing original source of libasync-mergepoint-perl
Added:
branches/upstream/libasync-mergepoint-perl/
branches/upstream/libasync-mergepoint-perl/current/
branches/upstream/libasync-mergepoint-perl/current/Build.PL
branches/upstream/libasync-mergepoint-perl/current/Changes
branches/upstream/libasync-mergepoint-perl/current/MANIFEST
branches/upstream/libasync-mergepoint-perl/current/META.yml
branches/upstream/libasync-mergepoint-perl/current/Makefile.PL
branches/upstream/libasync-mergepoint-perl/current/lib/
branches/upstream/libasync-mergepoint-perl/current/lib/Async/
branches/upstream/libasync-mergepoint-perl/current/lib/Async/MergePoint.pm
branches/upstream/libasync-mergepoint-perl/current/t/
branches/upstream/libasync-mergepoint-perl/current/t/01mergepoint.t
Added: branches/upstream/libasync-mergepoint-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libasync-mergepoint-perl/current/Build.PL?rev=34841&op=file
==============================================================================
--- branches/upstream/libasync-mergepoint-perl/current/Build.PL (added)
+++ branches/upstream/libasync-mergepoint-perl/current/Build.PL Wed May 6 04:22:11 2009
@@ -1,0 +1,17 @@
+use strict;
+use warnings;
+
+use Module::Build;
+
+my $build = Module::Build->new
+ (
+ module_name => 'Async::MergePoint',
+ build_requires => {
+ 'Test::Exception' => 0,
+ 'Test::More' => 0,
+ },
+ license => 'perl',
+ create_makefile_pl => 'traditional',
+ );
+
+$build->create_build_script;
Added: branches/upstream/libasync-mergepoint-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libasync-mergepoint-perl/current/Changes?rev=34841&op=file
==============================================================================
--- branches/upstream/libasync-mergepoint-perl/current/Changes (added)
+++ branches/upstream/libasync-mergepoint-perl/current/Changes Wed May 6 04:22:11 2009
@@ -1,0 +1,8 @@
+Revision history for Async-MergePoint
+
+0.02 BUGFIXES:
+ * Remember to rename IO::Async::MergePoint as Async::MergePoint in
+ test scripts
+
+0.01 First version, released on an unsuspecting world.
+
Added: branches/upstream/libasync-mergepoint-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libasync-mergepoint-perl/current/MANIFEST?rev=34841&op=file
==============================================================================
--- branches/upstream/libasync-mergepoint-perl/current/MANIFEST (added)
+++ branches/upstream/libasync-mergepoint-perl/current/MANIFEST Wed May 6 04:22:11 2009
@@ -1,0 +1,7 @@
+Build.PL
+Changes
+lib/Async/MergePoint.pm
+MANIFEST This list of files
+t/01mergepoint.t
+Makefile.PL
+META.yml
Added: branches/upstream/libasync-mergepoint-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libasync-mergepoint-perl/current/META.yml?rev=34841&op=file
==============================================================================
--- branches/upstream/libasync-mergepoint-perl/current/META.yml (added)
+++ branches/upstream/libasync-mergepoint-perl/current/META.yml Wed May 6 04:22:11 2009
@@ -1,0 +1,20 @@
+---
+name: Async-MergePoint
+version: 0.02
+author:
+ - 'Paul Evans E<lt>leonerd at leonerd.org.ukE<gt>'
+abstract: resynchronise diverged control flow
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+build_requires:
+ Test::Exception: 0
+ Test::More: 0
+provides:
+ Async::MergePoint:
+ file: lib/Async/MergePoint.pm
+ version: 0.02
+generated_by: Module::Build version 0.3
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libasync-mergepoint-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libasync-mergepoint-perl/current/Makefile.PL?rev=34841&op=file
==============================================================================
--- branches/upstream/libasync-mergepoint-perl/current/Makefile.PL (added)
+++ branches/upstream/libasync-mergepoint-perl/current/Makefile.PL Wed May 6 04:22:11 2009
@@ -1,0 +1,15 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.30
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'Async::MergePoint',
+ 'VERSION_FROM' => 'lib/Async/MergePoint.pm',
+ 'PREREQ_PM' => {
+ 'Test::Exception' => 0,
+ 'Test::More' => 0
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
+ )
+;
Added: branches/upstream/libasync-mergepoint-perl/current/lib/Async/MergePoint.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libasync-mergepoint-perl/current/lib/Async/MergePoint.pm?rev=34841&op=file
==============================================================================
--- branches/upstream/libasync-mergepoint-perl/current/lib/Async/MergePoint.pm (added)
+++ branches/upstream/libasync-mergepoint-perl/current/lib/Async/MergePoint.pm Wed May 6 04:22:11 2009
@@ -1,0 +1,157 @@
+# You may distribute under the terms of either the GNU General Public License
+# or the Artistic License (the same terms as Perl itself)
+#
+# (C) Paul Evans, 2007-2009 -- leonerd at leonerd.org.uk
+
+package Async::MergePoint;
+
+use strict;
+
+our $VERSION = '0.02';
+
+use Carp;
+
+=head1 NAME
+
+C<Async::MergePoint> - resynchronise diverged control flow
+
+=head1 SYNOPSIS
+
+ use Async::MergePoint;
+
+ my $merge = Async::MergePoint->new(
+ needs => [ "leaves", "water" ],
+
+ on_finished => sub {
+ my %items = @_;
+ # Make tea using $items{leaves} and $items{water}
+ }
+ );
+
+ Kettle->boil(
+ on_boiled => sub { $merge->done( "water", $_[0] ) }
+ );
+
+ Cupboard->get_tea_leaves(
+ on_fetched => sub { $merge->done( "leaves", $_[0] ) }
+ );
+
+=head1 DESCRIPTION
+
+Often in program logic, multiple different steps need to be taken that are
+independent of each other, but their total result is needed before the next
+step can be taken. In synchonous code, the usual approach is to do them
+sequentially.
+
+An asynchronous or event-based program could do this, but if each step
+involves some IO idle time, better overall performance can often be gained by
+running the steps in parallel. A C<Async::MergePoint> object can then be used
+to wait for all of the steps to complete, before passing the combined result
+of each step on to the next stage.
+
+A merge point maintains a set of outstanding operations it is waiting on;
+these are arbitrary string values provided at the object's construction. Each
+time the C<done()> method is called, the named item is marked as being
+complete. When all of the required items are so marked, the C<on_finished>
+continuation is invoked.
+
+When an item is marked as complete, a value can also be provided, which would
+contain the results of that step. The C<on_finished> callback is passed a hash
+(in list form, rather than by reference) of the collected item values.
+
+This module was originally part of the L<IO::Async> distribution, but was
+removed under the inspiration of Pedro Melo's L<Async::Hooks> distribution,
+because it doesn't itself contain anything IO-specific.
+
+=cut
+
+=head1 CONSTRUCTOR
+
+=cut
+
+=head2 $merge = Async::MergePoint->new( %params )
+
+This function returns a new instance of a C<Async::MergePoint> object. The
+C<%params> hash takes the following keys:
+
+=over 8
+
+=item needs => ARRAY
+
+An array containing unique item names to wait on. The order of this array is
+not significant.
+
+=item on_finished => CODE
+
+CODE reference to the continuation for when the merge point becomes ready.
+
+=back
+
+The C<on_finished> continuation will be called when every key in the C<needs>
+list has been notified by the C<done()> method. It will be called as
+
+ $on_finished->( %items )
+
+where the C<%items> hash will contain the item names that were waited on, and
+the values passed to the C<done()> method for each one. Note that this is
+passed as a list, not as a HASH reference.
+
+=cut
+
+sub new
+{
+ my $class = shift;
+ my ( %params ) = @_;
+
+ ref $params{needs} eq 'ARRAY' or croak "Expected 'needs' to be an ARRAY ref";
+ ref $params{on_finished} eq 'CODE' or croak "Expected 'on_finished' to be a CODE ref";
+
+ # Store these as a hash for ease of deletion
+ my %needs = map { $_ => 1 } @{ $params{needs} };
+
+ my $self = bless {
+ needs => \%needs,
+ items => {},
+ on_finished => $params{on_finished},
+ }, $class;
+
+ return $self;
+}
+
+=head1 METHODS
+
+=cut
+
+=head2 $merge->done( $item, $value )
+
+This method informs the merge point that the C<$item> is now ready, and
+passes it a value to store, to be passed into the C<on_finished> continuation.
+If this call gives the final remaining item being waited for, the
+C<on_finished> continuation is called within it, and the method will not
+return until it has completed.
+
+=cut
+
+sub done
+{
+ my $self = shift;
+ my ( $item, $value ) = @_;
+
+ exists $self->{needs}->{$item} or croak "$self does not need $item";
+
+ delete $self->{needs}->{$item};
+ $self->{items}->{$item} = $value;
+
+ if( !keys %{ $self->{needs} } ) {
+ $self->{on_finished}->( %{$self->{items}} );
+ }
+}
+
+# Keep perl happy; keep Britain tidy
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Paul Evans E<lt>leonerd at leonerd.org.ukE<gt>
Added: branches/upstream/libasync-mergepoint-perl/current/t/01mergepoint.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libasync-mergepoint-perl/current/t/01mergepoint.t?rev=34841&op=file
==============================================================================
--- branches/upstream/libasync-mergepoint-perl/current/t/01mergepoint.t (added)
+++ branches/upstream/libasync-mergepoint-perl/current/t/01mergepoint.t Wed May 6 04:22:11 2009
@@ -1,0 +1,61 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 11;
+use Test::Exception;
+
+use Async::MergePoint;
+
+dies_ok( sub { Async::MergePoint->new( on_finished => sub { "DUMMY" } ) },
+ 'No needs' );
+
+dies_ok( sub { Async::MergePoint->new( needs => ['foo'] ) },
+ 'No on_finished' );
+
+dies_ok( sub { Async::MergePoint->new( needs => "hello", on_finished => sub { "DUMMY" } ) },
+ 'needs not ARRAY' );
+
+dies_ok( sub { Async::MergePoint->new( needs => ['foo'], on_finished => "goodbye" ) },
+ 'on_finished not CODE' );
+
+my %items;
+
+my $merge = Async::MergePoint->new(
+ needs => [qw( red )],
+
+ on_finished => sub { %items = @_; },
+);
+
+ok( defined $merge, '$merge defined' );
+isa_ok( $merge, "Async::MergePoint", '$merge isa Async::MergePoint' );
+
+is_deeply( \%items, {}, '%items before done of one item' );
+
+$merge->done( red => '#f00' );
+
+is_deeply( \%items, { red => '#f00' }, '%items after done of one item' );
+
+%items = ();
+
+$merge = Async::MergePoint->new(
+ needs => [qw( blue green )],
+
+ on_finished => sub { %items = @_; },
+);
+
+$merge->done( green => '#0f0' );
+
+is_deeply( \%items, {}, '%items after one of 1/2 items' );
+
+$merge->done( blue => '#00f' );
+
+is_deeply( \%items, { blue => '#00f', green => '#0f0' }, '%items after done 2/2 items' );
+
+$merge = Async::MergePoint->new(
+ needs => [qw( purple )],
+ on_finished => sub { "DUMMY" },
+);
+
+dies_ok( sub { $merge->done( "orange" => 1 ) },
+ 'done something not needed fails' );
More information about the Pkg-perl-cvs-commits
mailing list