FM / rpm

/usr/lib/rpm

Name	Size	Mode	Actions
macros.d/	-	0755	rm
platform/	-	0755	rm
redhat/	-	0755	rm
brp-compress	1466	0755	edit dl rm
brp-java-gcjcompile	1401	0755	edit dl rm
brp-python-bytecompile	3031	0755	edit dl rm
brp-strip	487	0755	edit dl rm
brp-strip-comment-note	696	0755	edit dl rm
brp-strip-shared	684	0755	edit dl rm
brp-strip-static-archive	389	0755	edit dl rm
check-buildroot	1231	0755	edit dl rm
check-files	663	0755	edit dl rm
check-prereqs	418	0755	edit dl rm
check-rpaths	1039	0755	edit dl rm
check-rpaths-worker	5045	0755	edit dl rm
config.guess	44941	0755	edit dl rm
config.sub	34423	0755	edit dl rm
debugedit	30544	0755	edit dl rm
desktop-file.prov	437	0755	edit dl rm
find-debuginfo.sh	9358	0755	edit dl rm
find-lang.sh	5621	0755	edit dl rm
find-provides	1559	0755	edit dl rm
find-requires	3505	0755	edit dl rm
fontconfig.prov	489	0755	edit dl rm
javadeps	23400	0755	edit dl rm
libtooldeps.sh	707	0755	edit dl rm
macros	43450	0644	edit dl rm
macros.perl	596	0644	edit dl rm
macros.php	313	0644	edit dl rm
macros.python	906	0644	edit dl rm
mkinstalldirs	3495	0755	edit dl rm
mono-find-provides	1105	0755	edit dl rm
mono-find-requires	1914	0755	edit dl rm
ocaml-find-provides.sh	1880	0755	edit dl rm
ocaml-find-requires.sh	2354	0755	edit dl rm
osgideps.pl	10591	0755	edit dl rm
perl.prov	5776	0755	edit dl rm
perl.req	7973	0755	edit dl rm
perldeps.pl	32900	0644	edit dl rm
pkgconfigdeps.sh	1171	0755	edit dl rm
pythondeps.sh	875	0755	edit dl rm
rpm.daily	284	0644	edit dl rm
rpm.log	61	0644	edit dl rm
rpm.xinetd	319	0644	edit dl rm
rpm2cpio.sh	1255	0755	edit dl rm
rpmdb_archive	-	0	edit dl rm
rpmdb_deadlock	-	0	edit dl rm
rpmdb_dump	-	0	edit dl rm
rpmdb_load	-	0	edit dl rm
rpmdb_loadcvt	1467	0755	edit dl rm
rpmdb_printlog	-	0	edit dl rm
rpmdb_recover	-	0	edit dl rm
rpmdb_stat	-	0	edit dl rm
rpmdb_upgrade	-	0	edit dl rm
rpmdb_verify	-	0	edit dl rm
rpmdeps	8616	0755	edit dl rm
rpmdiff	23977	0755	edit dl rm
rpmdiff.cgi	15674	0644	edit dl rm
rpmpopt-4.8.0	7920	0644	edit dl rm
rpmrc	13698	0644	edit dl rm
tcl.req	2069	0755	edit dl rm
tgpg	907	0755	edit dl rm

Edit: /usr/lib/rpm/perldeps.pl (32900B)

#!/usr/bin/perl -Tw
#
# perldeps.pl -- Analyze dependencies of Perl packages
#
# Michael Jennings
# 7 November 2005
#
# $Id: perldeps.pl,v 1.6 2006/04/04 20:12:03 mej Exp $
#

use strict;
use Config;
use File::Basename;
use File::Find;
use Getopt::Long;
use POSIX;

############### Debugging stolen from Mezzanine::Util ###############
my $DEBUG = 0;

# Debugging output
sub
dprintf(@)
{
    my ($f, $l, $s, $format);
    my @params = @_;

return if (! $DEBUG);
    $format = shift @params;
    if (!scalar(@params)) {
        return dprint($format);
    }
    (undef, undef, undef, $s) = caller(1);
    if (!defined($s)) {
        $s = "MAIN";
    }
    (undef, $f, $l) = caller(0);
    $f =~ s/^.*\/([^\/]+)$/$1/;
    $s =~ s/^\w+:://g;
    $s .= "()" if ($s =~ /^\w+$/);
    $f = "" if (!defined($f));
    $l = "" if (!defined($l));
    $format = "" if (!defined($format));
    for (my $i = 0; $i < scalar(@params); $i++) {
        if (!defined($params[$i])) {
            $params[$i] = "<undef>";
        }
    }
    printf("[$f/$l/$s] $format", @params);
}

