File Coverage

blib/lib/Sub/Lib.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	16	16	100.0
condition			n/a
subroutine	7	7	100.0
pod	4	4	100.0
total	61	61	100.0

package Sub::Lib;

use strict;
use warnings;

our $VERSION = '0.01';

sub new {
  my ($class, @args) = @_;

  my $args;
  if(1 == @args) {
    die "reference argument to new() must be a HASH\n"
      unless 'HASH' eq ref $args[0];
    $args = $args[0];
  }
  else {
    die "non-reference argument list to new() must have an even number of elements\n"
      unless 0 == @args % 2;
    $args = {@args};
  }

  # \o/ Lobe den Abgrund
  my $self = bless do {
    my $_lib = { };
    sub {
      my ($name, $sub) = @_;

      return $_lib
        unless defined $name;

      if(defined $sub) {
        die "sub-routine ($name) is not a sub-routine?\n"
          unless 'CODE' eq ref $sub;
        die "sub-routine ($name) already installed in library\n"
          if exists $_lib->{$name};

        $_lib->{$name} = $sub;
      }
      else {
        die "sub-routine ($name) not installed in library\n"
          unless exists $_lib->{$name};
      }

      return $_lib->{$name};
    }
  }, $class;

  $self->($_, $args->{$_})
    for keys %$args;
  return $self;
}

sub has {
  my ($self, $name) = @_;

  my $_lib = $self->();
  return $_lib->{$name};
}

sub run {
  my ($self, $name, @args) = @_;

  return $self->($name)->(@args);
}

sub call {
  my ($self, $name, $object, @args) = @_;

  my $sub = $self->($name);
  return $object->$sub(@args);
}

1
__END__