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