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 ( grep !/0[01]0$/, 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