relative-0.04/0000755000076500007650000000000010751111316015172 5ustar maddinguemaddingue00000000000000relative-0.04/Build.PL0000444000076500007650000000072710751111316016472 0ustar maddinguemaddingue00000000000000use strict; use Module::Build; my $builder = Module::Build->new( module_name => 'relative', license => 'perl', dist_author => 'Sebastien Aperghis-Tramoni ', dist_version_from => 'lib/relative.pm', requires => { 'UNIVERSAL::require' => 0, }, build_requires => { 'Test::More' => 0, }, add_to_cleanup => [ 'relative-*' ], ); $builder->create_build_script(); relative-0.04/Changes0000444000076500007650000000135010751111316016462 0ustar maddinguemaddingue00000000000000Revision history for relative 0.04 2008.02.01 (SAPER) [BUGFIX] Really make the errors appear as coming from the caller. 0.03 2007.10.26 (SAPER) [BUGFIX] Fixed a bug in the regexp that resolve parent names. [FEATURE] New short-hand syntax for sibling modules. [FEATURE] Implement alias support (Curtis Poe). [CODE] Check the eval(import) as well (Eric Wilhelm). 0.02 2007.10.07 (SAPER) [FEATURE] import() now returns the list of loaded modules (thanks to Ken Williams). [API] Changed to short form from "to => ..." to "-to => ..." in order to avoid module name clash. 0.01 2007.10.06 (SAPER) First version, released on an unsuspecting world. relative-0.04/eg/0000755000076500007650000000000010751111316015565 5ustar maddinguemaddingue00000000000000relative-0.04/eg/README0000444000076500007650000000006410751111316016443 0ustar maddinguemaddingue00000000000000See examples in the documentation and in the tests. relative-0.04/lib/0000755000076500007650000000000010751111316015740 5ustar maddinguemaddingue00000000000000relative-0.04/lib/relative.pm0000444000076500007650000001704310751111316020114 0ustar maddinguemaddingue00000000000000package relative; use strict; use Carp; use UNIVERSAL::require; { no strict "vars"; $VERSION = '0.04'; } =head1 NAME relative - Load modules with relative names =head1 VERSION Version 0.04 =cut sub import { return if @_ <= 1; # called with no args my ($package, @args) = @_; my ($caller) = caller(); my @loaded = (); # read the optional parameters my %param = (); if (ref $args[0] eq 'HASH') { %param = %{shift @args} } elsif (ref $args[0] eq 'ARRAY') { %param = @{shift @args} } # go through the args list, looking to parameters with the dash syntax, # and module names and optional arguments my %args_for = (); # modules arguments my @modules = (); # will be filled with only the module names my $prev = ""; for my $item (@args) { # if $prev is true, the previous thing (parameter or module name) # is expecting a value if ($prev) { # this is a parameter if (index($prev, "-") == 0) { $param{substr($prev, 1)} = $item; $prev = ""; } # this is a module name else { push @modules, $prev; # this isn't a ref, so the previous module is just stored # and the current item becomes the new $prev if (not ref $item) { $prev = $item; } # this is an arrayref, which will be used as the import list # for the module name in $prev elsif (ref $item eq "ARRAY") { $args_for{$prev} = $item; $prev = ""; } else { my $that = "a ".lc(ref $item)."ref"; croak "error: Don't know how to deal with $that (after '$prev')"; } } } else { if ($item eq "-aliased") { # -aliased is a flag, so it doesn't expect a value $param{aliased} = 1 } else { $prev = $item } } } push @modules, $prev if $prev; # determine the base name my $base = exists $param{to} ? $param{to} : $caller; # load the modules for my $relname (@modules) { # resolve the module relative name to absolute name my $module = "$base\::$relname"; 1 while $module =~ s/::\w+::(?:\.\.)?::/::/g; $module =~ s/^:://; # load the module, die if it failed $module->require or croak _clean($@); # import the symbols from the loaded module into the caller module if (exists $args_for{$relname}) { my $args = $args_for{$relname}; # an arguments list has been defined, but only call import if # there are some arguments if (@$args) { my $args_str = join ", ", map {"q/\Q$_\E/"} @$args; eval qq{ package $caller; $module->import($args_str); 1 } or croak _clean($@); } } else { # use the default import method eval qq{ package $caller; $module->import; 1 } or croak _clean($@); } # define alias if asked to if ($param{aliased}) { my ($alias) = $module =~ /\b(\w+)$/; eval qq{ package $caller; sub $alias () { q/$module/ } }; } # keep a list of the loaded modules push @loaded, $module; } return wantarray ? @loaded : $loaded[-1] } sub _clean { my ($msg) = @_; $msg =~ s/ at .*relative.pm line \d+\.\s*$//s; return $msg } =head1 SYNOPSIS package BigApp::Report; use relative qw(Create Publish); # loads BigApp::Report::Create, BigApp::Report::Publish use relative qw(..::Utils); # loads BigApp::Utils use relative -to => "Enterprise::Framework" => qw(Base Factory); # loads Enterprise::Framework::Base, Enterprise::Framework::Factory =head1 DESCRIPTION This module allows you to load modules using only parts of their name, relatively to the current module or to a given module. Module names are by default searched below the current module, but can be searched upper in the hierarchy using the C<..::> syntax. In order to further loosen the namespace coupling, C returns the full names of the loaded modules, making object-oriented code easier to write: use relative; my ($Maker, $Publisher) = import relative qw(Create Publish); my $report = $Maker->new; my $publisher = $Publisher->new; my ($Base, $Factory) = import relative -to => "Enterprise::Framework" => qw(Base Factory); my $thing = $Factory->new; This can also be written using aliases: use relative -aliased => qw(Create Publish); my $report = Create->new; my $publisher = Publisher->new; use relative -to => "Enterprise::Framework", -aliased => qw(Base Factory); my $thing = Factory->new; =head1 IMPORT OPTIONS Import options can be given as an hashref or an arrayref as the first argument: # options as a hashref import relative { param => value, ... }, qw(Name ...); # options as an arrayref import relative [ param => value, ... ], qw(Name ...); In order to simplyfing syntax, options can also be given as dash-prefixed params: import relative -param => value, qw(name ...); Available options: =over =item * C can be used to indicate another hierarchy to search modules inside. B # in a hashref: import relative { to => "Some::Other::Namespace" }, qw(Other Modules); # as dash-param: import relative -to => "Some::Other::Namespace", qw(Other Modules); =item * C will create constants, named with the last component of each loaded module, returning its corresponding full name. Yes, this feature is very similar to what C does as it was added per Ovid request C<:-)> B # in a hashref: import relative { aliased => 1 }, qw(Whack Zlonk); my $frob = Whack->fizzle; # as dash-param: import relative -aliased, qw(Whack Zlonk); my $frob = Whack->fizzle; =back C will C as soon as a module can't be loaded. C returns the full names of the loaded modules when called in list context, or the last one when called in scalar context. =head1 AUTHOR SEbastien Aperghis-Tramoni, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc relative You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS Thanks to Aristotle Pagaltzis, Andy Armstrong, Ken Williams and Curtis Poe for their suggestions and ideas. =head1 COPYRIGHT & LICENSE Copyright 2007 SEbastien Aperghis-Tramoni, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut "evitaler fo dnE" # "End of relative" relative-0.04/Makefile.PL0000444000076500007650000000113110751111316017136 0ustar maddinguemaddingue00000000000000use strict; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'relative', license => 'perl', AUTHOR => 'Sebastien Aperghis-Tramoni ', VERSION_FROM => 'lib/relative.pm', ABSTRACT_FROM => 'lib/relative.pm', PREREQ_PM => { # prereqs 'UNIVERSAL::require' => 0, # build/tests prereqs 'Test::More' => 0, }, PL_FILES => {}, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'relative-*' }, ); relative-0.04/MANIFEST0000444000076500007650000000055610751111316016327 0ustar maddinguemaddingue00000000000000Build.PL Makefile.PL Changes MANIFEST META.yml README lib/relative.pm eg/README t/00-load.t t/BigApp/Report/Create.pm t/BigApp/Report.pm t/BigApp/Report/Publish.pm t/BigApp/Tools.pm t/BigApp/Utils.pm t/Enterprise/Framework/Base.pm t/Enterprise/Framework/Factory.pm t/pod-coverage.t t/pod.t t/relative-aliased.t t/relative-args.t t/relative-fail.t t/relative-plain.t relative-0.04/META.yml0000444000076500007650000000073010751111316016441 0ustar maddinguemaddingue00000000000000--- name: relative version: 0.04 author: - 'Sebastien Aperghis-Tramoni ' abstract: Load modules with relative names license: perl resources: license: http://dev.perl.org/licenses/ requires: UNIVERSAL::require: 0 build_requires: Test::More: 0 provides: relative: file: lib/relative.pm version: 0.04 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 relative-0.04/README0000444000076500007650000000302010751111316016043 0ustar maddinguemaddingue00000000000000NAME relative - Load modules with relative names DESCRIPTION This module allows you to load modules using only parts of their name, relatively to the current module or to a given module. Module names are by default searched below the current module, but can be searched upper in the hierarchy using the "..::" syntax. In order to further loosen the namespace coupling, "import" returns the full names of the loaded modules, making object-oriented code easier to write. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install Alternatively, to install with Module::Build, you can use the following commands: perl Build.PL ./Build ./Build test ./Build install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc relative You can also look for information at: Search CPAN http://search.cpan.org/dist/relative CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=relative AnnoCPAN, annotated CPAN documentation: http://annocpan.org/dist/relative CPAN Ratings: http://cpanratings.perl.org/d/relative COPYRIGHT AND LICENCE Copyright (C) 2007 Sébastien Aperghis-Tramoni This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. relative-0.04/t/0000755000076500007650000000000010751111316015435 5ustar maddinguemaddingue00000000000000relative-0.04/t/00-load.t0000444000076500007650000000020610751111316016752 0ustar maddinguemaddingue00000000000000#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'relative' ); } diag( "Testing relative $relative::VERSION, Perl $], $^X" ); relative-0.04/t/BigApp/0000755000076500007650000000000010751111316016577 5ustar maddinguemaddingue00000000000000relative-0.04/t/BigApp/Report/0000755000076500007650000000000010751111316020052 5ustar maddinguemaddingue00000000000000relative-0.04/t/BigApp/Report/Create.pm0000444000076500007650000000023410751111316021610 0ustar maddinguemaddingue00000000000000package BigApp::Report::Create; require Exporter; $VERSION = 2.16; @ISA = qw(Exporter); @EXPORT = qw(new_report); sub new_report { return bless {} } 1 relative-0.04/t/BigApp/Report/Publish.pm0000444000076500007650000000020710751111316022013 0ustar maddinguemaddingue00000000000000package BigApp::Report::Publish; require Exporter; $VERSION = 2.53; @ISA = qw(Exporter); @EXPORT = qw(render); sub render { 1 } 1 relative-0.04/t/BigApp/Report.pm0000444000076500007650000000557510751111316020422 0ustar maddinguemaddingue00000000000000package BigApp::Report; use Test::More; my @loaded; my $loaded; # load a sibling module, first syntax use_ok( relative => qw(..::Utils) ); is( $BigApp::Utils::VERSION, 3.12, "checking that BigApp::Utils was actually loaded" ); @loaded = import relative qw(..::Utils); is_deeply( \@loaded, ["BigApp::Utils"], "checking what import returns in list context" ); $loaded = import relative qw(..::Utils); is( $loaded, "BigApp::Utils", "checking what import returns in scalar context" ); # load a sibling module, short syntax use_ok( relative => qw(::Tools) ); is( $BigApp::Tools::VERSION, 3.45, "checking that BigApp::Tools was actually loaded" ); @loaded = import relative qw(::Tools); is_deeply( \@loaded, ["BigApp::Tools"], "checking what import returns in list context" ); $loaded = import relative qw(::Tools); is( $loaded, "BigApp::Tools", "checking what import returns in scalar context" ); # load two modules use_ok( relative => qw(Create Publish) ); is( $BigApp::Report::Create::VERSION, 2.16, "checking that BigApp::Report::Create was actually loaded" ); is( $BigApp::Report::Publish::VERSION, 2.53, "checking that BigApp::Report::Publish was actually loaded" ); @loaded = import relative qw(Create Publish); is_deeply( \@loaded, ["BigApp::Report::Create", "BigApp::Report::Publish"], "checking what import returns in list context" ); $loaded = import relative qw(Create Publish); is( $loaded, "BigApp::Report::Publish", "checking what import returns in scalar context" ); # check that the methods have been imported can_ok( "BigApp::Report::Create", qw(new_report) ); can_ok( __PACKAGE__, qw(new_report) ); my $report = eval { new_report() }; is( $@, "", "calling new_report()" ); isa_ok( $report, "BigApp::Report::Create", "checking that \$report" ); can_ok( "BigApp::Report::Publish", qw(render) ); can_ok( __PACKAGE__, qw(render) ); my $r = eval { render($report) }; is( $@, "", "calling render()" ); is( $r, 1, "checking result code" ); # load modules relatively to another hierarchy use_ok( relative => -to => "Enterprise::Framework" => qw(Base Factory) ); is( $Enterprise::Framework::Base::VERSION, "10.5.32.14", "checking that Enterprise::Framework::Base was actually loaded" ); is( $Enterprise::Framework::Factory::VERSION, "10.5.43.58", "checking that Enterprise::Framework::Factory was actually loaded" ); @loaded = import relative -to => "Enterprise::Framework" => qw(Base Factory); is_deeply( \@loaded, ["Enterprise::Framework::Base", "Enterprise::Framework::Factory"], "checking what import returns in list context" ); $loaded = import relative -to => "Enterprise::Framework" => qw(Factory Base); is( $loaded, "Enterprise::Framework::Base", "checking what import returns in scalar context" ); can_ok( $loaded, qw(new) ); my $obj = eval { $loaded->new() }; is( $@, "", "calling $loaded->new()" ); isa_ok( $obj, $loaded, "checking that \$obj" ); 1 relative-0.04/t/BigApp/Tools.pm0000444000076500007650000000005210751111316020230 0ustar maddinguemaddingue00000000000000package BigApp::Tools; $VERSION = 3.45; 1 relative-0.04/t/BigApp/Utils.pm0000444000076500007650000000005210751111316020230 0ustar maddinguemaddingue00000000000000package BigApp::Utils; $VERSION = 3.12; 1 relative-0.04/t/Enterprise/0000755000076500007650000000000010751111316017555 5ustar maddinguemaddingue00000000000000relative-0.04/t/Enterprise/Framework/0000755000076500007650000000000010751111316021512 5ustar maddinguemaddingue00000000000000relative-0.04/t/Enterprise/Framework/Base.pm0000444000076500007650000000012510751111316022716 0ustar maddinguemaddingue00000000000000package Enterprise::Framework::Base; $VERSION = "10.5.32.14"; sub new { bless {} } 1 relative-0.04/t/Enterprise/Framework/Factory.pm0000444000076500007650000000010310751111316023447 0ustar maddinguemaddingue00000000000000package Enterprise::Framework::Factory; $VERSION = "10.5.43.58"; 1 relative-0.04/t/pod-coverage.t0000444000076500007650000000027310751111316020175 0ustar maddinguemaddingue00000000000000#!perl use strict; use Test::More; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" unless eval "use Test::Pod::Coverage 1.04; 1"; all_pod_coverage_ok(); relative-0.04/t/pod.t0000444000076500007650000000023310751111316016400 0ustar maddinguemaddingue00000000000000#!perl use strict; use Test::More; plan skip_all => "Test::Pod 1.14 required for testing POD" unless eval "use Test::Pod 1.14; 1"; all_pod_files_ok(); relative-0.04/t/relative-aliased.t0000444000076500007650000000175410751111316021042 0ustar maddinguemaddingue00000000000000#!perl -Tw use strict; use Test::More; use lib "t"; plan tests => 11; use_ok( "relative" ); # load modules and create aliases from Enterprise::Framework my $loaded = eval { import relative -to => "Enterprise::Framework" => -aliased => qw(Factory Base) }; is( $@, "", "load modules and create aliases" ); # check that the aliases were created can_ok( __PACKAGE__, "Base", "Factory" ); can_ok( $loaded, qw(new) ); my $obj = eval { Base()->new() }; is( $@, "", "calling Base()->new()" ); isa_ok( $obj, $loaded, "checking that \$obj" ); # load modules and create aliases from BigApp $loaded = eval { import relative -to => "BigApp" => -aliased => qw(Report::Publish Report::Create) }; is( $@, "", "load modules and create aliases" ); # check that the aliases were created can_ok( __PACKAGE__, "Create", "Publish" ); can_ok( $loaded, qw(new_report) ); my $report = eval { Create()->new_report() }; is( $@, "", "calling Create()->new_report()" ); isa_ok( $report, $loaded, "checking that \$report" ); relative-0.04/t/relative-args.t0000444000076500007650000000174410751111316020373 0ustar maddinguemaddingue00000000000000#!perl -Tw package BigApp::Report; use strict; use Test::More; use lib "t"; plan tests => 7; use_ok( "relative" ); # load modules with empty import lists my @loaded = import relative Create => [], "::Tools", Publish => [], "::Utils"; is_deeply( \@loaded, [qw(BigApp::Report::Create BigApp::Tools BigApp::Report::Publish BigApp::Utils)], "check that the modules were correctly loaded" ); ok( !exists $BigApp::Report::{new_report}, "check that the function 'new_report' was not imported" ); ok( !exists $BigApp::Report::{render}, "check that the function 'render' was not imported" ); # load modules with non-empty import lists @loaded = import relative Create => ["new_report"], "::Tools", Publish => ["render"], "::Utils"; is_deeply( \@loaded, [qw(BigApp::Report::Create BigApp::Tools BigApp::Report::Publish BigApp::Utils)], "check that the modules were correctly loaded" ); can_ok( __PACKAGE__, "new_report" ); can_ok( __PACKAGE__, "render" ); relative-0.04/t/relative-fail.t0000444000076500007650000000050510751111316020344 0ustar maddinguemaddingue00000000000000#!perl -Tw package BigApp::Report; use strict; use Test::More; use lib "t"; plan tests => 2; use_ok( "relative" ); # check that loading a non-existing module results in failure my $module = "NoSuchModule"; eval { import relative $module }; like( $@, "/Can't locate BigApp/Report/$module.pm in \@INC/", "checking error" ); relative-0.04/t/relative-plain.t0000444000076500007650000000014310751111316020532 0ustar maddinguemaddingue00000000000000#!perl -Tw use strict; use Test::More; use lib "t"; plan tests => 30; use_ok( "BigApp::Report" );