File Coverage

blib/lib/Sub/Exporter/GlobExporter.pm

Criterion	Covered	Total	%
statement	33	34	97.0
branch	7	8	87.5
condition	2	3	66.6
subroutine	9	9	100.0
pod	0	1	0.0
total	51	55	92.7

use strict;
use warnings;
package Sub::Exporter::GlobExporter;
{
  $Sub::Exporter::GlobExporter::VERSION = '0.004';
}
# ABSTRACT: export shared globs with Sub::Exporter collectors

use Scalar::Util ();

use Sub::Exporter -setup => [ qw(glob_exporter) ];


my $is_ref;
BEGIN {
  $is_ref = sub {
    return(
      !  Scalar::Util::blessed($_[0])
      && Scalar::Util::reftype($_[0]) eq $_[1]
    );
  };
}

sub glob_exporter {
  my ($default_name, $globref) = @_;

  my $globref_method = $is_ref->($globref, 'GLOB')   ? sub { $globref }
                     : $is_ref->($globref, 'SCALAR') ? $$globref
                     : Carp::confess("illegal glob locator '$globref'");

  return sub {
    my ($value, $data) = @_;

    my @args = defined $value
      ? ({ map {; $_ => $value->{$_} } grep { ! /^-/ } keys %$value })
      : ();

    my $globref = $data->{class}->$globref_method(@args);

    # allow a SCALAR ref in the future to do ($$as = $globref) as we allow subs
    # to be exported into scalar refs -- rjbs, 2010-11-23
    my $name;
    $name = defined $value->{'-as'} ? $value->{'-as'} : $default_name;

    my $sym = "$data->{into}::$name";

    {
      no strict 'refs';
      *{$sym} = *$globref;
    }

    $_[0] = $globref;
    return 1;
  }
}

1;

__END__