view release on metacpan or  search on metacpan

local/lib/perl5/Module/ScanDeps.pm  view on Meta::CPAN

        $loader_regexp = $LoaderRegexp{"Catalyst"} || _build_loader_regexp("Catalyst", "Catalyst::Plugin");
        if ($_ =~ $loader_regexp) { # $1 == loader, $2 == loadee
          my $retval = _extract_loader_dependency($1, $2, "Catalyst::Plugin");
          return $retval if $retval;
        }

        return [ 'Class/Autouse.pm',
            map { s{::}{/}g; "$_.pm" }
              grep { length and !/^:|^q[qw]?$/ } split(/[^\w:]+/, $1) ]
          if /^use \s+ Class::Autouse \b \s* (.*)/sx
              or /^Class::Autouse \s* -> \s* autouse \s* (.*)/sx;

        return $1 if /^(?:use|no|require) \s+ ([\w:\.\-\\\/\"\']+)/x;
        return $1
          if /^(?:use|no|require) \s+ \( \s* ([\w:\.\-\\\/\"\']+) \s* \)/x;

        if (   s/^eval\s+\"([^\"]+)\"/$1/
            or s/^eval\s*\(\s*\"([^\"]+)\"\s*\)/$1/)
        {
            return $1 if /^\s* (?:use|no|require) \s+ ([\w:\.\-\\\/\"\']*)/x;
        }

        if (/(<[^>]*[^\$\w>][^>]*>)/) {
            my $diamond = $1;
            return "File/Glob.pm" if $diamond =~ /[*?\[\]{}~\\]/;
        }

        return "DBD/$1.pm"    if /\b[Dd][Bb][Ii]:(\w+):/;

        # check for stuff like
        #   decode("klingon", ...)
        #   open FH, "<:encoding(klingon)", ...
        if (my ($args) = /\b(?:open|binmode)\b(.*)/) {
            my @mods;
            push @mods, qw( PerlIO.pm PerlIO/encoding.pm Encode.pm ), _find_encoding($1)
                if $args =~ /:encoding\((.*?)\)/;
            push @mods, qw( PerlIO.pm PerlIO/via.pm )
                if $args =~ /:via\(/;
            return \@mods if @mods;
        }
        if (/\b(?:en|de)code\(\s*['"]?([-\w]+)/) {
            return [qw( Encode.pm ), _find_encoding($1)]; 
        }

        return $1 if /\b do \s+ ([\w:\.\-\\\/\"\']*)/x;

        if ($SeenTk) {
            my @modules;
            while (/->\s*([A-Z]\w+)/g) {
                push @modules, "Tk/$1.pm";
            }
            while (/->\s*Scrolled\W+([A-Z]\w+)/g) {
                push @modules, "Tk/$1.pm";
                push @modules, "Tk/Scrollbar.pm";
            }
            if (/->\s*setPalette/g) {
                push @modules,
                  map { "Tk/$_.pm" }
                  qw( Button Canvas Checkbutton Entry
                      Frame Label Labelframe Listbox
                      Menubutton Menu Message Radiobutton
                      Scale Scrollbar Spinbox Text );
            }
            return \@modules;
        }

        # Module::Runtime
        return $1 if /\b(?:require_module|use_module|use_package_optimistically) \s* \( \s* ([\w:"']+)/x;

        # Test::More
        return $1 if /\b(?:require_ok|use_ok) \s* \( \s* ([\w:"']+)/x;

        return;
    };

    # }}}

    return unless defined($module);
    return wantarray ? @$module : $module->[0] if ref($module);

    $module =~ s/^['"]//;
    return unless $module =~ /^\w/;

    $module =~ s/\W+$//;
    $module =~ s/::/\//g;
    return if $module =~ /^(?:[\d\._]+|'.*[^']|".*[^"])$/;

    $module .= ".pm" unless $module =~ /\./;
    return $module;
}

sub _find_encoding {
    return unless $] >= 5.008 and eval { require Encode; %Encode::ExtModule };

    my $mod = $Encode::ExtModule{ Encode::find_encoding($_[0])->name }
      or return;
    $mod =~ s{::}{/}g;
    return "$mod.pm";
}

sub _add_info {
    my %args = @_;
    my ($rv, $module, $file, $used_by, $type) = @args{qw/rv module file used_by type/};

    return unless defined($module) and defined($file);

    # Ensure file is always absolute
    $file = File::Spec->rel2abs($file);
    $file =~ s|\\|\/|go;

    # Avoid duplicates that can arise due to case differences that don't actually 
    # matter on a case tolerant system
    if (File::Spec->case_tolerant()) {
        foreach my $key (keys %$rv) {
            if (lc($key) eq lc($module)) {
                $module = $key;
                last;
            }
        }
        if (defined($used_by)) {
            if (lc($used_by) eq lc($module)) {