Exporter-Declare-0.113000755001750001750 012154252374 15211 5ustar00exodistexodist000000000000Exporter-Declare-0.113/META.yml000444001750001750 274712154252374 16631 0ustar00exodistexodist000000000000--- abstract: 'Exporting done right' author: - 'Chad Granum ' build_requires: Fennec::Lite: 0.004 Test::Exception: 0.29 Test::Simple: 0.88 configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Exporter-Declare provides: Exporter::Declare: file: lib/Exporter/Declare.pm version: 0.113 Exporter::Declare::Export: file: lib/Exporter/Declare/Export.pm version: 0 Exporter::Declare::Export::Alias: file: lib/Exporter/Declare/Export/Alias.pm version: 0 Exporter::Declare::Export::Generator: file: lib/Exporter/Declare/Export/Generator.pm version: 0 Exporter::Declare::Export::Sub: file: lib/Exporter/Declare/Export/Sub.pm version: 0 Exporter::Declare::Export::Variable: file: lib/Exporter/Declare/Export/Variable.pm version: 0 Exporter::Declare::Meta: file: lib/Exporter/Declare/Meta.pm version: 0 Exporter::Declare::Specs: file: lib/Exporter/Declare/Specs.pm version: 0 requires: Carp: 0 Meta::Builder: 0.003 Scalar::Util: 0 aliased: 0 perl: v5.8.0 resources: bugtracker: http://github.com/exodist/Exporter-Declare/issues homepage: http://open-exodus.net/projects/Exporter-Declare license: http://dev.perl.org/licenses/ repository: http://github.com/exodist/Exporter-Declare version: 0.113 Exporter-Declare-0.113/Changes000444001750001750 42212154252374 16617 0ustar00exodistexodist000000000000WARNING: This file is very likely to get out of date, I almost never remeber to update it. 0.111: * Fix broken inheritance, better fix for UNIVERAL::can sillyness 0.110: * Fixed 'can() used as function' warning that sometimes happens * Fixed brocken magic.t unit test Exporter-Declare-0.113/README000444001750001750 3105012154252374 16245 0ustar00exodistexodist000000000000NAME Exporter::Declare - Exporting done right DESCRIPTION Exporter::Declare is a meta-driven exporting tool. Exporter::Declare tries to adopt all the good features of other exporting tools, while throwing away horrible interfaces. Exporter::Declare also provides hooks that allow you to add options and arguments for import. Finally, Exporter::Declare's meta-driven system allows for top-notch introspection. FEATURES Declarative exporting (like Moose for exporting) Meta-driven for introspection Customizable import() method Export groups (tags) Export generators for subs and variables Clear and concise OO API Exports are blessed, allowing for more introspection Import syntax based off of Sub::Exporter Packages export aliases SYNOPSIS EXPORTER package Some::Exporter; use Exporter::Declare; default_exports qw/ do_the_thing /; exports qw/ subA subB $SCALAR @ARRAY %HASH /; # Create a couple tags (import lists) export_tag subs => qw/ subA subB do_the_thing /; export_tag vars => qw/ $SCALAR @ARRAY %HASH /; # These are simple boolean options, pass '-optionA' to enable it. import_options qw/ optionA optionB /; # These are options which slurp in the next argument as their value, pass # '-optionC' => 'foo' to give it a value. import_arguments qw/ optionC optionD /; export anon_export => sub { ... }; export '@anon_var' => [...]; default_export a_default => sub { 'default!' } our $X = "x"; default_export '$X'; my $iterator = 'a'; gen_export unique_class_id => sub { my $current = $iterator++; return sub { $current }; }; gen_default_export '$my_letter' => sub { my $letter = $iterator++; return \$letter; }; # You can create a function to mangle the arguments before they are # parsed into a Exporter::Declare::Spec object. sub alter_import_args { my ($class, $args) = @_; # fiddle with args before importing routines are called @$args = grep { !/^skip_/ } @$args } # There is no need to fiddle with import() or do any wrapping. # the $specs data structure means you generally do not need to parse # arguments yourself (but you can if you want using alter_import_args()) # Change the spec object before export occurs sub before_import { my $class = shift; my ( $importer, $specs ) = @_; if ($specs->config->{optionA}) { # Modify $spec attributes accordingly } } # Use spec object after export occurs sub after_import { my $class = shift; my ( $importer, $specs ) = @_; do_option_a() if $specs->config->{optionA}; do_option_c( $specs->config->{optionC} ) if $specs->config->{optionC}; print "-subs tag was used\n" if $specs->config->{subs}; print "exported 'subA'\n" if $specs->exports->{subA}; } ... IMPORTER package Some::Importer; use Some::Exporter qw/ subA $SCALAR !%HASH /, -default => { -prefix => 'my_' }, qw/ -optionA !-optionB /, subB => { -as => 'sub_b' }; subA(); print $SCALAR; sub_b(); my_do_the_thing(); ... IMPORT INTERFACE Importing from a package that uses Exporter::Declare will be familiar to anyone who has imported from modules before. Arguments are all assumed to be export names, unless prefixed with "-" or ":" In which case they may be a tag or an option. Exports without a sigil are assumed to be code exports, variable exports must be listed with their sigil. Items prefixed with the "!" symbol are forcfully excluded, regardless of any listed item that may normally include them. Tags can also be excluded, this will effectively exclude everything in the tag. Tags are simply lists of exports, the exporting class may define any number of tags. Exporter::Declare also has the concept of options, they have the same syntax as tags. Options may be boolean or argument based. Boolean options are actually 3 value, undef, false "!", or true. Argument based options will grab the next value in the arguments list as their own, regardless of what type of value it is. When you use the module, or call import(), all the arguments are transformed into an Exporter::Declare::Specs object. Arguments are parsed for you into a list of imports, and a configuration hash in which tags/options are keys. Tags are listed in the config hash as true, false, or undef depending on if they were included, negated, or unlisted. Boolean options will be treated in the same way as tags. Options that take arguments will have the argument as their value. SELECTING ITEMS TO IMPORT Exports can be subs, or package variables (scalar, hash, array). For subs simply ask for the sub by name, you may optionally prefix the subs name with the sub sigil "&". For variables list the variable name along with its sigil "$, %, or @". use Some::Exporter qw/ somesub $somescalar %somehash @somearray /; TAGS Every exporter automatically has the following 3 tags, in addition they may define any number of custom tags. Tags can be specified by their name prefixed by either "-" or ":". -all This tag may be used to import everything the exporter provides. -default This tag is used to import the default items exported. This will be used when no argument is provided to import. -alias Every package has an alias that it can export. This is the last segmant of the packages namespace. IE "My::Long::Package::Name::Foo" could export the "Foo()" function. These alias functionis simply return the full package name as a string, in this case 'My::Long::Package::Name::Foo'. This is similar to aliased. The -alias tag is a shortcut so that you do not need to think about what the alias name would be when adding it to the import arguments. use My::Long::Package::Name::Foo -alias; my $foo = Foo()->new(...); RENAMING IMPORTED ITEMS You can prefix, suffix, or completely rename the items you import. Whenever an item is followed by a hash in the import list, that hash will be used for configuration. Configuration items always start with a dash "-". The 3 available configuration options that effect import names are "-prefix", "-suffix", and "-as". If "-as" is seen it will be used as is. If prefix or suffix are seen they will be attached to the original name (unless -as is present in which case they are ignored). use Some::Exporter subA => { -as => 'DoThing' }, subB => { -prefix => 'my_', -suffix => '_ok' }; The example above will import "subA()" under the name "DoThing()". It will also import "subB()" under the name "my_subB_ok()". You may als specify a prefix and/or suffix for tags. The following example will import all the default exports with 'my_' prefixed to each name. use Some::Exporter -default => { -prefix => 'my_' }; OPTIONS Some exporters will recognise options. Options look just like tags, and are specified the same way. What options do, and how they effect things is exporter-dependant. use Some::Exporter qw/ -optionA -optionB /; ARGUMENTS Some options require an argument. These options are just like other tags/options except that the next item in the argument list is slurped in as the option value. use Some::Exporter -ArgOption => 'Value, not an export', -ArgTakesHash => { ... }; Once again available options are exporter specific. PROVIDING ARGUMENTS FOR GENERATED ITEMS Some items are generated at import time. These items may accept arguments. There are 3 ways to provide arguments, and they may all be mixed (though that is not recommended). As a hash use Some::Exporter generated => { key => 'val', ... }; As an array use Some::Exporter generated => [ 'Arg1', 'Arg2', ... ]; As an array in a config hash use Some::Exporter generated => { -as => 'my_gen', -args => [ 'arg1', ... ]}; You can use all three at once, but this is really a bad idea, documented for completeness: use Some::Exporter generated => { -as => 'my_gen, key => 'value', -args => [ 'arg1', 'arg2' ]} generated => [ 'arg3', 'arg4' ]; The example above will work fine, all the arguments will make it into the generator. The only valid reason for this to work is that you may provide arguments such as "-prefix" to a tag that brings in generator(), while also desiring to give arguments to generator() independantly. PRIMARY EXPORT API With the exception of import(), all the following work equally well as functions or class methods. import( @args ) The import() class method. This turns the @args list into an Exporter::Declare::Specs object. exports( @add_items ) Add items to be exported. @list = exports() Retrieve list of exports. default_exports( @add_items ) Add items to be exported, and add them to the -default tag. @list = default_exports() List of exports in the -default tag import_options(@add_items) Specify boolean options that should be accepted at import time. import_arguments(@add_items) Specify options that should be accepted at import that take arguments. export_tag( $name, @add_items ); Define an export tag, or add items to an existing tag. EXTENDED EXPORT API These all work fine in function or method form, however the syntax sugar will only work in function form. reexport( $package ) Make this exporter inherit all the exports and tags of $package. Works for Exporter::Declare or Exporter.pm based exporters. Re-Exporting of Sub::Exporter based classes is not currently supported. export_to( $package, @args ) Export to the specified class. export( $name ) export( $name, $ref ) export is a keyword that lets you export any 1 item at a time. The item can be exported by name, or name + ref. When a ref is provided, the export is created, but there is no corresponding variable/sub in the packages namespace. default_export( $name ) default_export( $name, $ref ) gen_export( $name ) gen_export( $name, $ref ) gen_default_export( $name ) gen_default_export( $name, $ref ) These all act just like export(), except that they add subrefs as generators, and/or add exports to the -default tag. MAGIC Please use Exporter::Declare::Magic directly from now on. DEPRECATED USAGE OF MAGIC use Exporter::Declare '-magic'; This adds Devel::Declare magic to several functions. It also allows you to easily create or use parsers on your own exports. See Exporter::Declare::Magic for more details. You can also provide import arguments to Devel::Declare::Magic # Arguments to -magic must be in an arrayref, not a hashref. use Exporter::Declare -magic => [ '-default', '!export', -prefix => 'magic_' ]; INTERNAL API Exporter/Declare.pm does not have much logic to speak of. Rather Exporter::Declare is sugar on top of class meta data stored in Exporter::Declare::Meta objects. Arguments are parsed via Exporter::Declare::Specs, and also turned into objects. Even exports are blessed references to the exported item itself, and handle the injection on their own (See Exporter::Declare::Export). META CLASS All exporters have a meta class, the only way to get the meta object is to call the exporter_meta() method on the class/object that is an exporter. Any class that uses Exporter::Declare gets this method, and a meta-object. AUTHORS Chad Granum exodist7@gmail.com COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/META.json000444001750001750 452612154252374 16776 0ustar00exodistexodist000000000000{ "abstract" : "Exporting done right", "author" : [ "Chad Granum " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Exporter-Declare", "prereqs" : { "build" : { "requires" : { "Fennec::Lite" : "0.004", "Test::Exception" : "0.29", "Test::Simple" : "0.88" } }, "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "requires" : { "Carp" : "0", "Meta::Builder" : "0.003", "Scalar::Util" : "0", "aliased" : "0", "perl" : "v5.8.0" } } }, "provides" : { "Exporter::Declare" : { "file" : "lib/Exporter/Declare.pm", "version" : "0.113" }, "Exporter::Declare::Export" : { "file" : "lib/Exporter/Declare/Export.pm", "version" : 0 }, "Exporter::Declare::Export::Alias" : { "file" : "lib/Exporter/Declare/Export/Alias.pm", "version" : 0 }, "Exporter::Declare::Export::Generator" : { "file" : "lib/Exporter/Declare/Export/Generator.pm", "version" : 0 }, "Exporter::Declare::Export::Sub" : { "file" : "lib/Exporter/Declare/Export/Sub.pm", "version" : 0 }, "Exporter::Declare::Export::Variable" : { "file" : "lib/Exporter/Declare/Export/Variable.pm", "version" : 0 }, "Exporter::Declare::Meta" : { "file" : "lib/Exporter/Declare/Meta.pm", "version" : 0 }, "Exporter::Declare::Specs" : { "file" : "lib/Exporter/Declare/Specs.pm", "version" : 0 } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://github.com/exodist/Exporter-Declare/issues" }, "homepage" : "http://open-exodus.net/projects/Exporter-Declare", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/exodist/Exporter-Declare" } }, "version" : "0.113" } Exporter-Declare-0.113/MANIFEST000444001750001750 104012154252374 16472 0ustar00exodistexodist000000000000Build.PL Changes lib/Exporter/Declare.pm lib/Exporter/Declare/Export.pm lib/Exporter/Declare/Export/Alias.pm lib/Exporter/Declare/Export/Generator.pm lib/Exporter/Declare/Export/Sub.pm lib/Exporter/Declare/Export/Variable.pm lib/Exporter/Declare/Meta.pm lib/Exporter/Declare/Specs.pm MANIFEST This list of files META.json META.yml README t/Declare.t t/Export.t t/Generator.t t/Inheritance.t t/lib/InheritanceChild.pm t/lib/InheritanceParent.pm t/Magic.t t/Meta.t t/Meta_From_Old.t t/misc.t t/pod.t t/reexport.t t/Specs.t t/Sub.t t/Variable.t Exporter-Declare-0.113/Build.PL000444001750001750 157512154252374 16652 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Exporter::Declare', license => 'perl', dist_author => 'Chad Granum ', create_readme => 1, requires => { 'perl' => '5.8.0', 'Carp' => 0, 'Scalar::Util' => 0, 'aliased' => 0, 'Meta::Builder' => '0.003', }, build_requires => { 'Test::Simple' => 0.88, 'Fennec::Lite' => '0.004', 'Test::Exception' => '0.29', }, meta_merge => { resources => { repository => 'http://github.com/exodist/Exporter-Declare', bugtracker => 'http://github.com/exodist/Exporter-Declare/issues', homepage => 'http://open-exodus.net/projects/Exporter-Declare', }, } ); $build->create_build_script; Exporter-Declare-0.113/t000755001750001750 012154252374 15454 5ustar00exodistexodist000000000000Exporter-Declare-0.113/t/pod.t000444001750001750 35412154252374 16542 0ustar00exodistexodist000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More; plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; eval "use Test::Pod 1.14"; plan skip_all => 'Test::Pod 1.14 required' if $@; all_pod_files_ok(); Exporter-Declare-0.113/t/Specs.t000444001750001750 1346012154252374 17077 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; use aliased 'Exporter::Declare::Meta'; use aliased 'Exporter::Declare::Export::Sub'; use aliased 'Exporter::Declare::Export::Variable'; our $CLASS = "Exporter::Declare::Specs"; require_ok $CLASS; sub TestPackage { 'TestPackage' } our $META = Meta->new( TestPackage ); $META->exports_add( $_, Sub->new( sub {}, exported_by => __PACKAGE__ ) ) for qw/x X xx XX/; my %vars; $META->exports_add( "\$$_", Variable->new( \$vars{$_}, exported_by => __PACKAGE__ ) ) for qw/y Y yy YY/; $META->exports_add( "\@$_", Variable->new( [$_], exported_by => __PACKAGE__ ) ) for qw/z Z zz ZZ/; $META->export_tags_push( 'xxx', qw/x $y @z/ ); $META->export_tags_push( 'yyy', qw/X $Y @Z/ ); $META->arguments_add( 'foo' ); tests construction => sub { my $spec = $CLASS->new( TestPackage ); isa_ok( $spec, $CLASS ); is( $spec->package, TestPackage, "Stored Package" ); isa_ok( $spec->config, 'HASH', "Config" ); isa_ok( $spec->exports, 'HASH', "Exports" ); isa_ok( $spec->excludes, 'ARRAY', "Excludes" ); }; tests util => sub { my $spec = $CLASS->new( TestPackage ); is( Exporter::Declare::Specs::_item_name('a' ), '&a', "Added sigil" ); is( Exporter::Declare::Specs::_item_name('&a'), '&a', "kept sigil" ); is( Exporter::Declare::Specs::_item_name('$a'), '$a', "kept sigil" ); is( Exporter::Declare::Specs::_item_name('%a'), '%a', "kept sigil" ); is( Exporter::Declare::Specs::_item_name('@a'), '@a', "kept sigil" ); is( Exporter::Declare::Specs::_get_item($spec, 'X'), $META->exports_get( 'X' ), "_exports_get" ); is_deeply( [ Exporter::Declare::Specs::_export_tags_get($spec, 'xxx')], [ $META->export_tags_get( 'xxx' )], "_exports_get" ); }; tests exclude_list => sub { my $spec = $CLASS->new( TestPackage ); is_deeply( $spec->excludes, [], "no excludes" ); $spec->_exclude_item( $_ ) for qw/a &b $c %d @e/; is_deeply( $spec->excludes, [qw/&a &b $c %d @e/], "excludes" ); $spec->_exclude_item( $_ ) for qw/q r -xxx :yyy/; is_deeply( $spec->excludes, [qw/&a &b $c %d @e &q &r &x $y @z &X $Y @Z/], "exclude tags" ); }; tests include_list => sub { my $spec = $CLASS->new( TestPackage ); is_deeply( $spec->exports, {}, "Exports is an empty hash" ); $spec->_include_item( 'XX' ); lives_ok { $spec->_include_item( 'XX' ) } "Multiple add is no-op"; is_deeply( $spec->exports, { '&XX' => [ $META->exports_get( 'XX' ), {}, [] ]}, "Added export" ); $spec->_include_item( 'XX', { -a => 'a' }, ['a'] ); is_deeply( $spec->exports, { '&XX' => [ $META->exports_get( 'XX' ), { a => 'a' }, ['a'] ]}, "Added export config" ); $spec->_include_item( 'XX', { -a => 'a', -b => 'b', x => 'y' }, ['a', 'b'] ); is_deeply( $spec->exports, { '&XX' => [ $META->exports_get( 'XX' ), { a => 'a', b => 'b' }, ['a', 'a', 'b', 'x', 'y' ] ]}, "combined configs" ); $spec->_include_item( '-xxx', { -tag => 1, 'param' => 'p' }, [ 'from tag' ] ); is_deeply( $spec->exports, { '&XX' => [ $META->exports_get( 'XX' ), { a => 'a', b => 'b' }, [ 'a', 'a', 'b', 'x', 'y' ]], '&x' => [ $META->exports_get( '&x' ), { tag => 1 }, [ 'from tag', 'param', 'p' ]], '$y' => [ $META->exports_get( '$y' ), { tag => 1 }, [ 'from tag', 'param', 'p' ]], '@z' => [ $META->exports_get( '@z' ), { tag => 1 }, [ 'from tag', 'param', 'p' ]], }, "included tag, with config" ); }; tests acceptance => sub { my $spec = $CLASS->new( TestPackage, qw/ $YY @ZZ &xx $yy @zz X $Y @Z !:xxx !$YY /, XX => [ 'a', 'b' ], '&xx' => { -as => 'apple', -args => [ 'o' ], a => 'b' }, -yyy => { -prefix => 'uhg_', -suffix => '_blarg' }, -foo => 'bar', -prefix => 'aaa_', ); is_deeply( $spec->excludes, [qw/ &x $y @z $YY/], "Excludes" ); my $exp = sub { $META->exports_get(@_)}; is_deeply( $spec->exports, { '@ZZ' => [ $exp->('@ZZ'), {}, []], '&XX' => [ $exp->('&XX'), {}, [ 'a', 'b' ]], '&xx' => [ $exp->('&xx'), { as => 'apple' }, [ 'o', 'a', 'b' ]], '$yy' => [ $exp->('$yy'), {}, []], '@zz' => [ $exp->('@zz'), {}, []], '&X' => [ $exp->('&X' ), { prefix => 'uhg_', suffix => '_blarg' }, []], '$Y' => [ $exp->('$Y' ), { prefix => 'uhg_', suffix => '_blarg' }, []], '@Z' => [ $exp->('@Z' ), { prefix => 'uhg_', suffix => '_blarg' }, []], }, "Export list" ); is_deeply( $spec->config, { foo => 'bar', prefix => 'aaa_', yyy => { -prefix => 'uhg_', -suffix => '_blarg' }, xxx => '', }, "Config" ); { local $SIG{__WARN__} = sub {}; $spec->export('FakePackage'); } can_ok( 'FakePackage', qw/apple aaa_XX uhg_X_blarg/ ); no strict 'refs'; isa_ok( \&{"FakePackage\::$_"}, Sub ) for qw/apple aaa_XX uhg_X_blarg/; isa_ok( \${"FakePackage\::$_"}, Variable ) for qw/aaa_yy uhg_Y_blarg/; isa_ok( \@{"FakePackage\::$_"}, Variable ) for qw/aaa_ZZ aaa_zz uhg_Z_blarg/; }; tests inject_api => sub { my $spec = $CLASS->new( TestPackage ); ok( !$spec->exports->{'&foo'}, "no foo export" ); $spec->add_export( '&foo' => sub { 'foo' }); ok( $spec->exports->{'&foo'}, "foo export" ); isa_ok( $spec->exports->{'&foo'}->[0], 'Exporter::Declare::Export::Sub' ); my $test_dest = 'Test::ExDec::Inject::API'; $spec->export( $test_dest ); can_ok( $test_dest, 'foo' ); is( $test_dest->can( 'foo' ), $spec->exports->{'&foo'}->[0], "sanity check" ); }; run_tests; done_testing; Exporter-Declare-0.113/t/reexport.t000444001750001750 265612154252374 17657 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; { package An::Exporter; use Exporter::Declare; default_exports qw/ a /; exports qw/ b c $X /; our $X = 'x'; sub a { 'a' } sub b { 'b' } sub c { 'c' } } { package Old::Exporter; use base 'Exporter'; our @EXPORT = qw/ d e f $Y /; our $Y = 'y'; sub d { 'd' } sub e { 'e' } sub f { 'f' } } { package Combination; use Exporter::Declare qw/reexport import/; reexport 'An::Exporter'; reexport 'Old::Exporter'; } tests meta_data => sub { is_deeply( [ sort keys %{ Combination->export_meta->exports }], [ sort qw/ &a &b &c &d &e &f $Y $X &Combination/], "All exports" ); is_deeply( [ sort @{ Combination->export_meta->export_tags->{ all }}], [ sort qw/ &a &b &c &d &e &f $Y $X &Combination/], "All exports tag" ); is_deeply( [ sort @{ Combination->export_meta->export_tags->{ default }}], [ sort qw/ a d e f $Y / ], "Defaults" ); }; tests imports => sub { Combination->import('-all'); can_ok( __PACKAGE__, qw/a b c d e f/ ); is( a(), 'a', "a()" ); is( b(), 'b', "b()" ); is( c(), 'c', "c()" ); is( d(), 'd', "d()" ); is( e(), 'e', "e()" ); is( f(), 'f', "f()" ); no strict 'vars'; no warnings 'once'; is( $X, 'x', '$X' ); is( $Y, 'y', '$Y' ); }; run_tests; done_testing; Exporter-Declare-0.113/t/Meta.t000444001750001750 1214012154252374 16702 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; use aliased 'Exporter::Declare::Export::Sub'; use aliased 'Exporter::Declare::Export::Variable'; our $CLASS = "Exporter::Declare::Meta"; require_ok $CLASS; tests construction => sub { my $meta = $CLASS->new('FakePackage'); isa_ok( $meta, $CLASS ); is( FakePackage->export_meta, $meta, "Linked" ); is( $meta->package, 'FakePackage', "Got package" ); is_deeply( $meta->exports, { '&FakePackage' => $meta->exports_get('FakePackage') }, "Got export hash" ); is_deeply( $meta->export_tags, { default => [], all => [ '&FakePackage' ], alias => ['FakePackage'] }, "Got export tags" ); is_deeply( $meta->options, {}, "Got options list" ); is_deeply( $meta->arguments, { suffix => 1, prefix => 1 }, "Got arguments list" ); }; tests tags => sub { my $meta = $CLASS->new('FakeTagPackage'); is_deeply( $meta->export_tags, { all => [ '&FakeTagPackage' ], alias => ['FakeTagPackage'], default => [] }, "Export tags" ); is_deeply( [$meta->export_tags_get('all')], [ '&FakeTagPackage' ], ':all only has alias' ); is_deeply( [$meta->export_tags_get('default')], [], ':default is empty list' ); $meta->export_tags_push( 'a', qw/a b c d/ ); is_deeply( [$meta->export_tags_get('a')], [qw/a b c d/], "Added tag" ); throws_ok { $meta->export_tags_push( 'all', "xxx" )} qr/'all' is a reserved tag, you cannot override it./, "Cannot modify 'all' tag"; $meta->export_tags_push( 'default', qw/a b c d/ ); is_deeply( [$meta->export_tags_get('default')], [qw/a b c d/], "updated default" ); }; tests exports => sub { my $meta = $CLASS->new('FakeExportPackage'); my $code_no_sigil = Sub->new(sub {}, exported_by => 'FakeExportPackage' ); $meta->exports_add( 'code_no_sigil', $code_no_sigil); is_deeply( $meta->exports->{ '&code_no_sigil' }, $code_no_sigil, "Added export without sigil as code" ); my $code_with_sigil = Sub->new(sub {}, exported_by => 'FakeExportPackage' ); $meta->exports_add( '&code_with_sigil', $code_with_sigil); is_deeply( $meta->exports->{ '&code_with_sigil' }, $code_with_sigil, "Added code export" ); my $anon = "xxx"; my $scalar = Variable->new( \$anon, exported_by => 'FakeExportPackage' ); $meta->exports_add( '$scalar', $scalar ); my $hash = Variable->new( {}, exported_by => 'FakeExportPackage' ); $meta->exports_add( '%hash', $hash ); my $array = Variable->new( [], exported_by => 'FakeExportPackage' ); $meta->exports_add( '@array', $array ); is_deeply( $meta->exports, { '&FakeExportPackage' => $meta->exports_get( 'FakeExportPackage' ), '&code_no_sigil' => $code_no_sigil, '&code_with_sigil' => $code_with_sigil, '$scalar' => $scalar, '%hash' => $hash, '@array' => $array, }, "Added exports" ); throws_ok { $meta->exports_add( '@array', $array )} qr/'\@array' already added for metric exports/, "Can't add an export twice"; throws_ok { $meta->exports_add( '@array2', [] )} qr/Exports must be instances of 'Exporter::Declare::Export'/, "Can't add an export twice"; is( $meta->exports_get( '$scalar' ), $scalar, "Got scalar export" ); is( $meta->exports_get( '@array' ), $array, "Got array export" ); is( $meta->exports_get( '%hash' ), $hash, "Got hash export" ); is( $meta->exports_get( '&code_with_sigil' ), $code_with_sigil, "Got &code export" ); is( $meta->exports_get( 'code_no_sigil' ), $code_no_sigil, "Got code export" ); throws_ok { $meta->exports_get( '@array2' )} qr/FakeExportPackage does not export '\@array2'/, "Can't import whats not exported"; throws_ok { $meta->exports_get( '-xxx' )} qr/exports_get\(\) does not accept a tag as an argument/, "Can't import whats not exported"; throws_ok { $meta->exports_get( ':xxx' )} qr/exports_get\(\) does not accept a tag as an argument/, "Can't import whats not exported"; }; { package PackageToPull; sub a { 'a' } our $B = 'b'; our @C = ( 'c' ); our %D = ( 'D' => 'd' ); } tests pull_from_package => sub { my $meta = $CLASS->new('PackageToPull'); is_deeply( [$meta->get_ref_from_package( 'a' )], [ \&PackageToPull::a, '&a' ], "Puled a sub" ); is_deeply( [$meta->get_ref_from_package( '&a' )], [ \&PackageToPull::a, '&a' ], "Puled a sub w/ sigil" ); is_deeply( [$meta->get_ref_from_package( '$B' )], [ \$PackageToPull::B, '$B' ], "Puled scalar" ); is_deeply( [$meta->get_ref_from_package( '@C' )], [ \@PackageToPull::C, '@C' ], "Puled array" ); is_deeply( [$meta->get_ref_from_package( '%D' )], [ \%PackageToPull::D, '%D' ], "Puled hash" ); }; run_tests(); done_testing; Exporter-Declare-0.113/t/Meta_From_Old.t000444001750001750 62212154252374 20425 0ustar00exodistexodist000000000000#!/usr/bin/perl use Fennec::Lite; use strict; use warnings; use aliased 'Exporter::Declare::Meta'; { package ExporterA; our @EXPORT_OK = qw/a b c/; sub a { 'a' } sub b { 'b' } sub c { 'c' } } tests ExporterA => sub { # Bug found when Testing 0.102 against Exodist:Util prior to release lives_ok { Meta->new_from_exporter( 'ExporterA' ) }; }; run_tests; done_testing; Exporter-Declare-0.113/t/Export.t000444001750001750 174512154252374 17266 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; our $CLASS = "Exporter::Declare::Export"; require_ok $CLASS; tests create => sub { throws_ok { $CLASS->new([]) } qr/You must specify exported_by when calling $CLASS\->new()/, "Required specs"; my $export = $CLASS->new([], exported_by => __PACKAGE__ ); isa_ok( $export, $CLASS ); is( $export->exported_by, __PACKAGE__, "Stored property" ); is_deeply( $export, [], "Is just an array" ); }; tests inject_vars => sub { my $var = "AAAA"; $CLASS->new( \$var, exported_by => __PACKAGE__ ); (\$var)->inject( __PACKAGE__, 'foo' ); no strict 'vars'; is( \$foo, \$var, "injected var" ); is( $foo, 'AAAA', "Sanity var" ); }; tests inject_subs => sub { my $sub = sub { "AAAA" }; $CLASS->new( $sub, exported_by => __PACKAGE__ ); $sub->inject( __PACKAGE__, 'bar' ); is( \&bar, $sub, "injected sub" ); is( bar(), 'AAAA', "Sanity sub" ); }; run_tests(); done_testing; Exporter-Declare-0.113/t/misc.t000444001750001750 331012154252374 16726 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; use Test::Exception; BEGIN { { package Export::Stuff; use Exporter::Declare; sub bar($) { my $x = shift; "bar $x" } { no strict 'refs'; *{'baz'} = sub($) { my $x = shift; "baz $x" }; } default_export foo => sub($) { my $x = shift; "foo $x" }; default_export 'bar'; default_export 'baz'; sub before_import { my $class = shift; my ( $caller, $specs ) = @_; $specs->add_export( '&whoosh' => sub { 'whoosh' } ); } } Export::Stuff->import(); } tests before_import => sub { can_ok( __PACKAGE__, qw/ whoosh / ); }; tests prototypes => sub { can_ok( __PACKAGE__, qw/foo bar baz/ ); is( prototype( \&foo ), '$', "foo prototype" ); is( prototype( \&bar ), '$', "bar prototype" ); is( prototype( \&baz ), '$', "baz prototype" ); is( foo('a'), "foo a", "foo prototype" ); is( bar('a'), "bar a", "bar prototype" ); is( baz('a'), "baz a", "baz prototype" ); # Even in throws ok we need to eval this, prototypes are a compile-time error throws_ok { eval 'foo()' || die $@ } qr/Not enough arguments for main::foo/, "Prototype takes effect (foo)"; throws_ok { eval 'bar()' || die $@ } qr/Not enough arguments for .*bar/, "Prototype takes effect (bar)"; throws_ok { eval 'baz()' || die $@ } qr/Not enough arguments for main::baz/, "Prototype takes effect (baz)"; }; tests proto_no_begin => sub { package Something; use Test::More; Export::Stuff->import(); is( foo( "A", "b" ), "foo A", "Prototype is bypassed by lack of BEGIN" ); }; run_tests; done_testing; Exporter-Declare-0.113/t/Sub.t000444001750001750 60412154252374 16507 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; our $CLASS = "Exporter::Declare::Export::Sub"; require_ok $CLASS; tests inject_subs => sub { my $sub = sub { "AAAA" }; $CLASS->new( $sub, exported_by => __PACKAGE__ ); $sub->inject( __PACKAGE__, 'bar' ); is( \&bar, $sub, "injected sub" ); is( bar(), 'AAAA', "Sanity sub" ); }; run_tests(); done_testing; Exporter-Declare-0.113/t/Variable.t000444001750001750 30312154252374 17477 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; our $CLASS = "Exporter::Declare::Export::Variable"; require_ok $CLASS; isa_ok( $CLASS, 'Exporter::Declare::Export' ); done_testing; Exporter-Declare-0.113/t/Generator.t000444001750001750 425412154252374 17731 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; our $CLASS = "Exporter::Declare::Export::Generator"; require_ok $CLASS; tests create => sub { throws_ok { $CLASS->new(sub{ sub {} }, exported_by => __PACKAGE__ ) } qr/You must specify type when calling $CLASS\->new()/, "Required specs"; my $export = $CLASS->new(sub { sub {} }, exported_by => __PACKAGE__, type => 'sub' ); isa_ok( $export, $CLASS ); is( $export->type, 'sub', "Stored property" ); }; tests generate_subs => sub { my $val = 1; my $export = $CLASS->new( sub { my $out = $val++; sub { $out } }, exported_by => __PACKAGE__, type => 'sub' ); $export->inject( __PACKAGE__, 'foo' ); $export->inject( __PACKAGE__, 'bar' ); $export->inject( __PACKAGE__, 'baz' ); is( foo(), 1, "First generated" ); is( bar(), 2, "Second generated" ); is( baz(), 3, "Third generated" ); is( $val, 4, "value incrimented" ); }; tests generate_vars => sub { my $val = 1; my $export = $CLASS->new( sub { my $out = $val++; \$out }, exported_by => __PACKAGE__, type => 'variable' ); $export->inject( __PACKAGE__, 'foo' ); $export->inject( __PACKAGE__, 'bar' ); $export->inject( __PACKAGE__, 'baz' ); no strict 'vars'; is( $foo, 1, "First generated" ); is( $bar, 2, "Second generated" ); is( $baz, 3, "Third generated" ); is( $val, 4, "value incrimented" ); }; run_tests(); done_testing; __END__ sub type { shift->_data->{ type }} sub new { my $class = shift; croak "Generators must be coderefs, not " . ref($_[0]) unless ref( $_[0] ) eq 'CODE'; $class->SUPER::new( @_ ); } sub generate { my $self = shift; my ( $import_class, @args ) = @_; my $ref = $self->( $self->exported_by, $import_class, @args ); return Exporter::Declare::Export::Sub->new( $ref, %{ $self->_data }, ) if $self->type eq 'sub'; return Exporter::Declare::Export::Variable->new( $ref, %{ $self->_data }, ); } sub inject { my $self = shift; my ( $class, $name, @args ) = @_; $self->generate( $class, @args )->inject( $class, $name ); } 1; Exporter-Declare-0.113/t/Inheritance.t000444001750001750 22112154252374 20202 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; use lib 'lib', 't/lib'; use_ok( 'InheritanceChild', 'the_export' ); done_testing; Exporter-Declare-0.113/t/Magic.t000444001750001750 1215212154252374 17037 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; BEGIN { my $skip = qq{Exporter::Declare::Magic 0.107 and Devel::Declare::Parser are required for -magic}; Test::More->import( skip_all => $skip ) unless eval <<" EOT"; require Devel\::Declare\::Parser; require Exporter\::Declare\::Magic; \$Exporter::Declare::Magic::VERSION >= 0.107; EOT } our $CLASS; BEGIN { $CLASS = 'Exporter::Declare::Magic'; require_ok $CLASS; } { package Export::Stuff; use Exporter::Declare qw/-magic/; use Fennec::Lite; BEGIN { can_ok( __PACKAGE__, qw/ exports default_exports import_options import_arguments export_tag export gen_export default_export gen_default_export parsed_exports parsed_default_exports parser / ); } sub a { 'a' } sub b { 'b' } sub c { 'c' } sub meth { return @_ } our $X = 'x'; our $Y = 'y'; our $Z = 'z'; exports qw/ $Y b /; default_exports qw/ $X a /; import_options qw/xxx yyy/; import_arguments qw/ foo bar /; export_tag vars => qw/ $X $Y /; export_tag subs => qw/ a b /; export $Z; export c; export baz { 'baz' } export eexport export { return @_ } my $gen = 0; gen_export gexp { my $out = $gen++; sub { $out } } gen_default_export defgen { my $out = $gen++; sub { $out } } } tests magic_tag => sub { # This tests that the magic tag brings in the magic methods as well as the # default which is a nested tag. can_ok( 'Export::Stuff', qw/ export gen_export default_export gen_default_export parser parsed_exports parsed_default_exports import exports default_exports import_options import_arguments export_tag / ); }; tests generator => sub { Export::Stuff->import(qw/gexp/); is( gexp(), 0, "Generated first" ); Export::Stuff->import(qw/defgen/); is( defgen(), 1, "Generated second" ); Export::Stuff->import( defgen => {-as => 'blah'} ); is( blah(), 2, "Generated again" ); }; tests tags_options_and_exports => sub { is_deeply( [sort keys %{Export::Stuff->export_meta->exports}], [sort qw/ $Y &b $X &a &Stuff $Z &c &baz &gexp &defgen &eexport /], "All exports accounted for" ); is_deeply( [sort @{Export::Stuff->export_meta->export_tags->{default}}], [sort qw/ $X a defgen /], "Default Exports" ); is_deeply( [sort @{Export::Stuff->export_meta->export_tags->{all}}], [sort qw/ $Y &b $X &a &Stuff $Z &c &baz &gexp &defgen &eexport /], "All Exports" ); is_deeply( Export::Stuff->export_meta->options, { xxx => 1, yyy => 1, }, "Options" ); is_deeply( Export::Stuff->export_meta->arguments, { foo => 1, bar => 1, prefix => 1, suffix => 1, }, "Arguments" ); is_deeply( Export::Stuff->export_meta->export_tags, { alias => ['Stuff'], vars => [qw/ $X $Y /], subs => [qw/ a b /], # These are checked elsware default => Export::Stuff->export_meta->export_tags->{'default'}, all => Export::Stuff->export_meta->export_tags->{all} }, "Extra tags" ); }; tests magic_import => sub { package MyMagic; use strict; use warnings; use Exporter::Declare qw/-magic -all/; use Fennec::Lite; sub xxx { 'xxx' } can_ok( __PACKAGE__, qw/ exports default_exports import_options import_arguments export_tag export gen_export default_export gen_default_export parsed_exports parsed_default_exports parser / ); lives_ok { export a b {} } "export magic"; lives_ok { export b => sub { }; export c => \&xxx; export 'xxx'; } "export magic non-interfering"; is( __PACKAGE__->export_meta->exports_get('xxx'), \&xxx, "export added" ); }; tests magic_import_args => sub { package MyMagic2; use strict; use warnings; use Exporter::Declare -magic => ['-default', -prefix => "magic_", '!export']; use Fennec::Lite; can_ok( __PACKAGE__, qw/ exports default_exports import_options import_arguments export_tag magic_gen_export magic_default_export magic_gen_default_export magic_parsed_exports magic_parsed_default_exports magic_parser / ); ok( !__PACKAGE__->can('export'), "export() was excluded" ); ok( !__PACKAGE__->can('magic_export'), "magic_export() was excluded" ); }; run_tests; done_testing; Exporter-Declare-0.113/t/Declare.t000444001750001750 721712154252374 17344 0ustar00exodistexodist000000000000#!/usr/bin/perl use strict; use warnings; use Fennec::Lite; use aliased 'Exporter::Declare::Meta'; use aliased 'Exporter::Declare::Specs'; use aliased 'Exporter::Declare::Export::Sub'; use aliased 'Exporter::Declare::Export::Variable'; our $CLASS; our @IMPORTS; BEGIN { @IMPORTS = qw/ export gen_export default_export gen_default_export import export_to exports default_exports reexport import_options import_arguments export_tag /; $CLASS = "Exporter::Declare"; require_ok $CLASS; $CLASS->import( '-alias', @IMPORTS ); } sub xxx {'xxx'} tests package_usage => sub { can_ok( $CLASS, 'export_meta' ); can_ok( __PACKAGE__, @IMPORTS, 'Declare' ); can_ok( __PACKAGE__, 'export_meta' ); is( Declare(), $CLASS, "Aliased" ); is_deeply( [ sort( Declare()->exports )], [ sort map {"\&$_" } @IMPORTS, 'Declare' ], "Export list" ); is_deeply( [ sort( Declare()->default_exports )], [ sort qw/ exports default_exports import import_options import_arguments export_tag default_export export gen_export gen_default_export /], "Default Exports" ); }; { package Export::Stuff; use Exporter::Declare; sub a { 'a' } sub b { 'b' } sub c { 'c' } sub meth { return @_ } our $X = 'x'; our $Y = 'y'; our $Z = 'z'; exports qw/ $Y b /; default_exports qw/ $X a /; import_options qw/xxx yyy/; import_arguments qw/ foo bar /; export_tag vars => qw/ $X $Y @P /; export_tag subs => qw/ a b /; export '$Z'; export '@P' => [ 'a', 'x' ]; export 'c'; export baz => sub { 'baz' }; my $gen = 0; gen_export gexp => sub { my $out = $gen++; sub { $out }}; gen_default_export defgen => sub { my $out = $gen++; sub { $out }}; } tests generator => sub { Export::Stuff->import(qw/gexp/); is( gexp(), 0, "Generated first" ); Export::Stuff->import(qw/defgen/); is( defgen(), 1, "Generated second" ); Export::Stuff->import( defgen => { -as => 'blah' }); is( blah(), 2, "Generated again" ); }; tests tags_options_and_exports => sub { is_deeply( [ sort keys %{ Export::Stuff->export_meta->exports }], [ sort qw/ $Y &b $X &a &Stuff $Z &c &baz &gexp &defgen @P /], "All exports accounted for" ); is_deeply( [ sort @{ Export::Stuff->export_meta->export_tags->{default} }], [ sort qw/ $X a defgen /], "Default Exports" ); is_deeply( [ sort @{ Export::Stuff->export_meta->export_tags->{all} }], [ sort qw/ $Y &b $X &a &Stuff $Z &c &baz &gexp &defgen @P /], "All Exports" ); is_deeply( Export::Stuff->export_meta->options, { xxx => 1, yyy => 1, }, "Options" ); is_deeply( Export::Stuff->export_meta->arguments, { foo => 1, bar => 1, prefix => 1, suffix => 1, }, "Arguments" ); is_deeply( Export::Stuff->export_meta->export_tags, { alias => [ 'Stuff' ], vars => [qw/ $X $Y @P /], subs => [qw/ a b /], # These are checked elsware default => Export::Stuff->export_meta->export_tags->{'default'}, all => Export::Stuff->export_meta->export_tags->{all} }, "Extra tags" ); isa_ok( Export::Stuff->export_meta->exports_get( '@P' ), 'ARRAY' ); is_deeply( [@{ Export::Stuff->export_meta->exports_get( '@P' ) }], [ 'a', 'x' ], "\@P Is what we expect" ); }; run_tests; done_testing; Exporter-Declare-0.113/t/lib000755001750001750 012154252374 16222 5ustar00exodistexodist000000000000Exporter-Declare-0.113/t/lib/InheritanceParent.pm000444001750001750 25312154252374 22300 0ustar00exodistexodist000000000000package InheritanceParent; use strict; use warnings; use Exporter::Declare qw/default_export import/; default_export the_export => sub { return 'the_export'; }; 1; Exporter-Declare-0.113/t/lib/InheritanceChild.pm000444001750001750 15212154252374 22070 0ustar00exodistexodist000000000000package InheritanceChild; use strict; use warnings; use base 'InheritanceParent'; sub foo { 'foo' } 1; Exporter-Declare-0.113/lib000755001750001750 012154252374 15757 5ustar00exodistexodist000000000000Exporter-Declare-0.113/lib/Exporter000755001750001750 012154252374 17567 5ustar00exodistexodist000000000000Exporter-Declare-0.113/lib/Exporter/Declare.pm000444001750001750 4364712154252374 21657 0ustar00exodistexodist000000000000package Exporter::Declare; use strict; use warnings; use Carp qw/croak/; use Scalar::Util qw/reftype/; use aliased 'Exporter::Declare::Meta'; use aliased 'Exporter::Declare::Specs'; use aliased 'Exporter::Declare::Export::Sub'; use aliased 'Exporter::Declare::Export::Variable'; use aliased 'Exporter::Declare::Export::Generator'; BEGIN { Meta->new(__PACKAGE__) } our $VERSION = '0.113'; our @CARP_NOT = qw/ Exporter::Declare Exporter::Declare::Specs Exporter::Declare::Meta Exporter::Declare::Magic /; default_exports( qw/ import exports default_exports import_options import_arguments export_tag export gen_export default_export gen_default_export / ); exports( qw/ reexport export_to / ); export_tag( magic => qw/ !export !gen_export !default_export !gen_default_export / ); sub import { my $class = shift; my $caller = caller; $class->alter_import_args( $caller, \@_ ) if $class->can('alter_import_args'); my $specs = _parse_specs( $class, @_ ); $class->before_import( $caller, $specs ) if $class->can('before_import'); $specs->export($caller); $class->after_import( $caller, $specs ) if $class->can('after_import'); } sub after_import { my $class = shift; my ( $caller, $specs ) = @_; Meta->new($caller); return unless my $args = $specs->config->{'magic'}; $args = ['-default'] unless ref $args && ref $args eq 'ARRAY'; croak "Exporter::Declare::Magic must be installed seperately for -magic to work" unless eval { require Exporter::Declare::Magic }; warn "Exporter::Declare -magic is deprecated. Please use Exporter::Declare::Magic directly"; export_to( 'Exporter::Declare::Magic', $caller, @$args ); } sub _parse_specs { my $class = _find_export_class( \@_ ); my (@args) = @_; # XXX This is ugly! unshift @args => '-default' if $class eq __PACKAGE__ && grep { $_ eq '-magic' } @args; return Specs->new( $class, @args ); } sub export_to { my $class = _find_export_class( \@_ ); my ( $dest, @args ) = @_; my $specs = _parse_specs( $class, @args ); $specs->export($dest); return $specs; } sub export_tag { my $class = _find_export_class( \@_ ); my ( $tag, @list ) = @_; $class->export_meta->export_tags_push( $tag, @list ); } sub exports { my $class = _find_export_class( \@_ ); my $meta = $class->export_meta; _export( $class, undef, $_ ) for @_; $meta->export_tags_get('all'); } sub default_exports { my $class = _find_export_class( \@_ ); my $meta = $class->export_meta; $meta->export_tags_push( 'default', _export( $class, undef, $_ ) ) for @_; $meta->export_tags_get('default'); } sub export { my $class = _find_export_class( \@_ ); _export( $class, undef, @_ ); } sub gen_export { my $class = _find_export_class( \@_ ); _export( $class, Generator(), @_ ); } sub default_export { my $class = _find_export_class( \@_ ); my $meta = $class->export_meta; $meta->export_tags_push( 'default', _export( $class, undef, @_ ) ); } sub gen_default_export { my $class = _find_export_class( \@_ ); my $meta = $class->export_meta; $meta->export_tags_push( 'default', _export( $class, Generator(), @_ ) ); } sub import_options { my $class = _find_export_class( \@_ ); my $meta = $class->export_meta; $meta->options_add($_) for @_; } sub import_arguments { my $class = _find_export_class( \@_ ); my $meta = $class->export_meta; $meta->arguments_add($_) for @_; } sub _parse_export_params { my ( $class, $expclass, $name, @param ) = @_; my $ref = ref( $param[-1] ) ? pop(@param) : undef; my $meta = $class->export_meta; ( $ref, $name ) = $meta->get_ref_from_package($name) unless $ref; ( my $type, $name ) = ( $name =~ m/^([\$\@\&\%]?)(.*)$/ ); $type = "" if $type eq '&'; my $fullname = "$type$name"; return ( class => $class, export_class => $expclass || undef, name => $name, ref => $ref, type => $type || "", fullname => $fullname, args => \@param, ); } sub _export { _add_export( _parse_export_params(@_) ); } sub _add_export { my %params = @_; my $meta = $params{class}->export_meta; $params{export_class} ||= reftype( $params{ref} ) eq 'CODE' ? Sub() : Variable(); $params{export_class}->new( $params{ref}, exported_by => $params{class}, ( $params{type} ? ( type => 'variable' ) : ( type => 'sub' ) ), ( $params{extra_exporter_props} ? %{$params{extra_exporter_props}} : () ), ); $meta->exports_add( $params{fullname}, $params{ref} ); return $params{fullname}; } sub _is_exporter_class { my ($name) = @_; return 0 unless $name; # This is to work around a bug in older versions of UNIVERSAL::can which # would issue a warning about $name->can() when $name was not a valid # package. # This will first verify that $name is a namespace, if not it will return false. # If the namespace defines 'export_meta' we know it is an exporter. # If there is no @ISA array in the namespace we simply return false, # otherwise we fall back to $name->can(). { no strict 'refs'; no warnings 'once'; return 0 unless keys %{"$name\::"}; return 1 if defined *{"$name\::export_meta"}{CODE}; return 0 unless @{"$name\::ISA"}; } return eval { $name->can('export_meta'); 1 }; } sub _find_export_class { my $args = shift; return shift(@$args) if @$args && _is_exporter_class(@$args); return caller(1); } sub reexport { my $from = pop; my $class = shift || caller; $class->export_meta->reexport($from); } 1; =head1 NAME Exporter::Declare - Exporting done right =head1 DESCRIPTION Exporter::Declare is a meta-driven exporting tool. Exporter::Declare tries to adopt all the good features of other exporting tools, while throwing away horrible interfaces. Exporter::Declare also provides hooks that allow you to add options and arguments for import. Finally, Exporter::Declare's meta-driven system allows for top-notch introspection. =head1 FEATURES =over 4 =item Declarative exporting (like L for exporting) =item Meta-driven for introspection =item Customizable import() method =item Export groups (tags) =item Export generators for subs and variables =item Clear and concise OO API =item Exports are blessed, allowing for more introspection =item Import syntax based off of L =item Packages export aliases =back =head1 SYNOPSIS =head2 EXPORTER package Some::Exporter; use Exporter::Declare; default_exports qw/ do_the_thing /; exports qw/ subA subB $SCALAR @ARRAY %HASH /; # Create a couple tags (import lists) export_tag subs => qw/ subA subB do_the_thing /; export_tag vars => qw/ $SCALAR @ARRAY %HASH /; # These are simple boolean options, pass '-optionA' to enable it. import_options qw/ optionA optionB /; # These are options which slurp in the next argument as their value, pass # '-optionC' => 'foo' to give it a value. import_arguments qw/ optionC optionD /; export anon_export => sub { ... }; export '@anon_var' => [...]; default_export a_default => sub { 'default!' } our $X = "x"; default_export '$X'; my $iterator = 'a'; gen_export unique_class_id => sub { my $current = $iterator++; return sub { $current }; }; gen_default_export '$my_letter' => sub { my $letter = $iterator++; return \$letter; }; # You can create a function to mangle the arguments before they are # parsed into a Exporter::Declare::Spec object. sub alter_import_args { my ($class, $args) = @_; # fiddle with args before importing routines are called @$args = grep { !/^skip_/ } @$args } # There is no need to fiddle with import() or do any wrapping. # the $specs data structure means you generally do not need to parse # arguments yourself (but you can if you want using alter_import_args()) # Change the spec object before export occurs sub before_import { my $class = shift; my ( $importer, $specs ) = @_; if ($specs->config->{optionA}) { # Modify $spec attributes accordingly } } # Use spec object after export occurs sub after_import { my $class = shift; my ( $importer, $specs ) = @_; do_option_a() if $specs->config->{optionA}; do_option_c( $specs->config->{optionC} ) if $specs->config->{optionC}; print "-subs tag was used\n" if $specs->config->{subs}; print "exported 'subA'\n" if $specs->exports->{subA}; } ... =head2 IMPORTER package Some::Importer; use Some::Exporter qw/ subA $SCALAR !%HASH /, -default => { -prefix => 'my_' }, qw/ -optionA !-optionB /, subB => { -as => 'sub_b' }; subA(); print $SCALAR; sub_b(); my_do_the_thing(); ... =head1 IMPORT INTERFACE Importing from a package that uses Exporter::Declare will be familiar to anyone who has imported from modules before. Arguments are all assumed to be export names, unless prefixed with C<-> or C<:> In which case they may be a tag or an option. Exports without a sigil are assumed to be code exports, variable exports must be listed with their sigil. Items prefixed with the C symbol are forcfully excluded, regardless of any listed item that may normally include them. Tags can also be excluded, this will effectively exclude everything in the tag. Tags are simply lists of exports, the exporting class may define any number of tags. Exporter::Declare also has the concept of options, they have the same syntax as tags. Options may be boolean or argument based. Boolean options are actually 3 value, undef, false C, or true. Argument based options will grab the next value in the arguments list as their own, regardless of what type of value it is. When you use the module, or call import(), all the arguments are transformed into an L object. Arguments are parsed for you into a list of imports, and a configuration hash in which tags/options are keys. Tags are listed in the config hash as true, false, or undef depending on if they were included, negated, or unlisted. Boolean options will be treated in the same way as tags. Options that take arguments will have the argument as their value. =head2 SELECTING ITEMS TO IMPORT Exports can be subs, or package variables (scalar, hash, array). For subs simply ask for the sub by name, you may optionally prefix the subs name with the sub sigil C<&>. For variables list the variable name along with its sigil C<$, %, or @>. use Some::Exporter qw/ somesub $somescalar %somehash @somearray /; =head2 TAGS Every exporter automatically has the following 3 tags, in addition they may define any number of custom tags. Tags can be specified by their name prefixed by either C<-> or C<:>. =over 4 =item -all This tag may be used to import everything the exporter provides. =item -default This tag is used to import the default items exported. This will be used when no argument is provided to import. =item -alias Every package has an alias that it can export. This is the last segmant of the packages namespace. IE C could export the C function. These alias functionis simply return the full package name as a string, in this case C<'My::Long::Package::Name::Foo'>. This is similar to L. The -alias tag is a shortcut so that you do not need to think about what the alias name would be when adding it to the import arguments. use My::Long::Package::Name::Foo -alias; my $foo = Foo()->new(...); =back =head2 RENAMING IMPORTED ITEMS You can prefix, suffix, or completely rename the items you import. Whenever an item is followed by a hash in the import list, that hash will be used for configuration. Configuration items always start with a dash C<->. The 3 available configuration options that effect import names are C<-prefix>, C<-suffix>, and C<-as>. If C<-as> is seen it will be used as is. If prefix or suffix are seen they will be attached to the original name (unless -as is present in which case they are ignored). use Some::Exporter subA => { -as => 'DoThing' }, subB => { -prefix => 'my_', -suffix => '_ok' }; The example above will import C under the name C. It will also import C under the name C. You may als specify a prefix and/or suffix for tags. The following example will import all the default exports with 'my_' prefixed to each name. use Some::Exporter -default => { -prefix => 'my_' }; =head2 OPTIONS Some exporters will recognise options. Options look just like tags, and are specified the same way. What options do, and how they effect things is exporter-dependant. use Some::Exporter qw/ -optionA -optionB /; =head2 ARGUMENTS Some options require an argument. These options are just like other tags/options except that the next item in the argument list is slurped in as the option value. use Some::Exporter -ArgOption => 'Value, not an export', -ArgTakesHash => { ... }; Once again available options are exporter specific. =head2 PROVIDING ARGUMENTS FOR GENERATED ITEMS Some items are generated at import time. These items may accept arguments. There are 3 ways to provide arguments, and they may all be mixed (though that is not recommended). As a hash use Some::Exporter generated => { key => 'val', ... }; As an array use Some::Exporter generated => [ 'Arg1', 'Arg2', ... ]; As an array in a config hash use Some::Exporter generated => { -as => 'my_gen', -args => [ 'arg1', ... ]}; You can use all three at once, but this is really a bad idea, documented for completeness: use Some::Exporter generated => { -as => 'my_gen, key => 'value', -args => [ 'arg1', 'arg2' ]} generated => [ 'arg3', 'arg4' ]; The example above will work fine, all the arguments will make it into the generator. The only valid reason for this to work is that you may provide arguments such as C<-prefix> to a tag that brings in generator(), while also desiring to give arguments to generator() independantly. =head1 PRIMARY EXPORT API With the exception of import(), all the following work equally well as functions or class methods. =over 4 =item import( @args ) The import() class method. This turns the @args list into an L object. =item exports( @add_items ) Add items to be exported. =item @list = exports() Retrieve list of exports. =item default_exports( @add_items ) Add items to be exported, and add them to the -default tag. =item @list = default_exports() List of exports in the -default tag =item import_options(@add_items) Specify boolean options that should be accepted at import time. =item import_arguments(@add_items) Specify options that should be accepted at import that take arguments. =item export_tag( $name, @add_items ); Define an export tag, or add items to an existing tag. =back =head1 EXTENDED EXPORT API These all work fine in function or method form, however the syntax sugar will only work in function form. =over 4 =item reexport( $package ) Make this exporter inherit all the exports and tags of $package. Works for Exporter::Declare or Exporter.pm based exporters. Re-Exporting of L based classes is not currently supported. =item export_to( $package, @args ) Export to the specified class. =item export( $name ) =item export( $name, $ref ) export is a keyword that lets you export any 1 item at a time. The item can be exported by name, or name + ref. When a ref is provided, the export is created, but there is no corresponding variable/sub in the packages namespace. =item default_export( $name ) =item default_export( $name, $ref ) =item gen_export( $name ) =item gen_export( $name, $ref ) =item gen_default_export( $name ) =item gen_default_export( $name, $ref ) These all act just like export(), except that they add subrefs as generators, and/or add exports to the -default tag. =back =head1 MAGIC Please use L directly from now on. =head2 DEPRECATED USAGE OF MAGIC use Exporter::Declare '-magic'; This adds L magic to several functions. It also allows you to easily create or use parsers on your own exports. See L for more details. You can also provide import arguments to L # Arguments to -magic must be in an arrayref, not a hashref. use Exporter::Declare -magic => [ '-default', '!export', -prefix => 'magic_' ]; =head1 INTERNAL API Exporter/Declare.pm does not have much logic to speak of. Rather Exporter::Declare is sugar on top of class meta data stored in L objects. Arguments are parsed via L, and also turned into objects. Even exports are blessed references to the exported item itself, and handle the injection on their own (See L). =head1 META CLASS All exporters have a meta class, the only way to get the meta object is to call the exporter_meta() method on the class/object that is an exporter. Any class that uses Exporter::Declare gets this method, and a meta-object. =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/lib/Exporter/Declare000755001750001750 012154252374 21126 5ustar00exodistexodist000000000000Exporter-Declare-0.113/lib/Exporter/Declare/Meta.pm000444001750001750 2276512154252374 22543 0ustar00exodistexodist000000000000package Exporter::Declare::Meta; use strict; use warnings; use Scalar::Util qw/blessed reftype/; use Carp qw/croak/; use aliased 'Exporter::Declare::Export::Sub'; use aliased 'Exporter::Declare::Export::Variable'; use aliased 'Exporter::Declare::Export::Alias'; use Meta::Builder; accessor 'export_meta'; hash_metric exports => ( add => sub { my $self = shift; my ( $data, $metric, $action, $item, $ref ) = @_; croak "Exports must be instances of 'Exporter::Declare::Export'" unless blessed($ref) && $ref->isa('Exporter::Declare::Export'); my ( $type, $name ) = ( $item =~ m/^([\&\%\@\$])?(.*)$/ ); $type ||= '&'; my $fullname = "$type$name"; $self->default_hash_add( $data, $metric, $action, $fullname, $ref ); push @{$self->export_tags->{all}} => $fullname; }, get => sub { my $self = shift; my ( $data, $metric, $action, $item ) = @_; croak "exports_get() does not accept a tag as an argument" if $item =~ m/^[:-]/; my ( $type, $name ) = ( $item =~ m/^([\&\%\@\$])?(.*)$/ ); $type ||= '&'; my $fullname = "$type$name"; return $self->default_hash_get( $data, $metric, $action, $fullname ) || croak $self->package . " does not export '$fullname'"; }, merge => sub { my $self = shift; my ( $data, $metric, $action, $merge ) = @_; my $newmerge = {}; for my $item ( keys %$merge ) { my $value = $merge->{$item}; next if $value->isa(Alias); next if $data->{$item}; $newmerge->{$item} = $value; } $self->default_hash_merge( $data, $metric, $action, $newmerge ); } ); hash_metric options => ( add => sub { my $self = shift; my ( $data, $metric, $action, $item ) = @_; croak "'$item' is already a tag, you can't also make it an option." if $self->export_tags_has($item); croak "'$item' is already an argument, you can't also make it an option." if $self->arguments_has($item); $self->default_hash_add( $data, $metric, $action, $item, 1 ); }, ); hash_metric arguments => ( add => sub { my $self = shift; my ( $data, $metric, $action, $item ) = @_; croak "'$item' is already a tag, you can't also make it an argument." if $self->export_tags_has($item); croak "'$item' is already an option, you can't also make it an argument." if $self->options_has($item); $self->default_hash_add( $data, $metric, $action, $item, 1 ); }, merge => sub { my $self = shift; my ( $data, $metric, $action, $merge ) = @_; my $newmerge = {%$merge}; delete $newmerge->{suffix}; delete $newmerge->{prefix}; $self->default_hash_merge( $data, $metric, $action, $newmerge ); } ); lists_metric export_tags => ( push => sub { my $self = shift; my ( $data, $metric, $action, $item, @args ) = @_; croak "'$item' is a reserved tag, you cannot override it." if $item eq 'all'; croak "'$item' is already an option, you can't also make it a tag." if $self->options_has($item); croak "'$item' is already an argument, you can't also make it a tag." if $self->arguments_has($item); $self->default_list_push( $data, $metric, $action, $item, @args ); }, merge => sub { my $self = shift; my ( $data, $metric, $action, $merge ) = @_; my $newmerge = {}; my %aliases = ( map { my ($name) = (m/^&?(.*)$/); ( $name => 1, "&$name" => 1 ) } @{$merge->{alias}} ); for my $item ( keys %$merge ) { my $values = $merge->{$item}; $newmerge->{$item} = [grep { !$aliases{$_} } @$values]; } $self->default_list_merge( $data, $metric, $action, $newmerge ); } ); sub new { my $class = shift; my $self = $class->SUPER::new( @_, export_tags => {all => [], default => [], alias => []}, arguments => {prefix => 1, suffix => 1}, ); $self->add_alias; return $self; } sub new_from_exporter { my $class = shift; my ($exporter) = @_; my $self = $class->new($exporter); my %seen; my ($exports) = $self->get_ref_from_package('@EXPORT'); my ($export_oks) = $self->get_ref_from_package('@EXPORT_OK'); my ($tags) = $self->get_ref_from_package('%EXPORT_TAGS'); $self->exports_add(@$_) for map { my ( $ref, $name ) = $self->get_ref_from_package($_); if ( $name =~ m/^\&/ ) { Sub->new( $ref, exported_by => $exporter ); } else { Variable->new( $ref, exported_by => $exporter ); } [$name, $ref]; } grep { !$seen{$_}++ } @$exports, @$export_oks; $self->export_tags_push( 'default', @$exports ) if @$exports; $self->export_tags_push( $_, $tags->{$_} ) for keys %$tags; return $self; } sub add_alias { my $self = shift; my $package = $self->package; my ($alias) = ( $package =~ m/([^:]+)$/ ); $self->exports_add( $alias, Alias->new( sub { $package }, exported_by => $package ) ); $self->export_tags_push( 'alias', $alias ); } sub is_tag { my $self = shift; my ($name) = @_; return exists $self->export_tags->{$name} ? 1 : 0; } sub is_argument { my $self = shift; my ($name) = @_; return exists $self->arguments->{$name} ? 1 : 0; } sub is_option { my $self = shift; my ($name) = @_; return exists $self->options->{$name} ? 1 : 0; } sub get_ref_from_package { my $self = shift; my ($item) = @_; use Carp qw/confess/; confess unless $item; my ( $type, $name ) = ( $item =~ m/^([\&\@\%\$]?)(.*)$/ ); $type ||= '&'; my $fullname = "$type$name"; my $ref = $self->package . '::' . $name; no strict 'refs'; return ( \&{$ref}, $fullname ) if !$type || $type eq '&'; return ( \${$ref}, $fullname ) if $type eq '$'; return ( \@{$ref}, $fullname ) if $type eq '@'; return ( \%{$ref}, $fullname ) if $type eq '%'; croak "'$item' cannot be exported"; } sub reexport { my $self = shift; my ($exporter) = @_; my $meta = $exporter->can('export_meta') ? $exporter->export_meta() : __PACKAGE__->new_from_exporter($exporter); $self->merge($meta); } 1; =head1 NAME Exporter::Declare::Meta - The mata object which stoes meta-data for all exporters. =head1 DESCRIPTION All classes that use Exporter::Declare have an associated Meta object. Meta objects track available exports, tags, and options. =head1 METHODS =over 4 =item $class->new( $package ) Created a meta object for the specified package. Also injects the export_meta() sub into the package namespace that returns the generated meta object. =item $class->new_from_exporter( $package ) Create a meta object for a package that already uses Exporter.pm. This will not turn the class into an Exporter::Declare package, but it will create a meta object and export_meta() method on it. This si primarily used for reexport purposes. =item $package = $meta->package() Get the name of the package with which the meta object is associated. =item $meta->add_alias() Usually called at construction to add a package alias function to the exports. =item $meta->add_export( $name, $ref ) Add an export, name should be the item name with sigil (assumed to be sub if there is no sigil). $ref should be a ref blessed as an L subclass. =item $meta->get_export( $name ) Retrieve the L object by name. Name should be the item name with sigil, assumed to be sub when sigil is missing. =item $meta->export_tags_push( $name, @items ) Add @items to the specified tag. Tag will be created if it does not already exist. $name should be the tag name B -/: prefix. =item $bool = $meta->is_tag( $name ) Check if a tag with the given name exists. $name should be the tag name B -/: prefix. =item @list = $meta->get_tag( $name ) Get the list of items associated with the specified tag. $name should be the tag name B -/: prefix. =item $meta->add_options( @names ) Add import options by name. These will be boolean options that take no arguments. =item $meta->add_arguments( @names ) Add import options that slurp in the next argument as a value. =item $bool = $meta->is_option( $name ) Check if the specifed name is an option. =item $bool = $meta->is_argument( $name ) Check if the specifed name is an option that takes an argument. =item $meta->add_parser( $name, sub { ... }) Add a parser sub that should be associated with exports via L =item $meta->get_parser( $name ) Get a parser by name. =item $ref = $meta->get_ref_from_package( $item ) Returns a reference to a specific package variable or sub. =item $meta->reexport( $package ) Re-export the exports in the provided package. Package may be an L based package or an L based package. =item $meta->merge( $meta2 ) Merge-in the exports and tags of the second meta object. =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/lib/Exporter/Declare/Specs.pm000444001750001750 2024112154252374 22715 0ustar00exodistexodist000000000000package Exporter::Declare::Specs; use strict; use warnings; use Carp qw/croak/; our @CARP_NOT = qw/Exporter::Declare/; sub new { my $class = shift; my ( $package, @args ) = @_; my $self = bless( [$package,{},{},[]], $class ); @args = (':default') unless @args; $self->_process( "import list", @args ); return $self; } sub package { shift->[0] } sub config { shift->[1] } sub exports { shift->[2] } sub excludes { shift->[3] } sub export { my $self = shift; my ( $dest ) = @_; for my $item ( keys %{ $self->exports }) { my ( $export, $conf, $args ) = @{ $self->exports->{$item} }; my ( $sigil, $name ) = ( $item =~ m/^([\&\%\$\@])(.*)$/ ); $name = $conf->{as} || join( '', $conf->{prefix} || $self->config->{prefix} || '', $name, $conf->{suffix} || $self->config->{suffix} || '', ); $export->inject( $dest, $name, @$args ); } } sub add_export { my $self = shift; my ( $name, $value, $config ) = @_; my $type = ref $value eq 'CODE' ? 'Sub' : 'Variable'; "Exporter::Declare::Export::$type"->new( $value, exported_by => scalar caller() ); $self->exports->{$name} = [ $value, $config || {}, [], ]; } sub arguments { my $self = shift; my $meta = $self->package->export_meta; return grep { $meta->is_argument($_) } keys %{$self->config}; } sub options { my $self = shift; my $meta = $self->package->export_meta; return grep { $meta->is_option($_) } keys %{$self->config}; } sub tags { my $self = shift; my $meta = $self->package->export_meta; return grep { $meta->is_tag($_) } keys %{$self->config}; } sub _make_info { my $self = shift; my $config = $self->config; return { map { $_, $config->{$_} } @_ }; } sub argument_info { my $self = shift; return $self->_make_info($self->arguments); } sub option_info { my $self = shift; return $self->_make_info($self->options); } sub tag_info { my $self = shift; my $all_tags = $self->package->export_meta->export_tags; return { map { $_, $all_tags->{$_} } $self->tags }; } sub _process { my $self = shift; my ( $tag, @args ) = @_; my $argnum = 0; while ( my $item = shift( @args )) { croak "not sure what to do with $item ($tag argument: $argnum)" if ref $item; $argnum++; if ( $item =~ m/^(!?)[:-](.*)$/ ) { my ( $neg, $param ) = ( $1, $2 ); if ( $self->package->export_meta->arguments_has( $param )) { $self->config->{$param} = shift( @args ); $argnum++; next; } else { $self->config->{$param} = ref( $args[0] ) ? $args[0] : !$neg; } } if ( $item =~ m/^!(.*)$/ ) { $self->_exclude_item( $1 ) } elsif ( my $type = ref( $args[0] )) { my $arg = shift( @args ); $argnum++; if ( $type eq 'ARRAY' ) { $self->_include_item( $item, undef, $arg ); } elsif ( $type eq 'HASH' ) { $self->_include_item( $item, $arg, undef ); } else { croak "Not sure what to do with $item => $arg ($tag arguments: " . ($argnum - 1) . " and $argnum)"; } } else { $self->_include_item( $item ) } } delete $self->exports->{$_} for @{ $self->excludes }; } sub _item_name { my $in = shift; $in =~ m/^[\&\$\%\@]/ ? $in : "\&$in" } sub _exclude_item { my $self = shift; my ( $item ) = @_; if ( $item =~ m/^[:-](.*)$/ ) { $self->_exclude_item( $_ ) for $self->_export_tags_get( $1 ); return; } push @{ $self->excludes } => _item_name($item); } sub _include_item { my $self = shift; my ( $item, $conf, $args ) = @_; $conf ||= {}; $args ||= []; use Carp qw/confess/; confess $item if $item =~ m/^&?aaa_/; push @$args => @{ delete $conf->{'-args'} } if defined $conf->{'-args'}; for my $key ( keys %$conf ) { next if $key =~ m/^[:-]/; push @$args => ( $key, delete $conf->{$key} ); } if ( $item =~ m/^[:-](.*)$/ ) { my $name = $1; return if $self->package->export_meta->options_has( $name ); for my $tagitem ( $self->_export_tags_get( $name ) ) { my ( $negate, $name ) = ( $tagitem =~ m/^(!)?(.*)$/ ); if ( $negate ) { $self->_exclude_item( $name ); } else { $self->_include_item( $tagitem, $conf, $args ); } } return; } $item = _item_name($item); my $existing = $self->exports->{ $item }; unless ( $existing ) { $existing = [ $self->_get_item( $item ), {}, []]; $self->exports->{ $item } = $existing; } push @{ $existing->[2] } => @$args; for my $param ( keys %$conf ) { my ( $name ) = ( $param =~ m/^[-:](.*)$/ ); $existing->[1]->{$name} = $conf->{$param}; } } sub _get_item { my $self = shift; my ( $name ) = @_; $self->package->export_meta->exports_get( $name ); } sub _export_tags_get { my $self = shift; my ( $name ) = @_; $self->package->export_meta->export_tags_get( $name ); } 1; =head1 NAME Exporter::Declare::Specs - Import argument parser for Exporter::Declare =head1 DESCRIPTION Import arguments cna get complicated. All arguments are assumed to be exports unless they have a - or : prefix. The prefix may denote a tag, a boolean option, or an option that takes the next argument as a value. In addition almost all these can be negated with the ! prefix. This class takes care of parsing the import arguments and generating data structures that can be used to find what the exporter needs to know. =head1 METHODS =over 4 =item $class->new( $package, @args ) Create a new instance and parse @args. =item $specs->package() Get the name of the package that should do the exporting. =item $hashref = $specs->config() Get the configuration hash, All specified options and tags are the keys. The value will be true/false/undef for tags/boolean options. For options that take arguments the value will be that argument. When a config hash is provided to a tag it will be the value. =item @names = $specs->arguments() =item @names = $specs->options() =item @names = $specs->tags() Get the argument, option, or tag names that were specified for the import. =item $hashref = $specs->argument_info() Get the arguments that were specified for the import. The key is the name of the argument and the value is what the user supplied during import. =item $hashref = $specs->option_info() Get the options that were specified for the import. The key is the name of the user supplied option and the value will evaluate to true. =item $hashref = $specs->tag_info() Get the values associated with the tags used during import. The key is the name of the tag and the value is an array ref containing the values given to export_tag() for the associated name. =item $hashref = $specs->exports() Get the exports hash. The keys are names of the exports. Values are an array containing the export, item specific config hash, and arguments array. This is generally not intended for direct consumption. =item $arrayref = $specs->excludes() Get the arrayref containing the names of all excluded exports. =item $specs->export( $package ) Do the actual exporting. All exports will be injected into $package. =item $specs->add_export( $name, $value ) =item $specs->add_export( $name, $value, \%config ) Add an export. Name is required, including sigil. Value is required, if it is a sub it will be blessed as a ::Sub, otherwise blessed as a ::Variable. $specs->add_export( '&foo' => sub { return 'foo' }); =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/lib/Exporter/Declare/Export.pm000444001750001750 527412154252374 23112 0ustar00exodistexodist000000000000package Exporter::Declare::Export; use strict; use warnings; use Carp qw/croak carp/; use Scalar::Util qw/reftype/; our %OBJECT_DATA; sub required_specs {qw/ exported_by /} sub new { my $class = shift; my ( $item, %specs ) = @_; my $self = bless( $item, $class ); for my $prop ( $self->required_specs ) { croak "You must specify $prop when calling $class\->new()" unless $specs{$prop}; } $OBJECT_DATA{$self} = \%specs; return $self; } sub _data { my $self = shift; ($OBJECT_DATA{$self}) = @_ if @_; $OBJECT_DATA{$self}; } sub exported_by { shift->_data->{ exported_by }; } sub inject { my $self = shift; my ( $class, $name, @args ) = @_; carp( "Ignoring arguments importing (" . reftype($self) . ")$name into $class: " . join( ', ', @args ) ) if (@args); croak "You must provide a class and name to inject()" unless $class && $name; no strict 'refs'; no warnings 'once'; *{"$class\::$name"} = $self; } sub DESTROY { my $self = shift; delete $OBJECT_DATA{$self}; } 1; =head1 NAME Exporter::Declare::Export - Base class for all export objects. =head1 DESCRIPTION All exports are refs, and all are blessed. This class tracks some per-export information via an inside-out objects system. All things an export may need to do, such as inject itself into a package are handled here. This allows some complicated, or ugly logic to be abstracted out of the exporter and metadata classes. =head1 METHODS =over =item $class->new( $ref, exported_by => $package, %data ) Create a new export from $ref. You must specify the name of the class doing the exporting. =item $export->inject( $package, $name, @args ) This will inject the export into $package under $name. @args are ignored in most cases. See L for an example where they are used. =item $package = $export->exported_by() Returns the name of the package from which this export was originally exported. =item @params = $export->required_specs() Documented for subclassing purposes. This should always return a list of required parameters at construction time. =item $export->DESTROY() Documented for subclassing purposes. This takes care of cleanup related to storing data in an inside-out objects system. =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/lib/Exporter/Declare/Export000755001750001750 012154252374 22407 5ustar00exodistexodist000000000000Exporter-Declare-0.113/lib/Exporter/Declare/Export/Alias.pm000444001750001750 125512154252374 24136 0ustar00exodistexodist000000000000package Exporter::Declare::Export::Alias; use strict; use warnings; use base 'Exporter::Declare::Export'; 1; =head1 NAME Exporter::Declare::Export::Alias - Export class for aliases. =head1 DESCRIPTION Export class for aliases. Currently does not expand upon L in any way. =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/lib/Exporter/Declare/Export/Sub.pm000444001750001750 123512154252374 23634 0ustar00exodistexodist000000000000package Exporter::Declare::Export::Sub; use strict; use warnings; use base 'Exporter::Declare::Export'; 1; =head1 NAME Exporter::Declare::Export::Sub - Export class for subs which are exported. =head1 DESCRIPTION Currently does not do anything L does not. =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/lib/Exporter/Declare/Export/Variable.pm000444001750001750 133512154252374 24631 0ustar00exodistexodist000000000000package Exporter::Declare::Export::Variable; use strict; use warnings; use base 'Exporter::Declare::Export'; 1; =head1 NAME Exporter::Declare::Export::Variable - Export class for variables which are exported. =head1 DESCRIPTION Export class for variables which are exported. Currently does not expand upon L in any way. =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Exporter-Declare-0.113/lib/Exporter/Declare/Export/Generator.pm000444001750001750 430212154252374 25027 0ustar00exodistexodist000000000000package Exporter::Declare::Export::Generator; use strict; use warnings; use base 'Exporter::Declare::Export::Sub'; use Exporter::Declare::Export::Variable; use Carp qw/croak/; sub required_specs { my $self = shift; return( $self->SUPER::required_specs(), qw/ type /, ); } sub type { shift->_data->{ type }} sub new { my $class = shift; croak "Generators must be coderefs, not " . ref($_[0]) unless ref( $_[0] ) eq 'CODE'; $class->SUPER::new( @_ ); } sub generate { my $self = shift; my ( $import_class, @args ) = @_; my $ref = $self->( $self->exported_by, $import_class, @args ); return Exporter::Declare::Export::Sub->new( $ref, %{ $self->_data }, ) if $self->type eq 'sub'; return Exporter::Declare::Export::Variable->new( $ref, %{ $self->_data }, ) if $self->type eq 'variable'; return $self->type->new( $ref, %{ $self->_data }, ); } sub inject { my $self = shift; my ( $class, $name, @args ) = @_; $self->generate( $class, @args )->inject( $class, $name ); } 1; =head1 NAME Exporter::Declare::Export::Generator - Export class for exports that should be generated when imported. =head1 DESCRIPTION Export class for exports that should be generated when imported. =head1 OVERRIDEN METHODS =over 4 =item $class->new( $ref, $ref, exported_by => $package, type => $type, %data ) You must specify the type as 'sub' or 'variable'. =item $export->inject( $package, $name, @args ) Calls generate() with @args to create a generated export. The new export is then injected. =back =head1 ADDITIONAL METHODS =over 4 =item $new = $export->generate( $import_class, @args ) Generates a new export object. =item $type = $export->type() Returns the type of object to be generated (sub or variable) =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Exporter-Declare is free software; Standard perl licence. Exporter-Declare is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details.