Tizen 2.1 basesubmit/tizen_2.2/20130710.072219submit/tizen_2.1/20130423.104200accepted/tizen_2.1/20130423.1513382.2_release2.2.1_release2.1b_releasetizen_2.2tizen_2.1

1 files changed, 1116 insertions, 0 deletions

diff --git a/scripts/perldeps.pl b/scripts/perldeps.pl
new file mode 100755
index 0000000..bffad67
--- /dev/null
+++ b/scripts/perldeps.pl
@@ -0,0 +1,1116 @@
+#!/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;
+
+        return $1 if /(?:^|\s)(?:use|no|require)\s+([\w:\.\-\\\/\"\']+)/;
+        return $1
+          if /(?:^|\s)(?:use|no|require)\s+\(\s*([\w:\.\-\\\/\"\']+)\s*\)/;
+
+        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;
+
+    Getopt::Long::Configure("no_getopt_compat", "bundling", "no_ignore_case");
+    Getopt::Long::GetOptions(\%OPTION, "debug|d!", "help|h", "version|v", "provides|p", "requires|r");
+
+    # 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();