view release on metacpan or  search on metacpan

lib/Exporter/Extensible.pm  view on Meta::CPAN

	*_exporter_get_coderef_name= $impl;
	$impl->(shift);
}

sub _exporter_get_ref_to_package_var {
	my ($class, $sigil, $name)= @_;
	unless (defined $name) {
		($sigil, $name)= ($_[1] =~ /^([\$\@\%\*\&]?)(\w+)$/)
			or $croak->("'$_[1]' is not an allowed variable name");
	}
	my $reftype= $sigil_to_reftype{$sigil};
	return undef unless ${$class.'::'}{$name};
	return $reftype eq 'GLOB'? \*{$class.'::'.$name} : *{$class.'::'.$name}{$reftype};
}

sub _exporter_process_attribute {
	my ($class, $coderef, $attr)= @_;
	if ($attr =~ /^Export(?:\(\s*(.*?)\s*\))?$/) {
		my (%tags, $subname, @export_names);
		# If given a list in parenthesees, split on space and proces each.  Else use the name of the sub itself.
		for my $token ($1? split(/\s+/, $1) : ()) {
			if ($token =~ /^:(.*)$/) {
				$tags{$1}++; # save tags until we have the export_names
			}
			elsif ($token =~ /^\w+$/) {
				push @export_names, $token;
				${$class.'::EXPORT'}{$token}= $coderef;
			}
			elsif ($token =~ /^-(\w*)(?:\(([0-9]+|\*|\?)\))?$/) {
				$subname ||= _exporter_get_coderef_name($coderef);
				push @export_names, length $1? $token : "-$subname";
				$class->exporter_register_option(substr($export_names[-1],1), $subname, $2);
			}
			elsif (my($sym, $name)= ($token =~ /^=([\&\$\@\%\*:]?(\w*))$/)) {
				$subname ||= _exporter_get_coderef_name($coderef);
				my $export_name= length $name? $sym : do {
					(my $x= $subname) =~ s/^_generate[A-Za-z]*_//;
					$sym . $x
				};
				$export_name =~ s/^[&]//;
				$class->exporter_register_generator($export_name, $subname);
				push @export_names, $export_name;
			}
			else {
				$croak->("Invalid export notation '$token'");
			}
		}
		if (!@export_names) { # if list was empty or only tags...
			push @export_names, _exporter_get_coderef_name($coderef);
			${$class.'::EXPORT'}{$export_names[-1]}= $coderef;
		}
		$class->exporter_register_tag_members($_, @export_names) for keys %tags;
		return 1;
	}
	return;
}

sub exporter_setup {
	my ($self, $version)= @_;
	push @{$self->{into}.'::ISA'}, ref($self);
	strict->import;
	warnings->import;
	if ($version == 1) {
		# Declare 'our %EXPORT'
		*{$self->{into}.'::EXPORT'}= \%{$self->{into}.'::EXPORT'};
		# Make @EXPORT and $EXPORT_TAGS{default} be the same arrayref.
		# Allow either one to have been declared already.
		my $tags= \%{$self->{into}.'::EXPORT_TAGS'};
		*{$self->{into}.'::EXPORT'}= $tags->{default}
			if ref $tags->{default} eq 'ARRAY';
		$tags->{default} ||= \@{$self->{into}.'::EXPORT'};
		# Export the 'export' function.
		*{$self->{into}.'::export'}= \&_exporter_export_from_caller;
	}
	elsif ($version) {
		$croak->("Unknown export API version $version");
	}
}