sub
dprint(@)
{
    my ($f, $l, $s);
    my @params = @_;

return if (! $DEBUG);
    (undef, undef, undef, $s) = caller(1);
    if (!defined($s)) {
        $s = "MAIN";
    }
    (undef, $f, $l) = caller(0);
    $f =~ s/^.*\/([^\/]+)$/$1/;
    $s =~ s/\w+:://g;
    $s .= "()" if ($s =~ /^\w+$/);
    $f = "" if (!defined($f));
    $l = "" if (!defined($l));
    $s = "" if (!defined($s));
    for (my $i = 0; $i < scalar(@params); $i++) {
        if (!defined($params[$i])) {
            $params[$i] = "<undef>";
        }
    }
    print "[$f/$l/$s] ", @params;
}

############### Module::ScanDeps Code ###############
use constant dl_ext  => ".$Config{dlext}";
use constant lib_ext => $Config{lib_ext};
use constant is_insensitive_fs => (
    -s $0 
        and (-s lc($0) || -1) == (-s uc($0) || -1)
        and (-s lc($0) || -1) == -s $0
);

my $CurrentPackage = '';
my $SeenTk;

# Pre-loaded module dependencies
my %Preload = (
    'AnyDBM_File.pm'  => [qw( SDBM_File.pm )],
    'Authen/SASL.pm'  => 'sub',
    'Bio/AlignIO.pm'  => 'sub',
    'Bio/Assembly/IO.pm'  => 'sub',
    'Bio/Biblio/IO.pm'  => 'sub',
    'Bio/ClusterIO.pm'  => 'sub',
    'Bio/CodonUsage/IO.pm'  => 'sub',
    'Bio/DB/Biblio.pm'  => 'sub',
    'Bio/DB/Flat.pm'  => 'sub',
    'Bio/DB/GFF.pm'  => 'sub',
    'Bio/DB/Taxonomy.pm'  => 'sub',
    'Bio/Graphics/Glyph.pm'  => 'sub',
    'Bio/MapIO.pm'  => 'sub',
    'Bio/Matrix/IO.pm'  => 'sub',
    'Bio/Matrix/PSM/IO.pm'  => 'sub',
    'Bio/OntologyIO.pm'  => 'sub',
    'Bio/PopGen/IO.pm'  => 'sub',
    'Bio/Restriction/IO.pm'  => 'sub',
    'Bio/Root/IO.pm'  => 'sub',
    'Bio/SearchIO.pm'  => 'sub',
    'Bio/SeqIO.pm'  => 'sub',
    'Bio/Structure/IO.pm'  => 'sub',
    'Bio/TreeIO.pm'  => 'sub',
    'Bio/LiveSeq/IO.pm'  => 'sub',
    'Bio/Variation/IO.pm'  => 'sub',
    'Crypt/Random.pm' => sub {
        _glob_in_inc('Crypt/Random/Provider', 1);
    },
    'Crypt/Random/Generator.pm' => sub {
        _glob_in_inc('Crypt/Random/Provider', 1);
    },
    'DBI.pm' => sub {
        grep !/\bProxy\b/, _glob_in_inc('DBD', 1);
    },
    'DBIx/SearchBuilder.pm' => 'sub',
    'DBIx/ReportBuilder.pm' => 'sub',
    'Device/ParallelPort.pm' => 'sub',
    'Device/SerialPort.pm' => [ qw(
        termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph
    ) ],
    'ExtUtils/MakeMaker.pm' => sub {
        grep /\bMM_/, _glob_in_inc('ExtUtils', 1);
    },
    'File/Basename.pm' => [qw( re.pm )],
    'File/Spec.pm'     => sub {
        require File::Spec;
        map { my $name = $_; $name =~ s!::!/!g; "$name.pm" } @File::Spec::ISA;
    },
    'HTTP/Message.pm' => [ qw(
        URI/URL.pm          URI.pm
    ) ],
    'IO.pm' => [ qw(
        IO/Handle.pm        IO/Seekable.pm      IO/File.pm
        IO/Pipe.pm          IO/Socket.pm        IO/Dir.pm
    ) ],
    'IO/Socket.pm'     => [qw( IO/Socket/UNIX.pm )],
    'LWP/UserAgent.pm' => [ qw(
        URI/URL.pm          URI/http.pm         LWP/Protocol/http.pm
        LWP/Protocol/https.pm
    ), _glob_in_inc("LWP/Authen", 1) ],
    'Locale/Maketext/Lexicon.pm'    => 'sub',
    'Locale/Maketext/GutsLoader.pm' => [qw( Locale/Maketext/Guts.pm )],
    'Mail/Audit.pm'                => 'sub',
    'Math/BigInt.pm'                => 'sub',
    'Math/BigFloat.pm'              => 'sub',
    'Module/Build.pm'               => 'sub',
    'Module/Pluggable.pm'           => sub {
        _glob_in_inc("$CurrentPackage/Plugin", 1);
    },
    'MIME/Decoder.pm'               => 'sub',
    'Net/DNS/RR.pm'                 => 'sub',
    'Net/FTP.pm'                    => 'sub',
    'Net/SSH/Perl.pm'               => 'sub',
    'PDF/API2/Resource/Font.pm'     => 'sub',
    'PDF/API2/Basic/TTF/Font.pm'    => sub {
        _glob_in_inc('PDF/API2/Basic/TTF', 1);
    },
    'PDF/Writer.pm'                 => 'sub',
    'POE'                           => [ qw(
        POE/Kernel.pm POE/Session.pm
    ) ],
    'POE/Kernel.pm'                    => [
        map "POE/Resource/$_.pm", qw(
            Aliases Events Extrefs FileHandles
            SIDs Sessions Signals Statistics
        )
    ],
    'Parse/AFP.pm'                  => 'sub',
    'Parse/Binary.pm'               => 'sub',
    'Regexp/Common.pm'              => 'sub',
    'SOAP/Lite.pm'                  => sub {
        (($] >= 5.008 ? ('utf8.pm') : ()), _glob_in_inc('SOAP/Transport', 1));
    },
    'SQL/Parser.pm' => sub {
        _glob_in_inc('SQL/Dialects', 1);
    },
    'SVN/Core.pm' => sub {
        _glob_in_inc('SVN', 1),
        map "auto/SVN/$_->{name}", _glob_in_inc('auto/SVN'),
    },
    'SVK/Command.pm' => sub {
        _glob_in_inc('SVK', 1);
    },
    'SerialJunk.pm' => [ qw(
        termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph
    ) ],
    'Template.pm'      => 'sub',
    'Term/ReadLine.pm' => 'sub',
    'Tk.pm'            => sub {
        $SeenTk = 1;
        qw( Tk/FileSelect.pm Encode/Unicode.pm );
    },
    'Tk/Balloon.pm'     => [qw( Tk/balArrow.xbm )],
    'Tk/BrowseEntry.pm' => [qw( Tk/cbxarrow.xbm Tk/arrowdownwin.xbm )],
    'Tk/ColorEditor.pm' => [qw( Tk/ColorEdit.xpm )],
    'Tk/FBox.pm'        => [qw( Tk/folder.xpm Tk/file.xpm )],
    'Tk/Toplevel.pm'    => [qw( Tk/Wm.pm )],
    'URI.pm'            => sub {
        grep !/.\b[_A-Z]/, _glob_in_inc('URI', 1);
    },
    'Win32/EventLog.pm'    => [qw( Win32/IPC.pm )],
    'Win32/Exe.pm'         => 'sub',
    'Win32/TieRegistry.pm' => [qw( Win32API/Registry.pm )],
    'Win32/SystemInfo.pm'  => [qw( Win32/cpuspd.dll )],
    'XML/Parser.pm'        => sub {
        _glob_in_inc('XML/Parser/Style', 1),
        _glob_in_inc('XML/Parser/Encodings', 1),
    },
    'XML/Parser/Expat.pm' => sub {
        ($] >= 5.008) ? ('utf8.pm') : ();
    },
    'XML/SAX.pm' => [qw( XML/SAX/ParserDetails.ini ) ],
    'XMLRPC/Lite.pm' => sub {
        _glob_in_inc('XMLRPC/Transport', 1),;
    },
    'diagnostics.pm' => sub {
        _find_in_inc('Pod/perldiag.pod')
          ? 'Pod/perldiag.pl'
          : 'pod/perldiag.pod';
    },
    'utf8.pm' => [
        'utf8_heavy.pl', do {
            my $dir = 'unicore';
            my @subdirs = qw( To );
            my @files = map "$dir/lib/$_->{name}", _glob_in_inc("$dir/lib");

if (@files) {
                # 5.8.x
                push @files, (map "$dir/$_.pl", qw( Exact Canonical ));
            }
            else {
                # 5.6.x
                $dir = 'unicode';
                @files = map "$dir/Is/$_->{name}", _glob_in_inc("$dir/Is")
                  or return;
                push @subdirs, 'In';
            }

foreach my $subdir (@subdirs) {
                foreach (_glob_in_inc("$dir/$subdir")) {
                    push @files, "$dir/$subdir/$_->{name}";
                }
            }
            @files;
        }
    ],
    'charnames.pm' => [
        _find_in_inc('unicore/Name.pl') ? 'unicore/Name.pl' : 'unicode/Name.pl'
    ],
);

