File Coverage

blib/lib/Sub/Chain.pm

Criterion	Covered	Total	%
statement	52	59	88.1
branch	13	24	54.1
condition	11	16	68.7
subroutine	13	13	100.0
pod	4	4	100.0
total	93	116	80.1

# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
#
# This file is part of Sub-Chain
#
# This software is copyright (c) 2010 by Randy Stauner.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;

package Sub::Chain;
BEGIN {
  $Sub::Chain::VERSION = '0.012';
}
BEGIN {
  $Sub::Chain::AUTHORITY = 'cpan:RWSTAUNER';
}
# ABSTRACT: Chain subs together and call in succession

use Carp qw(croak carp);

# enable object to be called like a coderef
use overload
  '&{}' => \&coderef,
  fallback => 1;

use Object::Enum 0.072 ();

our %Enums = (
  result => Object::Enum->new({unset => 0, default => 'replace',
    values => [qw(replace discard)]}),
  on_undef => Object::Enum->new({unset => 0, default => 'proceed',
    values => [qw(skip blank proceed)]}),
);


sub new {
  my $class = shift;
  my %opts = ref $_[0] ? %{$_[0]} : @_;

  my $self = {
    chain => []
  };
  bless $self, $class;

  $self->_copy_enums(\%opts);

  return $self;
}


sub append {
  my ($self, $sub, $args, $opts) = @_;

  # TODO: normalize_spec (better than this):
  $args ||= [];
  $opts ||= {};
  $self->_copy_enums($opts, $opts);

  CORE::push(@{ $self->{chain} }, [$sub, $args, $opts]);
  # allow calls to be chained
  return $self;
}


sub call {
  my ($self, @args) = @_;
  # cache function call
  my $wantarray = wantarray;

  my @chain = @{ $self->{chain} };
  carp("No subs appended to the chain")
    unless @chain;

  foreach my $tr ( @chain ){
    my ($sub, $extra, $opts) = @$tr;
    my @all = (@args, @$extra);
    my @result;

    # TODO: instead of duplicating enum objects do %opts = (%$self, %$opts)
    if( @args && $opts->{on_undef} && !defined($args[0]) ){
      next if $opts->{on_undef}->is_skip;
      $args[0] = ''
        if $opts->{on_undef}->is_blank;
    }

    # call sub with same context as this
    if( !defined $wantarray ){
      $sub->(@all);
    }
    elsif( $wantarray ){
      @result    = $sub->(@all);
    }
    else {
      $result[0] = $sub->(@all);
    }
    @args = @result
      if $opts->{result}->is_replace;
  }

  # if 'result' isn't 'replace' what would be a good return value?
  # would they expect one?

  # return value appropriate for context
  if( !defined $wantarray ){
    return;
  }
  elsif( $wantarray ){
    return @args;
  }
  else {
    return $args[0];
  }
}


sub coderef {
  my ($self) = @_;
  return sub { $self->call(@_); }
}

sub _copy_enums {
  my ($self, $from, $to) = @_;
  $to ||= $self;
  while( my ($name, $enum) = each %Enums ){
    $to->{$name} = ($self->{$name} || $enum)->clone(
      # use the string passed in
      exists $from->{$name} ? $from->{$name} :
        # clone from the default value saved on the instance
        $self->{$name} ? $self->{$name}->value : ()
    );
  };
}

1;


# TODO: link to questions on perlmonks and stackoverflow?


__END__