[perl5.git] / dist / Module-CoreList / corelist

#!/usr/bin/perl

=head1 NAME

corelist - a commandline frontend to Module::CoreList

=head1 DESCRIPTION

See L<Module::CoreList> for one.

=head1 SYNOPSIS

   corelist -v
   corelist [-a|-d] <ModuleName> | /<ModuleRegex>/ [<ModuleVersion>] ...
   corelist [-v <PerlVersion>] [ <ModuleName> | /<ModuleRegex>/ ] ...
   corelist [-r <PerlVersion>] ...
   corelist --feature <FeatureName> [<FeatureName>] ...
   corelist --diff PerlVersion PerlVersion
   corelist --upstream <ModuleName>

=head1 OPTIONS

=over

=item -a

lists all versions of the given module (or the matching modules, in case you
used a module regexp) in the perls Module::CoreList knows about.

    corelist -a Unicode

    Unicode was first released with perl v5.6.2
      v5.6.2     3.0.1
      v5.8.0     3.2.0
      v5.8.1     4.0.0
      v5.8.2     4.0.0
      v5.8.3     4.0.0
      v5.8.4     4.0.1
      v5.8.5     4.0.1
      v5.8.6     4.0.1
      v5.8.7     4.1.0
      v5.8.8     4.1.0
      v5.8.9     5.1.0
      v5.9.0     4.0.0
      v5.9.1     4.0.0
      v5.9.2     4.0.1
      v5.9.3     4.1.0
      v5.9.4     4.1.0
      v5.9.5     5.0.0
      v5.10.0    5.0.0
      v5.10.1    5.1.0
      v5.11.0    5.1.0
      v5.11.1    5.1.0
      v5.11.2    5.1.0
      v5.11.3    5.2.0
      v5.11.4    5.2.0
      v5.11.5    5.2.0
      v5.12.0    5.2.0
      v5.12.1    5.2.0
      v5.12.2    5.2.0
      v5.12.3    5.2.0
      v5.12.4    5.2.0
      v5.13.0    5.2.0
      v5.13.1    5.2.0
      v5.13.2    5.2.0
      v5.13.3    5.2.0
      v5.13.4    5.2.0
      v5.13.5    5.2.0
      v5.13.6    5.2.0
      v5.13.7    6.0.0
      v5.13.8    6.0.0
      v5.13.9    6.0.0
      v5.13.10   6.0.0
      v5.13.11   6.0.0
      v5.14.0    6.0.0
      v5.14.1    6.0.0
      v5.15.0    6.0.0

=item -d

finds the first perl version where a module has been released by
date, and not by version number (as is the default).

=item --diff

Given two versions of perl, this prints a human-readable table of all module
changes between the two.  The output format may change in the future, and is
meant for I<humans>, not programs.  For programs, use the L<Module::CoreList>
API.

=item -? or -help

help! help! help! to see more help, try --man.

=item -man

all of the help

=item -v

lists all of the perl release versions we got the CoreList for.

If you pass a version argument (value of C<$]>, like C<5.00503> or C<5.008008>),
you get a list of all the modules and their respective versions.
(If you have the C<version> module, you can also use new-style version numbers,
like C<5.8.8>.)

In module filtering context, it can be used as Perl version filter.

=item -r

lists all of the perl releases and when they were released

If you pass a perl version you get the release date for that version only.

=item --feature, -f

lists the first version bundle of each named feature given

=item --upstream, -u

Shows if the given module is primarily maintained in perl core or on CPAN
and bug tracker URL.

=back

As a special case, if you specify the module name C<Unicode>, you'll get
the version number of the Unicode Character Database bundled with the
requested perl versions.

=cut

BEGIN { pop @INC if $INC[-1] eq '.' }
use Module::CoreList;
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use strict;
use warnings;
use List::Util qw/maxstr/;

my %Opts;

GetOptions(
    \%Opts,
    qw[ help|?! man! r|release:s v|version:s a! d diff|D feature|f u|upstream ]
);

pod2usage(1) if $Opts{help};
pod2usage(-verbose=>2) if $Opts{man};

