view release on metacpan or  search on metacpan

bin/depends  view on Meta::CPAN

#!/usr/bin/perl
# abstract: list dependencies for perl modules/scripts, with optional core info

use vars qw($VERSION);
our $VERSION = '0.016';

use strict;
use File::Find::Rule;
use File::LibMagic ':easy';
use Module::CoreList;
use Term::ExtendedColor qw(:attributes);
use File::LsColor qw(ls_color);
use Getopt::Long;

my %opt = (
    core => 0,
  pragma => 0,
);

GetOptions(
  'c|core'    => \$opt{core},
  'p|pragmas' => \$opt{pragma},
  'h|help'    => sub {
    print "-c,  --core    also list core modules\n";
    print "-h,  --help    display this help and exit\n";
    exit;
  },
);

#< pragmas
my %pragmas = (
  attributes    =>  "Get/set subroutine or variable attributes",
  autodie       =>  "Replace functions with ones that succeed or die with lexical scope",
  autouse       =>  "Postpone load of modules until a function is used",
  base          =>  "Establish an ISA relationship with base classes at compile time",
  bigint        =>  "Transparent BigInteger support for Perl",
  bignum        =>  "Transparent BigNumber support for Perl",
  bigrat        =>  "Transparent BigNumber/BigRational support for Perl",
  blib          =>  "Use MakeMaker's uninstalled version of a package",
  bytes         =>  "Expose the individual bytes of characters",
  charnames     =>  "Access to Unicode character names and named character sequences; also define character names",
  constant      =>  "Declare constants",
  deprecate     =>  "Perl pragma for deprecating the inclusion of a module in core",
  diagnostics   =>  "Produce verbose warning diagnostics",
  encoding      =>  "Allows you to write your script in non-ASCII and non-UTF-8",
  experimental  =>  "Experimental features made easy",
  feature       =>  "Enable new features",
  fields        =>  "Compile-time class fields",
  filetest      =>  "Control the filetest permission operators",
  if            =>  "use a Perl module if a condition holds",
  integer       =>  "Use integer arithmetic instead of floating point",
  less          =>  "Request less of something",
  lib           =>  "Manipulate \@INC at compile time",
  locale        =>  "Use or avoid POSIX locales for built-in operations",
  mro           =>  "Method Resolution Order",
  ok            =>  "Alternative to Test::More::use_ok",
  open          =>  "Set default PerlIO layers for input and output",
  ops           =>  "Restrict unsafe operations when compiling",
  overload      =>  "Package for overloading Perl operations",
  overloading   =>  "Lexically control overloading",
  parent        =>  "Establish an ISA relationship with base classes at compile time",
  re            =>  "Alter regular expression behaviour",
  sigtrap       =>  "Enable simple signal handling",
  sort          =>  "Control sort() behaviour",
  strict        =>  "Restrict unsafe constructs",
  subs          =>  "Predeclare subroutine names",
  threads       =>  "Perl interpreter-based threads",
  utf8          =>  "Enable/disable UTF-8 (or UTF-EBCDIC) in source code",
  vars          =>  "Predeclare global variable names",
  version       =>  "Perl extension for Version Objects",
  vmsish        =>  "Control VMS-specific language features",
  warnings      =>  "Control optional warnings",
);
#>

my $file = shift;

my @perls;
if(-d $file) {
  my $ff = File::Find::Rule->new;
  $ff->file;
  $ff->name('*.pm', '*.pl');
  @perls = grep{ !/blib/ } $ff->in( $file );

  if(!@perls) {
    $ff->name('*');
    print $ff->in($file);
    @perls = grep{ MagicFile($_) =~ m/perl/i } $ff->in($file);
  }
}
elsif(-f $file) {
  @perls = $file;
}

if(!@perls) {
  my $ff = File::Find::Rule->new;
  $ff->file;
  @perls = grep{!/(?:blib|[.]git)/ } $ff->in( '.' );
  @perls = grep{ MagicFile($_) =~ m/perl/i } @perls;
}


@perls or print "No Perl files found.\n" and exit;

my %result = %{ get_modules(@perls) };

my $previous;
for my $file(sort(keys(%result))) {
  printf "%s\n", fg(240, join('', '-' x 40));
  if($previous ne $file) {
    $previous = $file;
  }

  my %pragmas_in_use;