相対パス指定でモジュールを use したいんですけど

  • Foo::Bar::Hoge
  • Foo::Bar::Hoge::Fuga
  • Foo::Bar::Baz

みたいなモジュール構成の際に,Foo::Bar::Hoge の定義として

package Foo::Bar::Hoge;

# identical to:
#   use Path::Class;
#   use Foo::Bar::Baz;
#   use Foo::Bar::Hoge::Fuga;

use Module::Relative qw(
    Path::Class
    ::Baz
    .::Fuga
);

# identical to:
#   use CGI qw/ :standard /;
#   use Foo::Bar::Baz;
#   use Foo::Bar::Hoge::Fuga ();

use Module::Relative [
    'CGI'     => [ ':standard' ],
    '::Baz'   => undef,
    '.::Fuga' => [],
];

...

みたいなマナー。DBIx::Class::Componentised や Class::Component 的テイストで,でも継承とか無縁で BEGIN 時にやってくれるもの。

いかにも CPAN にありそうだけど見付からないです(^Module::* しか探してませんが)。どこが便利?と聞かれるとかなり困りますが,それ○○ってのがあれば是非御教示を。

いちおう試作機をおいときます。

package Module::Relative;

use strict;
use warnings;
use Carp;
use Exporter;

sub import {
    shift;      # me
    return if ! @_;
    my ($pkg) = caller;

    my @modules
        = (ref $_[0] eq 'ARRAY') ? @{ $_[0] }
        : (ref $_[0] eq 'HASH' ) ? %{ $_[0] }
        :                          map { $_ => undef } @_
        ;

    my $pkg_base = $pkg;
    $pkg_base =~ s' :: .+? \z''xmso;

    while (@modules) {
        my ($module, $args) = splice @modules, 0, 2;

        if ($module =~ m'^::'o) {
            $module = $pkg_base . $module;
        }
        elsif ($module =~ s'^\.::'::'o) {
            $module = $pkg      . $module;
        }

        eval "require ${module}";
        if ($@) {
            $@ =~ s' \s+ at \s+ \( eval \s+ \d+ \)
                         (?: \s+ line \s+ \d+ )? \.? \s* \z
                   ''xmso;
            croak $@;
        }

        {
            local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
            local $Carp::CarpLevel       = $Carp::CarpLevel       + 1;

            if (! defined $args) {
                $module->import();
            }
            elsif (@$args) {
                $module->import(@$args);
            }
        }
    }

    return;
}

1;