if(exists $Opts{r} ){
    if ( !$Opts{r} ) {
        print "\nModule::CoreList has release info for the following perl versions:\n";
        my $versions = { };
        my $max_ver_len = max_mod_len(\%Module::CoreList::released);
        for my $ver ( grep !/0[01]0$/, sort keys %Module::CoreList::released ) {
          printf "%-${max_ver_len}s    %s\n", format_perl_version($ver), $Module::CoreList::released{$ver};
        }
        print "\n";
        exit 0;
    }

    my $num_r = numify_version( $Opts{r} );
    my $version_hash = Module::CoreList->find_version($num_r);

    if( !$version_hash ) {
        print "\nModule::CoreList has no info on perl $Opts{r}\n\n";
        exit 1;
    }

    printf "Perl %s was released on %s\n\n", format_perl_version($num_r), $Module::CoreList::released{$num_r};
    exit 0;
}

if(exists $Opts{v} ){
    if( !$Opts{v} ) {
        print "\nModule::CoreList has info on the following perl versions:\n";
        print format_perl_version($_)."\n" for grep !/0[01]0$/, sort keys %Module::CoreList::version;
        print "\n";
        exit 0;
    }

    my $num_v = numify_version( $Opts{v} );
    my $version_hash = Module::CoreList->find_version($num_v);

    if( !$version_hash ) {
        print "\nModule::CoreList has no info on perl $Opts{v}\n\n";
        exit 1;
    }

    if ( !@ARGV ) {
	print "\nThe following modules were in perl $Opts{v} CORE\n";
	my $max_mod_len = max_mod_len($version_hash);
	for my $mod ( sort keys %$version_hash ) {
	    printf "%-${max_mod_len}s  %s\n", $mod, $version_hash->{$mod} || "";
	}
	print "\n";
	exit 0;
    }
}

if ($Opts{diff}) {
    if(@ARGV != 2) {
        die "\nprovide exactly two perl core versions to diff with --diff\n";
    }

    my ($old_ver, $new_ver) = @ARGV;

    my $old = numify_version($old_ver);
    my $new = numify_version($new_ver);

    my %diff = Module::CoreList::changes_between($old, $new);

    for my $lib (sort keys %diff) {
      my $diff = $diff{$lib};

      my $was = ! exists  $diff->{left} ? '(absent)'
              : ! defined $diff->{left} ? '(undef)'
              :                          $diff->{left};

      my $now = ! exists  $diff->{right} ? '(absent)'
              : ! defined $diff->{right} ? '(undef)'
              :                          $diff->{right};

        printf "%-35s %10s %10s\n", $lib, $was, $now;
    }
    exit(0);
}

if ($Opts{feature}) {
    die "\n--feature is only available with perl v5.16.0 or greater\n"
      if $] < 5.016;

    die "\nprovide at least one feature name to --feature\n"
        unless @ARGV;

    no warnings 'once';
    require feature;

    my %feature2version;
    my @bundles =  map { $_->[0] }
                  sort { $b->[1] <=> $a->[1] }
                   map { [$_, numify_version($_)] }
                  grep { not /[^0-9.]/ }
                  keys %feature::feature_bundle;

    for my $version (@bundles) {
        $feature2version{$_} = $version =~ /^\d\.\d+$/ ? "$version.0" : $version
            for @{ $feature::feature_bundle{$version} };
    }

    # allow internal feature names, just in case someone gives us __SUB__
    # instead of current_sub.
    while (my ($name, $internal) = each %feature::feature) {
        $internal =~ s/^feature_//;
        $feature2version{$internal} = $feature2version{$name}
            if $feature2version{$name};
    }

    my $when = maxstr(values %Module::CoreList::released);
    print "\n","Data for $when\n";

    for my $feature (@ARGV) {
        print "feature \"$feature\" ",
            exists $feature2version{$feature}
                ? "was first released with the perl "
                  . format_perl_version(numify_version($feature2version{$feature}))
                  . " feature bundle\n"
                : "doesn't exist (or so I think)\n";
    }
    exit(0);
}

if ( !@ARGV ) {
    pod2usage(0);
}

