The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use 5.010;

use strict;
use warnings;

use autodie;

use Config;
use CPAN::DistnameInfo;
use CPAN::Access::AdHoc;
use Cwd;
use File::Temp;
use Getopt::Long 2.33 qw{ :config auto_version };
use Pod::Usage;
use POSIX qw{ strftime };
use Term::ReadLine;
use version 0.77;
use YAML::Any;

our $VERSION = '0.000_194';

use constant CURRENT_PACKAGE => 'current';

my %opt;

GetOptions( \%opt,
    qw{ verbose! },
    'help|?' => sub { pod2usage( { -verbose => 2 } ) },
) or pod2usage( { -verbose => 0 } );

my $rl;
{
    my $banner = <<"EOD";

cpan-adhoc - Get arbitrary information from a CPAN mirror.
Version $VERSION, based on CPAN::Access::AdHoc version @{[
    CPAN::Access::AdHoc->VERSION ]}

Use 'help' for documentation, copyright, and license.

EOD

    if ( -t STDIN ) {
	my $trl = Term::ReadLine->new( 'cpan-adhoc' );
	$rl = sub {
	    return $trl->readline( $_[0] );
	};
	warn $banner;
    } elsif ( -t STDOUT && $opt{verbose} ) {
	$rl = sub { print @_; return scalar <STDIN> };
	warn $banner;
    } else {
	$rl = sub { return scalar <STDIN> };
    }
}

my $cad = CPAN::Access::AdHoc->new();
my %dist;

@ARGV
    and verb_cpan( shift @ARGV );