sub _exporter_export_from_caller {
	unshift @_, scalar caller;
	goto $_[0]->can('exporter_export');
}
sub exporter_export {
	my $class= shift;
	my ($export, $is_gen, $sigil, $name, $args, $ref);
	arg_loop: for (my $i= 0; $i < @_;) {
		$export= $_[$i++];
		ref $export and $croak->("Expected non-ref export name at argument $i");
		# If they provided the ref, capture it from arg list.
		$ref= ref $_[$i]? $_[$i++] : undef;
		# Common case first - ordinary functions
		if ($export =~ /^\w+$/) {
			if ($ref) {
				ref $ref eq 'CODE' or $croak->("Expected CODEref following '$export'");
			} else {
				$ref= $class->can($export) or $croak->("Export '$export' not found in $class");
			}
			${$class.'::EXPORT'}{$export}= $ref;
		}
		# Next, check for generators
		elsif (($is_gen, $sigil, $name)= ($export =~ /^(=?)([\$\@\%\*]?)(\w+)$/)) {
			if ($is_gen) {
				if ($ref) {
					# special case, remove ref on method name (since it isn't possible to pass
					# a plain scalar as the second asrgument)
					$ref= $$ref if ref $ref eq 'SCALAR';
					$class->exporter_register_generator($sigil.$name, $ref);
				} else {
					for (@{ $sigil_to_generator_prefix{$sigil} }) {
						my $method= $_ . $name;
						if ($class->can($method)) {
							$class->exporter_register_generator($sigil.$name, $method);
							next arg_loop;
						}
					}
					$croak->("Export '$export' not found in package $class, nor a generator $sigil_to_generator_prefix{$sigil}[0]");
				}
			}
			else {
				$ref ||= $class->_exporter_get_ref_to_package_var($sigil, $name);
				ref $ref eq $sigil_to_reftype{$sigil} or (ref $ref eq 'REF' && $sigil eq '$')
					or $croak->("'$export' should be $sigil_to_reftype{$sigil} but you supplied ".ref($ref));
				${$class.'::EXPORT'}{$sigil.$name}= $ref;
			}
		}
		# Tags ":foo"
		elsif (($is_gen, $name)= ($export =~ /^(=?):(\w+)$/)) {
			if ($is_gen && !$ref) {
				my $gen= $sigil_to_generator_prefix{':'}.$name;
				$class->can($gen)
					or $croak->("Can't find generator for tag $name : '$gen'");
				$ref= $gen;
			}
			ref $ref eq 'ARRAY'? $class->exporter_register_tag_members($name, @$ref)
				: $class->exporter_register_generator($export, $ref);
		}
		# Options "-foo" or "-foo(3)"
		elsif (($name, $args)= ($export =~ /^-(\w+)(?:\(([0-9]+|\*|\?)\))?$/)) {
			if ($ref) {
				ref $ref eq 'CODE' or (ref $ref eq 'SCALAR' and $class->can($ref= $$ref))
					or $croak->("Option '$export' must be followed by coderef or method name as scalar ref");
			} else {
				$class->can($name)
					or $croak->("Option '$export' defaults to a method '$name' which does not exist on $class");
				$ref= $name;
			}
			$class->exporter_register_option($name, $ref, $args);
		}
		else {
			$croak->("'$export' is not a valid export syntax");
		}
	}
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Exporter::Extensible - Create easy-to-extend modules which export symbols

=head1 SYNOPSIS

Define a module with exports

  package My::Utils;
  use Exporter::Extensible -exporter_setup => 1;

  export(qw( foo $x @STUFF -strict_and_warnings ), ':baz' => ['foo'] );

  sub foo { ... }

  sub strict_and_warnings {
    strict->import;
    warnings->import;
  }

Create a new module which exports all that, and more

  package My::MoreUtils;
  use My::Utils -exporter_setup => 1;
  sub util_fn3 : Export(:baz) { ... }

Use the module

  use My::MoreUtils qw( -strict_and_warnings :baz @STUFF );
  # Use the exported things
  push @STUFF, foo(), util_fn3();

=head1 DESCRIPTION

As a module author, you have dozens of exporters to choose from, so I'll try to get straight to
the pros/cons of this module:

=head2 Pros

=over

=item Extend Your Module

This exporter focuses on the ability and ease of letting you "subclass" a module-with-exports to
create a derived module-with-exports.  It supports multiple inheritance, for things like tying
together all your utility modules into a mega-utility module.

=item Extend Behavior of C<import>

This exporter supports lots of ways to add custom processing during 'import' without needing to
dig into the implementation.

=item More than just subs

This module supports exporting C<foo>, C<$foo>, C<@foo>, C<%foo>, or even C<*foo>.  It also
supports tags (C<:foo>) and options (C<-foo>).

=item Be Lazy

This exporter supports on-demand generators for symbols, as well as tags!  So if you have a
complicated or expensive list of exports you can wait until the first time each is requested
before finding out whether it is available or loading the dependent module.

=item Full-featured

This exporter attempts to copy useful features from other popular exporters, like renaming
imports with C<-prefix>/C<-suffix>/C<-as>, excluding symbols with C<-not>, scoped-unimport,
passing options to generators, importing to things other than C<caller>, etc.

=item More-Than-One-Way-To-Declare-Exports

Pick your favorite.  You can use the L<export> do-what-I-mean function, method attributes, the
C<< __PACKAGE__->exporter_ ... >> API, or declare package variables similar to L<Exporter>.

=item No Non-core Dependencies (for Perl E<8805> 5.12)

Because nobody likes big dependency trees.