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 --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
  29 lists all versions of the given module (or the matching modules, in case you
  30 used 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
  83 finds the first perl version where a module has been released by
  84 date, and not by version number (as is the default).
  85
  86 =item --diff
  87
  88 Given two versions of perl, this prints a human-readable table of all module
  89 changes between the two.  The output format may change in the future, and is
  90 meant for I<humans>, not programs.  For programs, use the L<Module::CoreList>
  91 API.
  92
  93 =item -? or -help
  94
  95 help! help! help! to see more help, try --man.
  96
  97 =item -man
  98
  99 all of the help
 100
 101 =item -v
 102
 103 lists all of the perl release versions we got the CoreList for.
 104
 105 If you pass a version argument (value of C<$]>, like C<5.00503> or C<5.008008>),
 106 you 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,
 108 like C<5.8.8>.)
 109
 110 In module filtering context, it can be used as Perl version filter.
 111
 112 =item -r
 113
 114 lists all of the perl releases and when they were released
 115
 116 If you pass a perl version you get the release date for that version only.
 117
 118 =item --utils
 119
 120 lists the first version of perl each named utility program was released with
 121
 122 May be used with -d to modify the first release criteria.
 123
 124 If used with -v <version> then all utilities released with that version of perl
 125 are listed, and any utility programs named on the command line are ignored.
 126
 127 =item --feature, -f
 128
 129 lists the first version bundle of each named feature given
 130
 131 =item --upstream, -u
 132
 133 Shows if the given module is primarily maintained in perl core or on CPAN
 134 and bug tracker URL.
 135
 136 =back
 137
 138 As a special case, if you specify the module name C<Unicode>, you'll get
 139 the version number of the Unicode Character Database bundled with the
 140 requested perl versions.
 141
 142 =cut
 143
 144 BEGIN { pop @INC if $INC[-1] eq '.' }
 145 use Module::CoreList;
 146 use Getopt::Long qw(:config no_ignore_case);
 147 use Pod::Usage;
 148 use strict;
 149 use warnings;
 150 use List::Util qw/maxstr/;
 151
 152 my %Opts;
 153
 154 GetOptions(
 155     \%Opts,
 156     qw[ help|?! man! r|release:s v|version:s a! d diff|D utils feature|f u|upstream ]
 157 );
 158
 159 pod2usage(1) if $Opts{help};
 160 pod2usage(-verbose=>2) if $Opts{man};
 161
 162 if(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
 186 if(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
 219 if ($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
 255 if ($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
 274 if ($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
 318 if ( !@ARGV ) {
 319     pod2usage(0);
 320 }
 321
 322 while (@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
 354 exit();
 355
 356 sub 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
 411 sub 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
 434 sub 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
 453 sub 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
 463 sub max {
 464     my($this, $that) = @_;
 465     return $this if $this > $that;
 466     return $that;
 467 }
 468
 469 sub 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
 491 sub 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
 498 sub 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
 567 Copyright (c) 2002-2007 by D.H. aka PodMaster
 568
 569 Currently maintained by the perl 5 porters E<lt>perl5-porters@perl.orgE<gt>.
 570
 571 This program is distributed under the same terms as perl itself.
 572 See http://perl.org/ or http://cpan.org/ for more info on that.
 573
 574 =cut