while (@ARGV) {
	my ($mod, $ver);
	if ($ARGV[0] =~ /=/) {
	    ($mod, $ver) = split /=/, shift @ARGV;
	} else {
	    $mod = shift @ARGV;
	    $ver = (@ARGV && $ARGV[0] =~ /^\d/) ? shift @ARGV : "";
	}

	if ($mod !~ m|^/(.*)/([imosx]*)$|) { # not a regex
	    module_version($mod,$ver);
	} else {
	    my $re;
	    eval { $re = $2 ? qr/(?$2)($1)/ : qr/$1/; }; # trap exceptions while building regex
	    if ($@) {
		# regex errors are usually like 'Quantifier follow nothing in regex; marked by ...'
		# then we drop text after ';' to shorten message
		my $errmsg = $@ =~ /(.*);/ ? $1 : $@;
		warn "\n$mod  is a bad regex: $errmsg\n";
		next;
	    }
	    my @mod = Module::CoreList->find_modules($re);
	    if (@mod) {
		module_version($_, $ver) for @mod;
	    } else {
		$ver |= '';
		print "\n$mod $ver has no match in CORE (or so I think)\n";
	    }

	}
}

exit();

sub module_version {
    my($mod,$ver) = @_;

    if ( $Opts{v} ) {
	my $numeric_v = numify_version($Opts{v});
	my $version_hash = Module::CoreList->find_version($numeric_v);
	if ($version_hash) {
	    print $mod, " ", $version_hash->{$mod} || 'undef', "\n";
	    return;
	}
	else { die "Shouldn't happen" }
    }

    my $ret = $Opts{d}
	? Module::CoreList->first_release_by_date(@_)
	: Module::CoreList->first_release(@_);
    my $msg = $mod;
    $msg .= " $ver" if $ver;

    my $rem = $Opts{d}
	? Module::CoreList->removed_from_by_date($mod)
	: Module::CoreList->removed_from($mod);

	my $when = maxstr(values %Module::CoreList::released);
    print "\n","Data for $when\n";

    if( defined $ret ) {
        my $deprecated = Module::CoreList->deprecated_in($mod);
        $msg .= " was ";
        $msg .= "first " unless $ver;
        $msg .= "released with perl " . format_perl_version($ret);
        $msg .= ( $rem ? ',' : ' and' ) . " deprecated (will be CPAN-only) in " . format_perl_version($deprecated) if $deprecated;
        $msg .= " and removed from " . format_perl_version($rem) if $rem;
    } else {
        $msg .= " was not in CORE (or so I think)";
    }

    print $msg,"\n";

    if( defined $ret and exists $Opts{u} ) {
        my $upstream = $Module::CoreList::upstream{$mod};
        $upstream = 'undef' unless $upstream;
        print "upstream: $upstream\n";
        if ( $upstream ne 'blead' ) {
            my $bugtracker = $Module::CoreList::bug_tracker{$mod};
            $bugtracker = 'unknown' unless $bugtracker;
            print "bug tracker: $bugtracker\n";
        }
    }

    if(defined $ret and exists $Opts{a} and $Opts{a}){
        display_a($mod);
    }
}


sub max_mod_len {
    my $versions = shift;
    my $max = 0;
    for my $mod (keys %$versions) {
        $max = max($max, length $mod);
    }

    return $max;
}

sub max {
    my($this, $that) = @_;
    return $this if $this > $that;
    return $that;
}

sub display_a {
    my $mod = shift;

    for my $v (grep !/0[01]0$/, sort keys %Module::CoreList::version ) {
        next unless exists $Module::CoreList::version{$v}{$mod};

        my $mod_v = $Module::CoreList::version{$v}{$mod} || 'undef';
        printf "  %-10s %-10s\n", format_perl_version($v), $mod_v;
    }
    print "\n";
}


{
    my $have_version_pm;
    sub have_version_pm {
        return $have_version_pm if defined $have_version_pm;
        return $have_version_pm = eval { require version; 1 };
    }
}


sub format_perl_version {
    my $v = shift;
    return $v if $v < 5.006 or !have_version_pm;
    return version->new($v)->normal;
}


sub numify_version {
    my $ver = shift;
    if ($ver =~ /\..+\./) {
	have_version_pm()
	    or die "You need to install version.pm to use dotted version numbers\n";
        $ver = version->new($ver)->numify;
    }
    $ver += 0;
    return $ver;
}

