File Coverage

blib/lib/Sub/Exporter/ForMethods.pm

Criterion	Covered	Total	%
statement	33	37	89.1
branch	3	4	75.0
condition	2	3	66.6
subroutine	13	15	86.6
pod	1	2	50.0
total	52	61	85.2

use strict;
use warnings;
package Sub::Exporter::ForMethods 0.100055;
# ABSTRACT: helper routines for using Sub::Exporter to build methods

use Scalar::Util ();
use Sub::Util ();

use Sub::Exporter 0.978 -setup => {
  exports => [ qw(method_installer method_goto_installer) ],
};

#pod =head1 SYNOPSIS
#pod
#pod In an exporting library:
#pod
#pod   package Method::Builder;
#pod
#pod   use Sub::Exporter::ForMethods qw(method_installer);
#pod
#pod   use Sub::Exporter -setup => {
#pod     exports   => [ method => \'_method_generator' ],
#pod     installer => method_installer,
#pod   };
#pod
#pod   sub _method_generator {
#pod     my ($self, $name, $arg, $col) = @_;
#pod     return sub { ... };
#pod   };
#pod
#pod In an importing library:
#pod
#pod   package Vehicle::Autobot;
#pod   use Method::Builder method => { -as => 'transform' };
#pod
#pod =head1 DESCRIPTION
#pod
#pod The synopsis section, above, looks almost indistinguishable from any other
#pod use of L, apart from the use of
#pod C.  It is nearly indistinguishable in behavior, too.  The
#pod only change is that subroutines exported from Method::Builder into named slots
#pod in Vehicle::Autobot will be wrapped in a subroutine called
#pod C.  This will insert a named frame into stack
#pod traces to aid in debugging.
#pod
#pod More importantly (for the author, anyway), they will not be removed by
#pod L.  This makes the following code
#pod work:
#pod
#pod   package MyLibrary;
#pod
#pod   use Math::Trig qw(tan);         # uses Exporter.pm
#pod   use String::Truncate qw(trunc); # uses Sub::Exporter's defaults
#pod
#pod   use Sub::Exporter::ForMethods qw(method_installer);
#pod   use Mixin::Linewise { installer => method_installer }, qw(read_file);
#pod
#pod   use namespace::autoclean;
#pod
#pod   ...
#pod
#pod   1;
#pod
#pod After MyLibrary is compiled, C will remove C and
#pod C as foreign contaminants, but will leave C in place.  It
#pod will also remove C, an added win.
#pod
#pod =head1 EXPORTS
#pod
#pod Sub::Exporter::ForMethods offers only one routine for export, and it may also
#pod be called by its full package name:
#pod
#pod =head2 method_installer
#pod
#pod   my $installer = method_installer(\%arg);
#pod
#pod This routine returns an installer suitable for use as the C argument
#pod to Sub::Exporter.  It updates the C<\@to_export> argument to wrap all code that
#pod will be installed by name in a named subroutine, then passes control to the
#pod default Sub::Exporter installer.
#pod
#pod The only argument to C is an optional hashref which may
#pod contain a single entry for C.  If the value for C is true,
#pod when a blessed subroutine is wrapped, the wrapper will be blessed into the same
#pod package.
#pod
#pod =cut

sub method_installer {
  _generic_method_installer(
    sub { my $code = shift; sub { $code->(@_) } },
    @_,
  );
}

sub method_goto_installer {
  _generic_method_installer(
    sub { my $code = shift; sub { goto &$code } },
    @_,
  );
}

sub _generic_method_installer {
  my $generator = shift;

  my ($mxi_arg) = @_;
  my $rebless   = $mxi_arg->{rebless};

  sub {
    my ($arg, $to_export) = @_;

    my $into = $arg->{into};

    for (my $i = 0; $i < @$to_export; $i += 2) {
      my ($as, $code) = @$to_export[ $i, $i+1 ];

      next if ref $as;
      my $sub = $generator->($code);
      if ($rebless and defined (my $code_pkg = Scalar::Util::blessed($code))) {
        bless $sub, $code_pkg;
      }

      $to_export->[ $i + 1 ] = Sub::Util::set_subname(
        join(q{::}, $into, $as),
        $sub,
      );
    }

    Sub::Exporter::default_installer($arg, $to_export);
  };
}

1;

__END__