The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# Read the manual page from the pod at end for details.
#
# Generate a list of modules used by a perl script that has just run.
#
package Devel::Modlist;

require 5.6.0;
use strict;

# Suppress warnings without using the vars pragma
our ($VERSION, $reported, %options);
$VERSION = '0.801';

BEGIN
{
    # This defines a simple class that CPAN will use if it is requested
    package Devel::Modlist::QuietCPAN;

    sub myprint { }
    sub mywarn  { shift; CPAN::Shell->mywarn(@_); }
    sub mydie   { shift; CPAN::Shell->mydie(@_); }
}

sub report;

sub import
{
    shift(@_); # Lose the leading "classname" value

    grep($options{$_} = 1, @_);
}

sub DB::DB
{
    if ($options{stop})
    {
        report;
        exit;
    }
}

sub report
{
    return if $reported;

    unless (keys %options)
    {
        grep($options{$_} = 1,
             split(/[, ]/, ($ENV{'Devel::Modlist'} || $ENV{Devel__Modlist})));
    }
    # The 'noreport' option is not documented in the pod. It is only used by
    # the pod_coverage.t test suite, to prevent the loading of this module
    # from triggering a usage report.
    return if $options{noreport};

    local $!;
    $^W = 0;
    my $pkg;
    my $inc;
    my $format;
    my %yaml;
    my $fh = $options{stdout} ? \*STDOUT : \*STDERR;
    $DB::trace = 0 if ($DB::trace);
    my %files = %INC;
    # We use this ourselves, so delete it all the time. They shouldn't need
    # to see it here anyway.
    delete $files{'strict.pm'};

    # Anything required from here on won't show up unless it was already there
    require File::Spec;
    my @order = (0 .. 2);
    if ($options{nocore})
    {
        require Config; # Won't have to worry about grep'ing out this one :-)
        for my $lib ($Config::Config{installprivlib},
                     $Config::Config{installarchlib})
        {
            for (keys %files)
            {
                delete $files{$_} if ("$lib/$_" eq $files{$_});
            }
        }
    }
    if (my @yaml = grep(/^yaml/, keys %options))
    {
        %yaml =
            map
            {
                my ($k, $v) = split('=', $_, 2);
                (substr($k, 4) || 'yaml', lc $v || 1)
            } @yaml;
        # In case they only specified formatting options, no explicit
        # reference to the "yaml" option itself, set it for later tests:
        $yaml{yaml}++;

        # Start by defaulting the indentation. Defaults are no indentation for
        # the header and 4 spaces for the key/value pairs. If the user chose
        # to suppress the header, don't alter the key/value indentation.
        $yaml{headerindent} ||= 0;
        $yaml{indent} = 4
            unless (defined($yaml{indent}) or $yaml{header} eq 'none');
        # The indent value is relative to the header indentation, unless the
        # header is supressed
        $yaml{indent} += $yaml{headerindent} unless $yaml{header} eq 'none';

        # 'yamlcomplete' means to output a complete YAML stream, i.e. '---'
        print $fh '# Generated by ' . __PACKAGE__ . " $VERSION\n---\n"
            if ($yaml{complete});

        # Default the header to 'Requires', then print it if it isn't "none".
        $yaml{header} ||= 'Requires';
        unless ($yaml{header} eq 'none')
        {
            print $fh ' ' x $yaml{headerindent} . "$yaml{header}:\n";
        }
    }
    if ($options{cpan} or $options{cpandist})
    {
        require CPAN;

        # Defeat "used only once" warnings without using local() which breaks
        $CPAN::Frontend = $CPAN::Config->{index_expire} = '';
        $CPAN::Frontend = 'Devel::Modlist::QuietCPAN';
        CPAN::HandleConfig->load;
        # This is an arbitrary value to inhibit re-loading index files
        $CPAN::Config->{index_expire} = 300;
        my %seen_dist = ();
        my ($modobj, $cpan_file);

        for $inc (sort keys %files)
        {
            $pkg = join('::', File::Spec->splitdir($inc));
            $pkg =~ s/\.pm$//;
            $modobj = CPAN::Shell->expand('Module', $pkg) or next;
            $cpan_file = $modobj->cpan_file;
            if ($seen_dist{$cpan_file})
            {
                delete $files{$inc};
                next;
            }
            # Haven't seen it until now
            $seen_dist{$cpan_file}++;
            $files{$inc} = $cpan_file if $options{cpandist};
        }
    }
    # To prevent options being evaluated EVERY loop iteration, we set a format
    # and data ordering:
    if ($yaml{yaml})
    {
        $format = $options{noversion} ? "- '%s'\n" : "'%s': %s\n";
        $format = ' ' x ($yaml{indent} || 0) . $format;
        @order = (2, 1) if $options{path};
    }
    elsif ($options{noversion} || $options{path} || $options{cpandist})
    {
        $format = "%s\n";
        @order = (2) if ($options{path} || $options{cpandist});
        # Only include the value (3rd) element
    }
    else
    {
        $format = "%-20s %6s\n";
        @order = (2, 1) if $options{path};
    }
    for $inc (sort keys %files)
    {
        # Disable refs-checking so we can read VERSION values
        no strict 'refs';

        # Set the default for $version to either empty string or zero,
        # depending on user choice
        my $default = $options{zerodefault} ? '0' : '';
        next if ($inc =~ /\.(al|ix)$/);
        $pkg = join('::', File::Spec->splitdir($inc));
        $pkg =~ s/\.pm$//;
        next if ($pkg eq __PACKAGE__); # After all...
        my $version = ${"$pkg\::VERSION"} || '';
        printf $fh $format, ($pkg, $version || $default, $files{$inc})[@order];
    }

    $reported++;
}

END { report }

1;

__END__

=head1 NAME

Devel::Modlist - Perl extension to collect module use information

=head1 SYNOPSIS

    perl -d:Modlist script.pl

=head1 DESCRIPTION

The B<Devel::Modlist> utility is provided as a means by which to get a quick
run-down on which libraries and modules are being utilized by a given script.

Just as compiler systems like I<gcc> provide dependancy information via
switches such as C<-M>, B<Devel::Modlist> is intended to assist script authors
in preparing dependancy information for potential users of their scripts.

=head1 USAGE

Usage of B<Devel::Modlist> is simple. The primary method of invocation is to
use the C<-d> option of Perl:

    perl -d:Modlist script.pl

Alternately, one could use the C<-M> option:

    perl -MDevel::Modlist script.pl

In the case of this module, the two are identical save for the amount of
typing (and option passing, see below). It is I<not> recommended that this
module be loaded directly by a script via the B<use> keyword, as that would
cause the dependancy reporting after I<every> invocation until it was removed
from the code.

=head1 OPTIONS

The following options may be specified to the package. These are specified either by:

    perl -MDevel::Modlist=option1[,option2,...]

or

    perl -d:Modlist=option1[,option2,...]

Options may also be given in an environment variable, which gets read at any
invocation in which there are B<no> options explicitly provided. If any
options are given in the invocation, then the environment variable is ignored. Two different names are recognized:

    Devel::Modlist
    Devel__Modlist

The latter is to accomodate shells that do not like the presence of C<::> in
an environment variable name.

The options:

=over 4

=item stdout

By default, the report is printed on the STDERR filehandle. If this option is
present, it is sent to STDOUT instead.

=item cpan

Reduce the resulting list of modules by using the data maintained in the local
I<CPAN> configuration area. The B<CPAN> module (see L<CPAN>) maintains a very
thorough representation of the contents of the archive, on a per-module basis.
Using this option means that if there are two or more modules that are parts
of the same distribution, only one will be reported (the one with the shortest
name). This is useful for generating a minimalist dependancy set that can in
turn be fed to the B<CPAN> C<install> command to ensure that all needed
modules are in fact present.

=item cpandist

This is identical to the option above, with the exception that it causes the
reported output to be the B<CPAN> filename rather than the module name in
the standard Perl syntax. This can also be fed to the B<CPAN> shell, but it
can also be used by other front-ends as a path component in fetching the
requisite file from an archive site. Since the name contains the version
number, this behaves as though I<noversion> (see below) was also set. If
both I<cpan> and I<cpandist> are set, this option (I<cpandist>) takes
precedence. If I<path> is also specified, this option again takes precedence.

=item nocore

Suppress the display of those modules that are a part of the Perl core. This
is dependant on the Perl private library area not being an exact substring of
the site-dependant library. The build process checks this for you prior to
install.

=item noversion

Suppress the inclusion of version information with the module names. If a
module has defined its version by means of the accepted standard of
declaring a variable C<$VERSION> in the package namespace, B<Devel::Modlist>
finds this and includes it in the report by default. Use this option to
override that default.