=head1 EXAMPLES

    $ corelist File::Spec

    File::Spec was first released with perl 5.005

    $ corelist File::Spec 0.83

    File::Spec 0.83 was released with perl 5.007003

    $ corelist File::Spec 0.89

    File::Spec 0.89 was not in CORE (or so I think)

    $ corelist File::Spec::Aliens

    File::Spec::Aliens  was not in CORE (or so I think)

    $ corelist /IPC::Open/

    IPC::Open2 was first released with perl 5

    IPC::Open3 was first released with perl 5

    $ corelist /MANIFEST/i

    ExtUtils::Manifest was first released with perl 5.001

    $ corelist /Template/

    /Template/  has no match in CORE (or so I think)

    $ corelist -v 5.8.8 B

    B                        1.09_01

    $ corelist -v 5.8.8 /^B::/

    B::Asmdata               1.01
    B::Assembler             0.07
    B::Bblock                1.02_01
    B::Bytecode              1.01_01
    B::C                     1.04_01
    B::CC                    1.00_01
    B::Concise               0.66
    B::Debug                 1.02_01
    B::Deparse               0.71
    B::Disassembler          1.05
    B::Lint                  1.03
    B::O                     1.00
    B::Showlex               1.02
    B::Stackobj              1.00
    B::Stash                 1.00
    B::Terse                 1.03_01
    B::Xref                  1.01

=head1 COPYRIGHT

Copyright (c) 2002-2007 by D.H. aka PodMaster

Currently maintained by the perl 5 porters E<lt>perl5-porters@perl.orgE<gt>.

This program is distributed under the same terms as perl itself.
See http://perl.org/ or http://cpan.org/ for more info on that.

=cut
Commit	Line	Data
aee92da2	1	#!/usr/bin/perl
8f2fd531 JB	2
	3	=head1 NAME
	4
	5	corelist - a commandline frontend to Module::CoreList
	6
	7	=head1 DESCRIPTION
	8
	9	See L<Module::CoreList> for one.
	10
	11	=head1 SYNOPSIS
	12
555bd962 BG	13	corelist -v
	14	corelist [-a\|-d] <ModuleName> \| /<ModuleRegex>/ [<ModuleVersion>] ...
	15	corelist [-v <PerlVersion>] [ <ModuleName> \| /<ModuleRegex>/ ] ...
	16	corelist [-r <PerlVersion>] ...
	17	corelist --feature <FeatureName> [<FeatureName>] ...
	18	corelist --diff PerlVersion PerlVersion
	19	corelist --upstream <ModuleName>
8f2fd531 JB	20
	21	=head1 OPTIONS
	22
567f8e5b RGS	23	=over
567f8e5b RGS	24
6127f3cd	25	=item -a
8f2fd531	26
87fbace9 RGS	27	lists all versions of the given module (or the matching modules, in case you
	28	used a module regexp) in the perls Module::CoreList knows about.
	29
4f38928e MB	30	corelist -a Unicode
	31
	32	Unicode was first released with perl v5.6.2
	33	v5.6.2 3.0.1
	34	v5.8.0 3.2.0
	35	v5.8.1 4.0.0
	36	v5.8.2 4.0.0
	37	v5.8.3 4.0.0
	38	v5.8.4 4.0.1
	39	v5.8.5 4.0.1
	40	v5.8.6 4.0.1
	41	v5.8.7 4.1.0
	42	v5.8.8 4.1.0
	43	v5.8.9 5.1.0
	44	v5.9.0 4.0.0
	45	v5.9.1 4.0.0
	46	v5.9.2 4.0.1
	47	v5.9.3 4.1.0
	48	v5.9.4 4.1.0
	49	v5.9.5 5.0.0
	50	v5.10.0 5.0.0
	51	v5.10.1 5.1.0
	52	v5.11.0 5.1.0
	53	v5.11.1 5.1.0
	54	v5.11.2 5.1.0
	55	v5.11.3 5.2.0
	56	v5.11.4 5.2.0
	57	v5.11.5 5.2.0
	58	v5.12.0 5.2.0
	59	v5.12.1 5.2.0
	60	v5.12.2 5.2.0
	61	v5.12.3 5.2.0
	62	v5.12.4 5.2.0
	63	v5.13.0 5.2.0
	64	v5.13.1 5.2.0
	65	v5.13.2 5.2.0
	66	v5.13.3 5.2.0
	67	v5.13.4 5.2.0
	68	v5.13.5 5.2.0
	69	v5.13.6 5.2.0
	70	v5.13.7 6.0.0
	71	v5.13.8 6.0.0
	72	v5.13.9 6.0.0
	73	v5.13.10 6.0.0
	74	v5.13.11 6.0.0
	75	v5.14.0 6.0.0
	76	v5.14.1 6.0.0
	77	v5.15.0 6.0.0