MAIN_LOOP:
while ( defined( my $buffer = $rl->( 'cpan-adhoc> ' ) ) ) {
    $buffer =~ s/ \s+ \z //smx;
    $buffer =~ s/ \A \s+ //smx;
    '' eq $buffer
	and next;
    $buffer =~ m/ \A [#] /smx
	and next;
    my ( $verb, @args ) = split qr{ \s+ }smx, $buffer;
    if ( my $code = __PACKAGE__->can( "verb_$verb" ) ) {
	eval {
	    $code->( @args );
	    1;
	} or warn $@;
    } else {
	warn "Unrecognized verb '$verb'\n";
    }
}

{
    no warnings qw{ once };
    -t STOUT
	and say '';
}

sub verb_alias {
    my ( $old, $new ) = @_;
    defined $old
	or die "Package alias must be given\n";
    defined $new
	or ( $old, $new ) = ( CURRENT_PACKAGE, $old );
    $dist{$new} = _resolve_unique_distribution( $old, record => 1 );
    return;
}

sub verb_author {
    my @ids = @_;

    my $author_index = $cad->fetch_author_index();
    @ids
	or @ids = sort keys %{ $author_index };

    foreach my $id ( @ids ) {
	$id = uc $id;
	if ( my $auth = $author_index->{$id} ) {
	    say join "\t", $id, $auth->{name}, $auth->{address};
	} else {
	    warn "Author $id not found\n";
	}
    }

    return;
}

sub verb_base {
    my @args = @_;
    @args or @args = ( CURRENT_PACKAGE );
    foreach my $name ( @args ) {
	my $pkg = _resolve_unique_distribution( $name,
	    record	=> 1,
	    warn	=> 1,
	) or next;
	my $di = $pkg->{info};
	say sprintf '%s/%s  %s', $di->cpanid(), $di->filename(),
	    _get_archive( $pkg )->base_directory();
    }
    return;
}

sub verb_cache {
    foreach my $pkg ( sort keys %dist ) {
	say join "\t", $pkg, $dist{$pkg}{name};
    }
    return;
}

sub verb_cd {
    my ( $dir ) = @_;
    if ( defined $dir ) {
	chdir $dir
	    or die "Failed to cd to $dir: $!\n";
    } else {
	chdir
	    or die "Failed to cd to home directory: $!\n";
    }
    return;
}

sub verb_checksums {
    my ( $author ) = @_;
    defined $author
	or die 'Must specify a CPAN ID';
    my $cksum = $cad->fetch_distribution_checksums( $author );
    say $author;
    print Dump( $cksum );
    return;
}

sub verb_choose {
    my ( @args ) = @_;
    @args == 1
	or die "The choose command takes exactly one argument.\n";
    $dist{$args[0]}
	or die _err_not_requested( $args[0] );
    $dist{+CURRENT_PACKAGE} = $dist{$args[0]};
    return;
}

sub verb_clear {
    %dist = ();
    $cad->flush();
    return;
}

sub verb_corpus {
    local @ARGV = @_;
    my %opt;
    my $go = Getopt::Long::Parser->new();
    $go->getoptions( \%opt, qw{ date development! full|verbose! latest!
	production! } )
	or return;
    @ARGV
	or die "No author specified\n";
    $opt{development}
	or $opt{production}
	or $opt{development} = $opt{production} = 1;
    $opt{full} //= @ARGV > 1;
    $opt{latest}
	and $opt{full} = 1;
    my $inx = $cad->fetch_author_index();
    foreach my $id ( @ARGV ) {
	my $uc_id = uc $id;
	my %seen;
	if ( $inx->{$uc_id} ) {
	    $opt{full}
		and say sprintf '%-14s %s', $uc_id, $inx->{$uc_id}{address};
	    my %found;
	    foreach my $dist( $cad->corpus( $uc_id ) ) {
		my $obj = CPAN::DistnameInfo->new( $dist );
		defined( my $name = $obj->dist() )
		    or next;
		my $version = $obj->version();
		my $kind = ( $version =~ m/ _ /smx ) ? 'development' : 'production';
		push @{ $found{$name} }, {
		    name	=> $name,
		    obj		=> $obj,
		    version	=> version->parse( $version ),
		    dist	=> $dist,
		    kind	=> $kind,
		};
		_record_distribution( $dist );
	    }
	    foreach my $name ( sort keys %found ) {
		@{ $found{$name} } = sort {
		    $a->{version} <=> $b->{version} }
		    @{ $found{$name} };
		$opt{latest}
		    and $found{$name} = [ $found{$name}[-1] ];
		if ( $opt{full} ) {
		    foreach ( @{ $found{$name} } ) {
			$opt{$_->{kind}}
			    or next;
			if ( $opt{date} ) {
			    my $arch = $cad->fetch_distribution_archive(
				$_->{dist} );
			    say '    ', $_->{dist}, "\t", strftime
			    '%d-%b-%Y %H:%M:%S', localtime
			    $arch->mtime();
			} else {
			    say '    ', $_->{dist};
			}
		    }
		} else {
		    say $name;
		}
	    }
	} else {
	    warn "CPAN ID $uc_id not found\n";
	}
    }
    return;
}

sub verb_cpan {
    my @arg = _expand_default( @_ );
    if ( @arg ) {
	$cad->cpan( @arg );
	verb_clear();
    }
    defined $arg[0]
	or say $cad->cpan();
    return;
}

sub verb_default_cpan_source {
    my @arg = _expand_default( @_ );
    @arg
	and $cad->default_cpan_source( @arg );
    if ( ! defined $arg[0] ) {
	my @src = @{ $cad->default_cpan_source() };
	foreach ( @src ) {
	    s/ \A CPAN::Access::AdHoc::Default::CPAN:: //smx;
	}
	say join ',', @src;
    }
    return;
}

sub verb_diff {
    local @ARGV = @_;
    my ( @d_opt, @d_arg );
    my %opt;
    my $go = Getopt::Long::Parser->new(
	config => [ qw{ pass_through no_auto_abbrev } ] );
    $go->getoptions( \%opt, qw{ less! } );
    while ( @ARGV ) {
	local $_ = shift @ARGV;
	if ( '--' eq $_ ) {
	    @d_arg = @ARGV;
	    last;
	} elsif ( m/ \A - /smx ) {
	    push @d_opt, $_;
	} else {
	    push @d_arg, $_;
	}
    }
    @d_arg
	and @d_arg <= 3
	or die "The diff command requires one to three arguments\n";
    my ( $local, $remote, $pkg ) = reverse @d_arg;
    $remote //= $local;
    my $temp = _fetch_file( $pkg, $remote );
    _issue( \%opt, diff => @d_opt, $temp->filename(), $local );

    return;
}

sub verb_distribution {
    my @args = @_;
    foreach my $dist ( _resolve_distributions( @args ) ) {
	_record_distribution( $dist );
	say $dist;
    }
    return;
}

BEGIN {
    no warnings qw{ once };
    *verb_dist = \&verb_distribution;
}

sub verb_exit {
    no warnings qw{ exiting };
    last MAIN_LOOP;
}

sub verb_extract {
    my @args = @_;
    @args or @args = ( CURRENT_PACKAGE );
    foreach my $name ( @args ) {
	my $pkg = _resolve_unique_distribution(
	    $name, record => 1, warn => 1 )
	    or next;
	my $archive = _get_archive( $pkg );
	$archive->extract();
	my $di = $pkg->{info};
	say sprintf '%s/%s  %s', $di->cpanid(), $di->filename(),
	    $archive->base_directory();
    }
    return;
}

sub verb_help {
    pod2usage( { -verbose => 2, -exitval => 'NOEXIT' } );
    return;
}

sub verb_info {
    my @args = @_;
    @args or @args = ( CURRENT_PACKAGE );
    foreach my $name ( @args ) {
	my $pkg = _resolve_unique_distribution(
	    $name, record => 1, warn => 1 )
	    or next;
	my $di = $pkg->{info};
	say $di->filename();
	say '    ', $di->cpanid();
    }
    return;
}

sub verb_less {
    my ( $pkg, $file ) = @_;
    my $temp = _fetch_file( $pkg, $file );
    _less( $temp );
    return;
}

sub verb_list {
    local @ARGV = @_;
    my %opt;
    GetOptions( \%opt, qw{ less! } )
	or return;
    my @args = @ARGV;
    @args
	or push @args, CURRENT_PACKAGE;
    my $output = $opt{less} ? File::Temp->new() : *STDOUT;
    foreach my $name ( @args ) {
	my $pkg = _resolve_unique_distribution(
	    $name, record => 1, warn => 1 )
	    or next;
	say { $output } $pkg->{name};
	foreach my $file ( _get_archive( $pkg )->list_contents() ) {
	    say { $output } '    ', $file;
	}
    }
    $opt{less}
	and _less( $output );
    return;
}

sub verb_metadata {
    my @args = @_;
    @args or push @args, CURRENT_PACKAGE;
    foreach my $name ( @args ) {
	my $pkg = _resolve_unique_distribution(
	    $name, record => 1, warn => 1 )
	    or next;
	my $dv = $pkg->{info}->distvname();
	if ( my $meta = _get_archive( $pkg )->metadata() ) {
	    my $ms = $meta->as_string();
	    chomp $ms;
	    say "$dv: $ms";
	} else {
	    warn "No metadata found for $dv\n";
	}
    }
    return;
}

sub verb_module {
    my @arg = @_;
    my $inx = $cad->fetch_module_index();
    foreach my $module ( @arg ) {
	$inx->{$module}
	    or _flunk( "Module '$module' not indexed" )
	    or next;	# _flunk returns false
	my $dist = $inx->{$module}{distribution};
	say join "\t", $module, $inx->{$module}{version}, $dist;
	_record_distribution( $dist );
    }
    return;
}

sub verb_mtime {
    my ( $pkg, $file ) = _validate_pkg_file( @_ );
    say strftime( '%d-%b-%Y %H:%M:%S', localtime
	$pkg->{archive}->get_item_mtime( $file )
    );
    return;
}

sub verb_perldoc {
    my ( $pkg, $file ) = _validate_pkg_file( @_ );
    my $temp = _fetch_file( $pkg, $file );
    _issue( {}, perldoc => $temp );
    return;
}

sub verb_pwd {
    say cwd;
    return;
}

sub verb_write {
    my @args = @_;
    @args or @args = ( CURRENT_PACKAGE );
    foreach my $name ( @args ) {
	my $pkg = _resolve_unique_distribution(
	    $name, record => 1, warn => 1 )
	    or next;
	my $archive = _get_archive( $pkg );
	$archive->write();
	my $di = $pkg->{info};
	say sprintf '%s', $di->filename();
    }
    return;
}

sub _expand_default {
    local @ARGV = @_;
    my %opt;
    GetOptions( \%opt, qw{ default! } )
	or die "The only legal option is -default\n";
    if ( $opt{default} ) {
	@ARGV
	    and die "You may not specify both -default and an argument\n";
	return ( undef );
    } elsif ( @ARGV ) {
	@ARGV == 1
	    or die "You may not specify more than one argument\n";
	return @ARGV;
    } else {
	return;
    }
}

sub _validate_pkg_file {
    my ( $name, $file ) = @_;
    defined $name
	or defined $file
	or die "File name must be given\n";
    defined $file
	or ( $name, $file ) = ( undef, $name );

    if ( ! defined $name ) {
	my $inx = $cad->fetch_module_index();
	$inx->{$file}
	    and $name = $inx->{$file}{distribution};
    }

    $name //= CURRENT_PACKAGE;

    my $pkg = _resolve_unique_distribution( $name,
	record	=> 1 );
    my $dname = $pkg->{info}->distvname();
    my $arch = _get_archive( $pkg );

    $arch->item_present( $file )
	and return ( $pkg->{name}, $file );

    ( my $mp = $file ) =~ s{ :: }{/}smxg;
    my $re = qr{ / \Q$mp\E [.] pm \z }smx;
    foreach my $try ( $arch->list_contents() ) {
	$try =~ $re
	    or next;
	return ( $pkg->{name}, $try );
    }

    die "File '$file' not in distribution '$dname'\n";
}

sub _err_not_requested {
    my ( $name ) = @_;
    return $name eq CURRENT_PACKAGE ?
	"No current package\n" :
	"Package $name never requested by name\n";
}

sub _fetch_file {
    my ( $pkg, $file ) = _validate_pkg_file( @_ );
    my $content = _get_archive( $pkg )->get_item_content( $file );
    my $temp = File::Temp->new();
    print { $temp } $content;
    return $temp;
}

sub _get_archive {
    my ( $pkg, %arg ) = @_;
    defined $pkg
	or $pkg = CURRENT_PACKAGE;
    if ( ! ref $pkg ) {
	$pkg = _resolve_unique_distribution( $pkg, %arg, record => 1 );
    }
    return (
	$pkg->{archive} ||= $cad->fetch_distribution_archive(
	    $pkg->{name} )
    );
}

sub _record_distribution {
    my ( $pkg, %arg ) = @_;
    defined $pkg
	or return;
    $dist{$pkg}
	and return ( $dist{+CURRENT_PACKAGE} = $dist{$pkg} );
    my $di = CPAN::DistnameInfo->new( $pkg );
    my $dn = $di->dist();
    my $dv = $di->distvname();
    my $version = version->parse( $di->version() );
    defined( my $pathname = $di->pathname() )
	or return _flunk( "$pkg not found", %arg );
    $pathname =~ m{ \A /authors/id/ }smx
	or substr $pathname, 0, 0, '/authors/id/';
    $cad->exists( $pathname )
	or _flunk ( "$pkg not found", %arg );
    $dist{+CURRENT_PACKAGE} = $dist{$pkg} ||= {
	name	=> $pkg,
	version	=> $version,
	dist	=> $dn,
	info	=> $di,
    };

    # $dv and $dn may not be defined if we are dealimg with, e.g., one
    # of Tom Christiansen's unpackaged .pm files, say
    # T/TO/TOMC/scripts/whenon.dir/LastLog/File.pm.gz
    defined $dv
	and $dist{$dv} = $dist{$pkg};
    not defined $dn
	or $dist{$dn} and $dist{$dn}{version} > $version
	or $dist{$dn} = $dist{$pkg};
    return $dist{$pkg};
}

sub _resolve_distributions {
    my @args = @_;
    my %opt;
    @args
	and 'HASH' eq ref $args[-1]
	and %opt = %{ pop @args };
    my $re = qr< @{[ join ' | ', map { quotemeta } @args ]} >smx;
    my @rslt;
    foreach my $dist ( $cad->indexed_distributions() ) {
	$dist =~ $re
	    or next;
	$opt{record}
	    and $dist = _record_distribution( $dist );
	push @rslt, $dist;
    }
    return @rslt;
}

# Resolve a distribution name to a unique distribution, or throw an
# exception. By default the return is the reolved name. If $arg{record}
# is true, though, the distribution is recorded and a reference to the
# record is returned.

sub _resolve_unique_distribution {
    my ( $name, %arg ) = @_;
    $dist{$name}
	and return $arg{record} ? $dist{$name} : $name;

    $name eq CURRENT_PACKAGE
	and _flunk( 'No current package', %arg );
    my @rslt = _resolve_distributions( $name )
	or _flunk( "Distribution $name not found", %arg );
    if ( @rslt > 1 ) {
	my %base;
	foreach my $d ( @rslt ) {
	    my $di = CPAN::DistnameInfo->new( $d );
	    my $dn = $di->dist();
	    my $dv = version->parse( $di->version() );
	    $base{$dn}
		and $base{$dn}{version} >= $dv
		or $base{$dn} = {
		distro	=> $d,
		version	=> $dv,
	    };
	}
	@rslt = map { $base{$_}{distro} } keys %base;
    }
    @rslt > 1
	and return _flunk( "Distribution $name not unique", %arg );
    $arg{record}
	and return _record_distribution( $rslt[0] );
    return $rslt[0];
}

sub _flunk {
    my ( $msg, %arg ) = @_;
    $msg =~ s/ (?<! \n ) \z /\n/smx;
    $arg{warn}
	or die $msg;
    warn $msg;
    return;
}

sub _issue {
    my ( $opt, $name, @args ) = @_;
    if ( $opt->{less} ) {
	my $pid = open my $pipe, '-|';
	if ( ! defined $pid ) {
	    die "Failed to fork: $!\n";
	} elsif ( $pid ) {
	    # Parent
	    my $temp = File::Temp->new();
	    while ( <$pipe> ) {
		print { $temp } $_;
	    }
	    _less( $temp );
	} else {
	    # Child
	    exec { $name } $name, @args;
	    die "Exec failed: $!\n";
	}
    } else {
	system { $name } $name, @args;
    }
    return;
}

{

    my @pager;

    BEGIN {
	@pager = split qr{ \s+ }smx, $Config{pager};
    }

    sub _less {
	my ( $file ) = @_;
	_issue( {}, @pager, $file );
	return;
    }

}

__END__

=head1 TITLE

cpan-adhoc - Get arbitrary information from a CPAN mirror.

=head1 SYNOPSIS

 $ cpan-adhoc
 cpan-adhoc> help
 cpan-adhoc> module LWP::UserAgent
 cpan-adhoc> list
 cpan-adhoc> perldoc lib/LWP/UserAgent.pm
 cpan-adhoc> exit
 
 $ cpan-adhoc http://cpan.pair.com/
 cpan-adhoc> ...
 
 $ cpan-adhoc -help
 $ cpan-adhoc -version

=head1 OPTIONS

=head2 -help

This option displays the documentation for this script. The script then
exits.

=head2 -verbose

If asserted, this option causes the banner to be printed and commands
echoed when not reading commands from a terminal.

=head2 -version

This option displays the version of this script. The script then exits.

=head1 DETAILS

This Perl script implements an interactive query of a CPAN mirror. The
default is whatever mirror your CPAN client is set to, as determined by
L<CPAN::Access::AdHoc|CPAN::Access::AdHoc>. You can specify a different
mirror on the command line, or using the L<cpan|/cpan> command.

The following commands are supported:

=head2 alias

 cpan-adhoc> alias libwww-perl libwww
 cpan-adhoc> alias libwww

This command creates an alias for a distribution in the downloaded
distribution stash. It is simply a convenience to save typing if you
have a long distribution name you will be repeatedly typing. The first
argument is the name of a distribution, and the second is the alias.

The single-argument version creates an alias for the current
distribution, if any.

=head2 author

 cpan-adhoc> author
 cpan-adhoc> author adamk rjbs bingos

This command lists items from the author index
F<authors/01mailrc.txt.gz>. If no names are given the whole index is
listed in ASCIIbetical order.

=head2 base

This command displays the base directories for the named distributions.
If no distribution is specified, the current distribution, if any, is
displayed.

=head2 cache

This command lists the distribution names encountered since the
most-recent C<clear>, or since the script started. Each distribution may
appear under multiple names.

=head2 cd

 cpan-adhoc> cd fu/bar
 cpan-adhoc> cd

This command changes the default directory under which the script runs.
Without an argument, it changes to the user's home directory.

=head2 checksums

 cpan-adhoc> checksums MENUHIN
 cpan-adhoc> checksums MENUHIN/Yehudi-0.01.tar.gz

This command displays the checksums for the given author or
distribution.

=head2 choose

 cpan-adhoc> choose libwww-perl

This command makes the given downloaded distribution the default.

=head2 clear

 cpan-adhoc> clear

This command removes all distributions from the stash, and purges cached
data from the L<CPAN::Access::AdHoc|CPAN::Access::AdHoc> object.

=head2 corpus

 cpan-adhoc> corpus BACH

This command lists all distributions in the index for the given CPAN ID.
More than one CPAN ID can be specified. The CPAN ID is converted to
upper case before use, so the example could equally well be written

 cpan-adhoc> corpus bach

Supported options are:

=over

=item -development

If asserted, development releases are listed; if not asserted they are
not. This option is ignored unless C<-full> or C<-latest> is in effect.
The default is C<-development> if C<-production> is not asserted.

=item -full

If asserted, you get full distribution names. If not asserted, you get
the base distribution name only. The default is C<-nofull>.

=item -latest

If asserted, you get the full display, but only the highest-numbered
version of any distribution is displayed.

=item -production

If asserted, production releases are listed; if not asserted they are
not. This option is ignored unless C<-full> or C<-latest> is in effect.
The default is C<-production> if C<-development> is not asserted.

=item -verbose

This is just a synonym for C<-full>.

=back

=head2 cpan

 cpan-adhoc> cpan
 cpan-adhoc> cpan file:///home/yehudi/Mini-CPAN/
 cpan-adhoc> cpan -default

If no argument is specified, this command displays the CPAN URL being
used.

If an argument is specified, this command sets the CPAN URL being used.

If the CPAN URL was specified as C<-default>, a default value is
computed from the current setting of C<default_cpan_source>, and that
value is both set as the current soure and displayed. If no default can
be computed from the current C<default_cpan_source>, an error is
displayed and the current setting is left unchanged.

=head2 default_cpan_source

 cpan-adhoc> default_cpan_source
 cpan-adhoc> default_cpan_source cpanm,CPAN
 cpan-adhoc> default_cpan_source -default

If no argument is specified, this command displays the sources of
default CPAN URLs being used.

If an argument is specified, this command sets the sources of default
CPAN URLs. The value is a comma-delimited list.

If the argument was specified as C<-default>, the default value is
reinstated.

B<Note> that setting this value does not affect the C<cpan> setting. If
you want to recompute the C<cpan> URL after setting this, you must do

 cpan-adhoc> cpan -default

The default is C<'CPAN::Mini,cpanm,CPAN,CPANPLUS'>.

=head2 diff

 cpan-adhoc> diff libwww-perl README README
 cpan-adhoc> diff README README
 cpan-adhoc> diff README
 cpan-adhoc> diff -less -u README README

This command runs F<diff> on a file from a CPAN archive and a local
file. The arguments are the distribution name, the file in the
distribution, and the local file. The distribution defaults to the
current distribution, and the file in the distribution defaults to the
local file.

The C<-less> option specifies that the output of F<diff> be viewed in
F<less>. Anything else that looks like an option (that is, that has a
leading dash) will be passed to the F<diff> program. Because of the
possibility of conflict with F<diff> options, C<-less> may not be
abbreviated, though it may be specified as C<--less>, or negated
C<-noless>.

The null option (C<-->) ends option processing, and causes anything
after it to be considered an argument. For example, in

 cpan-adhoc> diff README -readme

the trailing C<-readme> is taken as an option for F<diff>. But in

 cpan-adhoc> diff -- README -readme

the trailing C<-readme> is taken as a file name.

=head2 dist

This is a synonym for L<distribution|/distribution>, for convenience.

=head2 distribution

 cpan-adhoc> distribution libwww-perl

This command looks up the given distributions in the module index (sic),
using an unanchored regular expression, and displays any matches.

=head2 exit

 cpan-adhoc> exit

This command causes the script to exit. An end-of-file also works.

=head2 extract

 cpan-adhoc> extract libwww-perl
 cpan-adhoc> extract

This command extracts the files in the given distributions into
subdirectories of the current directory. If no distribution is
specified, the current distribution is extracted.

=head2 help

 cpan-adhoc> help

This command displays the documentation for this script.

=head2 info

 cpan-adhoc> info libwww-perl
 cpan-adhoc> info

This command displays the archive name and CPAN ID of the given
distributions. If no distribution is specified, the current distribution
is displayed.

=head2 less

 cpan-adhoc> less libwww-perl lib/LWP/UserAgent.pm
 cpan-adhoc> less libwww-perl LWP::UserAgent
 cpan-adhoc> less lib/LWP/UserAgent.pm
 cpan-adhoc> less LWP::UserAgent

This command feeds the specified file from the specified distribution to
whatever pager was configured when Perl was built. If the file is not
found, it is assumed to be a module name, and an attempt is made to find
that module's file.

The single-argument form attempts to look up the argument in the module
index. If it is found, that module's file is displayed. Otherwise it
displays the given file in the current distribution, if any

=head2 list

 cpan-adhoc> list libwww-perl
 cpan-adhoc> list

This command lists the files in the given distributions. If no
distribution is specified, the current distribution is listed.

=head2 metadata

This command displays the metadata for the given distributions. If
metadata is not available (i.e. no F<META.json> or F<META.yml> was
found) a warning will be issued.

The metadata is displayed by the L<CPAN::Meta|CPAN::Meta> C<as_string()>
method.

=head2 module

 cpan-adhoc> module LWP::UserAgent

This command looks up the given modules in the module index, and
displays their version and the distribution they are contained in.

=head2 perldoc

 cpan-adhoc> perldoc libwww-perl-6.03 lib/LWP/UserAgent.pm
 cpan-adhoc> perldoc Libwww-perl LWP::UserAgent
 cpan-adhoc> perldoc lib/LWP/UserAgent.pm
 cpan-adhoc> perldoc LWP::UserAgent

This command feeds the specified file from the specified distribution to
perldoc. If the file is not found, it is assumed to be a module name,
and an attempt is made to find that module's file.

The single-argument form attempts to look up the argument in the module
index. If it is found, that module's documentation is displayed.
Otherwise it displays the given file in the current distribution, if any

=head2 pwd

This command displays the current default directory.

=head2 write

 cpan-adhoc> write libwww-perl
 cpan-adhoc> write

This command writes the archive of the given distributions into the
current directory. If no distribution is specified, the current
distribution is written.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012-2014 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the directory LICENSES.

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.

=cut

# ex: set textwidth=72 :