=item zerodefault

Also oriented towards the display of versions, this option tells the report
to use a zero (C<0>) as the default version if the package has not provided
a value. Otherwise, an empty string is displayed (unless B<noversion> is
given).

=item path

Display the path and filename of each module instead of the module name. Useful
for producing lists for later input to tools such as B<rpm>.

=item yaml
=item yamlheader=NAME
=item yamlheaderindent=N
=item yamlindent=N
=item yamlcomplete

(Experimental, some options and/or features may change in future releases.)

If any B<yaml> option is present, the output format is in YAML rather than
simple text. Additionally, the options can exert a degree of control
over the format of the resulting YAML. Those options that take value must
provide them by using a C<=> character immediately followed by the value, with
no space surrounding the C<=>.

=over 8

=item yamlheader=NAME

Specify a "header" for the YAML section being emitted. This roughly corresponds
to the name of the section (or item) in the resulting parsed YAML tree. (See
any of the YAML-related modules on CPAN for an explanation of how a YAML file
is transformed into a Perl data structure.) If no header value is specified,
the default is C<Requires>. If you wish to suppress this header entirely,
pass the special value C<none>, i.e., C<yamlheader=none>. 

=item yamlheaderindent=N

Specify the indentation for the section header. By default, the header is
flush to the left, an indentation of 0. The value provided specifies the
number of space characters printed before the header.

=item yamlindent=N

Specify the indentation for the key/value pairs (or sequential-list items,
see below). This defaults to 4, and represents the number of leading spaces
on each line. If B<yamlheader> is set to C<none>, then this is not given a
default, thus allowing the lines to be left-flush in the absence of the
header. If you wish the lines to have no indentation, pass this option with
a value of C<0>; the default is only applied if the option is not explicitly
present. The indentation is relative to the value of B<yamlheaderindent>, so
if you provide a non-zero value for that option, it will be added to this one
(unless the header is suppressed by C<yamlheader=none>).

=item yamlcomplete

If this option is present, the output will be a complete YAML document, with
a comment identifying the generator and a C<---> separator. B<yamlheader> may
still be set to C<none> to supress the header, even when a complete document
is being generated.

=back

The B<yaml> option is just to allow selection of the YAML option without
making any adjustments to the formatting. If any of the other YAML options
are present, it will trigger this output format; an explicit B<yaml> would
be unnecessary.

The YAML output format respects other options (B<stdout>, B<noversion>,
B<zerodefault>, etc.). If B<noversion> is given, the output is a sequential
list rather than key/value pairings. If B<path> is given, the keys (or
values of the sequential list) are pathnames. Whether pathnames or module
names are used, those values are always explicitly quoted in the YAML output.

=item stop

Exit before the first actual program line is executed. This provides for
fetching the dependancy list without actually running the full program. This
has a drawback: if the program uses any of B<require>, B<eval> or other
such mechanisms to load libraries after the compilation phase, these will
not be reported.

=back

=head1 CAVEATS

Perl versions up to 5.6.0 cannot accept options to the C<-d:> flag as
with the C<-M> flag. Thus, to pass options one must use:

    perl -MDevel::Modlist=option1[,option2,...]

Unfortunately, this inhibits the B<stop> option detailed earlier. To use this
option, an invocation of:

    perl -d:Modlist -MDevel::Modlist=option1[,option2,...]

does the trick, as the first invocation puts the interpreter in debugging mode
(necessary for B<stop> to work) while the second causes the options to be
parsed and recorded by B<Devel::Modlist>.

Versions of Perl from 5.6.1 onwards allow options to be included with the
C<-d:Modlist> flag.

Because B<Devel::Modlist> uses the C<strict> pragma internally (as all modules
should), that pragma is always removed from the output to avoid generating a
false-positive.

=head1 AUTHOR

Randy J. Ray <rjray@blackperl.com>, using idea and prototype code provided by
Tim Bunce <Tim.Bunce@ig.co.uk>

=head1 LICENSE

This module and the code within are
released under the terms of the Artistic License 2.0
(http://www.opensource.org/licenses/artistic-license-2.0.php). This
code may be redistributed under either the Artistic License or the GNU
Lesser General Public License (LGPL) version 2.1
(http://www.opensource.org/licenses/lgpl-2.1.php).

=cut