my $Keys = 'files|keys|recurse|rv|skip|first|execute|compile';
sub scan_deps {
    my %args = (
        rv => {},
        (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1)
    );

scan_deps_static(\%args);

if ($args{execute} or $args{compile}) {
        scan_deps_runtime(
            rv      => $args{rv},
            files   => $args{files},
            execute => $args{execute},
            compile => $args{compile},
            skip    => $args{skip}
        );
    }

return ($args{rv});
}

sub scan_deps_static {
    my ($args) = @_;
    my ($files, $keys, $recurse, $rv, $skip, $first, $execute, $compile) =
      @$args{qw( files keys recurse rv skip first execute compile )};

$rv   ||= {};
    $skip ||= {};

foreach my $file (@{$files}) {
        my $key = shift @{$keys};
        next if $skip->{$file}++;
        next if is_insensitive_fs()
          and $file ne lc($file) and $skip->{lc($file)}++;

local *FH;
        open FH, $file or die "Cannot open $file: $!";

$SeenTk = 0;

# Line-by-line scanning
        LINE:
        while (<FH>) {
            chomp(my $line = $_);
            foreach my $pm (scan_line($line)) {
                last LINE if $pm eq '__END__';

if ($pm eq '__POD__') {
                    while (<FH>) { last if (/^=cut/) }
                    next LINE;
                }

$pm = 'CGI/Apache.pm' if /^Apache(?:\.pm)$/;

add_deps(
                    used_by => $key,
                    rv      => $rv,
                    modules => [$pm],
                    skip    => $skip
                );

my $preload = $Preload{$pm} or next;
                if ($preload eq 'sub') {
                    $pm =~ s/\.p[mh]$//i;
                    $preload = [ _glob_in_inc($pm, 1) ];
                }
                elsif (UNIVERSAL::isa($preload, 'CODE')) {
                    $preload = [ $preload->($pm) ];
                }

add_deps(
                    used_by => $key,
                    rv      => $rv,
                    modules => $preload,
                    skip    => $skip
                );
            }
        }
        close FH;

# }}}
    }

# Top-level recursion handling {{{
    while ($recurse) {
        my $count = keys %$rv;
        my @files = sort grep -T $_->{file}, values %$rv;
        scan_deps_static({
            files   => [ map $_->{file}, @files ],
            keys    => [ map $_->{key},  @files ],
            rv      => $rv,
            skip    => $skip,
            recurse => 0,
        }) or ($args->{_deep} and return);
        last if $count == keys %$rv;
    }

# }}}

return $rv;
}

