our %Variable;
+my $sanitize_importing = sub {
+ my ($me, $spec) = @_;
+ return []
+ unless defined $spec;
+ my @specced =
+ not(ref $spec)
+ ? ($spec)
+ : (ref($spec) eq 'ARRAY')
+ ? (@$spec)
+ : (ref($spec) eq 'HASH')
+ ? (map {
+ croak qq{The import argument list for '$_' is not an array ref}
+ unless ref($spec->{$_}) eq 'ARRAY';
+ ($_ => $spec->{$_});
+ } sort keys %$spec)
+ : croak q{The 'importing' option has to be either a hash or array ref};
+ my @imports;
+ my $arg_count = 1;
+ while (@specced) {
+ my $key = shift @specced;
+ croak qq{Value $arg_count in 'importing' is not a package string},
+ $arg_count
+ unless defined($key) and not(ref $key);
+ $arg_count++;
+ my $import_args =
+ (not(@specced) or (defined($specced[0]) and not ref($specced[0])))
+ ? []
+ : (ref($specced[0]) eq 'ARRAY')
+ ? do { $arg_count++; shift @specced }
+ : croak(
+ qq{Value $arg_count for package '$key' in 'importing' is not}
+ . qq{ a package string or array ref}
+ );
+ push @imports, [$key, $import_args];
+ }
+ return \@imports;
+};
+
sub import {
my $target = caller;
my $me = shift;
no strict 'refs';
$Variable{$variable} = {
anon => $anon,
- args => \%args,
+ args => {
+ %args,
+ importing => $me->$sanitize_importing($args{importing}),
+ },
subs => {
map +($_ => sub {}), @{$args{subs}||[]},
},
}
}
-my $sanitize_importing = sub {
- my ($me, $spec) = @_;
- return []
- unless defined $spec;
- return [map {
- my $import_args = $spec->{$_};
- croak sprintf q{Import argument list for '%s' are is an array ref},
- $_,
- unless ref($import_args) and ref($import_args) eq 'ARRAY';
- [$_ => $import_args];
- } keys %$spec]
- if ref $spec eq 'HASH';
- croak q{The 'importing' option has to be either a hash or array ref}
- unless ref $spec eq 'ARRAY';
- my @specced = @$spec;
- my @imports;
- while (@specced) {
- my $key = shift @specced;
- push @imports, [
- $key,
- (ref($specced[0]) and ref($specced[0]) eq 'ARRAY')
- ? shift(@specced)
- : [],
- ];
- }
- return \@imports;
-};
-
sub build_variant_of {
my ($me, $variable, @args) = @_;
my $variant_name = "${variable}::_Variant_".++$Variable{$variable}{anon};
- my $import = $me
- ->$sanitize_importing($Variable{$variable}{args}{importing});
+ my $import = $Variable{$variable}{args}{importing};
my $setup = join("\n",
"package ${variant_name};",
(map sprintf(
The import method will be called even if the list of import arguments is
empty or not specified,
+If you just want to import a single package's default exports, you can
+also pass a string instead:
+
+ use PAckage::Variant importing => 'Package';
+
=head2 subs
An array reference of strings listing the names of subroutines that should
=head1 AUTHOR
-=over
+mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
-=item mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
+=head1 CONTRIBUTORS
-=back
+phaylon - Robert Sedlacek (cpan:PHAYLON) <r.sedlacek@shadowcat.co.uk>
=head1 COPYRIGHT
-Copyright (c) 2010-2011 the C<Package::Stash> L</AUTHOR> as listed above.
+Copyright (c) 2010-2011 the C<Package::Variant> L</AUTHOR> and
+L</CONTRIBUTORS> as listed above.
=head1 LICENSE