8f2fd531	78
6127f3cd RGS	79	=item -d
	80
	81	finds the first perl version where a module has been released by
	82	date, and not by version number (as is the default).
	83
835bc841 RS	84	=item --diff
	85
	86	Given two versions of perl, this prints a human-readable table of all module
	87	changes between the two. The output format may change in the future, and is
	88	meant for I<humans>, not programs. For programs, use the L<Module::CoreList>
	89	API.
	90
aee92da2	91	=item -? or -help
8f2fd531 JB	92
	93	help! help! help! to see more help, try --man.
	94
567f8e5b	95	=item -man
8f2fd531 JB	96
	97	all of the help
	98
567f8e5b	99	=item -v
8f2fd531 JB	100
	101	lists all of the perl release versions we got the CoreList for.
	102
87fbace9	103	If you pass a version argument (value of C<$]>, like C<5.00503> or C<5.008008>),
8f2fd531	104	you get a list of all the modules and their respective versions.
87fbace9 RGS	105	(If you have the C<version> module, you can also use new-style version numbers,
87fbace9 RGS	106	like C<5.8.8>.)
8f2fd531	107
0cecb811 RGS	108	In module filtering context, it can be used as Perl version filter.
0cecb811 RGS	109
dd413713 CBW	110	=item -r
	111
	112	lists all of the perl releases and when they were released
	113
	114	If you pass a perl version you get the release date for that version only.
	115
5f352ba2 TS	116	=item --feature, -f
	117
	118	lists the first version bundle of each named feature given
	119
d8a821fe AC	120	=item --upstream, -u
	121
	122	Shows if the given module is primarily maintained in perl core or on CPAN
	123	and bug tracker URL.
	124
567f8e5b	125	=back
8f2fd531	126
6f00ef79 RGS	127	As a special case, if you specify the module name C<Unicode>, you'll get
	128	the version number of the Unicode Character Database bundled with the
	129	requested perl versions.
	130
8f2fd531 JB	131	=cut
8f2fd531 JB	132
cee96d52	133	BEGIN { pop @INC if $INC[-1] eq '.' }
8f2fd531	134	use Module::CoreList;
81115207	135	use Getopt::Long qw(:config no_ignore_case);
8f2fd531 JB	136	use Pod::Usage;
8f2fd531 JB	137	use strict;
aee92da2	138	use warnings;
10526356	139	use List::Util qw/maxstr/;
8f2fd531 JB	140
	141	my %Opts;
	142
835bc841 RS	143	GetOptions(
835bc841 RS	144	\%Opts,
d8a821fe	145	qw[ help\|?! man! r\|release:s v\|version:s a! d diff\|D feature\|f u\|upstream ]
835bc841	146	);
8f2fd531 JB	147
	148	pod2usage(1) if $Opts{help};
	149	pod2usage(-verbose=>2) if $Opts{man};
	150
dd413713 CBW	151	if(exists $Opts{r} ){
	152	if ( !$Opts{r} ) {
	153	print "\nModule::CoreList has release info for the following perl versions:\n";
	154	my $versions = { };
	155	my $max_ver_len = max_mod_len(\%Module::CoreList::released);
8e036272	156	for my $ver ( grep !/0[01]0$/, sort keys %Module::CoreList::released ) {
dd413713 CBW	157	printf "%-${max_ver_len}s %s\n", format_perl_version($ver), $Module::CoreList::released{$ver};
	158	}
	159	print "\n";
	160	exit 0;
	161	}
	162
	163	my $num_r = numify_version( $Opts{r} );
	164	my $version_hash = Module::CoreList->find_version($num_r);
	165
	166	if( !$version_hash ) {
	167	print "\nModule::CoreList has no info on perl $Opts{r}\n\n";
	168	exit 1;
	169	}
	170
	171	printf "Perl %s was released on %s\n\n", format_perl_version($num_r), $Module::CoreList::released{$num_r};
	172	exit 0;
	173	}
	174