sub scan_deps_runtime {
    my %args = (
        perl => $^X,
        rv   => {},
        (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1)
    );
    my ($files, $rv, $execute, $compile, $skip, $perl) =
      @args{qw( files rv execute compile skip perl )};

$files = (ref($files)) ? $files : [$files];

my ($inchash, $incarray, $dl_shared_objects) = ({}, [], []);
    if ($compile) {
        my $file;

foreach $file (@$files) {
            ($inchash, $dl_shared_objects, $incarray) = ({}, [], []);
            _compile($perl, $file, $inchash, $dl_shared_objects, $incarray);

my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
            _merge_rv($rv_sub, $rv);
        }
    }
    elsif ($execute) {
        my $excarray = (ref($execute)) ? $execute : [@$files];
        my $exc;
        my $first_flag = 1;
        foreach $exc (@$excarray) {
            ($inchash, $dl_shared_objects, $incarray) = ({}, [], []);
            _execute(
                $perl, $exc, $inchash, $dl_shared_objects, $incarray,
                $first_flag
            );
            $first_flag = 0;
        }

my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
        _merge_rv($rv_sub, $rv);
    }

return ($rv);
}

sub scan_line {
    my $line = shift;
    my %found;

return '__END__' if $line =~ /^__(?:END|DATA)__$/;
    return '__POD__' if $line =~ /^=\w/;

$line =~ s/\s*#.*$//;
    $line =~ s/[\\\/]+/\//g;

foreach (split(/;/, $line)) {
        if (/^\s*package\s+(\w+);/) {
            $CurrentPackage = $1;
            $CurrentPackage =~ s{::}{/}g;
            return;
        }
        return if /^\s*(use|require)\s+[\d\._]+/;

if (my ($libs) = /\b(?:use\s+lib\s+|(?:unshift|push)\W+\@INC\W+)(.+)/)
        {
            my $archname =
              defined($Config{archname}) ? $Config{archname} : '';
            my $ver = defined($Config{version}) ? $Config{version} : '';
            foreach (grep(/\w/, split(/["';() ]/, $libs))) {
                unshift(@INC, "$_/$ver")           if -d "$_/$ver";
                unshift(@INC, "$_/$archname")      if -d "$_/$archname";
                unshift(@INC, "$_/$ver/$archname") if -d "$_/$ver/$archname";
            }
            next;
        }

$found{$_}++ for scan_chunk($_);
    }

return sort keys %found;
}

sub scan_chunk {
    my $chunk = shift;

# Module name extraction heuristics {{{
    my $module = eval {
        $_ = $chunk;

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

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

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

return [ 'encoding.pm',
            map { _find_encoding($_) }
              grep { length and !/^q[qw]?$/ } split(/[^\w:]+/, $1) ]
          if /^\s* use \s+ encoding \s+ (.*)/sx;

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

return "File/Glob.pm" if /<[^>]*[^\$\w>][^>]*>/;
        return "DBD/$1.pm"    if /\b[Dd][Bb][Ii]:(\w+):/;
        if (/(?:(:encoding)|\b(?:en|de)code)\(\s*['"]?([-\w]+)/) {
            my $mod = _find_encoding($2);
            return [ 'PerlIO.pm', $mod ] if $1 and $mod;
            return $mod if $mod;
        }
        return $1 if /(?:^|\s)(?:do|require)\s+[^"]*"(.*?)"/;
        return $1 if /(?:^|\s)(?:do|require)\s+[^']*'(.*?)'/;
        return $1 if /[^\$]\b([\w:]+)->\w/ and $1 ne 'Tk';
        return $1 if /\b(\w[\w:]*)::\w+\(/;

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";
            }
            return \@modules;
        }
        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 ($rv, $module, $file, $used_by, $type) = @_;
    return unless defined($module) and defined($file);

$rv->{$module} ||= {
        file => $file,
        key  => $module,
        type => $type,
    };

push @{ $rv->{$module}{used_by} }, $used_by
      if defined($used_by)
      and $used_by ne $module
      and !grep { $_ eq $used_by } @{ $rv->{$module}{used_by} };
}

sub add_deps {
    my %args =
      ((@_ and $_[0] =~ /^(?:modules|rv|used_by)$/)
        ? @_
        : (rv => (ref($_[0]) ? shift(@_) : undef), modules => [@_]));

my $rv   = $args{rv}   || {};
    my $skip = $args{skip} || {};
    my $used_by = $args{used_by};

foreach my $module (@{ $args{modules} }) {
        next if exists $rv->{$module};

my $file = _find_in_inc($module) or next;
        next if $skip->{$file};
        next if is_insensitive_fs() and $skip->{lc($file)};

my $type = 'module';
        $type = 'data' unless $file =~ /\.p[mh]$/i;
        _add_info($rv, $module, $file, $used_by, $type);

if ($module =~ /(.*?([^\/]*))\.p[mh]$/i) {
            my ($path, $basename) = ($1, $2);

foreach (_glob_in_inc("auto/$path")) {
                next if $skip->{$_->{file}};
                next if is_insensitive_fs() and $skip->{lc($_->{file})};
                next if $_->{file} =~ m{\bauto/$path/.*/};  # weed out subdirs
                next if $_->{name} =~ m/(?:^|\/)\.(?:exists|packlist)$/;
                my $ext = lc($1) if $_->{name} =~ /(\.[^.]+)$/;
                next if $ext eq lc(lib_ext());
                my $type = 'shared' if $ext eq lc(dl_ext());
                $type = 'autoload' if $ext eq '.ix' or $ext eq '.al';
                $type ||= 'data';

_add_info($rv, "auto/$path/$_->{name}", $_->{file}, $module,
                    $type);
            }
        }
    }

return $rv;
}

sub _find_in_inc {
    my $file = shift;

# absolute file names
    return $file if -f $file;

foreach my $dir (grep !/\bBSDPAN\b/, @INC) {
        return "$dir/$file" if -f "$dir/$file";
    }
    return;
}

sub _glob_in_inc {
    my $subdir  = shift;
    my $pm_only = shift;
    my @files;

require File::Find;

foreach my $dir (map "$_/$subdir", grep !/\bBSDPAN\b/, @INC) {
        next unless -d $dir;
        File::Find::find({
                "wanted" => sub {
                    my $name = $File::Find::name;
                    $name =~ s!^\Q$dir\E/!!;
                    return if $pm_only and lc($name) !~ /\.p[mh]$/i;
                    push @files, $pm_only
                        ? "$subdir/$name"
                        : {             file => $File::Find::name,
                                        name => $name,
                                    }
                    if -f;
                },
                "untaint" => 1,
                "untaint_skip" => 1,
                "untaint_pattern" => qr|^([-+@\w./]+)$|
                }, $dir
        );
    }

return @files;
}

# App::Packer compatibility functions

sub new {
    my ($class, $self) = @_;
    return bless($self ||= {}, $class);
}

sub set_file {
    my $self = shift;
    foreach my $script (@_) {
        my $basename = $script;
        $basename =~ s/.*\///;
        $self->{main} = {
            key  => $basename,
            file => $script,
        };
    }
}

sub set_options {
    my $self = shift;
    my %args = @_;
    foreach my $module (@{ $args{add_modules} }) {
        $module =~ s/::/\//g;
        $module .= '.pm' unless $module =~ /\.p[mh]$/i;
        my $file = _find_in_inc($module) or next;
        $self->{files}{$module} = $file;
    }
}

sub calculate_info {
    my $self = shift;
    my $rv   = scan_deps(
        keys  => [ $self->{main}{key}, sort keys %{ $self->{files} }, ],
        files => [ $self->{main}{file},
            map { $self->{files}{$_} } sort keys %{ $self->{files} },
        ],
        recurse => 1,
    );

my $info = {
        main => {  file     => $self->{main}{file},
            store_as => $self->{main}{key},
        },
    };

my %cache = ($self->{main}{key} => $info->{main});
    foreach my $key (sort keys %{ $self->{files} }) {
        my $file = $self->{files}{$key};

$cache{$key} = $info->{modules}{$key} = {
            file     => $file,
            store_as => $key,
            used_by  => [ $self->{main}{key} ],
        };
    }

foreach my $key (sort keys %{$rv}) {
        my $val = $rv->{$key};
        if ($cache{ $val->{key} }) {
            push @{ $info->{ $val->{type} }->{ $val->{key} }->{used_by} },
              @{ $val->{used_by} };
        }
        else {
            $cache{ $val->{key} } = $info->{ $val->{type} }->{ $val->{key} } =
              {        file     => $val->{file},
                store_as => $val->{key},
                used_by  => $val->{used_by},
              };
        }
    }

$self->{info} = { main => $info->{main} };

foreach my $type (sort keys %{$info}) {
        next if $type eq 'main';

my @val;
        if (UNIVERSAL::isa($info->{$type}, 'HASH')) {
            foreach my $val (sort values %{ $info->{$type} }) {
                @{ $val->{used_by} } = map $cache{$_} || "!!$_!!",
                  @{ $val->{used_by} };
                push @val, $val;
            }
        }

$type = 'modules' if $type eq 'module';
        $self->{info}{$type} = \@val;
    }
}

sub get_files {
    my $self = shift;
    return $self->{info};
}

# scan_deps_runtime utility functions

sub _compile {
    my ($perl, $file, $inchash, $dl_shared_objects, $incarray) = @_;

my $fname = File::Temp::mktemp("$file.XXXXXX");
    my $fhin  = FileHandle->new($file) or die "Couldn't open $file\n";
    my $fhout = FileHandle->new("> $fname") or die "Couldn't open $fname\n";

my $line = do { local $/; <$fhin> };
    $line =~ s/use Module::ScanDeps::DataFeed.*?\n//sg;
    $line =~ s/^(.*?)((?:[\r\n]+__(?:DATA|END)__[\r\n]+)|$)/
use Module::ScanDeps::DataFeed '$fname.out';
sub {
$1
}
$2/s;
    $fhout->print($line);
    $fhout->close;
    $fhin->close;

system($perl, $fname);

_extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
    unlink("$fname");
    unlink("$fname.out");
}

sub _execute {
    my ($perl, $file, $inchash, $dl_shared_objects, $incarray, $firstflag) = @_;

$DB::single = $DB::single = 1;

my $fname = _abs_path(File::Temp::mktemp("$file.XXXXXX"));
    my $fhin  = FileHandle->new($file) or die "Couldn't open $file";
    my $fhout = FileHandle->new("> $fname") or die "Couldn't open $fname";

my $line = do { local $/; <$fhin> };
    $line =~ s/use Module::ScanDeps::DataFeed.*?\n//sg;
    $line = "use Module::ScanDeps::DataFeed '$fname.out';\n" . $line;
    $fhout->print($line);
    $fhout->close;
    $fhin->close;

File::Path::rmtree( ['_Inline'], 0, 1); # XXX hack
    system($perl, $fname) == 0 or die "SYSTEM ERROR in executing $file: $?";

_extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
    unlink("$fname");
    unlink("$fname.out");
}

sub _make_rv {
    my ($inchash, $dl_shared_objects, $inc_array) = @_;

my $rv = {};
    my @newinc = map(quotemeta($_), @$inc_array);
    my $inc = join('|', sort { length($b) <=> length($a) } @newinc);

require File::Spec;

my $key;
    foreach $key (keys(%$inchash)) {
        my $newkey = $key;
        $newkey =~ s"^(?:(?:$inc)/?)""sg if File::Spec->file_name_is_absolute($newkey);

$rv->{$newkey} = {
            'used_by' => [],
            'file'    => $inchash->{$key},
            'type'    => _gettype($inchash->{$key}),
            'key'     => $key
        };
    }

my $dl_file;
    foreach $dl_file (@$dl_shared_objects) {
        my $key = $dl_file;
        $key =~ s"^(?:(?:$inc)/?)""s;

$rv->{$key} = {
            'used_by' => [],
            'file'    => $dl_file,
            'type'    => 'shared',
            'key'     => $key
        };
    }

return $rv;
}

sub _extract_info {
    my ($fname, $inchash, $dl_shared_objects, $incarray) = @_;

use vars qw(%inchash @dl_shared_objects @incarray);
    my $fh = FileHandle->new($fname) or die "Couldn't open $fname";
    my $line = do { local $/; <$fh> };
    $fh->close;

eval $line;

$inchash->{$_} = $inchash{$_} for keys %inchash;
    @$dl_shared_objects = @dl_shared_objects;
    @$incarray          = @incarray;
}

sub _gettype {
    my $name = shift;
    my $dlext = quotemeta(dl_ext());

return 'autoload' if $name =~ /(?:\.ix|\.al|\.bs)$/i;
    return 'module'   if $name =~ /\.p[mh]$/i;
    return 'shared'   if $name =~ /\.$dlext$/i;
    return 'data';
}

sub _merge_rv {
    my ($rv_sub, $rv) = @_;

my $key;
    foreach $key (keys(%$rv_sub)) {
        my %mark;
        if ($rv->{$key} and _not_dup($key, $rv, $rv_sub)) {
            warn "different modules for file: $key: were found" .
                 "(using the version) after the '=>': ".
                 "$rv->{$key}{file} => $rv_sub->{$key}{file}\n";

$rv->{$key}{used_by} = [
                grep (!$mark{$_}++,
                    @{ $rv->{$key}{used_by} },
                    @{ $rv_sub->{$key}{used_by} })
            ];
            @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
            $rv->{$key}{file} = $rv_sub->{$key}{file};
        }
        elsif ($rv->{$key}) {
            $rv->{$key}{used_by} = [
                grep (!$mark{$_}++,
                    @{ $rv->{$key}{used_by} },
                    @{ $rv_sub->{$key}{used_by} })
            ];
            @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
        }
        else {
            $rv->{$key} = {
                used_by => [ @{ $rv_sub->{$key}{used_by} } ],
                file    => $rv_sub->{$key}{file},
                key     => $rv_sub->{$key}{key},
                type    => $rv_sub->{$key}{type}
            };

@{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
        }
    }
}

sub _not_dup {
    my ($key, $rv1, $rv2) = @_;
    (_abs_path($rv1->{$key}{file}) ne _abs_path($rv2->{$key}{file}));
}

sub _abs_path {
    return join(
        '/',
        Cwd::abs_path(File::Basename::dirname($_[0])),
        File::Basename::basename($_[0]),
    );
}

#####################################################
### Actual perldeps.pl code starts here.

# Print usage information
sub
print_usage_info($)
{
    my $code = shift || 0;
    my ($leader, $underbar);

print "\n";
    $leader = "$0 Usage Information";
    $underbar = $leader;
    $underbar =~ s/./-/g;
    print "$leader\n$underbar\n";
    print "\n";
    print "  Syntax:   $0 [ options ] [ path(s)/file(s) ]\n";
    print "\n";
    print "    -h --help                        Show this usage information\n";
    print "    -v --version                     Show version and copyright\n";
    print "    -d --debug                       Turn on debugging\n";
    print "    -p --provides                    Find things provided by path(s)/file(s)\n";
    print "    -r --requires                    Find things required by path(s)/file(s)\n";
    #print "                                     \n";
    print "\nNOTE:  Path(s)/file(s) can also be specified on STDIN.  Default is \@INC.\n\n";
    exit($code);
}

# Locate perl modules (*.pm) in given locations.
sub
find_perl_modules(@)
{
    my @locations = @_;
    my %modules;

foreach my $loc (@locations) {
        if (-f $loc) {
            # It's a file.  Assume it's a Perl module.
            #print "Found module:  $loc.\n";
            $modules{$loc} = 1;
        } elsif (-d $loc) {
            my @tmp;

# Recurse the directory tree looking for all modules inside it.
            &File::Find::find({
                "wanted" => sub {
                    if ((-s _) && (substr($File::Find::fullname, -3, 3) eq ".pm")) {
                        push @tmp, $File::Find::fullname;
                    }
                },
                "follow_fast" => 1,
                "no_chdir" => 1,
                "untaint" => 1,
                "untaint_skip" => 1,
                "untaint_pattern" => qr|^([-+@\w./]+)$|
                }, $loc);

# @tmp is now a list with all non-empty *.pm files in and under $loc.
            # Untaint and save in %modules hash.
            foreach my $module (@tmp) {
                if ($module =~ /^([-+@\w.\/]+)$/) {
                    $modules{$1} = 1;
                    #print "Found module:  $1\n";
                }
            }
        } else {
            # Something wicked this way comes.
            print STDERR "$0:  Error:  Don't know what to do with location \"$loc\"\n";
        }
    }
    return keys(%modules);
}

# Generate an RPM-style "Provides:" list for the given modules.
sub
find_provides(@)
{
    my @modules = @_;
    my @prov;

foreach my $mod (@modules) {
        my (@contents, @pkgs);
        my $mod_path;
        local *MOD;

$mod_path = dirname($mod);
        if (!open(MOD, $mod)) {
            warn "Unable to read module $mod -- $!\n";
            next;
        }
        @contents = <MOD>;
        if (!close(MOD)) {
            warn "Unable to close module $mod -- $!\n";
        }

if (!scalar(grep { $_ eq $mod_path } @INC)) {
            push @INC, $mod_path;
        }
        foreach my $line (grep { $_ =~ /^\s*package\s+/ } @contents) {
            if ($line =~ /^\s*package\s+([^\;\s]+)\s*\;/) {
                push @pkgs, $1;
            }
        }

# Now we have a list of packages.  Load up the modules and get their versions.
        foreach my $pkg (@pkgs) {
            my $ret;
            local ($SIG{"__WARN__"}, $SIG{"__DIE__"});

# Make sure eval() can't display warnings/errors.
            $SIG{"__DIE__"} = $SIG{"__WARN__"} = sub {0;};
            $ret = eval("no strict ('vars', 'subs', 'refs'); use $pkg (); return $pkg->VERSION || 0.0;");
            if ($@) {
                dprint "Unable to parse version number from $pkg -- $@.  Assuming 0.\n";
                $ret = 0;
            }

if (! $ret) {
                $ret = 0;
            }
            push @prov, "perl($pkg) = $ret";
        }
    }
    printf("Provides:  %s\n", join(", ", sort(@prov)));
}

# Generate an RPM-style "Requires:" list for the given modules.
sub
find_requires(@)
{
    my @modules = @_;
    my @reqs;
    my $reqs;

$reqs = &scan_deps("files" => \@modules, "recurse" => 0);
    foreach my $key (grep { $reqs->{$_}{"type"} eq "module" } sort(keys(%{$reqs}))) {
        if (substr($key, -3, 3) eq ".pm") {
            $key = substr($key, 0, -3);
        }
        $key =~ s!/!::!g;
        push @reqs, "perl($key)";
    }
    printf("Requires:  %s\n", join(", ", @reqs));
}

sub
main()
{
    my $VERSION = '1.0';
    my (@locations, @modules);
    my %OPTION;

# For taint checks
    delete @ENV{("IFS", "CDPATH", "ENV", "BASH_ENV")};
    $ENV{"PATH"} = "/bin:/usr/bin:/sbin:/usr/sbin:/etc:/usr/ucb";
    foreach my $shell ("/bin/bash", "/usr/bin/ksh", "/bin/ksh", "/bin/sh", "/sbin/sh") {
        if (-f $shell) {
            $ENV{"SHELL"} = $shell;
            last;
        }
    }

$ENV{"LANG"} = "C" if (! $ENV{"LANG"});
    umask 022;
    select STDERR; $| = 1;
    select STDOUT; $| = 1;

# Post-parse the options stuff
    select STDOUT; $| = 1;
    if ($OPTION{"version"}) {
        # Do not edit this variable.  It is updated automatically by CVS when you commit
        my $rcs_info = 'CVS Revision $Revision: 1.6 $ created on $Date: 2006/04/04 20:12:03 $ by $Author: mej $ ';

$rcs_info =~ s/\$\s*Revision: (\S+) \$/$1/;
        $rcs_info =~ s/\$\s*Date: (\S+) (\S+) \$/$1 at $2/;
        $rcs_info =~ s/\$\s*Author: (\S+) \$ /$1/;
        print "\n";
	print "perldeps.pl $VERSION by Michael Jennings <mej\@eterm.org>\n";
        print "Copyright (c) 2005-2006, Michael Jennings\n";
        print "  ($rcs_info)\n";
        print "\n";
	return 0;
    } elsif ($OPTION{"help"}) {
	&print_usage_info(0);   # Never returns
    }

push @locations, @ARGV;
    if (!scalar(@ARGV) && !(-t STDIN)) {
        @locations = <STDIN>;
    }
    if (!scalar(@locations)) {
        @locations = @INC;
    }

if (!($OPTION{"provides"} || $OPTION{"requires"})) {
	&print_usage_info(-1);   # Never returns
    }

# Catch bogus warning messages like "A thread exited while 2 threads were running"
    $SIG{"__DIE__"} = $SIG{"__WARN__"} = sub {0;};

@modules = &find_perl_modules(@locations);
    if ($OPTION{"provides"}) {
        &find_provides(@modules);
    }
    if ($OPTION{"requires"}) {
        &find_requires(@modules);
    }
    return 0;
}

exit &main();

cmd: