d2fb4ad0c751cd8f5bcf5da92e15435145f41574
[perl.git] / dist / Module-CoreList / corelist
1 #!/usr/bin/perl
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
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>
20
21 =head1 OPTIONS
22
23 =over
24
25 =item -a
26
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
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
78
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
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
91 =item -? or -help
92
93 help! help! help! to see more help, try --man.
94
95 =item -man
96
97 all of the help
98
99 =item -v
100
101 lists all of the perl release versions we got the CoreList for.
102
103 If you pass a version argument (value of C<$]>, like C<5.00503> or C<5.008008>),
104 you get a list of all the modules and their respective versions.
105 (If you have the C<version> module, you can also use new-style version numbers,
106 like C<5.8.8>.)
107
108 In module filtering context, it can be used as Perl version filter.
109
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
116 =item --feature, -f
117
118 lists the first version bundle of each named feature given
119
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
125 =back
126
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
131 =cut
132
133 use Module::CoreList;
134 use Getopt::Long qw(:config no_ignore_case);
135 use Pod::Usage;
136 use strict;
137 use warnings;
138 use List::Util qw/maxstr/;
139
140 my %Opts;
141
142 GetOptions(
143     \%Opts,
144     qw[ help|?! man! r|release:s v|version:s a! d diff|D feature|f u|upstream ]
145 );
146
147 pod2usage(1) if $Opts{help};
148 pod2usage(-verbose=>2) if $Opts{man};
149
150 if(exists $Opts{r} ){
151     if ( !$Opts{r} ) {
152         print "\nModule::CoreList has release info for the following perl versions:\n";
153         my $versions = { };
154         my $max_ver_len = max_mod_len(\%Module::CoreList::released);
155         for my $ver ( sort keys %Module::CoreList::released ) {
156           printf "%-${max_ver_len}s    %s\n", format_perl_version($ver), $Module::CoreList::released{$ver};
157         }
158         print "\n";
159         exit 0;
160     }
161
162     my $num_r = numify_version( $Opts{r} );
163     my $version_hash = Module::CoreList->find_version($num_r);
164
165     if( !$version_hash ) {
166         print "\nModule::CoreList has no info on perl $Opts{r}\n\n";
167         exit 1;
168     }
169
170     printf "Perl %s was released on %s\n\n", format_perl_version($num_r), $Module::CoreList::released{$num_r};
171     exit 0;
172 }
173
174 if(exists $Opts{v} ){
175     if( !$Opts{v} ) {
176         print "\nModule::CoreList has info on the following perl versions:\n";
177         print format_perl_version($_)."\n" for grep !/0[01]0$/, sort keys %Module::CoreList::version;
178         print "\n";
179         exit 0;
180     }
181
182     my $num_v = numify_version( $Opts{v} );
183     my $version_hash = Module::CoreList->find_version($num_v);
184
185     if( !$version_hash ) {
186         print "\nModule::CoreList has no info on perl $Opts{v}\n\n";
187         exit 1;
188     }
189
190     if ( !@ARGV ) {
191         print "\nThe following modules were in perl $Opts{v} CORE\n";
192         my $max_mod_len = max_mod_len($version_hash);
193         for my $mod ( sort keys %$version_hash ) {
194             printf "%-${max_mod_len}s  %s\n", $mod, $version_hash->{$mod} || "";
195         }
196         print "\n";
197         exit 0;
198     }
199 }
200
201 if ($Opts{diff}) {
202     if(@ARGV != 2) {
203         die "\nprovide exactly two perl core versions to diff with --diff\n";
204     }
205
206     my ($old_ver, $new_ver) = @ARGV;
207
208     my $old = numify_version($old_ver);
209     my $new = numify_version($new_ver);
210
211     my %diff = Module::CoreList::changes_between($old, $new);
212
213     for my $lib (sort keys %diff) {
214       my $diff = $diff{$lib};
215
216       my $was = ! exists  $diff->{left} ? '(absent)'
217               : ! defined $diff->{left} ? '(undef)'
218               :                          $diff->{left};
219
220       my $now = ! exists  $diff->{right} ? '(absent)'
221               : ! defined $diff->{right} ? '(undef)'
222               :                          $diff->{right};
223
224         printf "%-35s %10s %10s\n", $lib, $was, $now;
225     }
226     exit(0);
227 }
228
229 if ($Opts{feature}) {
230     die "\n--feature is only available with perl v5.16.0 or greater\n"
231       if $] < 5.016;
232
233     die "\nprovide at least one feature name to --feature\n"
234         unless @ARGV;
235
236     no warnings 'once';
237     require feature;
238
239     my %feature2version;
240     my @bundles =  map { $_->[0] }
241                   sort { $b->[1] <=> $a->[1] }
242                    map { [$_, numify_version($_)] }
243                   grep { not /[^0-9.]/ }
244                   keys %feature::feature_bundle;
245
246     for my $version (@bundles) {
247         $feature2version{$_} = $version =~ /^\d\.\d+$/ ? "$version.0" : $version
248             for @{ $feature::feature_bundle{$version} };
249     }
250
251     # allow internal feature names, just in case someone gives us __SUB__
252     # instead of current_sub.
253     while (my ($name, $internal) = each %feature::feature) {
254         $internal =~ s/^feature_//;
255         $feature2version{$internal} = $feature2version{$name}
256             if $feature2version{$name};
257     }
258
259     my $when = maxstr(values %Module::CoreList::released);
260     print "\n","Data for $when\n";
261
262     for my $feature (@ARGV) {
263         print "feature \"$feature\" ",
264             exists $feature2version{$feature}
265                 ? "was first released with the perl "
266                   . format_perl_version(numify_version($feature2version{$feature}))
267                   . " feature bundle\n"
268                 : "doesn't exist (or so I think)\n";
269     }
270     exit(0);
271 }
272
273 if ( !@ARGV ) {
274     pod2usage(0);
275 }
276
277 while (@ARGV) {
278         my ($mod, $ver);
279         if ($ARGV[0] =~ /=/) {
280             ($mod, $ver) = split /=/, shift @ARGV;
281         } else {
282             $mod = shift @ARGV;
283             $ver = (@ARGV && $ARGV[0] =~ /^\d/) ? shift @ARGV : "";
284         }
285
286         if ($mod !~ m|^/(.*)/([imosx]*)$|) { # not a regex
287             module_version($mod,$ver);
288         } else {
289             my $re;
290             eval { $re = $2 ? qr/(?$2)($1)/ : qr/$1/; }; # trap exceptions while building regex
291             if ($@) {
292                 # regex errors are usually like 'Quantifier follow nothing in regex; marked by ...'
293                 # then we drop text after ';' to shorten message
294                 my $errmsg = $@ =~ /(.*);/ ? $1 : $@;
295                 warn "\n$mod  is a bad regex: $errmsg\n";
296                 next;
297             }
298             my @mod = Module::CoreList->find_modules($re);
299             if (@mod) {
300                 module_version($_, $ver) for @mod;
301             } else {
302                 $ver |= '';
303                 print "\n$mod $ver has no match in CORE (or so I think)\n";
304             }
305
306         }
307 }
308
309 exit();
310
311 sub module_version {
312     my($mod,$ver) = @_;
313
314     if ( $Opts{v} ) {
315         my $numeric_v = numify_version($Opts{v});
316         my $version_hash = Module::CoreList->find_version($numeric_v);
317         if ($version_hash) {
318             print $mod, " ", $version_hash->{$mod} || 'undef', "\n";
319             return;
320         }
321         else { die "Shouldn't happen" }
322     }
323
324     my $ret = $Opts{d}
325         ? Module::CoreList->first_release_by_date(@_)
326         : Module::CoreList->first_release(@_);
327     my $msg = $mod;
328     $msg .= " $ver" if $ver;
329
330     my $rem = $Opts{d}
331         ? Module::CoreList->removed_from_by_date($mod)
332         : Module::CoreList->removed_from($mod);
333
334         my $when = maxstr(values %Module::CoreList::released);
335     print "\n","Data for $when\n";
336
337     if( defined $ret ) {
338         my $deprecated = Module::CoreList->deprecated_in($mod);
339         $msg .= " was ";
340         $msg .= "first " unless $ver;
341         $msg .= "released with perl " . format_perl_version($ret);
342         $msg .= ( $rem ? ',' : ' and' ) . " deprecated (will be CPAN-only) in " . format_perl_version($deprecated) if $deprecated;
343         $msg .= " and removed from " . format_perl_version($rem) if $rem;
344     } else {
345         $msg .= " was not in CORE (or so I think)";
346     }
347
348     print $msg,"\n";
349
350     if( defined $ret and exists $Opts{u} ) {
351         my $upsream = $Module::CoreList::upstream{$mod};
352         $upsream = 'undef' unless $upsream;
353         print "upstream: $upsream\n";
354         if ( $upsream ne 'blead' ) {
355             my $bugtracker = $Module::CoreList::bug_tracker{$mod};
356             $bugtracker = 'unknown' unless $bugtracker;
357             print "bug tracker: $bugtracker\n";
358         }
359     }
360
361     if(defined $ret and exists $Opts{a} and $Opts{a}){
362         display_a($mod);
363     }
364 }
365
366
367 sub max_mod_len {
368     my $versions = shift;
369     my $max = 0;
370     for my $mod (keys %$versions) {
371         $max = max($max, length $mod);
372     }
373
374     return $max;
375 }
376
377 sub max {
378     my($this, $that) = @_;
379     return $this if $this > $that;
380     return $that;
381 }
382
383 sub display_a {
384     my $mod = shift;
385
386     for my $v (grep !/0[01]0$/, sort keys %Module::CoreList::version ) {
387         next unless exists $Module::CoreList::version{$v}{$mod};
388
389         my $mod_v = $Module::CoreList::version{$v}{$mod} || 'undef';
390         printf "  %-10s %-10s\n", format_perl_version($v), $mod_v;
391     }
392     print "\n";
393 }
394
395
396 {
397     my $have_version_pm;
398     sub have_version_pm {
399         return $have_version_pm if defined $have_version_pm;
400         return $have_version_pm = eval { require version; 1 };
401     }
402 }
403
404
405 sub format_perl_version {
406     my $v = shift;
407     return $v if $v < 5.006 or !have_version_pm;
408     return version->new($v)->normal;
409 }
410
411
412 sub numify_version {
413     my $ver = shift;
414     if ($ver =~ /\..+\./) {
415         have_version_pm()
416             or die "You need to install version.pm to use dotted version numbers\n";
417         $ver = version->new($ver)->numify;
418     }
419     $ver += 0;
420     return $ver;
421 }
422
423 =head1 EXAMPLES
424
425     $ corelist File::Spec
426
427     File::Spec was first released with perl 5.005
428
429     $ corelist File::Spec 0.83
430
431     File::Spec 0.83 was released with perl 5.007003
432
433     $ corelist File::Spec 0.89
434
435     File::Spec 0.89 was not in CORE (or so I think)
436
437     $ corelist File::Spec::Aliens
438
439     File::Spec::Aliens  was not in CORE (or so I think)
440
441     $ corelist /IPC::Open/
442
443     IPC::Open2 was first released with perl 5
444
445     IPC::Open3 was first released with perl 5
446
447     $ corelist /MANIFEST/i
448
449     ExtUtils::Manifest was first released with perl 5.001
450
451     $ corelist /Template/
452
453     /Template/  has no match in CORE (or so I think)
454
455     $ corelist -v 5.8.8 B
456
457     B                        1.09_01
458
459     $ corelist -v 5.8.8 /^B::/
460
461     B::Asmdata               1.01
462     B::Assembler             0.07
463     B::Bblock                1.02_01
464     B::Bytecode              1.01_01
465     B::C                     1.04_01
466     B::CC                    1.00_01
467     B::Concise               0.66
468     B::Debug                 1.02_01
469     B::Deparse               0.71
470     B::Disassembler          1.05
471     B::Lint                  1.03
472     B::O                     1.00
473     B::Showlex               1.02
474     B::Stackobj              1.00
475     B::Stash                 1.00
476     B::Terse                 1.03_01
477     B::Xref                  1.01
478
479 =head1 COPYRIGHT
480
481 Copyright (c) 2002-2007 by D.H. aka PodMaster
482
483 Currently maintained by the perl 5 porters E<lt>perl5-porters@perl.orgE<gt>.
484
485 This program is distributed under the same terms as perl itself.
486 See http://perl.org/ or http://cpan.org/ for more info on that.
487
488 =cut