8f2fd531	175	if(exists $Opts{v} ){
0cecb811	176	if( !$Opts{v} ) {
b69ffb0c	177	print "\nModule::CoreList has info on the following perl versions:\n";
ff0f0afd	178	print format_perl_version($_)."\n" for grep !/0[01]0$/, sort keys %Module::CoreList::version;
8f2fd531	179	print "\n";
0cecb811 RGS	180	exit 0;
	181	}
	182
157ebcf5 MS	183	my $num_v = numify_version( $Opts{v} );
	184	my $version_hash = Module::CoreList->find_version($num_v);
	185
6127f3cd	186	if( !$version_hash ) {
157ebcf5	187	print "\nModule::CoreList has no info on perl $Opts{v}\n\n";
0cecb811	188	exit 1;
8f2fd531	189	}
0cecb811 RGS	190
0cecb811 RGS	191	if ( !@ARGV ) {
157ebcf5 MS	192	print "\nThe following modules were in perl $Opts{v} CORE\n";
	193	my $max_mod_len = max_mod_len($version_hash);
	194	for my $mod ( sort keys %$version_hash ) {
	195	printf "%-${max_mod_len}s %s\n", $mod, $version_hash->{$mod} \|\| "";
	196	}
0cecb811 RGS	197	print "\n";
	198	exit 0;
	199	}
	200	}
	201
835bc841 RS	202	if ($Opts{diff}) {
	203	if(@ARGV != 2) {
	204	die "\nprovide exactly two perl core versions to diff with --diff\n";
	205	}
	206
	207	my ($old_ver, $new_ver) = @ARGV;
	208
797ced94 RS	209	my $old = numify_version($old_ver);
797ced94 RS	210	my $new = numify_version($new_ver);
835bc841	211
797ced94	212	my %diff = Module::CoreList::changes_between($old, $new);
835bc841	213
797ced94 RS	214	for my $lib (sort keys %diff) {
797ced94 RS	215	my $diff = $diff{$lib};
835bc841	216
797ced94 RS	217	my $was = ! exists $diff->{left} ? '(absent)'
	218	: ! defined $diff->{left} ? '(undef)'
	219	: $diff->{left};
	220
	221	my $now = ! exists $diff->{right} ? '(absent)'
	222	: ! defined $diff->{right} ? '(undef)'
	223	: $diff->{right};
	224
	225	printf "%-35s %10s %10s\n", $lib, $was, $now;
835bc841 RS	226	}
	227	exit(0);
	228	}
	229
5f352ba2	230	if ($Opts{feature}) {
352d600d CBW	231	die "\n--feature is only available with perl v5.16.0 or greater\n"
352d600d CBW	232	if $] < 5.016;
81648096	233
5f352ba2 TS	234	die "\nprovide at least one feature name to --feature\n"
	235	unless @ARGV;
	236
	237	no warnings 'once';
	238	require feature;
	239
	240	my %feature2version;
	241	my @bundles = map { $_->[0] }
	242	sort { $b->[1] <=> $a->[1] }
	243	map { [$_, numify_version($_)] }
	244	grep { not /[^0-9.]/ }
	245	keys %feature::feature_bundle;
	246
	247	for my $version (@bundles) {
	248	$feature2version{$_} = $version =~ /^\d\.\d+$/ ? "$version.0" : $version
	249	for @{ $feature::feature_bundle{$version} };
	250	}
	251
	252	# allow internal feature names, just in case someone gives us __SUB__
	253	# instead of current_sub.
	254	while (my ($name, $internal) = each %feature::feature) {
	255	$internal =~ s/^feature_//;
	256	$feature2version{$internal} = $feature2version{$name}
	257	if $feature2version{$name};
	258	}
	259
	260	my $when = maxstr(values %Module::CoreList::released);
	261	print "\n","Data for $when\n";
	262
	263	for my $feature (@ARGV) {
	264	print "feature \"$feature\" ",
	265	exists $feature2version{$feature}
	266	? "was first released with the perl "
	267	. format_perl_version(numify_version($feature2version{$feature}))
	268	. " feature bundle\n"
	269	: "doesn't exist (or so I think)\n";
	270	}
	271	exit(0);
	272	}
	273
0cecb811 RGS	274	if ( !@ARGV ) {
	275	pod2usage(0);
	276	}
	277
	278	while (@ARGV) {
567f8e5b RGS	279	my ($mod, $ver);
	280	if ($ARGV[0] =~ /=/) {
	281	($mod, $ver) = split /=/, shift @ARGV;
	282	} else {
	283	$mod = shift @ARGV;
	284	$ver = (@ARGV && $ARGV[0] =~ /^\d/) ? shift @ARGV : "";
	285	}
18b19aec RGS	286
	287	if ($mod !~ m\|^/(.)/([imosx])$\|) { # not a regex
	288	module_version($mod,$ver);
	289	} else {
	290	my $re;
	291	eval { $re = $2 ? qr/(?$2)($1)/ : qr/$1/; }; # trap exceptions while building regex
	292	if ($@) {
	293	# regex errors are usually like 'Quantifier follow nothing in regex; marked by ...'
	294	# then we drop text after ';' to shorten message
	295	my $errmsg = $@ =~ /(.*);/ ? $1 : $@;
	296	warn "\n$mod is a bad regex: $errmsg\n";
	297	next;
	298	}
	299	my @mod = Module::CoreList->find_modules($re);
	300	if (@mod) {
	301	module_version($_, $ver) for @mod;
	302	} else {
	303	$ver \|= '';
	304	print "\n$mod $ver has no match in CORE (or so I think)\n";
	305	}
	306
	307	}
8f2fd531 JB	308	}
	309
	310	exit();
	311
	312	sub module_version {
	313	my($mod,$ver) = @_;
	314
0cecb811	315	if ( $Opts{v} ) {
157ebcf5 MS	316	my $numeric_v = numify_version($Opts{v});
157ebcf5 MS	317	my $version_hash = Module::CoreList->find_version($numeric_v);
6127f3cd RGS	318	if ($version_hash) {
	319	print $mod, " ", $version_hash->{$mod} \|\| 'undef', "\n";
	320	return;
	321	}
	322	else { die "Shouldn't happen" }
0cecb811 RGS	323	}
0cecb811 RGS	324
6127f3cd RGS	325	my $ret = $Opts{d}
	326	? Module::CoreList->first_release_by_date(@_)
	327	: Module::CoreList->first_release(@_);
f9cff7e6 RGS	328	my $msg = $mod;
f9cff7e6 RGS	329	$msg .= " $ver" if $ver;
8f2fd531	330
044d64a8 CBW	331	my $rem = $Opts{d}
	332	? Module::CoreList->removed_from_by_date($mod)
	333	: Module::CoreList->removed_from($mod);
	334
10526356 AC	335	my $when = maxstr(values %Module::CoreList::released);
	336	print "\n","Data for $when\n";
	337
8f2fd531	338	if( defined $ret ) {
10526356	339	my $deprecated = Module::CoreList->deprecated_in($mod);
8f2fd531 JB	340	$msg .= " was ";
8f2fd531 JB	341	$msg .= "first " unless $ver;
044d64a8	342	$msg .= "released with perl " . format_perl_version($ret);
d8a821fe	343	$msg .= ( $rem ? ',' : ' and' ) . " deprecated (will be CPAN-only) in " . format_perl_version($deprecated) if $deprecated;
044d64a8	344	$msg .= " and removed from " . format_perl_version($rem) if $rem;
8f2fd531 JB	345	} else {
	346	$msg .= " was not in CORE (or so I think)";
	347	}
	348
10526356	349	print $msg,"\n";
567f8e5b	350
d8a821fe	351	if( defined $ret and exists $Opts{u} ) {
88223661 TS	352	my $upstream = $Module::CoreList::upstream{$mod};
	353	$upstream = 'undef' unless $upstream;
	354	print "upstream: $upstream\n";
	355	if ( $upstream ne 'blead' ) {
d8a821fe AC	356	my $bugtracker = $Module::CoreList::bug_tracker{$mod};
	357	$bugtracker = 'unknown' unless $bugtracker;
	358	print "bug tracker: $bugtracker\n";
	359	}
	360	}
	361
8f2fd531	362	if(defined $ret and exists $Opts{a} and $Opts{a}){
157ebcf5 MS	363	display_a($mod);
	364	}
	365	}
	366
	367
	368	sub max_mod_len {
	369	my $versions = shift;
	370	my $max = 0;
	371	for my $mod (keys %$versions) {
	372	$max = max($max, length $mod);
8f2fd531	373	}
157ebcf5 MS	374
	375	return $max;
	376	}
	377
	378	sub max {
	379	my($this, $that) = @_;
	380	return $this if $this > $that;
	381	return $that;
8f2fd531 JB	382	}
8f2fd531 JB	383
157ebcf5 MS	384	sub display_a {
	385	my $mod = shift;
	386
ff0f0afd	387	for my $v (grep !/0[01]0$/, sort keys %Module::CoreList::version ) {
157ebcf5 MS	388	next unless exists $Module::CoreList::version{$v}{$mod};
	389
	390	my $mod_v = $Module::CoreList::version{$v}{$mod} \|\| 'undef';
	391	printf " %-10s %-10s\n", format_perl_version($v), $mod_v;
	392	}
	393	print "\n";
	394	}
	395
	396
	397	{
	398	my $have_version_pm;
	399	sub have_version_pm {
	400	return $have_version_pm if defined $have_version_pm;
	401	return $have_version_pm = eval { require version; 1 };
	402	}
	403	}
	404
	405
	406	sub format_perl_version {
	407	my $v = shift;
	408	return $v if $v < 5.006 or !have_version_pm;
	409	return version->new($v)->normal;
	410	}
	411
	412
0cecb811 RGS	413	sub numify_version {
0cecb811 RGS	414	my $ver = shift;
6127f3cd	415	if ($ver =~ /\..+\./) {
157ebcf5	416	have_version_pm()
6127f3cd	417	or die "You need to install version.pm to use dotted version numbers\n";
0cecb811 RGS	418	$ver = version->new($ver)->numify;
0cecb811 RGS	419	}
6127f3cd	420	$ver += 0;
0cecb811 RGS	421	return $ver;
0cecb811 RGS	422	}
8f2fd531 JB	423
	424	=head1 EXAMPLES
	425
	426	$ corelist File::Spec
	427
f9cff7e6	428	File::Spec was first released with perl 5.005
8f2fd531 JB	429
	430	$ corelist File::Spec 0.83
	431
	432	File::Spec 0.83 was released with perl 5.007003
	433
	434	$ corelist File::Spec 0.89
	435
	436	File::Spec 0.89 was not in CORE (or so I think)
	437
	438	$ corelist File::Spec::Aliens
	439
	440	File::Spec::Aliens was not in CORE (or so I think)
	441
18b19aec RGS	442	$ corelist /IPC::Open/
18b19aec RGS	443
f9cff7e6	444	IPC::Open2 was first released with perl 5
18b19aec	445
f9cff7e6	446	IPC::Open3 was first released with perl 5
18b19aec RGS	447
	448	$ corelist /MANIFEST/i
	449
f9cff7e6	450	ExtUtils::Manifest was first released with perl 5.001
18b19aec RGS	451
	452	$ corelist /Template/
	453
	454	/Template/ has no match in CORE (or so I think)
	455
0cecb811 RGS	456	$ corelist -v 5.8.8 B
	457
	458	B 1.09_01
	459
	460	$ corelist -v 5.8.8 /^B::/
	461
	462	B::Asmdata 1.01
	463	B::Assembler 0.07
	464	B::Bblock 1.02_01
	465	B::Bytecode 1.01_01
	466	B::C 1.04_01
	467	B::CC 1.00_01
	468	B::Concise 0.66
	469	B::Debug 1.02_01
	470	B::Deparse 0.71
	471	B::Disassembler 1.05
	472	B::Lint 1.03
	473	B::O 1.00
	474	B::Showlex 1.02
	475	B::Stackobj 1.00
	476	B::Stash 1.00
	477	B::Terse 1.03_01
	478	B::Xref 1.01
18b19aec	479
8f2fd531 JB	480	=head1 COPYRIGHT
8f2fd531 JB	481
6f00ef79	482	Copyright (c) 2002-2007 by D.H. aka PodMaster
567f8e5b	483
6f00ef79	484	Currently maintained by the perl 5 porters E<lt>perl5-porters@perl.orgE<gt>.
8f2fd531 JB	485
8f2fd531 JB	486	This program is distributed under the same terms as perl itself.
f372d768	487	See http://perl.org/ or http://cpan.org/ for more info on that.
8f2fd531 JB	488
8f2fd531 JB	489	=cut