From 82cce8cd22d5e9e8a231d666170c9a5f8b0d31f3 Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 16 2020 14:53:44 +0000 Subject: perl-Module-ScanDeps-1.24 base --- diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 0000000..b91748d --- /dev/null +++ b/AUTHORS @@ -0,0 +1,55 @@ +Here is a list of people and their CPAN id, extracted from the ChangeLog +file and the mailing list archives. These people have either submitted +patches or suggestions, or their bug reports or comments have inspired +the appropriate patches. Corrections, additions, deletions welcome: + +Adam Kennedy (ADAMK) +Adrian Issott +Alan Stewart +Alexandr Ciornii (CHORNY) +Andrew Lee +Brian Cassidy (BRICAS) +Bruce Winter +Chris Dolan (CDOLAN,CLOTHO) +Christoph Lamprecht (LAMPRECHT) +D. H. (PODMASTER) +Dan Friedman (LAMECH) +Darek Adamkiewicz (DADAMK) +David Romano +Dominique Quatravaux (DOMQ) +Edward S. Peschko +Eric J. Roode (ROODE) +Eric Wilhelm +Germain Garand (GGARAND) +Iain Cass +Indy Singh +Jan Dubois (JDB) +Jerry Veldhuis +Jess Robinson +Jesse Schoch +Jesse Vincent (JESSE) +Johan Vromans +Jouke Visser (JOUKE) +Malcolm Nooning +Marcus Rueckert +Mark Stosberg (MARKSTOS) +Markus Jansen +Matt S Trout (MSTROUT) +Matt Sergeant (MSERGEANT) +Nadim Ibn Hamouda El Khemir (NKH) +Nathan Haigh +Nik Clayton (NIKC) +Rafael Garcia-Suarez (RGARCIA) +Randal L. Schwartz (MERLYN) +Renee Baecker (RENEEB) +Robert Spier (RSPIER) +Roderich Schupp (RSCHUPP) +Scott Stanton +Seth L. Blumberg (METAL) +Simon Andrews +Simon Cozens (SIMON) +Slaven Rezic (SREZIC) +Steffen Mueller (SMUELLER) +Stephen Schulze +Steve Pick +Steven Mackenzie diff --git a/Changes b/Changes new file mode 100644 index 0000000..45d0ae4 --- /dev/null +++ b/Changes @@ -0,0 +1,968 @@ +1.24 2017-06-28 + +- Merge pull request from Salvador Fandiño (salva), thx! + Specio::PartialDump uses unicore + +- Fix RT#119737: Problems with detecting DateTime::Format::Natural dependencies + ... by adding a %Preload rule + +1.23 2016-11-16 + +- add %Preload rules for List::SomeUtils and Pod::Simple::Transcode + +- get rid of Module::Install, use ExtUtils::MakeMaker + +1.22 2016-09-17 + +- Fix RT#117887: Not parsing new release of Net::DNS::Resolver + add %Preload rule for Net/DNS/Resolver.pm + +- Move to GitHub. Thanks, OpenFoundry, for years of service. + +1.21 2016-04-05 + +- %Preload: add rules for List::MoreUtils and Log::Dispatch + +- %Preload: make the following modules require the unicore stuff: + charnames.pm + Unicode/Normalize.pm + Unicode/UCD.pm + +- add helper _glob_in_inc_1() + +- remove all references to http://par.perl.org/, doesn't exist anymore + +1.20 2015-10-04 + +- Fix RT #107304: Newer versions of File::Path cause warning "_Inline for _Inline: No such file or directory at Module/ScanDeps.pm line 1339." + - drop the dubious call to rmtree() + +- Fix RT106142: Preload dependencies for PDL and PDL::NiceSlice + - adopted from a patch by Shawn Laffan, thanks Shawn! + +- Fix RT#106144: Preload dependencies for File::BOM) + - adopted from a patch by Shawn Laffan, thanks Shawn! + +- Revise our stance on utf8.pm: + + - A line of "use utf8;" just means "this file is encoded in UTF-8" + and should _not_ result in scanning utf8.pm which will pull in + the whole Unicode shebang (propery tables and what not). + Yes, utf8.pm *does* contain "require utf8_heavy.pl", but only inside + an AUTOLOAD() that is *not* triggered by calling functions + like utf8::is_utf8(). + + - OTOH the innocently looking one-liner + + perl -ne 'print if /\pN/' + + implicitly loads utf8.pm and triggers the AUTOLAD(). + + - So prevent utf8.pm from being scanned and make utf8_heavy.pl + the indicator for "I need the Unicode stuff" instead. + + - Cache the results of _get_preload('utf8_heavy.pl'). + +- Make %Preload "transitive" so that given + + my %Preload = ( + 'Foo.pm' => [ 'Bar.pm' ], + 'Bar.pm' => [ 'Quux.pm' ], + ... + ); + + scan_deps_static() registers a dependency on Bar.pm _and_ + Quux.pm when it has seen "use Foo;" + +- Minor changes: + - drop dubious %Preload of utf8.pm for SOAP::Lite and XML::Parser::Expat + - drop code for Perl < 5.008 as we require 5.8.1 already + - rework the implementation of -x/-c + - add add_preload_rule() to dynamically add a %Preload rule + - recognize constructs like "open FH, '<:via(Foo)', ..." + - upgrade to Module::Install 1.16 + +1.19 2015-05-27 + + - add %Preload rule for LWP::MediaTypes: data file LWP/media.types + + - add %Preload entry for MIME::Types: data file MIME/types.db + + - add %Preload rule for AnyEvent + + - always add Encode.pm when fix encountering constructs like + + decode("klingon", ...) + open FH, "<:encoding(klingon)", .. + + - add license + + - update OpenFoundry repository URL + +1.18 2015-01-19 + + - Fix RT #101569: Incorrect module parsing if Moose is included + +1.17 2014-10-31 + + - scandeps.pl: die if an option is not recognized + + - Reformat Changes file according to CPAN::Changes::Spec + + - Modify %Preload rule: let Unicode::UCD explicitly imply utf8.pm. + This fixes PAR::Packer's self test. + Previously Unicode::UCD implied utf8.pm implicitly because + it contains calls to some utf8::foo() functions. + + - Add %Preload rule: Mozilla::CA requires its cacert.pem file + + - Recognize "do filename" constructs even if "do" isn't at the start + of a chunk. + + - Upgrade to Module::Install 1.14 + +1.16 2014-09-28 + + - Fix RT#98938: recognize Module::Runtime module-loading functions + + - Fix a nasty typo that broke scandeps.pl option -E + + $ scandeps -E "some string" + Unknown option: E + Can't open some string: No such file or directory at scandeps.pl line 49. + + - also scandeps.pl: die if an option is not recognized + + - Remove some overzealous heuristics from scan_chunk() + - they were looking for + + Foo::Bar->something + Foo::Bar::whatever(...) + + _anywhere_ in programs to infer a dependency on Foo/Bar.pm. + + BEWARE: This might break some use cases, i.e. missing some dependencies. + On the other hand, this causes hard to investigate problems like the one + starting at http://www.mail-archive.com/par@perl.org/msg05531.html. + While the former can easily be worked around by the user itself (just + add a missing dependecy explicitly, e.g. using "pp -M ...") and + typically can be solved in general by adding a %Preload rule, + the latter just wastes people's times. + + - Recognize Test::More require_ok() and use_ok() + - makes 3-static_oo_interface_real.t pass again (fallout from the above) + + - Upgrade to Module::Install 1.12 + + - Add option -T to request information from CPAN + - don't access CPAN behind the user's back just because they have + CPANPLUS installed (it was in the Perl core from 5.10 to 5.18) - + it might not even have been configured (e.g. in a corporate internet) + - only do this when explicitly requested + +1.15 2014-08-23 + + - Fix RT #98203: Migrate from deprecated Module::Build::ModuleInfo to Module::Metadata + - thanx Petr Pisar (ppisar@redhat.com) for the hint + + - add long option names to scandeps.pl + + - implement option --xargs for scandeps.pl + + - fix wrong version numbers in Changes + +1.14 2014-08-03 + + - Fix RT #92860 (t/7-check-dynaloader.t doesn't handle systems with mod2fname), + also RT #97519 (Fix for t/7-check-dynaloader.t on systems with DynaLoader::mod2fname) + - applied patch from Brian Fraser (fraserbn@gmail.com), thanks! + - lib/Module/ScanDeps/DataFeed.pm: apply here, too + +1.13 2013-12-21 + + - Fix recognition of (open() arguments) "<:encoding(klingon)", + implies modules PerlIO and PerlIO::encoding. + +1.12 2013-12-01 + + - Fix RT #90869: Use of uninitialized value $module in substitution (s///) + + - Fix RT #87775: typo fixes, thanks dsteinbrunner@pobox.com + + - new %Preload rule for B::Hooks::EndOfScope + + - new %Preload rule for Pod::Usage + + - add a fake %Preload rule that warns if use of Module::Implementation + or Module::Runtime is detected (coz' they're doing runtime loading) + + - change some tests to use Test::Requires instead of homegrown stuff; + hence add it to "test_requires" + - clean up some uses of Test::More + +1.11 2013-09-28 + + - Fix RT #89000: test broken by indirect base.pm disuse + - delete base.pm from list of expected deps, + patch by Andrew Main (zefram@fysh.org) + + - new %Preload rule for Net::HTTPS (e.g. used by LWP::Protocol::https) + - look for IO::Socket::SSL or Net::SSL + + - new %Preload rule for YAML::Any + - try to figure out what YAML::Any would have used + (using YAML::Any->implementation) + - as fallback, include anything below YAML + +1.10 2012-10-20 + + - add %Preload rule for Params::Validate to detect + its PP and XS implementations + + - Fix RT #80276 Module DateTime::Format::ISO8601 generates error + after being packaged + - caused by failing to pack DateTime::Format::Builder::Parser::XXX modules + needed by DateTime::Format::Builder::Parser + - add a corresponding %Preload rule + + - update to Module::Install 1.06 + +1.09 2012-09-09 + + - teach Module::ScanDeps about "use if ..." constructs + - fixes CPAN Testers failures for PAR::Packer with perl 5.17.1 and up + (Roderich Schupp) + + - RT #79003: t/7-check-dynaloader.t failing when /usr/lib != /usr/lib64 + - scrap the test for "$entry{file} starts with $expected_prefix" as + its assumptions are flawed (Roderich Schupp) + + - Mojo::Base is a loader (Alexandr Ciornii) + - Special case for Class::Load (Alexandr Ciornii) + +1.08 2012-02-21 + + - RT #73785: scandeps -c fails on modules that depend on Getopt::Euclid + - for "scandeps -c ..." switch from an INIT block to a CHECK block + and call the augmented script with "perl -c" instaed of "perl" + + - RT#72954 ":encoding(UTF-8)" doesn't imply a dependency on Encode.pm + - if scan_chunk sees ":encoding(FOO)" or similar, it goes to some + length to find the "external" Encode module to handle FOO; but it + forgets that Encode.pm itself is needed at runtime (esp. if FOO + is an encoding "internally" handled by Encode.pm, e.g. "UTF-8") + + - %Preload: add rules for Gtk2.pm and Pango.pm + - %Preload: fix a problem with Image::ExifTool + +1.07 2011-11-29 + + - RT #72796: dynaloader test fails when the .so files are in the + system lib dirs and local::lib is involved? + Relax a check in t/7-check-dynaloader.t + - Update Module::Install to 1.04 + +1.06 2011-11-28 + + - RT #72211: pp includes way too much modules (when using 'use strict;')? + Rework regexes to detect "use MODULE ...": + the following line from unicore/mktables + + my $unihan = 'Unihan properties are by default not enabled in the Perl core. Instead use CPAN: Unicode::Unihan'; + + would erroneously detect a dependency on CPAN.pm (which will in turn + pull in a lot of modules) + - Bump Perl version requirement to 5.8.1 (Schwern: The End Of 5.6 Is Nigh!) + - Rewrite t/7-check-dynaloader.t to look for more candidates of dynamic modules + that might be used as test cases + +1.05 2011-11-02 + + - RT #72082: $FindBin::Bin issue on Moudel::ScanDeps 1.04 + Make FindBin work (at least with option -c or -x) by spoofing $0 + in the temp script generated for M:SD::DataFeed + - RT #70134: patch suggestions for Module::ScanDeps 1.04: additional preload + rules, used_via_preload attribute + Add suggested %Preload rules from the attached patch (thanks, Markus Jansen) + - Add %Preload rules for MozRepl + - Special case for Package::Stash (Alexandr Ciornii) + - Special case for Moose (Alexandr Ciornii) + +1.04 2011-07-21 + + - Brown paper bag bug: fix option -x (execute) (broken by changes for -c) + - While we're at it: honor option -I with -c + +1.03 2011-07-18 + + - RT #69213: ScanDeps incompatible with AnyEvent (Perl 5.14, AnyEvent 5.34, PAR 1.00.2) + For option -c (compile) M:SD used to wrap the file in one big sub and + appended an END block where it dumps %INC etc; the outer sub causes problems + with certain contructs. Instead we now use an INIT block prepended + to the file. + + - RT #69471: Problem with "eval { require SomeModule }" constructions + Module::ScanDeps::DataFeed now omits %INC pairs with an undefined value + (these may be created by an unsuccessful "require" under certain conditions). + Also omit CODE refs from @INC. + + - Fix for failing CPAN Testers report + http://www.cpantesters.org/cpan/report/4208fa16-a5d1-11e0-a0bc-c71a7862a918: + Perl 5.15.0 got rid of Shell.pm + + - Fix for failing CPAN Testers report + http://www.cpantesters.org/cpan/report/772147dc-6c1f-1014-baf2-318eb63ba09a: + - regex meta characters in filenames break consistency check + + - Simplify Module::ScanDeps::DataFeed somewhat by localizing %INC + around "require Module::ScanDeps::DataFeed" and by using Data::Dumper + for the actual dump. + + - Don't create the tempfiles for DataFeed in the working directory. + + - Purge all pod from Module::ScanDeps::DataFeed, advise the CPAN + indexer not to bother with it; same for Module::ScanDeps::Cache. + +1.02 2011-04-03 + + - %Preload: add _all_ *.pl file below .../unicore for utf8.pm + +1.01 2011-03-26 + + - %Preload: add "unicore/version" for Unicode/UCD.pm + (because it contains a call openunicode(..., "version")) + +1.00 2011-02-19 + + - RT #65855: Special handling for POSIX requested (Roderich Schupp) + - RT #65252: Temp files left when execute fails (Roderich Schupp) + - add a %Preload rule for Log::Report::Dispatcher (Roderich Schupp) + cf. http://www.nntp.perl.org/group/perl.par/2011/01/msg4871.html + - add %Preload rule for Date::Manip (Roderich Schupp) + - speed up scanning *significantly* by not re-constructing regexen + for every line of input and reducing the no. of sub calls (Steffen Mueller) + - add Eric Roode to AUTHORS (Steffen Mueller) + - RT #61027: "use lib" does not work (Roderich Schupp) + scan_line(): When handling "use lib '/some/dir'" we add "/some/dir/ARCHNAME", + "/some/dir/VER" and "/some/dir/VER/ARCHNAME", but forgot + to add "/some/dir" itself. + While we're at it, improve parsing the argument list of "use lib". + Simply eval the string, this should at least make all forms of + quoted strings work correctly. + - fix URI special case (clkao) + - fix a regression reported by CPAN Testers (Roderich Schupp) + - finally: bump version to 1.00 + +0.98 2010-07-26 + + - Make %Preload entry for "utf8.pm" lazy (Roderich Schupp) + - Upgrade to Module::Install 1.00 (Roderich Schupp) + - RT #58093: Par-Packer not including all dependencies (unicore/Heavy.pl) (Roderich Schupp) + - Add %Preload rule for RPC::XML (Roderich Schupp) + - RT #57494: add %Preload rule for JSON.pm (Roderich Schupp) + +0.97 2010-04-10 + + - Pack the content of module/distribution sharedirs is automatically. (kmx) + - RT #56020 - add data files used by Unicode::UCD (Roderich Schupp) + - RT #55746 - remove bogus "... if %Config::Config" condition (Roderich Schupp) + - Add special case for CGI::Application::Plugin::AutoRunmode (Alexandr Ciornii) + - Add special case for CGI::Application::Plugin::Authentication (Alexandr Ciornii) + - Add special case for DBIx::Perlish (Alexandr Ciornii) + +0.96 2009-11-13 + + - perl 5.6.1 compatibility (Alexandr Ciornii) + - Test for "use module version;" (Alexandr Ciornii) + +0.95 2009-10-16 + + - Fix "uninitialized value" warnings (Dave Rolsky) + - Add special case for Perl::Critic (Alexandr Ciornii) + - Add special case for Event (Alexandr Ciornii) + - Add special case for Wx.pm (Alexandr Ciornii) + - Add special case for Log::Any + +0.94 2009-08-10 + + - Add tests for scan_line (Alexandr Ciornii) + - RT#48151 fixed, "require __PACKAGE__" should not die (Alexandr Ciornii) + - OS/2 fixes (Ilya Zakharevich) + +0.93 2009-07-19 + + - Implement caching of dependencies (Christoph Lamprecht) + +0.92 2009-07-19 + + - Fix bug with {type} being set to unexpected values in some cases (Christoph Lamprecht) + - Add tests for scan_chunk (Alexandr Ciornii) + - Add special case for parent.pm (Alexandr Ciornii) + - Fix for "use parent::something" (Alexandr Ciornii) + - Add special case for Catalyst.pm (Alexandr Ciornii) + +0.91 2009-06-22 + + - Add special case for Tk's setPalette call (Christoph Lamprecht) + +0.90 2009-05-09 + + - Add special case for DateTime::Locale + - Add special case for PAR::Repository and PAR::Repository::Client + +0.89 2008-11-03 + + - Distribution fixes. + - Do not use base Exporter. + - Detection of 'asa' and 'only::matching'. + +0.88 2008-10-28 + + - Add special case for File::HomeDir. + +0.87 2008-10-28 + + - Add special case for PPI. + +0.86 2008-10-23 + + - Fix the 'use prefork "Foo"' static detection. + - Fix the detection of any of the module-loader modules such as + prefork, autouse, etc. if invoked as 'use prefork"Foo"' (note + the lack of a space). + - Slightly refactor the loader-module scanning. (see above) + - Support for "use maybe 'foo';" + - Use (arch|priv)libexp instead of (arch|priv)lib + in scandeps.pl (Mark Stosberg) + - Update to Module::Install 0.77 + +0.85 2008-08-01 + + - Add special case for Net::Server. + +0.84 2008-05-13 + + - Add special case for Class::MethodMaker. + +0.83 2008-03-23 + + - Add special case for Image::ExifTool. + +0.82 2008-01-08 + + - Add Test::More to build requirements (Alexandr Ciornii) + - Add dependency on version.pm + - Now correctly identifies feature.pm as a dependency if + "use 5.10.0;" (and up) is found. + +0.81 2007-12-07 + + - Fix for the case-insensitive-file-system-test. + +0.80 2007-11-30 + + - Fix to avoid duplicated entries arising from used_by references with + case differences. + - Do not report input files themselves as dependencies. + (Regression from 0.74 onwards) + - Remove warning from ScanFileRE tests. + +0.78 2007-11-17 + + - Fix ScanFileRE heuristics to allow for scanning files without + suffixes. + +0.77 2007-09-20 + + - Add support for prefork.pm (similar to how base.pm is detected). + - Added uses field to hash descriptions returned by scan_deps + + tests (Adrian Issott) + - Added ScanFileRE to restrict the files scanned to .pl, .pm, .al and + .t but allow the user to override + tests (Adrian Issott) + +0.76 2007-07-21 + + - Fix special case for Term::ReadLine (should not rope in Tk) + - New special case for Tcl::Tk (should not rope in Tk either!) + - New special case for threads::shared ==> rope in attributes.pm + - Fix to avoid duplicated entries that can arise due to case + differences that don't actually matter on case-tolerant + systems (Adrian Issott) + - M::SD warnings now go to STDERR not STDOUT (Adrian Issott) + - Fixed bug #24162: scandeps.(bat|pl) doesn't correctly identify Core + Modules on Windows (Adrian Issott) + - Now finds shared libraries for modules specified as input files. + - Tests for finding shared libraries. + +0.75 2007-06-24 + + - Fix special cases for POE. (Roderich Schupp) + - Added exported path_to_inc_name subroutine (Adrian Issott) + - Added Module::Build::ModuleInfo dependency (Adrian Issott) + - Fixed bug where input files weren't scoped properly + - Add new "check-for-dynaloader" test. (Eric Wilhelm) + +0.74 2007-04-26 + + - Same as 0.73_01, but not a developer release. + +0.73_01 2007-03-28 + + - Fixed bug "scan_deps doesn't show ALL the dependencies" + - Ensured all file entries are given by absolute paths + - Added a number of test artificial dependency trees as test data + mainly for "scan_deps doesn't show ALL the dependencies" bug + - Added tests for scandeps recurse option (all pass) + - Added tests for scandeps skip option (all pass) + - Added tests to show a duplicated dependency is in fact only shown + once (all pass) + - Added Utils.pm test module containing generic_scandeps_rv_test and + compare_scandeps_rvs subroutines (Adrian Issott) + +0.73 2007-03-25 + + - Now being a little cleverer for detecting globs in diamond operators. + (Requiring a meta character within the <>.) + +0.72 2007-02-03 + + - Case-insensitive @INC removal for case-insensitive + filesystems (Eric Wilhelm) + +0.71 2007-01-04 + + - Added special cases for + Catalyst + Class::MakeMethods + Config::Any + DBIx::Class + Email::Send + Log::Log4perl + SQL::Translator + - print() the "# Legend..." line instead of warn()ing it. + +0.70 2006-11-21 + + - Added special case for Image::Info. + +0.69 2006-11-07 + + - Additional corner cases for LWP::UserAgent and LWP::Parallel::UserAgent and + friends. + +0.68 2006-10-25 + + - Added special case for PerlIO.pm. If PerlIO.pm is needed, require + PerlIO::scalar, too, because it can be used "under the hood". + (Roderich Schupp) + - Added some File::Spec'ness. (Steffen Mueller) + - Refactored the %Preload mapping code into _get_preload so that + the PAR -M %Preload fix would work. (Steffen Mueller) + +0.67 2006-10-24 + + - Added @IncludeLibs which is used alongside @INC for searching modules. + (David Romano) + - Won't pick up Tk as a dependency for Term::ReadLine any more. + You can stop laughing now! + +0.66 2006-09-24 + + - Fixed another bug in Module::ScanDeps::Datafeed which would break + run- and compile-time dependency scanners if $ENV{PERL5LIB} entries + had trailing backslashes. Thanks to Steven Mackenzie for pointing + this out. + - Added some documentation and comments to M::SD::Datafeed for the sake of + future maintainers. + +0.65 2006-09-24 + + - Fixed bug in Module::ScanDeps::Datafeed which would die() in 0.64. + +0.64 2006-09-22 + + - Upgraded to Module::Install 0.64 + - Added warning of missing modules when -V is in effect (scandeps.pl). + - Added warning of missing modules if "warn_missing=>1" specified as + an option to scan_deps. + +0.63 2006-08-27 + + - Upgraded to Module::Install 0.63 + +0.62 2006-07-16 + + - Better diagnostics.pm support for searching the related + .pod file. + +0.61 2006-06-30 + + - Now presenting more helpful (and correct) error messages when + multiple versions of a module (files) are found. + - Corrected a POD error. + - Added test for POD correctness. + +0.60 2006-05-23 + + - Fixed bug that prevented "use encoding 'utf-8';" from being + picked up. This was because the -8 was stripped and thus, the + encoding wasn't recognized. + +0.59 2006-05-03 + + - Recovering 5.005 compatibility. (Hopefully!) + - Using Module::Install 0.62 + - Added a dependency on File::Temp for pre 5.6 perls. + - Fixed broken Module::Pluggable support. + +0.58 2006-04-16 + + - Added dependency for Test::Deep + - Added dependency for Math::Symbolic + +0.57 2006-03-03 + + - Applied Stephen Schulze's patch which fixes the problem that modules are + reported as depended upon only once. + +0.56 2006-02-20 + + - Added special dependency for Tk::Getopt. Suggested by Slaven Rezic. + +0.55 2006-02-17 + + - Applied Roderich Schupp's patch to fix a problem with 'autouse'. + - Now using Module::Install 0.56 + +0.54 2006-01-11 + + - Switch to File::Temp::tempfile() for more robust temporary file creation. + Contributed by: Jesse Vincent + + - Update to latest Module::Install _again_ to fix Cygwin installation. + Reported by: Matt S Trout + +0.53 2006-01-10 + + - Update to latest Module::Install; no functional changes. + +0.52 2005-12-12 + + - Support for autouse.pm. + + - Support for Tk::DragDrop. Reported by: Renee Baecker. + +0.51 2005-01-08 + + - scandeps.pl is now usable without CPANPLUS.pm installed. + Reported by: Rafael Garcia-Suarez + +0.50 2004-10-03 + + - LWP::Authen::* is now bundled with LWP::UserAgent. + Reported by: Marcus Rueckert + + - Properly sign the release with newer EU::MM. + +0.49 2004-09-26 + + - Adds Class::Autouse support, as requested by Adam Kennedy. + +0.48 2004-09-07 + + - Skip auto/ files too if explicitly specified. + + - Also check for lower-cased keys in %skip, if operating under a + case-insensitive file system. + +0.47 2004-09-07 + + - First version under svk management. + + - Support for Mail::Audit plugins; prompted by Andrew Lee. + + - Support for modules that use Module::Plugin; prompted by Brian Cassidy. + + - scandeps.pl now reports module versions, courtesy of Dan Friedman. + + - Delayed loading of CPANPLUS on scandeps.pl. + +0.46 2004-07-02 + + - Doc fixes; update signature test; add Alan to authors. + + - add POE heuristics from: +http://search.cpan.org/dist/POE/lib/POE/Preprocessor.pm + +0.44 2004-06-08 + + - Consistently recognize .ph files and upper-cased .p[mh] + files. + + - Support for PDF::Writer. + - Patfch from Roderich Shupps to fix absolute filename +detection on non-Unix systems. + +0.43 2004-06-02 + + - Add preliminary support for BioPerl, as suggested by +Nathan Haigh. + - Support for Net::SSH::Perl was incorrectly specified. + - Add some support for PDF::API2 -- note you still have +to explicitly require "PDF::API2::Basic::TTF::Font" +to get TrueType support. + + - add heuristics for Devel::ParallelPort, as reported by + Jouke Visser. + +0.42 2004-04-30 + + + - add support for DBIx::SearchBuilder and + DBIx::ReportBuilder. + + + - oops, typo + + - add PerlIO.pm to :encoding. + +0.41 2004-04-18 + + + - correctly handle SVN::Core, courtesy of Robert Spiers. + + - handles SVK::Command properly. + + - add support for Parse::Binary-based modules + +0.40 2004-02-23 + + - Malcolm Nooning noticed that _execute() and _compile() + checks were failing under directories that contain spaces, + due to a qw() misuse. + + - Add heuristics for XML::SAX and XML::Parser::Expat, + reported by Darek Adamkiewicz and Iain Cass. + +0.39 2004-01-25 + + - Merged Edward's patch to make DataFeed.pm work with + pre-5.8.3 perl versions. + +0.38 2004-01-08 + + - Switching back to ExtUtils::MakeMaker, + hoping to make ActiveState's cpanrun happy. + +0.37 2003-12-31 + + + - Win32 does not take Cwd::abs_path() for filenames. + - Detection for __END__ blocks was wrong in _compile(). + +0.36 2003-12-31 + + - sorry, "scandeps.pl -r" should be "-x". + +0.35 2003-12-31 + + - New "-c" and "-r" flags to scandeps.pl for additional + compile- and runtime-checking of dependencies. + - New "compile" and "execute" flags to scan_deps() for + runtime scanning, using scan_deps_runtime(). + + - integrated Edward S. Peschko's massive runtime detection + patch, as scan_deps_runtime(). + +0.34 2003-12-30 + + - changes. + +0.33 2003-12-21 + + - Upgrades to Module::Install 0.30 framework. + + - Nik's got a CPAN ID. + +0.32 2003-10-26 + + - Support for Locale::Maketext::Guts, reported by Jouke + Visser. + - Support for XML::Parser, reported by Jan Dubois. + - Support for :encoding(), encoding.pm, and + encode()/decode(). + +0.31 2003-10-17 + + + - Jesse Schoch reports that LWP::Protocol::https is not properly detected. + +0.30 2003-09-20 + + - "use base" was still incorrectly parsed. + +0.29 2003-09-17 + + - Simon Andrews points out that Math::BigInt's heuristics + is badly coded. Fixed, and added heuristics for Math::BigFloat. + - More defense against hash randomisation by sorting all keys() and values(). + +0.28 2003-08-17 + + - Move ScanDeps.pm to lib/Module/. + + - Suggestion from Matt Sergeant to recognize A::B from + A::B::C only on functions like A::B::C(). + + - This be 0.27 for real. + - "use base" was improperly detected. + +0.27 2003-08-16 + + + - more patch from Roderich Schupp: handles "use base" and fixed Tk::Scrolled. + + - add $SeenTk to control Tk-specific heuristics. + - add_deps now takes (skip => \%skip) properly. + - scan_chunk() can now return more than one files in list + context. + - bump version. + +0.26 2003-08-11 + + - add link to http://par.perl.org/ and the mailing list. + + - don't append ".pm" to require '' lines if it already has an extension. + (this is required for Win32API::Registry to work with .pc files.) + +0.25 2003-08-10 + + - tidy up the source a little. + + - POD and END sections was also scanned. bad. + - PAR::read_file() should not imply dependency on PAR.pm. + +0.24 2003-08-10 + + - Add support for SOAP::Lite, XMLRPC::Lite and + Win32::SystemInfo. + +0.23 2003-08-08 + + - @File::Spec::ISA was crippled during scanning, thanks + to Roderich Schupp for pointing out. + +0.22 2003-08-07 + + + - huge patch to include almost all heuristics deducible from PerlApp: + Authen::SASL, Crypt::Random, DBI, File::Spec, + HTTP::Message, Math::BigInt, MIME::Decoder, Net::DNS::RR, + Net::FTP, Net::SSH::Perl, SQL::Parser, Template, + Term::ReadLine, URI, XML::Parser::Expat, diagnostics. + + - now accepts uppercased "DBI:" in DSN strings. + - fixed a typo on Tk::FBox's xpm file. + +0.21 2003-07-30 + + - Jouke reports that Win32.pm pulls all Win32::* DLLs. + + - oops. + + - scandeps.pl now take -e to scan a perl expression + + - anydbm implies SDBM. + + - Bruce Winter says that this fix for SerialJunks is needed + on his Red Hat Linux oh well. + +0.19 2003-03-22 + + + - Jess Robinson reported that the fix was not -w safe. + +0.18 2003-03-20 + + - added logic for "utf8" and "charnames" needed by Germain Garand. + - added logic for "Devel::SerialPort" needed by Bruce Winter. + - POSIX.pm no longer pulls in utf8.pm anymore. + - .ph files are now fully supported. + + - take unshift/push @INC into account, too. + - add Nik to authors. + + - Nik Clayton's patch to properly handle 'use lib'. + + - IO.pm dependencies, courtesy of Jerry Veldhuis. + +0.14 2003-01-19 + + + - s/UNIVERSA/UNIVERSAL/; + + - test explicitly for a hashref for safety. + + - try to fix D.H.'s bug report about broken 5.6 and pseudohashfications. + + - add lathos and obra to authors. + + - mention scandeps.pl earlier in pod. + +0.13 2003-01-18 + + + - much more improved scandeps, as suggested by jesse + vincent. + + - add #! for core; explains the symbols. + + - use cpanplus to tell apart redundant modules if possible. + +0.12 2003-01-18 + + - adds script/scandeps.pl + - new year. + + - add CAVEATS about the fact that we don't probe beyond + @INC, as requested by crazyinsomniac. + + - M::B heuristics. + + - reflect SEE ALSO in README. + +0.10 2002-11-04 + + - Now featuring an object-oriented syntax, conformant + with App::Packer::Frontend. + - added corresponding documentation and tests. + +0.03 2002-11-03 + + - add AUTHORS. + + - last minute fix from merlyn's bug report. + + - New presets for Locale::Maketext::Lexicon, Term::ReadLine, + Regexp::Common, File::Spec, ExtUtils::MakeMaker. + - New heuristics for Module::Name->method, + Module::Name::sub + - Strings in comments were erroneously checked. Fixed. + - Mention PerlApp as a source of inspiration. + + - Regexp::Common. + +0.02 2002-11-02 + + - now performs testing by looking at the test file itself. + + - displays correct message when connection fails. + + - backported to 5.001. + - was looking in POD sections; fixed. + - thorough comments and documentations. + + - oops, Makefile shouldn't be in RCS. + + - written-from-scratch version of dependency finding + algorithm. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..38437d6 --- /dev/null +++ b/LICENSE @@ -0,0 +1,383 @@ +Copyright 2002-2008 by Audrey Tang ; +2005-2009 by Steffen Mueller . + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +Terms of the Perl programming language system itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +--- The GNU General Public License, Version 1, February 1989 --- + +Copyright 2002-2008 by Audrey Tang ; +2005-2009 by Steffen Mueller . + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +Copyright 2002-2008 by Audrey Tang ; +2005-2009 by Steffen Mueller . + +This is free software, licensed under: + + The Artistic License 1.0 + +The Artistic License + +Preamble + +The intent of this document is to state the conditions under which a Package +may be copied, such that the Copyright Holder maintains some semblance of +artistic control over the development of the package, while giving the users of +the package the right to use and distribute the Package in a more-or-less +customary fashion, plus the right to make reasonable modifications. + +Definitions: + + - "Package" refers to the collection of files distributed by the Copyright + Holder, and derivatives of that collection of files created through + textual modification. + - "Standard Version" refers to such a Package if it has not been modified, + or has been modified in accordance with the wishes of the Copyright + Holder. + - "Copyright Holder" is whoever is named in the copyright or copyrights for + the package. + - "You" is you, if you're thinking about copying or distributing this Package. + - "Reasonable copying fee" is whatever you can justify on the basis of media + cost, duplication charges, time of people involved, and so on. (You will + not be required to justify it to the Copyright Holder, but only to the + computing community at large as a market that must bear the fee.) + - "Freely Available" means that no fee is charged for the item itself, though + there may be fees involved in handling the item. It also means that + recipients of the item may redistribute it under the same conditions they + received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications derived +from the Public Domain or from the Copyright Holder. A Package modified in such +a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided that +you insert a prominent notice in each changed file stating how and when you +changed that file, and provided that you do at least ONE of the following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or an + equivalent medium, or placing the modifications on a major archive site + such as ftp.uu.net, or by allowing the Copyright Holder to include your + modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict with + standard executables, which must also be provided, and provide a separate + manual page for each non-standard executable that clearly documents how it + differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or executable +form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where to + get the Standard Version. + + b) accompany the distribution with the machine-readable source of the Package + with your modifications. + + c) accompany any non-standard executables with their corresponding Standard + Version executables, giving the non-standard executables non-standard + names, and clearly documenting the differences in manual pages (or + equivalent), together with instructions on where to get the Standard + Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this Package. You +may not charge a fee for this Package itself. However, you may distribute this +Package in aggregate with other (possibly commercial) programs as part of a +larger (possibly commercial) software distribution provided that you do not +advertise this Package as a product of your own. + +6. The scripts and library files supplied as input to or produced as output +from the programs of this Package do not automatically fall under the copyright +of this Package, but belong to whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED +WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +The End + + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..17c93d3 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,71 @@ +AUTHORS +Changes +lib/Module/ScanDeps.pm +lib/Module/ScanDeps/Cache.pm +LICENSE +Makefile.PL +MANIFEST This list of files +README +script/scandeps.pl +t/0-pod.t +t/1-static_functional_interface_real.t +t/10-case-insensitive-keys.t +t/12-ScanFileRE.t +t/13-static_prefork_test.t +t/14-scan_chunk.t +t/14-static_functional_cached.t +t/16-scan_line.t +t/17-private_methods.t +t/2-static_functional_interface_fake.t +t/3-static_oo_interface_real.t +t/4-static_functional_interface_options_fake.t +t/5-pluggable_fake.t +t/6-file-glob.t +t/7-check-dynaloader.t +t/8-check_duplicated_entries.t +t/9-check_path_to_inc_name.t +t/data/case-insensitive-keys/Test.pm +t/data/case-insensitive-keys/Test2.pm +t/data/case-insensitive-keys/that_case.pl +t/data/case-insensitive-keys/this_case.pl +t/data/check_path_to_inc_name/Scoped/Package.pm +t/data/check_path_to_inc_name/Some.pm +t/data/check_path_to_inc_name/use_scoped_package.pl +t/data/duplicated_entries/Scoped/Package.pm +t/data/duplicated_entries/use_scoped_package.pl +t/data/file-glob-no.pl +t/data/file-glob-yes.pl +t/data/pluggable/Foo.pm +t/data/pluggable/Foo/Plugin/Bar.pm +t/data/pluggable/Foo/Plugin/Baz.pm +t/data/rt90869.pl +t/data/ScanFileRE/auto/example/example.h +t/data/ScanFileRE/example.pm +t/data/ScanFileRE/example_too.pm +t/data/static/chicken.pm +t/data/static/Duplicated.pm +t/data/static/Duplicator.pl +t/data/static/egg.pm +t/data/static/inner_diamond_E.pm +t/data/static/inner_diamond_N.pm +t/data/static/inner_diamond_S.pm +t/data/static/inner_diamond_W.pm +t/data/static/InputA.pl +t/data/static/InputB.pl +t/data/static/InputC.pl +t/data/static/null.pl +t/data/static/outer_diamond_E.pm +t/data/static/outer_diamond_N.pm +t/data/static/outer_diamond_S.pm +t/data/static/outer_diamond_W.pm +t/data/static/TestA.pm +t/data/static/TestB.pm +t/data/static/TestC.pm +t/data/static/TestD.pm +t/data/static/useVERSION.pm +t/data/use_lib.pl +t/rt90869.t +t/Utils.pm +wip/scan_dlls.pl +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/META.json b/META.json new file mode 100644 index 0000000..781d307 --- /dev/null +++ b/META.json @@ -0,0 +1,66 @@ +{ + "abstract" : "Recursively scan Perl code for dependencies", + "author" : [ + "Audrey Tang " + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150010", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Module-ScanDeps", + "no_index" : { + "directory" : [ + "t", + "inc" + ], + "package" : [ + "Module::ScanDeps::Cache", + "Module::ScanDeps::DataFeed" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "File::Spec" : "0", + "File::Temp" : "0", + "Getopt::Long" : "0", + "Module::Metadata" : "0", + "Text::ParseWords" : "0", + "perl" : "5.008001", + "version" : "0" + } + }, + "test" : { + "requires" : { + "Test::More" : "0", + "Test::Requires" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "type" : "git", + "url" : "git://github.com/rschupp/Module-ScanDeps.git", + "web" : "https://github.com/rschupp/Module-ScanDeps" + }, + "x_MailingList" : "par@perl.org" + }, + "version" : "1.24", + "x_serialization_backend" : "JSON::PP version 2.27300_01" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..ed5917b --- /dev/null +++ b/META.yml @@ -0,0 +1,37 @@ +--- +abstract: 'Recursively scan Perl code for dependencies' +author: + - 'Audrey Tang ' +build_requires: + ExtUtils::MakeMaker: '0' + Test::More: '0' + Test::Requires: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150010' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Module-ScanDeps +no_index: + directory: + - t + - inc + package: + - Module::ScanDeps::Cache + - Module::ScanDeps::DataFeed +requires: + File::Spec: '0' + File::Temp: '0' + Getopt::Long: '0' + Module::Metadata: '0' + Text::ParseWords: '0' + perl: '5.008001' + version: '0' +resources: + MailingList: par@perl.org + repository: git://github.com/rschupp/Module-ScanDeps.git +version: '1.24' +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..7cf2cef --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,75 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile1( + + NAME => 'Module::ScanDeps', + VERSION_FROM => 'lib/Module/ScanDeps.pm', + ABSTRACT_FROM => 'lib/Module/ScanDeps.pm', + LICENSE => 'perl_5', + AUTHOR => [ 'Audrey Tang ' ], + + MIN_PERL_VERSION => '5.008001', + PREREQ_PM => { + 'File::Temp' => 0, + 'File::Spec' => 0, + 'Getopt::Long' => 0, + 'Module::Metadata' => 0, + 'Text::ParseWords' => 0, + 'version' => 0, + }, + TEST_REQUIRES => { + 'Test::More' => 0, + 'Test::Requires' => 0, + }, + + EXE_FILES => [ 'script/scandeps.pl' ], + + META_MERGE => { + "meta-spec" => { version => 2 }, + resources => { + repository => { + type => 'git', + url => 'git://github.com/rschupp/Module-ScanDeps.git', + web => 'https://github.com/rschupp/Module-ScanDeps', + }, + MailingList => 'par@perl.org', + }, + no_index => { + package => [qw( Module::ScanDeps::Cache Module::ScanDeps::DataFeed )], + }, + }, +); + + +sub WriteMakefile1 { #Compatibility code for old versions of EU::MM. Written by Alexandr Ciornii, version 0.23. Added by eumm-upgrade. + my %params=@_; + my $eumm_version=$ExtUtils::MakeMaker::VERSION; + $eumm_version=eval $eumm_version; + die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; + die "License not specified" if not exists $params{LICENSE}; + if ($params{AUTHOR} and ref($params{AUTHOR}) eq 'ARRAY' and $eumm_version < 6.5705) { + $params{META_ADD}->{author}=$params{AUTHOR}; + $params{AUTHOR}=join(', ',@{$params{AUTHOR}}); + } + if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { + $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; + delete $params{TEST_REQUIRES}; + } + if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { + #EUMM 6.5502 has problems with BUILD_REQUIRES + $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; + delete $params{BUILD_REQUIRES}; + } + delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; + delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; + delete $params{META_MERGE} if $eumm_version < 6.46; + delete $params{META_ADD} if $eumm_version < 6.46; + delete $params{LICENSE} if $eumm_version < 6.31; + + WriteMakefile(%params); +} + diff --git a/README b/README new file mode 100644 index 0000000..c944b1e --- /dev/null +++ b/README @@ -0,0 +1,26 @@ +This is the README file for Module::ScanDeps, a module to recursively +scan Perl programs for dependencies. + +An application of Module::ScanDeps is to generate executables from scripts +that contains necessary modules; this module supports two such projects, +PAR and App::Packer. Please see their respective documentations on CPAN +for further information. + +* Installation + +Module::ScanDeps uses the standard perl module install process: + + perl Makefile.PL + make + make test + make install + +* Copyright + +Copyright 2002-2008 by Audrey Tang ; +2005-2009 by Steffen Mueller . + +All rights reserved. You can redistribute and/or modify +this bundle under the same terms as Perl itself. + +See . diff --git a/lib/Module/ScanDeps.pm b/lib/Module/ScanDeps.pm new file mode 100644 index 0000000..7f5b44d --- /dev/null +++ b/lib/Module/ScanDeps.pm @@ -0,0 +1,1675 @@ +package Module::ScanDeps; +use 5.008001; +use strict; +use warnings; +use vars qw( $VERSION @EXPORT @EXPORT_OK @ISA $CurrentPackage @IncludeLibs $ScanFileRE ); + +$VERSION = '1.24'; +@EXPORT = qw( scan_deps scan_deps_runtime ); +@EXPORT_OK = qw( scan_line scan_chunk add_deps scan_deps_runtime path_to_inc_name ); + +use Config; +require Exporter; +our @ISA = qw(Exporter); +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 +); + +use version; +use Cwd (); +use File::Path (); +use File::Temp (); +use File::Spec (); +use File::Basename (); +use FileHandle; +use Module::Metadata; + +$ScanFileRE = qr/(?:^|\\|\/)(?:[^.]*|.*\.(?i:p[ml]|t|al))$/; + +=head1 NAME + +Module::ScanDeps - Recursively scan Perl code for dependencies + +=head1 SYNOPSIS + +Via the command-line program L: + + % scandeps.pl *.pm # Print PREREQ_PM section for *.pm + % scandeps.pl -e "use utf8" # Read script from command line + % scandeps.pl -B *.pm # Include core modules + % scandeps.pl -V *.pm # Show autoload/shared/data files + +Used in a program; + + use Module::ScanDeps; + + # standard usage + my $hash_ref = scan_deps( + files => [ 'a.pl', 'b.pl' ], + recurse => 1, + ); + + # shorthand; assume recurse == 1 + my $hash_ref = scan_deps( 'a.pl', 'b.pl' ); + + # App::Packer::Frontend compatible interface + # see App::Packer::Frontend for the structure returned by get_files + my $scan = Module::ScanDeps->new; + $scan->set_file( 'a.pl' ); + $scan->set_options( add_modules => [ 'Test::More' ] ); + $scan->calculate_info; + my $files = $scan->get_files; + +=head1 DESCRIPTION + +This module scans potential modules used by perl programs, and returns a +hash reference; its keys are the module names as appears in C<%INC> +(e.g. C); the values are hash references with this structure: + + { + file => '/usr/local/lib/perl5/5.8.0/Test/More.pm', + key => 'Test/More.pm', + type => 'module', # or 'autoload', 'data', 'shared' + used_by => [ 'Test/Simple.pm', ... ], + uses => [ 'Test/Other.pm', ... ], + } + +One function, C, is exported by default. Other +functions such as (C, C, C, C) +are exported upon request. + +Users of B may also use this module as the dependency-checking +frontend, by tweaking their F like below: + + use Module::ScanDeps; + ... + my $packer = App::Packer->new( frontend => 'Module::ScanDeps' ); + ... + +Please see L for detailed explanation on +the structure returned by C. + +=head2 B + + $rv_ref = scan_deps( + files => \@files, recurse => $recurse, + rv => \%rv, skip => \%skip, + compile => $compile, execute => $execute, + ); + $rv_ref = scan_deps(@files); # shorthand, with recurse => 1 + +This function scans each file in C<@files>, registering their +dependencies into C<%rv>, and returns a reference to the updated +C<%rv>. The meaning of keys and values are explained above. + +If C<$recurse> is true, C will call itself recursively, +to perform a breadth-first search on text files (as defined by the +-T operator) found in C<%rv>. + +If the C<\%skip> is specified, files that exists as its keys are +skipped. This is used internally to avoid infinite recursion. + +If C<$compile> or C<$execute> is true, runs C in either +compile-only or normal mode, then inspects their C<%INC> after +termination to determine additional runtime dependencies. + +If C<$execute> is an array reference, passes C<@$execute> +as arguments to each file in C<@files> when it is run. + +If performance of the scanning process is a concern, C can be +set to a filename. The scanning results will be cached and written to the +file. This will speed up the scanning process on subsequent runs. + +Additionally, an option C is recognized. If set to true, +C issues a warning to STDERR for every module file that the +scanned code depends but that wasn't found. Please note that this may +also report numerous false positives. That is why by default, the heuristic +silently drops all dependencies it cannot find. + +=head2 B + +Like B, but skips the static scanning part. + +=head2 B + + @modules = scan_line($line); + +Splits a line into chunks (currently with the semicolon characters), and +return the union of C calls of them. + +If the line is C<__END__> or C<__DATA__>, a single C<__END__> element is +returned to signify the end of the program. + +Similarly, it returns a single C<__POD__> if the line matches C; +the caller is responsible for skipping appropriate number of lines +until C<=cut>, before calling C again. + +=head2 B + + $module = scan_chunk($chunk); + @modules = scan_chunk($chunk); + +Apply various heuristics to C<$chunk> to find and return the module +name(s) it contains. In scalar context, returns only the first module +or C. + +=head2 B + + $rv_ref = add_deps( rv => \%rv, modules => \@modules ); + $rv_ref = add_deps( @modules ); # shorthand, without rv + +Resolves a list of module names to its actual on-disk location, by +finding in C<@INC> and C<@Module::ScanDeps::IncludeLibs>; +modules that cannot be found are skipped. + +This function populates the C<%rv> hash with module/filename pairs, and +returns a reference to it. + +=head2 B + + $perl_name = path_to_inc_name($path, $warn) + +Assumes C<$path> refers to a perl file and does it's best to return the +name as it would appear in %INC. Returns undef if no match was found +and a prints a warning to STDERR if C<$warn> is true. + +E.g. if C<$path> = perl/site/lib/Module/ScanDeps.pm then C<$perl_name> +will be Module/ScanDeps.pm. + +=head1 NOTES + +=head2 B<@Module::ScanDeps::IncludeLibs> + +You can set this global variable to specify additional directories in +which to search modules without modifying C<@INC> itself. + +=head2 B<$Module::ScanDeps::ScanFileRE> + +You can set this global variable to specify a regular expression to +identify what files to scan. By default it includes all files of +the following types: .pm, .pl, .t and .al. Additionally, all files +without a suffix are considered. + +For instance, if you want to scan all files then use the following: + +C<$Module::ScanDeps::ScanFileRE = qr/./> + +=head1 CAVEATS + +This module intentionally ignores the B hack on FreeBSD -- the +additional directory is removed from C<@INC> altogether. + +The static-scanning heuristic is not likely to be 100% accurate, especially +on modules that dynamically load other modules. + +Chunks that span multiple lines are not handled correctly. For example, +this one works: + + use base 'Foo::Bar'; + +But this one does not: + + use base + 'Foo::Bar'; + +=cut + +my $SeenTk; +my %SeenRuntimeLoader; + +# Pre-loaded module dependencies {{{ +my %Preload = ( + 'AnyDBM_File.pm' => [qw( SDBM_File.pm )], + 'AnyEvent.pm' => 'sub', + 'Authen/SASL.pm' => 'sub', + 'B/Hooks/EndOfScope.pm' => + [qw( B/Hooks/EndOfScope/PP.pm B/Hooks/EndOfScope/XS.pm )], + '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', + 'Catalyst.pm' => sub { + return ('Catalyst/Runtime.pm', + 'Catalyst/Dispatcher.pm', + _glob_in_inc('Catalyst/DispatchType', 1)); + }, + 'Catalyst/Engine.pm' => 'sub', + 'CGI/Application/Plugin/Authentication.pm' => + [qw( CGI/Application/Plugin/Authentication/Store/Cookie.pm )], + 'CGI/Application/Plugin/AutoRunmode.pm' => [qw( Attribute/Handlers.pm )], + 'charnames.pm' => \&_unicore, + 'Class/Load.pm' => [qw( Class/Load/PP.pm )], + 'Class/MakeMethods.pm' => 'sub', + 'Class/MethodMaker.pm' => 'sub', + 'Config/Any.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); + }, + 'Date/Manip.pm' => + [qw( Date/Manip/DM5.pm Date/Manip/DM6.pm )], + 'Date/Manip/Base.pm' => sub { + _glob_in_inc('Date/Manip/Lang', 1); + }, + 'Date/Manip/TZ.pm' => sub { + return (_glob_in_inc('Date/Manip/TZ', 1), + _glob_in_inc('Date/Manip/Offset', 1)); + }, + 'DateTime/Format/Builder/Parser.pm' => 'sub', + 'DateTime/Format/Natural.pm' => 'sub', + 'DateTime/Locale.pm' => 'sub', + 'DateTime/TimeZone.pm' => 'sub', + 'DBI.pm' => sub { + grep !/\bProxy\b/, _glob_in_inc('DBD', 1); + }, + 'DBIx/Class.pm' => 'sub', + 'DBIx/SearchBuilder.pm' => 'sub', + 'DBIx/Perlish.pm' => [qw( attributes.pm )], + '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 )], + 'diagnostics.pm' => sub { + # shamelessly taken and adapted from diagnostics.pm + use Config; + my($privlib, $archlib) = @Config{qw(privlibexp archlibexp)}; + if ($^O eq 'VMS') { + require VMS::Filespec; + $privlib = VMS::Filespec::unixify($privlib); + $archlib = VMS::Filespec::unixify($archlib); + } + + for ( + "pod/perldiag.pod", + "Pod/perldiag.pod", + "pod/perldiag-$Config{version}.pod", + "Pod/perldiag-$Config{version}.pod", + "pods/perldiag.pod", + "pods/perldiag-$Config{version}.pod", + ) { + return $_ if _find_in_inc($_); + } + + for ( + "$archlib/pods/perldiag.pod", + "$privlib/pods/perldiag-$Config{version}.pod", + "$privlib/pods/perldiag.pod", + ) { + return $_ if -f $_; + } + + return 'pod/perldiag.pod'; + }, + 'Email/Send.pm' => 'sub', + 'Event.pm' => sub { + map "Event/$_.pm", qw( idle io signal timer var ); + }, + 'ExtUtils/MakeMaker.pm' => sub { + grep /\bMM_/, _glob_in_inc('ExtUtils', 1); + }, + 'File/Basename.pm' => [qw( re.pm )], + 'File/BOM.pm' => [qw( Encode/Unicode.pm )], + 'File/HomeDir.pm' => 'sub', + 'File/Spec.pm' => sub { + require File::Spec; + map { my $name = $_; $name =~ s!::!/!g; "$name.pm" } @File::Spec::ISA; + }, + 'Gtk2.pm' => [qw( Cairo.pm )], # Gtk2.pm does: eval "use Cairo;" + 'HTTP/Message.pm' => [qw( URI/URL.pm URI.pm )], + 'Image/ExifTool.pm' => sub { + return( + (map $_->{name}, _glob_in_inc('Image/ExifTool', 0)), # also *.pl files + qw( File/RandomAccess.pm ), + ); + }, + 'Image/Info.pm' => sub { + return( + _glob_in_inc('Image/Info', 1), + qw( Image/TIFF.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 )], + 'JSON.pm' => sub { + # add JSON/PP*.pm, JSON/PP/*.pm + # and ignore other JSON::* modules (e.g. JSON/Syck.pm, JSON/Any.pm); + # but accept JSON::XS, too (because JSON.pm might use it if present) + return( grep /^JSON\/(PP|XS)/, _glob_in_inc('JSON', 1) ); + }, + 'List/MoreUtils.pm' => 'sub', + 'List/SomeUtils.pm' => 'sub', + 'Locale/Maketext/Lexicon.pm' => 'sub', + 'Locale/Maketext/GutsLoader.pm' => [qw( Locale/Maketext/Guts.pm )], + 'Log/Any.pm' => 'sub', + 'Log/Dispatch.pm' => 'sub', + 'Log/Log4perl.pm' => 'sub', + 'Log/Report/Dispatcher.pm' => 'sub', + 'LWP/MediaTypes.pm' => [qw( LWP/media.types )], + 'LWP/Parallel.pm' => sub { + _glob_in_inc( 'LWP/Parallel', 1 ), + qw( + LWP/ParallelUA.pm LWP/UserAgent.pm + LWP/RobotPUA.pm LWP/RobotUA.pm + ), + }, + 'LWP/Parallel/UserAgent.pm' => [qw( LWP/Parallel.pm )], + 'LWP/UserAgent.pm' => sub { + return( + qw( URI/URL.pm URI/http.pm LWP/Protocol/http.pm ), + _glob_in_inc("LWP/Authen", 1), + _glob_in_inc("LWP/Protocol", 1), + ); + }, + 'Mail/Audit.pm' => 'sub', + 'Math/BigInt.pm' => 'sub', + 'Math/BigFloat.pm' => 'sub', + 'Math/Symbolic.pm' => 'sub', + 'MIME/Decoder.pm' => 'sub', + 'MIME/Types.pm' => [qw( MIME/types.db )], + 'Module/Build.pm' => 'sub', + 'Module/Pluggable.pm' => sub { + _glob_in_inc('$CurrentPackage/Plugin', 1); + }, + 'Moose.pm' => sub { + _glob_in_inc('Moose', 1), + _glob_in_inc('Class/MOP', 1), + }, + 'MooseX/AttributeHelpers.pm' => 'sub', + 'MooseX/POE.pm' => sub { + _glob_in_inc('MooseX/POE', 1), + _glob_in_inc('MooseX/Async', 1), + }, + 'Mozilla/CA.pm' => [qw( Mozilla/CA/cacert.pem )], + 'MozRepl.pm' => sub { + qw( MozRepl/Log.pm MozRepl/Client.pm Module/Pluggable/Fast.pm ), + _glob_in_inc('MozRepl/Plugin', 1), + }, + 'Module/Implementation.pm' => \&_warn_of_runtime_loader, + 'Module/Runtime.pm' => \&_warn_of_runtime_loader, + 'Net/DNS/Resolver.pm' => 'sub', + 'Net/DNS/RR.pm' => 'sub', + 'Net/FTP.pm' => 'sub', + 'Net/HTTPS.pm' => [qw( IO/Socket/SSL.pm Net/SSL.pm )], + 'Net/Server.pm' => 'sub', + 'Net/SSH/Perl.pm' => 'sub', + 'Package/Stash.pm' => [qw( Package/Stash/PP.pm Package/Stash/XS.pm )], + 'Pango.pm' => [qw( Cairo.pm )], # Pango.pm does: eval "use Cairo;" + 'PAR/Repository.pm' => 'sub', + 'PAR/Repository/Client.pm' => 'sub', + 'Params/Validate.pm' => 'sub', + 'Parse/AFP.pm' => 'sub', + 'Parse/Binary.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', + 'PDL/NiceSlice.pm' => 'sub', + 'Perl/Critic.pm' => 'sub', #not only Perl/Critic/Policy + 'PerlIO.pm' => [qw( PerlIO/scalar.pm )], + 'Pod/Simple/Transcode.pm' => [qw( Pod/Simple/TranscodeDumb.pm Pod/Simple/TranscodeSmart.pm )], + 'Pod/Usage.pm' => sub { # from Pod::Usage (as of 1.61) + $] >= 5.005_58 ? 'Pod/Text.pm' : 'Pod/PlainText.pm' + }, + 'POE.pm' => [qw( POE/Kernel.pm POE/Session.pm )], + 'POE/Component/Client/HTTP.pm' => sub { + _glob_in_inc('POE/Component/Client/HTTP', 1), + qw( POE/Filter/HTTPChunk.pm POE/Filter/HTTPHead.pm ), + }, + 'POE/Kernel.pm' => sub { + _glob_in_inc('POE/XS/Resource', 1), + _glob_in_inc('POE/Resource', 1), + _glob_in_inc('POE/XS/Loop', 1), + _glob_in_inc('POE/Loop', 1), + }, + 'POSIX.pm' => sub { + map $_->{name}, + _glob_in_inc('auto/POSIX/SigAction', 0), # *.al files + _glob_in_inc('auto/POSIX/SigRt', 0), # *.al files + }, + 'PPI.pm' => 'sub', + 'Regexp/Common.pm' => 'sub', + 'RPC/XML/ParserFactory.pm' => sub { + _glob_in_inc('RPC/XML/Parser', 1); + }, + 'SerialJunk.pm' => [qw( + termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph + )], + 'SOAP/Lite.pm' => sub { + _glob_in_inc('SOAP/Transport', 1), + _glob_in_inc('SOAP/Lite', 1), + }, + 'Socket/GetAddrInfo.pm' => 'sub', + 'Specio/PartialDump.pm' => \&_unicore, + 'SQL/Parser.pm' => sub { + _glob_in_inc('SQL/Dialects', 1); + }, + 'SQL/Translator/Schema.pm' => sub { + _glob_in_inc('SQL/Translator', 1); + }, + 'Sub/Exporter/Progressive.pm' => [qw( Sub/Exporter.pm )], + 'SVK/Command.pm' => sub { + _glob_in_inc('SVK', 1); + }, + 'SVN/Core.pm' => sub { + _glob_in_inc('SVN', 1), + map $_->{name}, _glob_in_inc('auto/SVN', 0), # *.so, *.bs files + }, + 'Template.pm' => 'sub', + 'Term/ReadLine.pm' => 'sub', + 'Test/Deep.pm' => 'sub', + 'threads/shared.pm' => [qw( attributes.pm )], + # anybody using threads::shared is likely to declare variables + # with attribute :shared + '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/DragDrop/Common.pm' => sub { + _glob_in_inc('Tk/DragDrop', 1), + }, + 'Tk/FBox.pm' => [qw( Tk/folder.xpm Tk/file.xpm )], + 'Tk/Getopt.pm' => [qw( Tk/openfolder.xpm Tk/win.xbm )], + 'Tk/Toplevel.pm' => [qw( Tk/Wm.pm )], + 'Unicode/Normalize.pm' => \&_unicore, + 'Unicode/UCD.pm' => \&_unicore, + 'URI.pm' => sub { grep !/urn/, _glob_in_inc('URI', 1) }, + 'utf8_heavy.pl' => \&_unicore, + '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 )], + 'Wx.pm' => [qw( attributes.pm )], + 'XML/Parser.pm' => sub { + _glob_in_inc('XML/Parser/Style', 1), + _glob_in_inc('XML/Parser/Encodings', 1), + }, + 'XML/SAX.pm' => [qw( XML/SAX/ParserDetails.ini ) ], + 'XMLRPC/Lite.pm' => sub { + _glob_in_inc('XMLRPC/Transport', 1); + }, + 'YAML.pm' => [qw( YAML/Loader.pm YAML/Dumper.pm )], + 'YAML/Any.pm' => sub { + # try to figure out what YAML::Any would have used + my $impl = eval "use YAML::Any; YAML::Any->implementation;"; + unless ($@) + { + $impl =~ s!::!/!g; + return "$impl.pm"; + } + _glob_in_inc('YAML', 1); # fallback + }, +); + +# }}} + +sub path_to_inc_name($$) { + my $path = shift; + my $warn = shift; + my $inc_name; + + if ($path =~ m/\.pm$/io) { + die "$path doesn't exist" unless (-f $path); + my $module_info = Module::Metadata->new_from_file($path); + die "Module::Metadata error: $!" unless defined($module_info); + $inc_name = $module_info->name(); + if (defined($inc_name)) { + $inc_name =~ s|\:\:|\/|og; + $inc_name .= '.pm'; + } else { + warn "# Couldn't find include name for $path\n" if $warn; + } + } else { + # Bad solution! + (my $vol, my $dir, $inc_name) = File::Spec->splitpath($path); + } + + return $inc_name; +} + +my $Keys = 'files|keys|recurse|rv|skip|first|execute|compile|warn_missing|cache_cb|cache_file'; +sub scan_deps { + my %args = ( + rv => {}, + (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1) + ); + + if (!defined($args{keys})) { + $args{keys} = [map {path_to_inc_name($_, $args{warn_missing})} @{$args{files}}]; + } + my $cache_file = $args{cache_file}; + my $using_cache; + if ($cache_file) { + require Module::ScanDeps::Cache; + $using_cache = Module::ScanDeps::Cache::init_from_file($cache_file); + if( $using_cache ){ + $args{cache_cb} = Module::ScanDeps::Cache::get_cache_cb(); + }else{ + my @missing = Module::ScanDeps::Cache::prereq_missing(); + warn join(' ', + "Can not use cache_file: Needs Modules [", + @missing, + "]\n",); + } + } + my ($type, $path); + foreach my $input_file (@{$args{files}}) { + if ($input_file !~ $ScanFileRE) { + warn "Skipping input file $input_file because it matches \$Module::ScanDeps::ScanFileRE\n" if $args{warn_missing}; + next; + } + + $type = _gettype($input_file); + $path = $input_file; + if ($type eq 'module') { + # necessary because add_deps does the search for shared libraries and such + add_deps( + used_by => undef, + rv => $args{rv}, + modules => [path_to_inc_name($path, $args{warn_missing})], + skip => undef, + warn_missing => $args{warn_missing}, + ); + } + else { + _add_info( + rv => $args{rv}, + module => path_to_inc_name($path, $args{warn_missing}), + file => $path, + used_by => undef, + type => $type, + ); + } + } + + 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} + ); + } + + if ( $using_cache ){ + Module::ScanDeps::Cache::store_cache(); + } + + # do not include the input files themselves as dependencies! + delete $args{rv}{$_} foreach @{$args{files}}; + + return ($args{rv}); +} + +sub scan_deps_static { + my ($args) = @_; + my ($files, $keys, $recurse, $rv, + $skip, $first, $execute, $compile, + $cache_cb, $_skip) + = @$args{qw( files keys recurse rv + skip first execute compile + cache_cb _skip )}; + + $rv ||= {}; + $_skip ||= { %{$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)}++; + next unless $file =~ $ScanFileRE; + + my @pm; + my $found_in_cache; + if ($cache_cb){ + my $pm_aref; + # cache_cb populates \@pm on success + $found_in_cache = $cache_cb->(action => 'read', + key => $key, + file => $file, + modules => \@pm, + ); + unless( $found_in_cache ){ + @pm = scan_file($file); + $cache_cb->(action => 'write', + key => $key, + file => $file, + modules => \@pm, + ); + } + }else{ # no caching callback given + @pm = scan_file($file); + } + + foreach my $pm (@pm){ + add_deps( + used_by => $key, + rv => $args->{rv}, + modules => [$pm], + skip => $args->{skip}, + warn_missing => $args->{warn_missing}, + ); + + my @preload = _get_preload($pm) or next; + + add_deps( + used_by => $key, + rv => $args->{rv}, + modules => \@preload, + skip => $args->{skip}, + warn_missing => $args->{warn_missing}, + ); + } + } + + # Top-level recursion handling {{{ + + # prevent utf8.pm from being scanned + $_skip->{$rv->{"utf8.pm"}{file}}++ if $rv->{"utf8.pm"}; + + while ($recurse) { + my $count = keys %$rv; + my @files = sort grep { defined $_->{file} && -T $_->{file} } values %$rv; + scan_deps_static({ + files => [ map $_->{file}, @files ], + keys => [ map $_->{key}, @files ], + rv => $rv, + skip => $skip, + recurse => 0, + cache_cb => $cache_cb, + _skip => $_skip, + }); + last if $count == keys %$rv; + } + + # }}} + + return $rv; +} + +sub scan_deps_runtime { + my %args = ( + rv => {}, + (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1) + ); + my ($files, $rv, $execute, $compile) = + @args{qw( files rv execute compile )}; + + $files = (ref($files)) ? $files : [$files]; + + if ($compile) { + foreach my $file (@$files) { + next unless $file =~ $ScanFileRE; + + my ($inchash, $dl_shared_objects, $incarray) = _compile_or_execute($file); + _merge_rv(_make_rv($inchash, $dl_shared_objects, $incarray), $rv); + } + } + elsif ($execute) { + foreach my $file (@$files) { + $execute = [] unless ref $execute; # make sure it's an array ref + + my ($inchash, $dl_shared_objects, $incarray) = _compile_or_execute($file, $execute); + _merge_rv(_make_rv($inchash, $dl_shared_objects, $incarray), $rv); + } + } + + return ($rv); +} + +sub scan_file{ + my $file = shift; + my %found; + my $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; + } + + # Skip Tk hits from Term::ReadLine and Tcl::Tk + my $pathsep = qr/\/|\\|::/; + if ($pm =~ /^Tk\b/) { + next if $file =~ /(?:^|${pathsep})Term${pathsep}ReadLine\.pm$/; + next if $file =~ /(?:^|${pathsep})Tcl${pathsep}Tk\W/; + } + $SeenTk ||= $pm =~ /Tk\.pm$/; + + $found{$pm}++; + } + } + close $FH or die "Cannot close $file: $!"; + return keys %found; +} + +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)) { + s/^\s*//; + + if (/^package\s+(\w+)/) { + $CurrentPackage = $1; + $CurrentPackage =~ s{::}{/}g; + return; + } + # use VERSION: + if (/^(?:use|require)\s+v?(\d[\d\._]*)/) { + # include feature.pm if we have 5.9.5 or better + if (version->new($1) >= version->new("5.9.5")) { + # seems to catch 5.9, too (but not 5.9.4) + return "feature.pm"; + } + } + + if (my ($pragma, $args) = /^use \s+ (autouse|if) \s+ (.+)/x) + { + # NOTE: There are different ways the MODULE may + # be specified for the "autouse" and "if" pragmas, e.g. + # use autouse Module => qw(func1 func2); + # use autouse "Module", qw(func1); + # To avoid to parse them ourself, we simply try to eval the + # string after the pragma (in a list context). The MODULE + # should be the first ("autouse") or second ("if") element + # of the list. + my $module; + { + no strict; no warnings; + if ($pragma eq "autouse") { + ($module) = eval $args; + } + else { + # The syntax of the "if" pragma is + # use if COND, MODULE => ARGUMENTS + # The COND may contain undefined functions (i.e. undefined + # in Module::ScanDeps' context) which would throw an + # exception. Sneak "1 || " in front of COND so that + # COND will not be evaluated. This will work in most + # cases, but there are operators with lower precedence + # than "||" which will cause this trick to fail. + (undef, $module) = eval "1 || $args"; + } + # punt if there was a syntax error + return if $@ or !defined $module; + }; + $module =~ s{::}{/}g; + return ("$pragma.pm", "$module.pm"); + } + + if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC \s+ ,) (.+)/x) + { + my $archname = defined($Config{archname}) ? $Config{archname} : ''; + my $ver = defined($Config{version}) ? $Config{version} : ''; + foreach my $dir (do { no strict; no warnings; eval $libs }) { + next unless defined $dir; + my @dirs = $dir; + push @dirs, "$dir/$ver", "$dir/$archname", "$dir/$ver/$archname" + if $how =~ /lib/; + foreach (@dirs) { + unshift(@INC, $_) if -d $_; + } + } + next; + } + + $found{$_}++ for scan_chunk($_); + } + + return sort keys %found; +} + +# short helper for scan_chunk +my %LoaderRegexp; # cache +sub _build_loader_regexp { + my $loaders = shift; + my $prefix = (@_ && $_[0]) ? $_[0].'::' : ''; + + my $loader = join '|', map quotemeta($_), split /\s+/, $loaders; + my $regexp = qr/^\s* use \s+ ($loader)(?!\:) \b \s* (.*)/sx; + # WARNING: This doesn't take the prefix into account + $LoaderRegexp{$loaders} = $regexp; + return $regexp +} + +# short helper for scan_chunk +sub _extract_loader_dependency { + my $loader = shift; + my $loadee = shift; + my $prefix = (@_ && $_[0]) ? $_[0].'::' : ''; + + my $loader_file = $loader; + $loader_file =~ s/::/\//; + $loader_file .= ".pm"; + + return [ + $loader_file, + map { my $mod="$prefix$_"; $mod =~ s{::}{/}g; "$mod.pm" } + grep { length and !/^q[qw]?$/ and !/-/ } + split /[^\w:-]+/, $loadee + #should skip any module name that contains '-', not split it in two + ]; +} + +sub scan_chunk { + my $chunk = shift; + + # Module name extraction heuristics {{{ + my $module = eval { + $_ = $chunk; + s/^\s*//; + + # TODO: There's many more of these "loader" type modules on CPAN! + # scan for the typical module-loader modules + my $loaders = "asa base parent prefork POE encoding maybe only::matching Mojo::Base"; + # grab pre-calculated regexp or re-build it (and cache it) + my $loader_regexp = $LoaderRegexp{$loaders} || _build_loader_regexp($loaders); + if ($_ =~ $loader_regexp) { # $1 == loader, $2 == loadee + my $retval = _extract_loader_dependency($1, $2); + return $retval if $retval; + } + + $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)) { + $used_by = $module; + } else { + foreach my $key (keys %$rv) { + if (lc($key) eq lc($used_by)) { + $used_by = $key; + last; + } + } + } + } + } + + $rv->{$module} ||= { + file => $file, + key => $module, + type => $type, + }; + + if (defined($used_by) and $used_by ne $module) { + push @{ $rv->{$module}{used_by} }, $used_by + if ( (!File::Spec->case_tolerant() && !grep { $_ eq $used_by } @{ $rv->{$module}{used_by} }) + or ( File::Spec->case_tolerant() && !grep { lc($_) eq lc($used_by) } @{ $rv->{$module}{used_by} })); + + # We assume here that another _add_info will be called to provide the other parts of $rv->{$used_by} + push @{ $rv->{$used_by}{uses} }, $module + if ( (!File::Spec->case_tolerant() && !grep { $_ eq $module } @{ $rv->{$used_by}{uses} }) + or ( File::Spec->case_tolerant() && !grep { lc($_) eq lc($module) } @{ $rv->{$used_by}{uses} })); + } +} + +# This subroutine relies on not being called for modules that have already been visited +sub add_deps { + my %args = + ((@_ and $_[0] =~ /^(?:modules|rv|used_by|warn_missing)$/) + ? @_ + : (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} }) { + my $file = _find_in_inc($module) + or _warn_of_missing_module($module, $args{warn_missing}), next; + next if $skip->{$file}; + + if (exists $rv->{$module}) { + _add_info( rv => $rv, module => $module, + file => $file, used_by => $used_by, + type => undef ); + next; + } + + my $type = _gettype($file); + _add_info( rv => $rv, module => $module, + file => $file, used_by => $used_by, + type => $type ); + + if ($module =~ /(.*?([^\/]*))\.p[mh]$/i) { + my ($path, $basename) = ($1, $2); + + foreach (_glob_in_inc("auto/$path")) { + next if $_->{file} =~ m{\bauto/$path/.*/}; # weed out subdirs + next if $_->{name} =~ m{/\.(?:exists|packlist)$}; + my ($ext,$type); + $ext = lc($1) if $_->{name} =~ /(\.[^.]+)$/; + if (defined $ext) { + next if $ext eq lc(lib_ext()); + $type = 'shared' if $ext eq lc(dl_ext()); + $type = 'autoload' if ($ext eq '.ix' or $ext eq '.al'); + } + $type ||= 'data'; + + _add_info( rv => $rv, module => $_->{name}, + file => $_->{file}, used_by => $module, + type => $type ); + } + + ### Now, handle module and distribution share dirs + # convert 'Module/Name' to 'Module-Name' + my $modname = $path; + $modname =~ s|/|-|g; + # TODO: get real distribution name related to module name + my $distname = $modname; + foreach (_glob_in_inc("auto/share/module/$modname")) { + _add_info( rv => $rv, module => $_->{name}, + file => $_->{file}, used_by => $module, + type => 'data' ); + } + foreach (_glob_in_inc("auto/share/dist/$distname")) { + _add_info( rv => $rv, module => $_->{name}, + file => $_->{file}, used_by => $module, + type => 'data' ); + } + } + } # end for modules + return $rv; +} + +sub _find_in_inc { + my $file = shift; + return unless defined $file; + + foreach my $dir (grep !/\bBSDPAN\b/, @INC, @IncludeLibs) { + return "$dir/$file" if -f "$dir/$file"; + } + + # absolute file names + return $file if -f $file; + + return; +} + +sub _glob_in_inc { + my $subdir = shift; + my $pm_only = shift; + my @files; + + require File::Find; + + $subdir =~ s/\$CurrentPackage/$CurrentPackage/; + + foreach my $inc (grep !/\bBSDPAN\b/, @INC, @IncludeLibs) { + my $dir = "$inc/$subdir"; + next unless -d $dir; + File::Find::find( + sub { + return unless -f; + return if $pm_only and !/\.p[mh]$/i; + (my $name = $File::Find::name) =~ s!^\Q$inc\E/!!; + push @files, $pm_only + ? $name + : { file => $File::Find::name, name => $name }; + }, + $dir + ); + } + + return @files; +} + +# like _glob_in_inc, but looks only at the first level +# (i.e. the children of $subdir) +# NOTE: File::Find has no public notion of the depth of the traversal +# in its "wanted" callback, so it's not helpful +sub _glob_in_inc_1 { + my $subdir = shift; + my $pm_only = shift; + my @files; + + $subdir =~ s/\$CurrentPackage/$CurrentPackage/; + + foreach my $inc (grep !/\bBSDPAN\b/, @INC, @IncludeLibs) { + my $dir = "$inc/$subdir"; + next unless -d $dir; + + opendir my $dh, $dir or next; + my @names = map { "$subdir/$_" } grep { -f "$dir/$_" } readdir $dh; + closedir $dh; + + push @files, $pm_only + ? ( grep { /\.p[mh]$/i } @names ) + : ( map { { file => "$inc/$_", name => $_ } } @names ); + } + + return @files; +} + +my $unicore_stuff; +sub _unicore { + $unicore_stuff ||= [ 'utf8_heavy.pl', map $_->{name}, _glob_in_inc('unicore', 0) ]; + return @$unicore_stuff; +} + +# App::Packer compatibility functions + +sub new { + my ($class, $self) = @_; + return bless($self ||= {}, $class); +} + +sub set_file { + my $self = shift; + my $script = shift; + + my ($vol, $dir, $file) = File::Spec->splitpath($script); + $self->{main} = { + key => $file, + 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 _warn_of_missing_module($module, $args{warn_missing}), 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} }) { + defined($val->{used_by}) or next; + 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}; +} + +sub add_preload_rule { + my ($pm, $rule) = @_; + die qq[a preload rule for "$pm" already exists] if $Preload{$pm}; + $Preload{$pm} = $rule; +} + +# scan_deps_runtime utility functions + +# compile $file if $execute is undef, +# otherwise execute $file with arguments @$execute +sub _compile_or_execute { + my ($file, $execute) = @_; + + my ($ih, $instrumented_file) = File::Temp::tempfile(UNLINK => 1); + + # spoof $0 (to $file) so that FindBin works as expected + # NOTE: We don't directly assign to $0 as it has magic (i.e. + # assigning has side effects and may actually fail, cf. perlvar(1)). + # Instead we alias *0 to a package variable holding the correct value. + local $ENV{MSD_ORIGINAL_FILE} = $file; + print $ih <<'...'; +BEGIN { my $_0 = $ENV{MSD_ORIGINAL_FILE}; *0 = \$_0; } +... + + my (undef, $data_file) = File::Temp::tempfile(UNLINK => 1); + local $ENV{MSD_DATA_FILE} = $data_file; + + # NOTE: When compiling the block will run as the last CHECK block; + # when executing the block will run as the first END block and + # the programs continues. + print $ih $execute ? "END\n" : "CHECK\n", <<'...'; +{ + # save %INC etc so that requires below don't pollute them + my %_INC = %INC; + my @_INC = @INC; + my @_dl_shared_objects = @DynaLoader::dl_shared_objects; + my @_dl_modules = @DynaLoader::dl_modules; + + require Cwd; + require DynaLoader; + require Data::Dumper; + require B; + require Config; + + while (my ($k, $v) = each %_INC) + { + # NOTES: + # (1) An unsuccessful "require" may store an undefined value into %INC. + # (2) If a key in %INC was located via a CODE or ARRAY ref or + # blessed object in @INC the corresponding value in %INC contains + # the ref from @INC. + # (3) Some modules (e.g. Moose) fake entries in %INC, e.g. + # "Class/MOP/Class/Immutable/Moose/Meta/Class.pm" => "(set by Moose)" + # On some architectures (e.g. Windows) Cwd::abs_path() will throw + # an exception for such a pathname. + if (defined $v && !ref $v && -e $v) + { + $_INC{$k} = Cwd::abs_path($v); + } + else + { + delete $_INC{$k}; + } + } + + # drop refs from @_INC + @_INC = grep { !ref $_ } @_INC; + + my $dlext = $Config::Config{dlext}; + my @so = grep { defined $_ && -e $_ } Module::ScanDeps::DataFeed::_dl_shared_objects(); + my @bs = @so; + my @shared_objects = ( @so, grep { s/\Q.$dlext\E$/\.bs/ && -e $_ } @bs ); + + my $data_file = $ENV{MSD_DATA_FILE}; + open my $fh, ">", $data_file + or die "Couldn't open $data_file: $!\n"; + print $fh Data::Dumper->Dump( + [ \%_INC, \@_INC, \@shared_objects ], + [qw( *inchash *incarray *dl_shared_objects )]); + print $fh "1;\n"; + close $fh; + + sub Module::ScanDeps::DataFeed::_dl_shared_objects { + if (@_dl_shared_objects) { + return @_dl_shared_objects; + } + elsif (@_dl_modules) { + return map { Module::ScanDeps::DataFeed::_dl_mod2filename($_) } @_dl_modules; + } + return; + } + + sub Module::ScanDeps::DataFeed::_dl_mod2filename { + my $mod = shift; + + return if $mod eq 'B'; + return unless defined &{"$mod\::bootstrap"}; + + my $dl_ext = $Config::Config{dlext}; + + # cf. DynaLoader.pm + my @modparts = split(/::/, $mod); + my $modfname = defined &DynaLoader::mod2fname ? DynaLoader::mod2fname(\@modparts) : $modparts[-1]; + my $modpname = join('/', @modparts); + + foreach my $dir (@_INC) { + my $file = "$dir/auto/$modpname/$modfname.$dl_ext"; + return $file if -r $file; + } + return; + } +} # END or CHECK +... + + # append the file to compile or execute + { + open my $fh, "<", $file or die "Couldn't open $file: $!"; + print $ih qq[#line 1 "$file"\n], <$fh>; + close $fh; + } + close $ih; + + # run the instrumented file + my $rc = system( + $^X, + $execute ? () : ("-c"), + (map { "-I$_" } @IncludeLibs), + $instrumented_file, + $execute ? @$execute : ()); + + die $execute + ? "SYSTEM ERROR in executing $file @$execute: $rc" + : "SYSTEM ERROR in compiling $file: $rc" + unless $rc == 0; + + return _extract_info($data_file); +} + +# create a new hashref, applying fixups +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); + # don't pack lib/c:/ or lib/C:/ + $inc = qr/$inc/i if(is_insensitive_fs()); + + require File::Spec; + + foreach my $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 + }; + } + + foreach my $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) = @_; + + use vars qw(%inchash @dl_shared_objects @incarray); + + unless (do $fname) { + die "error extracting info from DataFeed file: ", + $@ || "can't read $fname: $!"; + } + + my %ih = %inchash; + my @dso = @dl_shared_objects; + my @ia = @incarray; + return (\%ih, \@dso, \@ia); +} + +sub _gettype { + my $name = shift; + my $dlext = quotemeta(dl_ext()); + + return 'autoload' if $name =~ /(?:\.ix|\.al)$/i; + return 'module' if $name =~ /\.p[mh]$/i; + return 'shared' if $name =~ /\.$dlext$/i; + return 'data'; +} + +# merge all keys from $rv_sub into the $rv mega-ref +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.\n" + . " -> Using '" . _abs_path($rv_sub->{$key}{file}) . "'.\n" + . " -> Ignoring '" . _abs_path($rv->{$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) = @_; + if (File::Spec->case_tolerant()) { + return lc(_abs_path($rv1->{$key}{file})) ne lc(_abs_path($rv2->{$key}{file})); + } + else { + return _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]), + ); +} + + +sub _warn_of_runtime_loader { + my $module = shift; + return if $SeenRuntimeLoader{$module}++; + $module =~ s/\.pm$//; + $module =~ s|/|::|g; + warn "# Use of runtime loader module $module detected. Results of static scanning may be incomplete.\n"; + return; +} + +sub _warn_of_missing_module { + my $module = shift; + my $warn = shift; + return if not $warn; + return if not $module =~ /\.p[ml]$/; + warn "# Could not find source file '$module' in \@INC or \@IncludeLibs. Skipping it.\n" + if not -f $module; +} + +sub _get_preload1 { + my $pm = shift; + my $preload = $Preload{$pm} or return(); + if ($preload eq 'sub') { + $pm =~ s/\.p[mh]$//i; + return _glob_in_inc($pm, 1); + } + elsif (UNIVERSAL::isa($preload, 'CODE')) { + return $preload->($pm); + } + return @$preload; +} + +sub _get_preload { + my ($pm, $seen) = @_; + $seen ||= {}; + $seen->{$pm}++; + my @preload; + + foreach $pm (_get_preload1($pm)) + { + next if $seen->{$pm}; + $seen->{$pm}++; + push @preload, $pm, _get_preload($pm, $seen); + } + return @preload; +} + +1; +__END__ + +=head1 SEE ALSO + +L is a bundled utility that writes C section +for a number of files. + +An application of B is to generate executables from +scripts that contains prerequisite modules; this module supports two +such projects, L and L. Please see their respective +documentations on CPAN for further information. + +=head1 AUTHORS + +Audrey Tang Ecpan@audreyt.orgE + +To a lesser degree: Steffen Mueller Esmueller@cpan.orgE + +Parts of heuristics were deduced from: + +=over 4 + +=item * + +B by ActiveState Tools Corp L + +=item * + +B by IndigoStar, Inc L + +=back + +The B function is contributed by Edward S. Peschko. + +You can write to the mailing list at Epar@perl.orgE, or send an empty +mail to Epar-subscribe@perl.orgE to participate in the discussion. + +Please submit bug reports to Ebug-Module-ScanDeps@rt.cpan.orgE. + +=head1 COPYRIGHT + +Copyright 2002-2008 by +Audrey Tang Ecpan@audreyt.orgE; +2005-2010 by Steffen Mueller Esmueller@cpan.orgE. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +See L + +=cut diff --git a/lib/Module/ScanDeps/Cache.pm b/lib/Module/ScanDeps/Cache.pm new file mode 100644 index 0000000..ac4a2b2 --- /dev/null +++ b/lib/Module/ScanDeps/Cache.pm @@ -0,0 +1,97 @@ +package Module::ScanDeps::Cache; +use strict; +use warnings; +my $has_DMD5; +eval { require Digest::MD5 }; +$has_DMD5 = 1 unless $@; +my $has_Storable; +eval { require Storable }; +$has_Storable = 1 unless $@; + + +my $cache; +my $cache_file; +my $cache_dirty; + +sub prereq_missing{ + my @missing; + push @missing, 'Digest::MD5' unless $has_DMD5; + push @missing, 'Storable' unless $has_Storable; + return @missing; +} + +sub init_from_file{ + my $c_file = shift; + return 0 if prereq_missing(); + eval{$cache = Storable::retrieve($c_file)}; + #warn $@ if ($@); + unless ($cache){ + warn "Couldn't retrieve data from file $c_file. Building new cache.\n"; + $cache = {}; + } + $cache_file = $c_file; + return 1; +} + +sub store_cache{ + my $c_file = shift || $cache_file; + # no need to store to the file we retrieved from + # unless we have seen changes written to the cache + return unless ($cache_dirty + || $c_file ne $cache_file); + Storable::nstore($cache, $c_file) + or warn "Could not store cache to file $c_file!"; +} + +sub get_cache_cb{ + return sub{ + my %args = @_; + if ( $args{action} eq 'read' ){ + return _read_cache( %args ); + } + elsif ( $args{action} eq 'write' ){ + return _write_cache( %args ); + } + die "action in cache_cb must be read or write!"; + }; +} + +### check for existence of the entry +### check for identity of the file +### pass cached value in $mod_aref +### return true in case of a hit + +sub _read_cache{ + my %args = @_; + my ($key, $file, $mod_aref) = @args{qw/key file modules/}; + return 0 unless (exists $cache->{$key}); + my $entry = $cache->{$key}; + my $checksum = _file_2_md5($file); + if ($entry->{checksum} eq $checksum){ + @$mod_aref = @{$entry->{modules}}; + return 1; + } + return 0; +} + +sub _write_cache{ + my %args = @_; + my ($key, $file, $mod_aref) = @args{qw/key file modules/}; + my $entry = $cache->{$key} ||= {}; + my $checksum = _file_2_md5($file); + $entry->{checksum} = $checksum; + $entry->{modules} = [@$mod_aref]; + $cache_dirty = 1; + return 1; +} + +sub _file_2_md5{ + my $file = shift; + open my $fh, '<', $file or die "can't open $file: $!"; + my $md5 = Digest::MD5->new; + $md5->addfile($fh); + close $fh or die "can't close $file: $!"; + return $md5->hexdigest; +} +1; + diff --git a/script/scandeps.pl b/script/scandeps.pl new file mode 100644 index 0000000..7010fb0 --- /dev/null +++ b/script/scandeps.pl @@ -0,0 +1,264 @@ +#!/usr/bin/perl + +$VERSION = '0.76'; + +use strict; +use Config; +use Getopt::Long qw(:config bundling no_ignore_case); +use Module::ScanDeps; +use ExtUtils::MakeMaker; +use subs qw( _name _modtree ); + +my $usage = "Usage: $0 [ -B ] [ -V ] [ -T ] [ -x [ --xargs STRING ] | -c ] [ -R ] [-C FILE ] [ -e STRING | FILE ... ]\n"; + +my %opts; +GetOptions(\%opts, + "B|bundle", + "C|cachedeps=s", + "c|compile", + "e|eval=s", + "xargs=s", + "R|no-recurse", + "T|modtree", + "V|verbose", + "x|execute", +) or die $usage; + +my (%map, %skip); +my $core = $opts{B}; +my $verbose = $opts{V}; +my $eval = $opts{e}; +my $recurse = $opts{R} ? 0 : 1; +my $modtree = {} unless $opts{T}; # i.e. disable it unless explicitly requested + +if ($eval) { + require File::Temp; + my ($fh, $filename) = File::Temp::tempfile( UNLINK => 1 ); + print $fh $eval, "\n" or die $!; + close $fh; + push @ARGV, $filename; +} + +if ($opts{x} && defined $opts{xargs}) { + require Text::ParseWords; + $opts{x} = [ Text::ParseWords::shellwords($opts{xargs}) ]; +} + +die $usage unless @ARGV; + +my @files = @ARGV; +while (<>) { + next unless /^package\s+([\w:]+)/; + $skip{$1}++; +} + +my $map = scan_deps( + files => \@files, + recurse => $recurse, + $opts{x} ? ( execute => $opts{x} ) : + $opts{c} ? ( compile => 1 ) : (), + $opts{V} ? ( warn_missing => 1 ) : (), + $opts{C} ? ( cache_file => $opts{C}) : (), +); + + +my $len = 0; +my @todo; +my (%seen, %dist, %core, %bin); + +foreach my $key (sort keys %$map) { + my $mod = $map->{$key}; + my $name = $mod->{name} = _name($key); + + print "# $key [$mod->{type}]\n" if $verbose; + + if ($mod->{type} eq 'shared') { + $key =~ s!auto/!!; + $key =~ s!/[^/]+$!!; + $key =~ s!/!::!; + $bin{$key}++; + } + + next unless $mod->{type} eq 'module'; + + next if $skip{$name}; + + my $privPath = "$Config::Config{privlibexp}/$key"; + my $archPath = "$Config::Config{archlibexp}/$key"; + $privPath =~ s|\\|\/|og; + $archPath =~ s|\\|\/|og; + if ($mod->{file} eq $privPath + or $mod->{file} eq $archPath) { + next unless $core; + + $core{$name}++; + } + elsif (my $dist = _modtree->{$name}) { + $seen{$name} = $dist{$dist->package}++; + } + + $len = length($name) if $len < length($name); + $mod->{used_by} ||= []; + + push @todo, $mod; +} + +$len += 2; + +print "# Legend: [C]ore [X]ternal [S]ubmodule [?]NotOnCPAN\n" if $verbose; + +foreach my $mod (sort { + "@{$a->{used_by}}" cmp "@{$b->{used_by}}" or + $a->{key} cmp $b->{key} +} @todo) { + + my $version = MM->parse_version($mod->{file}); + + if (!$verbose) { + printf "%-${len}s => '$version',", "'$mod->{name}'" if $version; + } else { + printf "%-${len}s => '0', # ", "'$mod->{name}'"; + my @base = map(_name($_), @{$mod->{used_by}}); + print $seen{$mod->{name}} ? 'S' : ' '; + print $bin{$mod->{name}} ? 'X' : ' '; + print $core{$mod->{name}} ? 'C' : ' '; + print _modtree && !_modtree->{$mod->{name}} ? '?' : ' '; + print " # "; + print "@base" if @base; + } + print "\n"; + +} + +warn "No modules found!\n" unless @todo; + +sub _name { + my $str = shift; + $str =~ s!/!::!g; + $str =~ s!.pm$!!i; + $str =~ s!^auto::(.+)::.*!$1!; + return $str; +} + +sub _modtree { + $modtree ||= eval { + require CPANPLUS::Backend; + CPANPLUS::Backend->new->module_tree; + } || {}; +} + + +1; + +__END__ + +=head1 NAME + +scandeps.pl - Scan file prerequisites + +=head1 SYNOPSIS + + % scandeps.pl *.pm # Print PREREQ_PM section for *.pm + % scandeps.pl -e 'STRING' # Scan an one-liner + % scandeps.pl -B *.pm # Include core modules + % scandeps.pl -V *.pm # Show autoload/shared/data files + % scandeps.pl -R *.pm # Don't recurse + % scandeps.pl -C CACHEFILE # use CACHEFILE to cache dependencies + +=head1 DESCRIPTION + +F is a simple-minded utility that prints out the +C section needed by modules. + +If the option C<-T> is specified and +you have B installed, modules that are part of an +earlier module's distribution with be denoted with C; modules +without a distribution name on CPAN are marked with C. + +Also, if the C<-B> option is specified, module belongs to a perl +distribution on CPAN (and thus uninstallable by C or +C) are marked with C. + +Finally, modules that has loadable shared object files (usually +needing a compiler to install) are marked with C; with the +C<-V> flag, those files (and all other files found) will be listed +before the main output. Additionally, all module files that the +scanned code depends on but were not found (and thus not scanned +recursively) are listed. These may include genuinely missing +modules or false positives. That means, modules your code does +not depend on (on this particular platform) but that were picked +up by the heuristic anyway. + +=head1 OPTIONS + +=over 4 + +=item B<-e>, B<--eval>=I + +Scan I as a string containing perl code. + +=item B<-c>, B<--compile> + +Compiles the code and inspects its C<%INC>, in addition to static scanning. + +=item B<-x>, B<--execute> + +Executes the code and inspects its C<%INC>, in addition to static scanning. +You may use B<--xargs> to specify C<@ARGV> when executing the code. + +=item B<--xargs>=I + +If B<-x> is given, splits the C using the function +C from L and passes the result +as C<@ARGV> when executing the code. + +=item B<-B>, B<--bundle> + +Include core modules in the output and the recursive search list. + +=item B<-R>, B<--no-recurse> + +Only show dependencies found in the files listed and do not recurse. + +=item B<-V>, B<--verbose> + +Verbose mode: Output all files found during the process; +show dependencies between modules and availability. + +Additionally, warns of any missing dependencies. If you find missing +dependencies that aren't really dependencies, you have probably found +false positives. + +=item B<-C>, B<--cachedeps>=I + +Use CACHEFILE to speed up the scanning process by caching dependencies. +Creates CACHEFILE if it does not exist yet. + +=item B<-T>, B<--modtree> + +Retrieves module information from CPAN if you have B installed. + +=back + +=head1 SEE ALSO + +L, L, L + +=head1 ACKNOWLEDGMENTS + +Simon Cozens, for suggesting this script to be written. + +=head1 AUTHORS + +Audrey Tang Eautrijus@autrijus.orgE + +=head1 COPYRIGHT + +Copyright 2003, 2004, 2005, 2006 by Audrey Tang Eautrijus@autrijus.orgE. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +See L + +=cut diff --git a/t/0-pod.t b/t/0-pod.t new file mode 100644 index 0000000..5fab38f --- /dev/null +++ b/t/0-pod.t @@ -0,0 +1,6 @@ +use strict; +use Test::More; +use Test::Requires { "Test::Pod" => "1.00" }; + +all_pod_files_ok(); + diff --git a/t/1-static_functional_interface_real.t b/t/1-static_functional_interface_real.t new file mode 100644 index 0000000..08ea6cb --- /dev/null +++ b/t/1-static_functional_interface_real.t @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib 't'; +use Test::More qw(no_plan); # no_plan because the number of objects in the dependency tree (and hence the number of tests) can change +use Utils; + +my $rv; +my $root; + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps' ); } + +############################################################## +# Tests static dependency scanning on a real set of modules. +# This exercises the scanning functionality but because the +# majority of files scanned aren't fixed, the checks are +# necessarily loose. +############################################################## +$root = $0; + +my @deps = qw( + Carp.pm Config.pm Exporter.pm + Test/More.pm strict.pm vars.pm +); + +# Functional i/f +$rv = scan_deps($root); +generic_scandeps_rv_test($rv, [$0], \@deps); + +__END__ diff --git a/t/10-case-insensitive-keys.t b/t/10-case-insensitive-keys.t new file mode 100644 index 0000000..a9398b7 --- /dev/null +++ b/t/10-case-insensitive-keys.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Spec; + +use Test::More; +BEGIN { + if(!File::Spec->case_tolerant()) { + plan skip_all => 'Test irrelevant on case-sensitive systems'; + } else { + plan tests => 43; + } +} + +use lib qw(t t/data/case-insensitive-keys); +use Utils; + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps' ); } + + +############################################################## +# Static dependency check of scripts that reference the same +# module but in different cases +############################################################## +my @roots1 = qw(t/data/case-insensitive-keys/this_case.pl t/data/case-insensitive-keys/that_case.pl); +my $expected_rv1 = +{ + "Test.pm" => { + file => generic_abs_path("t/data/case-insensitive-keys/Test.pm"), + key => "Test.pm", + type => "module", + used_by => ["this_case.pl", "that_case.pl"], + }, + "that_case.pl" => { + file => generic_abs_path("t/data/case-insensitive-keys/that_case.pl"), + key => "that_case.pl", + type => "data", + uses => ["Test.pm"], + }, + "this_case.pl" => { + file => generic_abs_path("t/data/case-insensitive-keys/this_case.pl"), + key => "this_case.pl", + type => "data", + uses => ["Test.pm"], + }, +}; + +# Functional i/f +my $rv1 = scan_deps(@roots1); +#use Data::Dumper; +#print STDERR "\n", Dumper($rv1); + +compare_scandeps_rvs($rv1, $expected_rv1, \@roots1); + +# Check that only one entry for Cwd is created. + +my @roots2 = qw(t/data/case-insensitive-keys/Test2.pm); +my $rv2 = scan_deps(files => \@roots2); +my @keys = grep { lc($_) eq "cwd.pm" } keys %$rv2; +ok($#keys == 0, "contains only one match"); + +__END__ diff --git a/t/12-ScanFileRE.t b/t/12-ScanFileRE.t new file mode 100644 index 0000000..89674c6 --- /dev/null +++ b/t/12-ScanFileRE.t @@ -0,0 +1,48 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Temp; + +use Test::More tests => 8; +use lib 't/data/ScanFileRE'; + +BEGIN { use_ok( 'Module::ScanDeps' ); } + +# Test that ScanFileRE is applied to the input files +my ($fh, $filename) = File::Temp::tempfile( UNLINK => 1, SUFFIX => '.na' ); +ok(defined $Module::ScanDeps::ScanFileRE, "ScanFileRE is accessible outside Module::ScanDeps"); +ok($filename !~ $Module::ScanDeps::ScanFileRE, "$filename does not match"); +my $rv = scan_deps(files => [$filename]); +ok( + !(scalar grep { /\Q$filename\E/ } keys %$rv), + "ScanFileRE removed non-matching input files" +); + +my ($fh2, $filename2) = File::Temp::tempfile( UNLINK => 1 ); +ok($filename2 =~ $Module::ScanDeps::ScanFileRE, "$filename2 does match"); +my $rv2 = scan_deps(files => [$filename2]); +my $basename = $filename2; +$basename =~ s/^.*(?:\/|\\)([^\\\/]+)$/$1/; +ok( + (scalar grep { /\Q$basename\E/ } keys %$rv2) == 1, + "ScanFileRE did not remove matching input files" +); +# The next two tests rely on t/data/ScanFileRE/auto/example/example.h using t/data/ScanFileRE/example_too.pm + +# Test that the default ScanFileRE is applied to the used files +$rv = scan_deps(files => ['t/data/ScanFileRE/example.pm'], recurse => 1); +ok( + !(scalar grep { /example_too\.pm/ } keys %$rv), + "ScanFileRE only scanned matching files in the dependency tree" +); + +# Test that ScanFileRE can be changed to now pick up all files in the dependency tree +$Module::ScanDeps::ScanFileRE = qr/.*/; +$rv = scan_deps(files => ['t/data/ScanFileRE/example.pm'], recurse => 1); +ok( + (scalar grep { /example_too\.pm/ } keys %$rv), + "M::SD recognised the new ScanFileRE and scanned all files in the dependency tree" +); + +__END__ diff --git a/t/13-static_prefork_test.t b/t/13-static_prefork_test.t new file mode 100644 index 0000000..5430dae --- /dev/null +++ b/t/13-static_prefork_test.t @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Requires qw( prefork ); + +use lib 't'; +use Utils; + +BEGIN { + # Mwuahahaha! + delete $INC{"prefork.pm"}; + %prefork:: = (); + + plan 'no_plan'; # no_plan because the number of objects in the dependency tree (and hence the number of tests) can change +} + +my $rv; +my $root; + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps' ); } + +############################################################## +# Tests static dependency scanning with the prefork module. +# This was broken until Module::ScanDeps 0.85 +############################################################## +$root = $0; + +use prefork "less"; + +my @deps = qw( + Carp.pm Config.pm Exporter.pm + Test/More.pm strict.pm vars.pm + prefork.pm less.pm +); + +# Functional i/f +$rv = scan_deps($root); +generic_scandeps_rv_test($rv, [$0], \@deps); + +__END__ diff --git a/t/14-scan_chunk.t b/t/14-scan_chunk.t new file mode 100644 index 0000000..3a0a88d --- /dev/null +++ b/t/14-scan_chunk.t @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 7; +use Module::ScanDeps qw/scan_chunk/; + +{ +my $chunk=<<'EOT'; +use strict; +EOT +my @array=sort(scan_chunk($chunk)); +is_deeply(\@array,[sort qw{strict.pm}]); +} + +{ +my $chunk=<<'EOT'; +use base qw(strict); +EOT +my @array=sort(scan_chunk($chunk)); +is_deeply(\@array,[sort qw{base.pm strict.pm}]); +} + +{ +my $chunk=<<'EOT'; +use parent qw(strict); +EOT +my @array=sort(scan_chunk($chunk)); +is_deeply(\@array,[sort qw{parent.pm strict.pm}]); +} + +{ +my $chunk=<<'EOT'; +use parent::doesnotexists qw(strict); +EOT +my @array=sort(scan_chunk($chunk)); +is_deeply(\@array,[sort qw{parent/doesnotexists.pm}]); +} + +{ +my $chunk=<<'EOT'; +use Mojo::Base 'strict'; +EOT +my @array=sort(scan_chunk($chunk)); +is_deeply(\@array,[sort qw{Mojo/Base.pm strict.pm}],'Mojo::Base'); +} + +{ +my $chunk=<<'EOT'; +use Catalyst qw/-Debug ConfigLoader Session::State::Cookie/ +EOT +#-Debug should be skipped +my @array=sort(scan_chunk($chunk)); +is_deeply(\@array,[sort qw{Catalyst.pm Catalyst/Plugin/ConfigLoader.pm Catalyst/Plugin/Session/State/Cookie.pm}]); +} + +{ +my $chunk=<<'EOT'; +use I18N::LangTags 0.30 (); +EOT +my @array=sort(scan_chunk($chunk)); +is_deeply(\@array,[sort qw{I18N/LangTags.pm}]); +} diff --git a/t/14-static_functional_cached.t b/t/14-static_functional_cached.t new file mode 100644 index 0000000..c0223a5 --- /dev/null +++ b/t/14-static_functional_cached.t @@ -0,0 +1,382 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More 'no_plan'; +use lib qw(t t/data/static); +use Utils; +use version; + + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps' ); } + + + +############################################################## +# Static dependency check of a script that doesn't use +# anything with basic cache_cb test added +############################################################## +my @roots1 = qw(t/data/static/null.pl); +my $expected_rv1 = +{ + "null.pl" => { + file => generic_abs_path("t/data/static/null.pl"), + key => "null.pl", + type => "data", + }, +}; +expected_cache_cb_args({key => 'null.pl', + file => 't/data/static/null.pl', + }); + +my $rv1 = scan_deps(files => \@roots1, + cache_cb => \&cache_cb + ); +compare_scandeps_rvs($rv1, $expected_rv1, \@roots1); + +### check if we can use M::SD::Cache +my $skip_cache_tests = 1; +eval {require Module::ScanDeps::Cache;}; +unless ($@){ + $skip_cache_tests = Module::ScanDeps::Cache::prereq_missing(); + warn $skip_cache_tests, "\n"; +} +my $cache_file = 'deps_cache.dat'; + +for my $t(qw/write_cache use_cache/){ + + SKIP: + { + skip "Skipping M:SD::Cache tests" , 289 if $skip_cache_tests; + + ############################################################## + # Static dependency check of a circular dependency: + # ___ + # |/_ \ + # M _M + # \____/| + # + ############################################################## + my @roots2 = qw(t/data/static/egg.pm); + my $expected_rv2 = + { + "chicken.pm" => { + file => generic_abs_path("t/data/static/chicken.pm"), + key => "chicken.pm", + type => "module", + used_by => ["egg.pm"], + uses => ["egg.pm"], + }, + "egg.pm" => { + file => generic_abs_path("t/data/static/egg.pm"), + key => "egg.pm", + type => "module", + used_by => ["chicken.pm"], + uses => ["chicken.pm"], + }, + }; + + # Functional i/f + my $rv2 = scan_deps(files => \@roots2, + cache_file => $cache_file, + recurse => 1, + ); + compare_scandeps_rvs($rv2, $expected_rv2, \@roots2); + + ############################################################## + # Static dependency check of the following dependency tree + # + # M + # /|\ + # / | \ + # / | \ + # / M \ + # / / \ \ + # / / \ \ + # M M M M + # \ \ / / + # \ \ / / + # \ M / + # \ | / + # \ | / + # M + # + # With dependencies always going from the top downwards + ############################################################## + my @roots3 = qw(t/data/static/outer_diamond_N.pm); + my $expected_rv3 = + { + "inner_diamond_E.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_E.pm"), + key => "inner_diamond_E.pm", + type => "module", + used_by => ["inner_diamond_N.pm"], + uses => ["inner_diamond_S.pm"], + }, + "inner_diamond_N.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_N.pm"), + key => "inner_diamond_N.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + uses => ["inner_diamond_E.pm", "inner_diamond_W.pm"], + }, + "inner_diamond_S.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_S.pm"), + key => "inner_diamond_S.pm", + type => "module", + used_by => ["inner_diamond_W.pm", "inner_diamond_E.pm"], + uses => ["outer_diamond_S.pm"], + }, + "inner_diamond_W.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_W.pm"), + key => "inner_diamond_W.pm", + type => "module", + used_by => ["inner_diamond_N.pm"], + uses => ["inner_diamond_S.pm"], + }, + "outer_diamond_E.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_E.pm"), + key => "outer_diamond_E.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + uses => ["outer_diamond_S.pm"], + }, + "outer_diamond_N.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_N.pm"), + key => "outer_diamond_N.pm", + type => "module", + uses => ["inner_diamond_N.pm", "outer_diamond_E.pm", "outer_diamond_W.pm"], + }, + "outer_diamond_S.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_S.pm"), + key => "outer_diamond_S.pm", + type => "module", + used_by => ["outer_diamond_E.pm", "outer_diamond_W.pm", "inner_diamond_S.pm"], + }, + "outer_diamond_W.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_W.pm"), + key => "outer_diamond_W.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + uses => ["outer_diamond_S.pm"], + }, + }; + + # Functional i/f + my $rv3 = scan_deps(cache_file => $cache_file, + recurse => 1, + files => \@roots3); + compare_scandeps_rvs($rv3, $expected_rv3, \@roots3); + + + ############################################################## + # Static dependency check of the following dependency tree + # (i.e. multiple inputs) + # + # InputA.pl InputB.pl InputC.pl + # / \ \ / + # / \ \ / + # / \ \ / + # TestA.pm TestB.pm TestC.pm / + # \ / + # \ / + # TestD.pm + # + ############################################################## + my @roots4 = qw(t/data/static/InputA.pl + t/data/static/InputB.pl + t/data/static/InputC.pl); + my $expected_rv4 = + { + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "InputC.pl" => { + file => generic_abs_path("t/data/static/InputC.pl"), + key => "InputC.pl", + type => "data", + uses => ["TestD.pm"], + }, + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + uses => ["TestD.pm"], + }, + "TestD.pm" => { + file => generic_abs_path("t/data/static/TestD.pm"), + key => "TestD.pm", + type => "module", + used_by => ["InputC.pl", "TestC.pm"], + }, + }; + + # Functional i/f + my $rv4 = scan_deps(cache_file => $cache_file, + recurse => 1, + files => \@roots4); + compare_scandeps_rvs($rv4, $expected_rv4, \@roots4); + + + ############################################################## + # Static dependency check of the following dependency tree + # Tests the .pm only lists the .pl once in it's used_by entries + # + # Duplicator.pl + # / \ + # / \ + # / \ + # \ / + # \ / + # \ / + # Duplicated.pm + # + ############################################################## + my @roots5 = qw(t/data/static/Duplicator.pl); + my $expected_rv5 = + { + "Duplicated.pm" => { + file => generic_abs_path("t/data/static/Duplicated.pm"), + key => "Duplicated.pm", + type => "module", + used_by => ["Duplicator.pl"], + }, + "Duplicator.pl" => { + file => generic_abs_path("t/data/static/Duplicator.pl"), + key => "Duplicator.pl", + type => "data", + uses => ["Duplicated.pm"], + }, + }; + + # Functional i/f + my $rv5 = scan_deps(cache_file => $cache_file, + recurse => 1, + files => \@roots5); + compare_scandeps_rvs($rv5, $expected_rv5, \@roots5); + + + } ### SKIP block wrapping M::SD::Cache tests +} ### end of for (qw/write_cache use_cache/) + + + + + +### cache testing helper functions ### +{ +my ($cb_args, $expecting_write); + +sub expected_cache_cb_args{ + $cb_args = shift; +} +sub cache_cb{ + my %args = @_; + is($args{key}, $cb_args->{key}, "check arg 'key' in cache_cb."); + is($args{file}, $cb_args->{file}, "check arg 'file' in cache_cb."); + if ( $expecting_write ){ + is($args{action}, 'write', "expecting write action"); + } + if ($args{action} eq 'read'){ + $expecting_write = 1; + return 0; + } + elsif ( $args{action} eq 'write' ){ + $expecting_write = 0; + return 1 + } + my $action = $args{action}; + ok( 0, "wrong action: got [$action] must be 'read' or 'write'"); +} + + +}### end cache testing helper functions ### + +### test Module::ScanDeps::Cache.pm + +SKIP: +{ + skip "Skipping M:SD::Cache tests" , 9 if $skip_cache_tests; + my %files = ('file1.pl' => "use TestModule;\n", + 'file2.pl' => "use TestModule;\n", + 'file3.pl' => "use TestModule;\n return 0;\n"); + + for my $name (keys %files){ + open my $fh, '>', $name or die "Can not open file $name: $!"; + print $fh $files{$name}; + close $fh or die "Can not close file $name: $!"; + } + + my $cb = Module::ScanDeps::Cache::get_cache_cb(); + my $mod = []; + my $ret = $cb->(key => 'testfile', + file => 'file1.pl', + action => 'read', + modules => $mod + ); + is( $ret, 0, "File not present in cache"); + $ret = $cb->(key => 'testfile', + file => 'file1.pl', + modules => [qw /TestModule.pm/], + action => 'write', + ); + is( $ret, 1, "Writing file to cache"); + $ret = $cb->(key => 'testfile', + file => 'file1.pl', + action => 'read', + modules => $mod + ); + is( $ret, 1, "File is present in cache"); + is( $mod->[0], 'TestModule.pm', "cache_cb sets modules 1"); + $mod = []; + $ret = $cb->(key => 'testfile', + file => 'file2.pl', + action => 'read', + modules => $mod + ); + is( $ret, 1, "Identical file returns the same dependencies from cache"); + is( $mod->[0], 'TestModule.pm', "cache_cb sets modules 2"); + $mod = []; + $ret = $cb->(key => 'testfile', + file => 'file3.pl', + action => 'read', + modules => $mod + ); + is( $ret, 0, "No cached deps returned for file with different content"); + is( @$mod, 0, "cache_cb does not set modules if no deps found"); + + eval {$cb->(action => 'foo')}; + ok ($@ =~ /must be read or write/, "cache_cb dies on wrong action"); + for my $name (keys %files){ + unlink $name or die "Could not unlink file $name: $!"; + } +} + +unlink( $cache_file ); +__END__ diff --git a/t/16-scan_line.t b/t/16-scan_line.t new file mode 100644 index 0000000..5f3cb56 --- /dev/null +++ b/t/16-scan_line.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 3; +use Module::ScanDeps qw/scan_line/; + +{ +my $chunk=<<'EOT'; +use strict; +EOT +my @array=scan_line($chunk);@array=sort @array; +is_deeply(\@array,[sort qw{strict.pm}]); +} + +{ +my $chunk=<<'EOT'; +require 5.10; +EOT +my @array=scan_line($chunk);@array=sort @array; +is_deeply(\@array,[sort qw{feature.pm}]); +} + +{# RT#48151 +my $chunk=<<'EOT'; +require __PACKAGE__ . "SomeExt.pm"; +EOT +eval { + scan_line($chunk); +}; +is($@,''); +} + diff --git a/t/17-private_methods.t b/t/17-private_methods.t new file mode 100644 index 0000000..f129f25 --- /dev/null +++ b/t/17-private_methods.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 1; +use Module::ScanDeps (); + +my @deps = Module::ScanDeps::_get_preload('Event.pm'); +ok(grep {$_ eq 'Event/idle.pm'} @deps) or diag(join(', ',@deps)); + diff --git a/t/2-static_functional_interface_fake.t b/t/2-static_functional_interface_fake.t new file mode 100644 index 0000000..969d23f --- /dev/null +++ b/t/2-static_functional_interface_fake.t @@ -0,0 +1,276 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 304; +use lib qw(t t/data/static); +use Utils; +use version; + + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps' ); } + + +############################################################## +# Static dependency check of a script that doesn't use +# anything +############################################################## +my @roots1 = qw(t/data/static/null.pl); +my $expected_rv1 = +{ + "null.pl" => { + file => generic_abs_path("t/data/static/null.pl"), + key => "null.pl", + type => "data", + }, +}; + +# Functional i/f +my $rv1 = scan_deps(@roots1); +compare_scandeps_rvs($rv1, $expected_rv1, \@roots1); + + +############################################################## +# Static dependency check of a circular dependency: +# ___ +# |/_ \ +# M _M +# \____/| +# +############################################################## +my @roots2 = qw(t/data/static/egg.pm); +my $expected_rv2 = +{ + "chicken.pm" => { + file => generic_abs_path("t/data/static/chicken.pm"), + key => "chicken.pm", + type => "module", + used_by => ["egg.pm"], + uses => ["egg.pm"], + }, + "egg.pm" => { + file => generic_abs_path("t/data/static/egg.pm"), + key => "egg.pm", + type => "module", + used_by => ["chicken.pm"], + uses => ["chicken.pm"], + }, +}; + +# Functional i/f +my $rv2 = scan_deps(@roots2); +compare_scandeps_rvs($rv2, $expected_rv2, \@roots2); + + +############################################################## +# Static dependency check of the following dependency tree +# +# M +# /|\ +# / | \ +# / | \ +# / M \ +# / / \ \ +# / / \ \ +# M M M M +# \ \ / / +# \ \ / / +# \ M / +# \ | / +# \ | / +# M +# +# With dependencies always going from the top downwards +############################################################## +my @roots3 = qw(t/data/static/outer_diamond_N.pm); +my $expected_rv3 = +{ + "inner_diamond_E.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_E.pm"), + key => "inner_diamond_E.pm", + type => "module", + used_by => ["inner_diamond_N.pm"], + uses => ["inner_diamond_S.pm"], + }, + "inner_diamond_N.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_N.pm"), + key => "inner_diamond_N.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + uses => ["inner_diamond_E.pm", "inner_diamond_W.pm"], + }, + "inner_diamond_S.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_S.pm"), + key => "inner_diamond_S.pm", + type => "module", + used_by => ["inner_diamond_W.pm", "inner_diamond_E.pm"], + uses => ["outer_diamond_S.pm"], + }, + "inner_diamond_W.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_W.pm"), + key => "inner_diamond_W.pm", + type => "module", + used_by => ["inner_diamond_N.pm"], + uses => ["inner_diamond_S.pm"], + }, + "outer_diamond_E.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_E.pm"), + key => "outer_diamond_E.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + uses => ["outer_diamond_S.pm"], + }, + "outer_diamond_N.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_N.pm"), + key => "outer_diamond_N.pm", + type => "module", + uses => ["inner_diamond_N.pm", "outer_diamond_E.pm", "outer_diamond_W.pm"], + }, + "outer_diamond_S.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_S.pm"), + key => "outer_diamond_S.pm", + type => "module", + used_by => ["outer_diamond_E.pm", "outer_diamond_W.pm", "inner_diamond_S.pm"], + }, + "outer_diamond_W.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_W.pm"), + key => "outer_diamond_W.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + uses => ["outer_diamond_S.pm"], + }, +}; + +# Functional i/f +my $rv3 = scan_deps(@roots3); +compare_scandeps_rvs($rv3, $expected_rv3, \@roots3); + + +############################################################## +# Static dependency check of the following dependency tree +# (i.e. multiple inputs) +# +# InputA.pl InputB.pl InputC.pl +# / \ \ / +# / \ \ / +# / \ \ / +# TestA.pm TestB.pm TestC.pm / +# \ / +# \ / +# TestD.pm +# +############################################################## +my @roots4 = qw(t/data/static/InputA.pl + t/data/static/InputB.pl + t/data/static/InputC.pl); +my $expected_rv4 = +{ + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "InputC.pl" => { + file => generic_abs_path("t/data/static/InputC.pl"), + key => "InputC.pl", + type => "data", + uses => ["TestD.pm"], + }, + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + uses => ["TestD.pm"], + }, + "TestD.pm" => { + file => generic_abs_path("t/data/static/TestD.pm"), + key => "TestD.pm", + type => "module", + used_by => ["InputC.pl", "TestC.pm"], + }, +}; + +# Functional i/f +my $rv4 = scan_deps(@roots4); +compare_scandeps_rvs($rv4, $expected_rv4, \@roots4); + + +############################################################## +# Static dependency check of the following dependency tree +# Tests the .pm only lists the .pl once in it's used_by entries +# +# Duplicator.pl +# / \ +# / \ +# / \ +# \ / +# \ / +# \ / +# Duplicated.pm +# +############################################################## +my @roots5 = qw(t/data/static/Duplicator.pl); +my $expected_rv5 = +{ + "Duplicated.pm" => { + file => generic_abs_path("t/data/static/Duplicated.pm"), + key => "Duplicated.pm", + type => "module", + used_by => ["Duplicator.pl"], + }, + "Duplicator.pl" => { + file => generic_abs_path("t/data/static/Duplicator.pl"), + key => "Duplicator.pl", + type => "data", + uses => ["Duplicated.pm"], + }, +}; + +# Functional i/f +my $rv5 = scan_deps(@roots5); +compare_scandeps_rvs($rv5, $expected_rv5, \@roots5); + + +############################################################## +# Static dependency check of a module that does a +# use 5.010; +# Note that this doesn't test as much as the other tests +# since feature.pm ropes in all kinds of things. +############################################################## +SKIP: { + skip "Skipping 'use VERSION' tests on pre-5.10.0", 2 if version->new($]) < version->new("5.10.0"); + my @roots1 = qw(t/data/static/useVERSION.pm); + + # Functional i/f + my $rv1 = scan_deps(@roots1); + ok(exists $rv1->{"useVERSION.pm"}, "use VERSION: source file included"); + ok(exists $rv1->{"feature.pm"}, "use VERSION: feature.pm included"); +} + + + +__END__ diff --git a/t/3-static_oo_interface_real.t b/t/3-static_oo_interface_real.t new file mode 100644 index 0000000..1a1dd8b --- /dev/null +++ b/t/3-static_oo_interface_real.t @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +my $rv; + +############################################################## +# Tests static dependency scanning on a real set of modules. +# This exercises the scanning functionality but because the +# majority of files scanned aren't fixed, the checks are +# necessarily loose. +############################################################## +my @deps = qw( + Carp.pm + Config.pm + Exporter.pm + Test/More.pm + constant.pm + strict.pm + vars.pm + Module/ScanDeps.pm +); +plan tests => @deps + 3; + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +use_ok( 'Module::ScanDeps' ); + + +my $obj = Module::ScanDeps->new; +$obj->set_file($0); +$obj->calculate_info; +ok($rv = $obj->get_files); + +foreach my $mod (@deps) { + ok(grep {$_->{store_as} eq $mod } @{$rv->{modules}}); +}; + +use File::Basename qw/basename/; +my $basename = basename($0); +ok(not(grep {$_->{store_as} =~ /\Q$basename\E/} @{$rv->{modules}})); +__END__ diff --git a/t/4-static_functional_interface_options_fake.t b/t/4-static_functional_interface_options_fake.t new file mode 100644 index 0000000..0470580 --- /dev/null +++ b/t/4-static_functional_interface_options_fake.t @@ -0,0 +1,459 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 546; + +use lib qw(t t/data/static); +use Utils; + + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps' ); } + + +############################################################## +# RECURSE OPTION TESTS + +############################################################## +# Using the following dependency tree +# +# M +# /|\ +# / | \ +# / | \ +# / M \ +# / / \ \ +# / / \ \ +# M M M M +# \ \ / / +# \ \ / / +# \ M / +# \ | / +# \ | / +# M +# +# With dependencies always going from the top downwards +############################################################## +my @roots1 = qw(t/data/static/outer_diamond_N.pm); +my $expected_rv1 = +{ + "inner_diamond_N.pm" => { + file => generic_abs_path("t/data/static/inner_diamond_N.pm"), + key => "inner_diamond_N.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + }, + "outer_diamond_E.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_E.pm"), + key => "outer_diamond_E.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + }, + "outer_diamond_N.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_N.pm"), + key => "outer_diamond_N.pm", + type => "module", + uses => ["inner_diamond_N.pm", "outer_diamond_E.pm", "outer_diamond_W.pm"], + }, + "outer_diamond_W.pm" => { + file => generic_abs_path("t/data/static/outer_diamond_W.pm"), + key => "outer_diamond_W.pm", + type => "module", + used_by => ["outer_diamond_N.pm"], + }, +}; + +my $rv1 = scan_deps( + files => \@roots1, + recurse => 0, + ); + +compare_scandeps_rvs($rv1, $expected_rv1, \@roots1); + + +############################################################## +# Using the following dependency tree +# +# InputA.pl InputB.pl InputC.pl +# / \ \ / +# / \ \ / +# / \ \ / +# TestA.pm TestB.pm TestC.pm / +# \ / +# \ / +# TestD.pm +# +############################################################## +my @roots2 = qw(t/data/static/InputA.pl + t/data/static/InputB.pl + t/data/static/InputC.pl); + +my $expected_rv2 = +{ + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "InputC.pl" => { + file => generic_abs_path("t/data/static/InputC.pl"), + key => "InputC.pl", + type => "data", + uses => ["TestD.pm"], + }, + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + }, + "TestD.pm" => { + file => generic_abs_path("t/data/static/TestD.pm"), + key => "TestD.pm", + type => "module", + used_by => ["InputC.pl"], # No "TestC.pm" used_by entry + }, +}; + +my $rv2 = scan_deps( + files => \@roots2, + recurse => 0, + ); + +compare_scandeps_rvs($rv2, $expected_rv2, \@roots2); + + +############################################################## +# SKIP OPTION TESTS + +############################################################## +# Dependency tree for tests +# +# InputA.pl InputB.pl InputC.pl +# / \ \ / +# / \ \ / +# / \ \ / +# TestA.pm TestB.pm TestC.pm / +# \ / +# \ / +# TestD.pm +# +############################################################## +my @roots_ABC = qw(t/data/static/InputA.pl + t/data/static/InputB.pl + t/data/static/InputC.pl); + +############################################################## +my $expected_rv_ABC_skip_TestA = +{ + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "InputC.pl" => { + file => generic_abs_path("t/data/static/InputC.pl"), + key => "InputC.pl", + type => "data", + uses => ["TestD.pm"], + }, + +# It's OK to have this despite TestA.pm being skipped since this entry only shows +# InputA.pl has been parsed and shown to depend on TestA.pm + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + uses => ["TestD.pm"], + }, + "TestD.pm" => { + file => generic_abs_path("t/data/static/TestD.pm"), + key => "TestD.pm", + type => "module", + used_by => ["InputC.pl", "TestC.pm"], + }, +}; + +my $rv3 = scan_deps( + files => \@roots_ABC, + skip => { generic_abs_path("t/data/static/TestA.pm") => 1 }, + recurse => 1, + ); + +compare_scandeps_rvs($rv3, $expected_rv_ABC_skip_TestA, \@roots_ABC); + + +############################################################## +my $expected_rv_ABC_skip_TestC = +{ + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "InputC.pl" => { + file => generic_abs_path("t/data/static/InputC.pl"), + key => "InputC.pl", + type => "data", + uses => ["TestD.pm"], + }, + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + +# It's OK to have this despite TestC.pm being skipped since this entry only shows +# InputB.pl has been parsed and shown to depend on TestC.pm + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + }, + + "TestD.pm" => { + file => generic_abs_path("t/data/static/TestD.pm"), + key => "TestD.pm", + type => "module", + used_by => ["InputC.pl"], # No TestC used_by + }, +}; + +my $rv4 = scan_deps( + files => \@roots_ABC, + skip => { generic_abs_path("t/data/static/TestC.pm") => 1 }, + recurse => 1, + ); + +compare_scandeps_rvs($rv4, $expected_rv_ABC_skip_TestC, \@roots_ABC); + + +############################################################## +# Test multiple skip entries +my $expected_rv_ABC_skip_TestA_TestC = +{ + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "InputC.pl" => { + file => generic_abs_path("t/data/static/InputC.pl"), + key => "InputC.pl", + type => "data", + uses => ["TestD.pm"], + }, + +# It's OK to have this despite TestA.pm being skipped since this entry only shows +# InputA.pl has been parsed and shown to depend on TestA.pm + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + +# It's OK to have this despite TestC.pm being skipped since this entry only shows +# InputB.pl has been parsed and shown to depend on TestC.pm + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + }, + + "TestD.pm" => { + file => generic_abs_path("t/data/static/TestD.pm"), + key => "TestD.pm", + type => "module", + used_by => ["InputC.pl"], # No TestC used_by + }, +}; + +my $rv5 = scan_deps( + files => \@roots_ABC, + skip => { + generic_abs_path("t/data/static/TestA.pm") => 1, + generic_abs_path("t/data/static/TestC.pm") => 1, + }, + recurse => 1, + ); + +compare_scandeps_rvs($rv5, $expected_rv_ABC_skip_TestA_TestC, \@roots_ABC); + + +############################################################## +my @roots_AB = qw(t/data/static/InputA.pl + t/data/static/InputB.pl); + +my $expected_rv_AB_skip_TestC = +{ + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + +# It's OK to have this despite TestC.pm being skipped since this entry only shows +# InputB.pl has been parsed and shown to depend on TestC.pm + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + }, +# +# No TestD entry +# +}; + +my $rv6 = scan_deps( + files => \@roots_AB, + skip => { generic_abs_path("t/data/static/TestC.pm") => 1 }, + recurse => 1, + ); + +compare_scandeps_rvs($rv6, $expected_rv_AB_skip_TestC, \@roots_AB); + +############################################################## + +my $expected_rv_AB_skip_TestD = +{ + "InputA.pl" => { + file => generic_abs_path("t/data/static/InputA.pl"), + key => "InputA.pl", + type => "data", + uses => ["TestA.pm", "TestB.pm"], + }, + "InputB.pl" => { + file => generic_abs_path("t/data/static/InputB.pl"), + key => "InputB.pl", + type => "data", + uses => ["TestC.pm"], + }, + "TestA.pm" => { + file => generic_abs_path("t/data/static/TestA.pm"), + key => "TestA.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestB.pm" => { + file => generic_abs_path("t/data/static/TestB.pm"), + key => "TestB.pm", + type => "module", + used_by => ["InputA.pl"], + }, + "TestC.pm" => { + file => generic_abs_path("t/data/static/TestC.pm"), + key => "TestC.pm", + type => "module", + used_by => ["InputB.pl"], + }, +# +# No TestD entry +# +}; + +my $rv7 = scan_deps( + files => \@roots_AB, + skip => { "t/data/static/TestD.pm" => 1 }, + recurse => 1, + ); + +#is_deeply($rv7, $expected_rv_AB_skip_TestD); +compare_scandeps_rvs($rv7, $expected_rv_AB_skip_TestD, \@roots_AB); + +__END__ diff --git a/t/5-pluggable_fake.t b/t/5-pluggable_fake.t new file mode 100644 index 0000000..d161ca3 --- /dev/null +++ b/t/5-pluggable_fake.t @@ -0,0 +1,21 @@ +#!/usr/bin/perl + +use Module::ScanDeps; +use strict; +use warnings; + +use Test::More qw(no_plan); # no_plan because the number of objects in the dependency tree (and hence the number of tests) can change +use Test::Requires qw( Module::Pluggable ); + +use lib qw(t t/data/pluggable); +use Utils; + +my $rv = scan_deps( + files => ['t/data/pluggable/Foo.pm'], + recurse => 1, +); + +my @deps = qw(Module/Pluggable.pm Foo/Plugin/Bar.pm Foo/Plugin/Baz.pm); +generic_scandeps_rv_test($rv, ['t/data/pluggable/Foo.pm'], \@deps); + +__END__ diff --git a/t/6-file-glob.t b/t/6-file-glob.t new file mode 100644 index 0000000..103a989 --- /dev/null +++ b/t/6-file-glob.t @@ -0,0 +1,24 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 2; +use Module::ScanDeps; +use lib qw(t/data); + +my $map = scan_deps( + files => ['t/data/file-glob-no.pl'], + recurse => 1, +); + +ok(not exists $map->{'File/Glob.pm'}); + +$map = scan_deps( + files => ['t/data/file-glob-yes.pl'], + recurse => 1, +); + +ok(exists $map->{'File/Glob.pm'}); + +__END__ diff --git a/t/7-check-dynaloader.t b/t/7-check-dynaloader.t new file mode 100644 index 0000000..3b0dd0d --- /dev/null +++ b/t/7-check-dynaloader.t @@ -0,0 +1,97 @@ +#!perl + +use strict; +use Test::More; +use Config (); + +use Module::ScanDeps; +use DynaLoader; +use File::Temp; + +plan skip_all => "No dynamic loading available in your version of perl" + unless $Config::Config{usedl}; + +my @try_mods = qw( Cwd File::Glob Data::Dumper List::Util Time::HiRes Compress::Raw::Zlib ); +my @dyna_mods = grep { my $mod = $_; + eval("require $mod; 1") + && grep { $_ eq $mod } @DynaLoader::dl_modules + } @try_mods; +plan skip_all => "No dynamic module found (tried @try_mods)" + unless @dyna_mods; +diag "dynamic modules used for test: @dyna_mods"; + +plan tests => 4 * 2 * @dyna_mods; + +foreach my $module (@dyna_mods) +{ + # cf. DynaLoader.pm + my @modparts = split(/::/,$module); + my $modfname = defined &DynaLoader::mod2fname ? DynaLoader::mod2fname(\@modparts) : $modparts[-1]; + my $auto_path = join('/', 'auto', @modparts, "$modfname.$Config::Config{dlext}"); + + check_bundle_path($module, $auto_path, ".pl", <<"...", +use $module; +1; +... + sub { scan_deps( + files => [ $_[0] ], + recurse => 0); + } + ); + check_bundle_path($module, $auto_path, ".pm", <<"...", +package Bar; +use $module; +1; +... + sub { scan_deps_runtime( + files => [ $_[0] ], + recurse => 0, + compile => 1); + } + ); + check_bundle_path($module, $auto_path, ".pl", <<"...", +# no way in hell can this detected by static analysis :) +my \$req = join("", qw( r e q u i r e )); +eval "\$req $module"; +exit(0); +... + sub { scan_deps_runtime( + files => [ $_[0] ], + recurse => 0, + execute => 1); + } + ); + check_bundle_path($module, $auto_path, ".pl", <<"...", +# no way in hell can this detected by static analysis :) +my \$req = join("", qw( r e q u i r e )); +eval "\$req \$_" foreach \@ARGV; +exit(0); +... + sub { scan_deps_runtime( + files => [ $_[0] ], + recurse => 0, + execute => [ $module ]); + } + ); +} + +exit(0); + +# NOTE: check_bundle_path runs 2 tests +sub check_bundle_path { + my ($module, $auto_path, $suffix, $code, $scan) = @_; + + my ($fh, $filename) = File::Temp::tempfile( UNLINK => 1, SUFFIX => $suffix ); + print $fh $code, "\n" or die $!; + close $fh; + + my $rv = $scan->($filename); + my ( $entry ) = grep { /^\Q$auto_path\E$/ } keys %$rv; + ok( $entry, "$module: found some key that looks like it pulled in its shared lib (auto_path=$auto_path)" ); + + # Actually we accept anything that ends with $auto_path. + ok($rv->{$entry}->{file} =~ m{/\Q$auto_path\E$}, + "$module: the full bundle path we got ($rv->{$entry}->{file}) looks legit" ); +} + + diff --git a/t/8-check_duplicated_entries.t b/t/8-check_duplicated_entries.t new file mode 100644 index 0000000..bbd5d81 --- /dev/null +++ b/t/8-check_duplicated_entries.t @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 30; +use lib qw(t t/data/duplicated_entries); +use Utils; + + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps' ); } + +my @roots = qw(t/data/duplicated_entries/use_scoped_package.pl t/data/duplicated_entries/Scoped/Package.pm); +my $expected_rv = +{ + "use_scoped_package.pl" => { + file => generic_abs_path("t/data/duplicated_entries/use_scoped_package.pl"), + key => "use_scoped_package.pl", + type => "data", + uses => ["Scoped/Package.pm"], + }, + "Scoped/Package.pm" => { + file => generic_abs_path("t/data/duplicated_entries/Scoped/Package.pm"), + key => "Scoped/Package.pm", + type => "module", + used_by => ["use_scoped_package.pl"], + }, +}; + +# Functional i/f +my $rv = scan_deps(@roots); +compare_scandeps_rvs($rv, $expected_rv, \@roots); + +__END__ diff --git a/t/9-check_path_to_inc_name.t b/t/9-check_path_to_inc_name.t new file mode 100644 index 0000000..b552917 --- /dev/null +++ b/t/9-check_path_to_inc_name.t @@ -0,0 +1,41 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Cwd; + +use Test::More tests => 7; + +############################################################## +# Tests compilation of Module::ScanDeps +############################################################## +BEGIN { use_ok( 'Module::ScanDeps', qw(path_to_inc_name scan_deps) ); } + +my $name; +my $basepath; +my $warn = 1; + +# Absolute path tests +$basepath = cwd().'/t/data/check_path_to_inc_name/'; +$name = 'Some.pm'; +is(path_to_inc_name($basepath.$name, $warn), $name, "$name correctly returned by path_to_inc_name($basepath$name)"); +$name = 'Scoped/Package.pm'; +is(path_to_inc_name($basepath.$name, $warn), $name, "$name correctly returned by path_to_inc_name($basepath$name)"); + +# Relative path tests +$basepath = 't/data/check_path_to_inc_name/'; +$name = 'Some.pm'; +is(path_to_inc_name($basepath.$name, $warn), $name, "$name correctly returned by path_to_inc_name($basepath$name)"); +$name = 'Scoped/Package.pm'; +is(path_to_inc_name($basepath.$name, $warn), $name, "$name correctly returned by path_to_inc_name($basepath$name)"); + +# script test +$basepath = 't/data/check_path_to_inc_name/'; +$name = 'use_scoped_package.pl'; +is(path_to_inc_name($basepath.$name, $warn), $name, "$name correctly returned by path_to_inc_name($basepath$name)"); + +# 'use lib ...' +my $rv = scan_deps("t/data/use_lib.pl"); +ok(exists $rv->{"Some.pm"}, "'use lib ...' correctly interpreted"); + +__END__ diff --git a/t/Utils.pm b/t/Utils.pm new file mode 100644 index 0000000..01e0f30 --- /dev/null +++ b/t/Utils.pm @@ -0,0 +1,170 @@ +package Utils; + +use strict; +use warnings; +use vars qw( $VERSION @ISA @EXPORT ); +require Exporter; +use Module::ScanDeps qw(path_to_inc_name); + +use Test::More; + +@ISA=qw(Exporter); +$VERSION = '0.1'; +@EXPORT = qw( generic_scandeps_rv_test compare_scandeps_rvs generic_abs_path ); + +my $test = Test::More->builder; + +sub import { + my($self) = shift; + my $pack = caller; + + $test->exported_to($pack); + $self->export_to_level(1, $self, @EXPORT); +} + +sub generic_scandeps_rv_test { + my $rv = shift; + my $array_ref = shift; + my @input_keys = sort @$array_ref; + $array_ref = shift; + my @known_deps = sort @$array_ref; + my @used_by; + my ($used_by_ok, $i); + + # sanity check input + foreach my $input (@input_keys) { + !(grep {$_ eq $input} @known_deps) or die "\@input_keys overlaps with \@known_deps\n"; + } + + $test->ok(ref($rv) eq "HASH", "\$rv is a ref") or return; + + # check all input files and known deps correspond to an entry in rv + map {$_ = path_to_inc_name($_, 1)} @input_keys; + map {$_ =~ s|\\|\/|go} (@input_keys, @known_deps); + $test->ok(exists $rv->{$_}, "$_ is in rv") foreach (@input_keys, @known_deps); + + # Check general properties of the keys + foreach my $key (keys %$rv) { + $test->ok(exists($rv->{$key}{key}) && $key eq $rv->{$key}{key}, "For $key: the sub-key matches"); + $test->ok(exists($rv->{$key}{file}) && $rv->{$key}{file} =~ /(?:^|[\/\\])\Q$key\E$/ + && File::Spec->file_name_is_absolute($rv->{$key}{file}), "For $key: the file has been verified"); + $test->ok(exists($rv->{$key}{type}) && $rv->{$key}{type} =~ /^(?:module|autoload|data|shared)$/, "For $key: the type matches module|autoload|data|shared"); + + if (exists($rv->{$key}{used_by})) { + @used_by = sort @{$rv->{$key}{used_by}}; + if (scalar @used_by > 0) { + $used_by_ok = 1; + if (scalar @used_by > 1) { + for ($i=0; $i<$#used_by; $i++) { + if ($used_by[$i] eq $used_by[$i+1]) { # relies on @used_by being sorted earlier + $used_by_ok = 0; + last; + } + } + } + $test->ok($used_by_ok, "$key\'s used_by has no duplicates"); + + $used_by_ok = 1; + foreach my $used_by (@used_by) { + $used_by_ok &= exists($rv->{$used_by}); + } + $test->ok($used_by_ok, "All entries in $key\'s used_by are themselves described in \$rv"); + + # check corresponding uses field + foreach my $used_by (@used_by) { + if (exists($rv->{$used_by}{uses})) { + $test->ok(scalar(grep { $_ eq $key } @{$rv->{$used_by}{uses}}), "\$rv contains a matching uses field for the used_by entry $used_by for key $key"); + } else { + $test->ok(0, "\$rv contains a matching uses field for the used_by entry $used_by for key $key"); + } + } + } else { + $test->ok(0, "$key\'s used_by exists and isn't empty"); + } + } else { + $test->ok((grep {$_ eq $key} @input_keys) | ($key =~ m/Plugin/o), "used-by not defined so $key must be one of the input files or is a plugin"); + } + + if (exists($rv->{$key}{uses})) { + # check corresponding used_by field + foreach my $uses (@{$rv->{$key}{uses}}) { + if (exists($rv->{$uses}{used_by})) { + $test->ok(scalar(grep { $_ eq $key } @{$rv->{$uses}{used_by}}), "\$rv contains a matching used_by field for the uses entry $uses for key $key"); + } else { + $test->ok(0, "\$rv contains a matching used_by field for the uses entry $uses for key $key"); + } + } + } + } +} + +sub compare_scandeps_rvs { + my $rv_to_test = shift; + my $rv_to_match = shift; + my $array_ref = shift; + my @input_keys = @$array_ref; + + my (@used_by_test, @used_by_match); + my (@uses_test, @uses_match); + my ($used_by_ok, $uses_ok); + my ($compare_ok, $i); + + generic_scandeps_rv_test($rv_to_match, \@input_keys, []); # validate test data + + $test->ok(ref($rv_to_test) eq "HASH", "\$rv_to_test is a ref") or return; + + my @rv_to_match_keys = sort keys %{$rv_to_match}; + my @rv_to_test_keys = sort keys %{$rv_to_test}; + $test->cmp_ok(scalar @rv_to_test_keys, '==', scalar @rv_to_match_keys, "Number of keys in \$rv_to_test == Number of keys in \$rv_to_match") or return; + $compare_ok = 1; + for ($i=0; $i<=$#rv_to_match_keys; $i++) { + $compare_ok &= ($rv_to_match_keys[$i] eq $rv_to_test_keys[$i]); + } + $test->ok($compare_ok, "Keys in \$rv_to_test all eq keys in \$rv_to_match"); + + foreach my $key (@rv_to_match_keys) { + $test->ok(exists($rv_to_test->{$key}{key}) && $rv_to_test->{$key}{key} eq $rv_to_match->{$key}{key}, "For $key: sub-key matches the expected"); + $test->ok(exists($rv_to_test->{$key}{file}) && $rv_to_test->{$key}{file} eq $rv_to_match->{$key}{file}, "For $key: file matches the expected"); + $test->ok(exists($rv_to_test->{$key}{type}) && $rv_to_test->{$key}{type} eq $rv_to_match->{$key}{type}, "For $key: type matches the expected"); + + if (exists($rv_to_match->{$key}{used_by})) { + $test->ok(exists($rv_to_test->{$key}{used_by}), "For $key: used_by exists as expected") or next; + + @used_by_test = sort @{$rv_to_test->{$key}{used_by}}; # order isn't important + @used_by_match = sort @{$rv_to_match->{$key}{used_by}}; # order isn't important + $test->cmp_ok(scalar @used_by_test, '==', scalar @used_by_match, "For $key: number of used_by in \$rv_to_test == Number of used_by in \$rv_to_match") or next; + + $used_by_ok = 1; + for ($i=0; $i < scalar @used_by_match; $i++) { + $used_by_ok &= ($used_by_match[$i] eq $used_by_test[$i]); + } + $test->ok($used_by_ok, "For $key: used_by in \$rv_to_test all eq used_by in \$rv_to_match"); + } + + if (exists($rv_to_match->{$key}{uses})) { + $test->ok(exists($rv_to_test->{$key}{uses}), "For $key: uses exists as expected") or next; + + @uses_test = sort @{$rv_to_test->{$key}{uses}}; # order isn't important + @uses_match = sort @{$rv_to_match->{$key}{uses}}; # order isn't important + $test->cmp_ok(scalar @uses_test, '==', scalar @uses_match, "For $key: number of uses in \$rv_to_test == Number of uses in \$rv_to_match") or next; + + $uses_ok = 1; + for ($i=0; $i < scalar @uses_match; $i++) { + $uses_ok &= ($uses_match[$i] eq $uses_test[$i]); + } + $test->ok($uses_ok, "For $key: uses in \$rv_to_test all eq uses in \$rv_to_match"); + } + } +} + +sub generic_abs_path { + my $file = shift @_; + $file = File::Spec->rel2abs($file); + $file =~ s|\\|\/|go; + return $file; +} + + +1; +# Marks the end of any code. Any symbols after this are ignored. Use for documentation +__END__ diff --git a/t/data/ScanFileRE/auto/example/example.h b/t/data/ScanFileRE/auto/example/example.h new file mode 100644 index 0000000..990462e --- /dev/null +++ b/t/data/ScanFileRE/auto/example/example.h @@ -0,0 +1 @@ +use example_too; \ No newline at end of file diff --git a/t/data/ScanFileRE/example.pm b/t/data/ScanFileRE/example.pm new file mode 100644 index 0000000..7856b0d --- /dev/null +++ b/t/data/ScanFileRE/example.pm @@ -0,0 +1,3 @@ +package example; + +1; diff --git a/t/data/ScanFileRE/example_too.pm b/t/data/ScanFileRE/example_too.pm new file mode 100644 index 0000000..c9995f2 --- /dev/null +++ b/t/data/ScanFileRE/example_too.pm @@ -0,0 +1,3 @@ +package example_too; + +1; diff --git a/t/data/case-insensitive-keys/Test.pm b/t/data/case-insensitive-keys/Test.pm new file mode 100644 index 0000000..c661b67 --- /dev/null +++ b/t/data/case-insensitive-keys/Test.pm @@ -0,0 +1,4 @@ +package Test; + +1; +__END__ \ No newline at end of file diff --git a/t/data/case-insensitive-keys/Test2.pm b/t/data/case-insensitive-keys/Test2.pm new file mode 100644 index 0000000..c961e96 --- /dev/null +++ b/t/data/case-insensitive-keys/Test2.pm @@ -0,0 +1,4 @@ +package Test2; +use Cwd; +$foo->cwd->foo(); +1; diff --git a/t/data/case-insensitive-keys/that_case.pl b/t/data/case-insensitive-keys/that_case.pl new file mode 100644 index 0000000..94931ce --- /dev/null +++ b/t/data/case-insensitive-keys/that_case.pl @@ -0,0 +1,2 @@ +use test; +1; diff --git a/t/data/case-insensitive-keys/this_case.pl b/t/data/case-insensitive-keys/this_case.pl new file mode 100644 index 0000000..2e6f7d5 --- /dev/null +++ b/t/data/case-insensitive-keys/this_case.pl @@ -0,0 +1,2 @@ +use Test; +1; diff --git a/t/data/check_path_to_inc_name/Scoped/Package.pm b/t/data/check_path_to_inc_name/Scoped/Package.pm new file mode 100644 index 0000000..f651e60 --- /dev/null +++ b/t/data/check_path_to_inc_name/Scoped/Package.pm @@ -0,0 +1,4 @@ +package Scoped::Package; + +1; +__END__ \ No newline at end of file diff --git a/t/data/check_path_to_inc_name/Some.pm b/t/data/check_path_to_inc_name/Some.pm new file mode 100644 index 0000000..2e97b6c --- /dev/null +++ b/t/data/check_path_to_inc_name/Some.pm @@ -0,0 +1,4 @@ +package Some; + +1; +__END__ \ No newline at end of file diff --git a/t/data/check_path_to_inc_name/use_scoped_package.pl b/t/data/check_path_to_inc_name/use_scoped_package.pl new file mode 100644 index 0000000..a1609a1 --- /dev/null +++ b/t/data/check_path_to_inc_name/use_scoped_package.pl @@ -0,0 +1,3 @@ +#!/usr/bin/perl + +use Scoped::Package; diff --git a/t/data/duplicated_entries/Scoped/Package.pm b/t/data/duplicated_entries/Scoped/Package.pm new file mode 100644 index 0000000..f651e60 --- /dev/null +++ b/t/data/duplicated_entries/Scoped/Package.pm @@ -0,0 +1,4 @@ +package Scoped::Package; + +1; +__END__ \ No newline at end of file diff --git a/t/data/duplicated_entries/use_scoped_package.pl b/t/data/duplicated_entries/use_scoped_package.pl new file mode 100644 index 0000000..a1609a1 --- /dev/null +++ b/t/data/duplicated_entries/use_scoped_package.pl @@ -0,0 +1,3 @@ +#!/usr/bin/perl + +use Scoped::Package; diff --git a/t/data/file-glob-no.pl b/t/data/file-glob-no.pl new file mode 100644 index 0000000..2696571 --- /dev/null +++ b/t/data/file-glob-no.pl @@ -0,0 +1,10 @@ +my $serial_asn1; +my $i; +package Foo; +sub length {1}; +package main; +bless $serial_asn1 => 'Foo'; + +for ($i=0; $i<$serial_asn1->length; $i++) { +} + diff --git a/t/data/file-glob-yes.pl b/t/data/file-glob-yes.pl new file mode 100644 index 0000000..91311ad --- /dev/null +++ b/t/data/file-glob-yes.pl @@ -0,0 +1,10 @@ +my $serial_asn1; +my $i; +package Foo; +sub length {1}; +package main; +bless $serial_asn1 => 'Foo'; + +for ($i=0; $i++,$_=<*.txt>; $i++) { +} + diff --git a/t/data/pluggable/Foo.pm b/t/data/pluggable/Foo.pm new file mode 100644 index 0000000..61191bc --- /dev/null +++ b/t/data/pluggable/Foo.pm @@ -0,0 +1,5 @@ +package Foo; + +use Module::Pluggable; + +1; diff --git a/t/data/pluggable/Foo/Plugin/Bar.pm b/t/data/pluggable/Foo/Plugin/Bar.pm new file mode 100644 index 0000000..f3209df --- /dev/null +++ b/t/data/pluggable/Foo/Plugin/Bar.pm @@ -0,0 +1,3 @@ +package Foo::Plugin::Bar; + +1; diff --git a/t/data/pluggable/Foo/Plugin/Baz.pm b/t/data/pluggable/Foo/Plugin/Baz.pm new file mode 100644 index 0000000..3d70f0a --- /dev/null +++ b/t/data/pluggable/Foo/Plugin/Baz.pm @@ -0,0 +1,3 @@ +package Foo::Plugin::Baz; + +1; diff --git a/t/data/rt90869.pl b/t/data/rt90869.pl new file mode 100644 index 0000000..b7e8482 --- /dev/null +++ b/t/data/rt90869.pl @@ -0,0 +1,7 @@ +# some forms of "use autouse ..." +use autouse TestA => qw(foo bar); +use autouse "TestB", qw(foo bar); + +# "use if ..." (note the function call in COND) +sub frobnicate { 1 } +use if frobnicate(), TestC => qw(quux); diff --git a/t/data/static/Duplicated.pm b/t/data/static/Duplicated.pm new file mode 100644 index 0000000..4ed1174 --- /dev/null +++ b/t/data/static/Duplicated.pm @@ -0,0 +1,4 @@ +package Duplicated; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/Duplicator.pl b/t/data/static/Duplicator.pl new file mode 100644 index 0000000..e21b4f4 --- /dev/null +++ b/t/data/static/Duplicator.pl @@ -0,0 +1,2 @@ +use Duplicated.pm; +use Duplicated.pm; \ No newline at end of file diff --git a/t/data/static/InputA.pl b/t/data/static/InputA.pl new file mode 100644 index 0000000..35670ac --- /dev/null +++ b/t/data/static/InputA.pl @@ -0,0 +1,2 @@ +use TestA.pm; +use TestB.pm; \ No newline at end of file diff --git a/t/data/static/InputB.pl b/t/data/static/InputB.pl new file mode 100644 index 0000000..4869af4 --- /dev/null +++ b/t/data/static/InputB.pl @@ -0,0 +1 @@ +use TestC.pm; \ No newline at end of file diff --git a/t/data/static/InputC.pl b/t/data/static/InputC.pl new file mode 100644 index 0000000..1bfef28 --- /dev/null +++ b/t/data/static/InputC.pl @@ -0,0 +1 @@ +use TestD.pm; \ No newline at end of file diff --git a/t/data/static/TestA.pm b/t/data/static/TestA.pm new file mode 100644 index 0000000..d8b463f --- /dev/null +++ b/t/data/static/TestA.pm @@ -0,0 +1,4 @@ +package TestA; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/TestB.pm b/t/data/static/TestB.pm new file mode 100644 index 0000000..5f12198 --- /dev/null +++ b/t/data/static/TestB.pm @@ -0,0 +1,4 @@ +package TestB; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/TestC.pm b/t/data/static/TestC.pm new file mode 100644 index 0000000..47e8861 --- /dev/null +++ b/t/data/static/TestC.pm @@ -0,0 +1,6 @@ +package TestC; + +use TestD; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/TestD.pm b/t/data/static/TestD.pm new file mode 100644 index 0000000..3baa8c2 --- /dev/null +++ b/t/data/static/TestD.pm @@ -0,0 +1,4 @@ +package TestD; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/chicken.pm b/t/data/static/chicken.pm new file mode 100644 index 0000000..4de94f9 --- /dev/null +++ b/t/data/static/chicken.pm @@ -0,0 +1,6 @@ +package chicken; + +use egg; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/egg.pm b/t/data/static/egg.pm new file mode 100644 index 0000000..b288e9d --- /dev/null +++ b/t/data/static/egg.pm @@ -0,0 +1,6 @@ +package egg; + +use chicken; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/inner_diamond_E.pm b/t/data/static/inner_diamond_E.pm new file mode 100644 index 0000000..013b9dc --- /dev/null +++ b/t/data/static/inner_diamond_E.pm @@ -0,0 +1,6 @@ +package inner_diamond_E; + +use inner_diamond_S; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/inner_diamond_N.pm b/t/data/static/inner_diamond_N.pm new file mode 100644 index 0000000..33e3546 --- /dev/null +++ b/t/data/static/inner_diamond_N.pm @@ -0,0 +1,7 @@ +package inner_diamond_N; + +use inner_diamond_E; +use inner_diamond_W; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/inner_diamond_S.pm b/t/data/static/inner_diamond_S.pm new file mode 100644 index 0000000..d20d000 --- /dev/null +++ b/t/data/static/inner_diamond_S.pm @@ -0,0 +1,6 @@ +package inner_diamond_S; + +use outer_diamond_S; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/inner_diamond_W.pm b/t/data/static/inner_diamond_W.pm new file mode 100644 index 0000000..a825b87 --- /dev/null +++ b/t/data/static/inner_diamond_W.pm @@ -0,0 +1,6 @@ +package inner_diamond_W; + +use inner_diamond_S; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/null.pl b/t/data/static/null.pl new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/t/data/static/null.pl diff --git a/t/data/static/outer_diamond_E.pm b/t/data/static/outer_diamond_E.pm new file mode 100644 index 0000000..3a07013 --- /dev/null +++ b/t/data/static/outer_diamond_E.pm @@ -0,0 +1,6 @@ +package outer_diamond_E; + +use outer_diamond_S; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/outer_diamond_N.pm b/t/data/static/outer_diamond_N.pm new file mode 100644 index 0000000..40543a0 --- /dev/null +++ b/t/data/static/outer_diamond_N.pm @@ -0,0 +1,8 @@ +package outer_diamond_N; + +use outer_diamond_E; +use outer_diamond_W; +use inner_diamond_N; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/outer_diamond_S.pm b/t/data/static/outer_diamond_S.pm new file mode 100644 index 0000000..67f3c08 --- /dev/null +++ b/t/data/static/outer_diamond_S.pm @@ -0,0 +1,4 @@ +package outer_diamond_S; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/outer_diamond_W.pm b/t/data/static/outer_diamond_W.pm new file mode 100644 index 0000000..f43dd5d --- /dev/null +++ b/t/data/static/outer_diamond_W.pm @@ -0,0 +1,6 @@ +package outer_diamond_W; + +use outer_diamond_S; + +1; +__END__ \ No newline at end of file diff --git a/t/data/static/useVERSION.pm b/t/data/static/useVERSION.pm new file mode 100644 index 0000000..fc03733 --- /dev/null +++ b/t/data/static/useVERSION.pm @@ -0,0 +1,5 @@ +package useVERSION; +use 5.010; + +1; +__END__ diff --git a/t/data/use_lib.pl b/t/data/use_lib.pl new file mode 100644 index 0000000..7ef13dc --- /dev/null +++ b/t/data/use_lib.pl @@ -0,0 +1,4 @@ +#!/usr/bin/perl + +use lib "t/data/check_path_to_inc_name"; +use Some; diff --git a/t/rt90869.t b/t/rt90869.t new file mode 100644 index 0000000..7544d47 --- /dev/null +++ b/t/rt90869.t @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Module::ScanDeps qw(scan_deps); +use lib qw(t/data/static); + +my @expected_modules = qw( TestA TestB TestC ); +plan tests => scalar @expected_modules; + +my $rv = scan_deps("t/data/rt90869.pl"); +foreach (@expected_modules) +{ + ok(exists $rv->{"$_.pm"}, "expected module $_ found"); +} diff --git a/wip/scan_dlls.pl b/wip/scan_dlls.pl new file mode 100644 index 0000000..9d70f00 --- /dev/null +++ b/wip/scan_dlls.pl @@ -0,0 +1,236 @@ +#!/usr/bin/perl + +# recursively find NEEDED (in the ELF sense) shared libraries +# for a given share library or for all installed Perl "glue" libraries + +use strict; +use warnings; + +use File::Spec; +use File::Find; +use File::Basename; + +package DLL +{ + use strict; + use warnings; + use Capture::Tiny qw(:all); + + our ($show_system_libs, $show_perl_libs); # default: don't show + + my @dll_path = File::Spec->path; # Windows + # my @dll_path = qw(/lib /lib/x86_64-linux-gnu /usr/lib /usr/lib/x86_64-linux-gnu); + # + $ENV{LD_LIBRARY_PATH} if set + # Linux (Debian multi-arch) + # maybe use "gcc -print-search-dirs" (pathnames may need canonicalization) + # install: /usr/lib/gcc/x86_64-linux-gnu/4.9/ + # programs: =/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/bin/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/bin/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/bin/ + # libraries: =/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/../lib/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../lib/:/lib/x86_64-linux-gnu/4.9/:/lib/x86_64-linux-gnu/:/lib/../lib/:/usr/lib/x86_64-linux-gnu/4.9/:/usr/lib/x86_64-linux-gnu/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../:/lib/:/usr/lib/ + + require Tie::CPHash; + tie my %cache, "Tie::CPHash"; + + sub name { shift->{name} } + sub path { shift->{path} } + + + sub find # class method + { + my ($class, $name) = @_; + unless ($cache{$name}) + { + my $found; + foreach (@dll_path) + { + my $path = File::Spec->catfile($_, $name); + $found = $path, last if -e $path; + } + + $cache{$name} = bless { + name => $name, + path => $found, + }, $class; + } + return $cache{$name}; + } + + sub needed + { + my ($self, $path) = @_; + if (ref $self) + { + return @{ $self->{needed} } if $self->{needed}; + $path = $self->{path}; + die "can't find DLL $self->{name}" unless defined $path; + } + else + { + die __PACKAGE__."->needed: argument PATH missing" unless defined $path; + } + + my ($out, $err, $exit) = capture { system(qw( objdump -ax ), $path) }; + die qq["objdump -ax $path" failed: $err] unless $exit == 0; + + my @needed = map { __PACKAGE__->find($_) } + $out =~ /^\s*DLL Name:\s*(\S+)/gm; # Windows + # $out =~ /^\s*NEEDED\s+(\S+)/gm; # Linux + $self->{needed} = \@needed if ref $self; + return @needed; + } + + + sub depends + { + my ($self, $path) = @_; + if (ref $self) + { + $path = $self->{path}; + die "can't find DLL $self->{name}" unless defined $path; + } + else + { + die __PACKAGE__."->depends argument PATH missing" unless defined $path; + } + + tie my %seen, "Tie::CPHash"; + $seen{$self->name} = $self if ref $self; + _depends(\%seen, $self->needed($path)); + return values %seen; + } + + sub _depends + { + my ($seen, @needed) = @_; + + foreach (@needed) + { + next if $seen->{$_->name}; + if (defined $_->path) + { + next if $_->is_system_lib && !$show_system_libs; + next if $_->is_perl_lib && !$show_perl_libs; + } + + $seen->{$_->name} = $_; + _depends($seen, $_->needed) if defined $_->path; + } + } + + sub canon_path + { + my ($self) = @_; + return unless defined $_->path; + + return $_->{canon_path} ||= _canon_path($_->path); + } + + sub _canon_path + { + my ($path, $no_file) = @_; + + my ($vol, $dirs, $file) = File::Spec->splitpath($path, $no_file); + $dirs =~ s{[/\\]$}{}; + my $foo = join("/", $vol, File::Spec->splitdir($dirs), $file); + return lc $foo; + } + + my $system_root = _canon_path($ENV{SystemRoot}, 1); + + sub is_system_lib + { + my ($self) = @_; + my $canon_path = $_->canon_path or return; + return length $canon_path > length $system_root + && substr($canon_path, 0, length $system_root) eq $system_root; + } + + tie my %perl_libs, "Tie::CPHash"; + { + local $show_system_libs = 0; + local $show_perl_libs = 1; + $perl_libs{$_->name} = $_ foreach __PACKAGE__->depends($^X); + }; + + sub is_perl_lib { $perl_libs{shift->name} ? 1 : 0 } +} + + +# return a list of installed (ie. found below some directory in @INC) glue DLLs +sub find_all_installed_glue_dlls +{ + my @dlls; + + find(sub { push @dlls, $File::Find::name if /\.dll/i; }, + grep { my $auto; + !ref $_ && -d ($auto = File::Spec->catdir($_, "auto")) ? + $auto : () + } @INC); + + return @dlls; +} + + +# guess the Perl module from the pathname of a glue DLL +sub guess_module_from_glue_dll +{ + my ($path) = @_; + + # module Foo::Bar::Quux typically installs its glue DLL as + # .../auto/Foo/Bar/Quux/Quux.dll or + # .../auto/Foo/Bar/Quux/Quux.xs.dll + my ($vol, $dirs, $file) = File::Spec->splitpath($path); + $dirs =~ s{[/\\]$}{}; + $dirs =~ s{^(?:.*?[/\\])?auto[/\\]}{} + or warn(qq[DLL "$path": path doesn't contain "auto"\n]), return; + return join("::", File::Spec->splitdir($dirs)); +} + + +my $show_lib_path = 0; +sub show_lib +{ + my ($dll) = @_; + if ($show_lib_path) + { + printf "\t%s => %s\n", $dll->name, $dll->path || "(not found)"; + } + else + { + printf "\t%s\n", $dll->name; + } +} + +if (@ARGV) +{ + foreach (@ARGV) + { + print $_, "\n"; + show_lib($_) foreach DLL->depends($_); + } +} +else +{ + my %mod2dll; + my @non_mod_dlls; + foreach (find_all_installed_glue_dlls()) + { + my $mod = guess_module_from_glue_dll($_); + push(@non_mod_dlls, $_), next unless $mod; + $mod2dll{$mod} = $_; + } + + foreach my $mod (sort keys %mod2dll) + { + my $dll = $mod2dll{$mod}; + my @deps = DLL->depends($dll) or next; # suppress glue DLLs w/o dependencies + print "$mod ($dll)\n"; + show_lib($_) foreach @deps; + } + + print "\n"; + foreach my $dll (sort @non_mod_dlls) + { + print "$dll\n"; + show_lib($_) foreach DLL->depends($dll); + } +}