view release on metacpan or  search on metacpan

lib/Data/Pipeline/Machine.pm  view on Meta::CPAN

package Data::Pipeline::Machine;

use Moose;
use Sub::Exporter;
use Sub::Name 'subname';
use Class::MOP ();
use Carp ();

use namespace::autoclean;
            
#use Data::Pipeline::Aggregator::Machine;
use Data::Pipeline::Machine::Surrogate;
use Data::Pipeline::Iterator::Options;

use MooseX::Types::Moose qw(HashRef);  

use Data::Pipeline::Types qw(Iterator IteratorSource Aggregator IteratorOutput);
                        
BEGIN {
    Class::MOP::load_class('Data::Pipeline::Aggregator::Machine');
    Class::MOP::load_class('Data::Pipeline::Aggregator::Pipeline');
}

has _m => (
    isa => 'Object',
    is => 'rw',
    lazy => 1,
    default => sub {
        _machine( $_[0] -> meta -> name )
    },
    handles => [qw( from transform )]
);

{
my %machines;
sub _machine {
    my($class) = @_;

    $machines{$class} ||= Data::Pipeline::Aggregator::Machine -> new( );
}
}

sub import {
    my($own_class) = @_;
        
    my $CALLER = caller();

    # see Moose.pm for explanation :-)
    strict->import;
    warnings->import;

    return if $CALLER eq 'main';

    my $machine = _machine($CALLER);

    my %exports;


#    $exports{connect} = sub {
#        my $class = $CALLER;
#        my $machine = _machine($class);
#        return subname "Data::Pipeline::Machine::connect" => sub {
#            my($from, $to);
#            while( ($from, $to) = splice @_, 2) {
#                $machine -> connect($from, $to);
#            }
#        };
#    };

    $exports{pipeline} = sub {
        subname "Data::Pipeline::Machine::pipeline" => sub {
            my $n;
            if(ref $_[0]) {
                $n = 'finally';
            }
            else {
                $n = shift;
            }
            if( @_ > 1 ) {
                $machine -> add_pipeline($n => [ @_ ]);
            }
            else {
                $machine -> add_pipeline($n =>  @_ );
            }
        };
    };

    # initial caps because this is used as if it were an action
    $exports{Option} = sub {
        my $class = $CALLER;
        my $machine = _machine($class);
        return subname "Data::Pipeline::Machine::Option" => sub {
            my($name, %options) = @_;
            return Data::Pipeline::Iterator -> new( coded_source => sub {
                #print STDERR caller(), "\n";
                #print STDERR "$machine -> Option( $name )\n";
                #print STDERR "has option\n" if Data::Pipeline::Machine::has_option($name);
                #print STDERR "options available: ", join(", ", keys %Data::Pipeline::Macine::current_options), "\n";
		#print STDERR "$name => ", Data::Pipeline::Machine::get_option($name), "\n";
                to_IteratorSource( Data::Pipeline::Machine::has_option($name) ?
                    Data::Pipeline::Machine::get_option($name) :
                    $options{default}
                );
            } )
            ;
        };
    };

    $exports{Pipeline} = sub {