lib/Module/Metadata.pm

   1 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
   2 # vim:ts=8:sw=2:et:sta:sts=2
   3 package Module::Metadata;
   4
   5 # Adapted from Perl-licensed code originally distributed with
   6 # Module-Build by Ken Williams
   7
   8 # This module provides routines to gather information about
   9 # perl modules (assuming this may be expanded in the distant
  10 # parrot future to look at other types of modules).
  11
  12 use strict;
  13 use vars qw($VERSION);
  14 $VERSION = '1.000005';
  15 $VERSION = eval $VERSION;
  16
  17 use File::Spec;
  18 use IO::File;
  19 use version 0.87;
  20 BEGIN {
  21   if ($INC{'Log/Contextual.pm'}) {
  22     Log::Contextual->import('log_info');
  23   } else {
  24     *log_info = sub (&) { warn $_[0]->() };
  25   }
  26 }
  27 use File::Find qw(find);
  28
  29 my $V_NUM_REGEXP = qr{v?[0-9._]+};  # crudely, a v-string or decimal
  30
  31 my $PKG_REGEXP  = qr{   # match a package declaration
  32   ^[\s\{;]*             # intro chars on a line
  33   package               # the word 'package'
  34   \s+                   # whitespace
  35   ([\w:]+)              # a package name
  36   \s*                   # optional whitespace
  37   ($V_NUM_REGEXP)?        # optional version number
  38   \s*                   # optional whitesapce
  39   ;                     # semicolon line terminator
  40 }x;
  41
  42 my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
  43   ([\$*])         # sigil - $ or *
  44   (
  45     (             # optional leading package name
  46       (?:::|\')?  # possibly starting like just :: (Ì  la $::VERSION)
  47       (?:\w+(?:::|\'))*  # Foo::Bar:: ...
  48     )?
  49     VERSION
  50   )\b
  51 }x;
  52
  53 my $VERS_REGEXP = qr{ # match a VERSION definition
  54   (?:
  55     \(\s*$VARNAME_REGEXP\s*\) # with parens
  56   |
  57     $VARNAME_REGEXP           # without parens
  58   )
  59   \s*
  60   =[^=~]  # = but not ==, nor =~
  61 }x;
  62
  63
  64 sub new_from_file {
  65   my $class    = shift;
  66   my $filename = File::Spec->rel2abs( shift );
  67
  68   return undef unless defined( $filename ) && -f $filename;
  69   return $class->_init(undef, $filename, @_);
  70 }
  71
  72 sub new_from_module {
  73   my $class   = shift;
  74   my $module  = shift;
  75   my %props   = @_;
  76
  77   $props{inc} ||= \@INC;
  78   my $filename = $class->find_module_by_name( $module, $props{inc} );
  79   return undef unless defined( $filename ) && -f $filename;
  80   return $class->_init($module, $filename, %props);
  81 }
  82
  83 {
  84
  85   my $compare_versions = sub {
  86     my ($v1, $op, $v2) = @_;
  87     $v1 = version->new($v1)
  88       unless UNIVERSAL::isa($v1,'version');
  89
  90     my $eval_str = "\$v1 $op \$v2";
  91     my $result   = eval $eval_str;
  92     log_info { "error comparing versions: '$eval_str' $@" } if $@;
  93
  94     return $result;
  95   };
  96
  97   my $normalize_version = sub {
  98     my ($version) = @_;
  99     if ( $version =~ /[=<>!,]/ ) { # logic, not just version
 100       # take as is without modification
 101     }
 102     elsif ( ref $version eq 'version' ) { # version objects
 103       $version = $version->is_qv ? $version->normal : $version->stringify;
 104     }
 105     elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
 106       # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
 107       $version = "v$version";
 108     }
 109     else {
 110       # leave alone
 111     }
 112     return $version;
 113   };
 114
 115   # separate out some of the conflict resolution logic
 116
 117   my $resolve_module_versions = sub {
 118     my $packages = shift;
 119
 120     my( $file, $version );
 121     my $err = '';
 122       foreach my $p ( @$packages ) {
 123         if ( defined( $p->{version} ) ) {
 124         if ( defined( $version ) ) {
 125           if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
 126             $err .= "  $p->{file} ($p->{version})\n";
 127           } else {
 128             # same version declared multiple times, ignore
 129           }
 130         } else {
 131           $file    = $p->{file};
 132           $version = $p->{version};
 133         }
 134         }
 135         $file ||= $p->{file} if defined( $p->{file} );
 136       }
 137
 138     if ( $err ) {
 139       $err = "  $file ($version)\n" . $err;
 140     }
 141
 142     my %result = (
 143       file    => $file,
 144       version => $version,
 145       err     => $err
 146     );
 147
 148     return \%result;
 149   };
 150
 151   sub package_versions_from_directory {
 152     my ( $class, $dir, $files ) = @_;
 153
 154     my @files;
 155
 156     if ( $files ) {
 157       @files = @$files;
 158     } else {
 159       find( {
 160         wanted => sub {
 161           push @files, $_ if -f $_ && /\.pm$/;
 162         },
 163         no_chdir => 1,
 164       }, $dir );
 165     }
 166
 167     # First, we enumerate all packages & versions,
 168     # separating into primary & alternative candidates
 169     my( %prime, %alt );
 170     foreach my $file (@files) {
 171       my $mapped_filename = File::Spec->abs2rel( $file, $dir );
 172       my @path = split( /\//, $mapped_filename );
 173       (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
 174
 175       my $pm_info = $class->new_from_file( $file );
 176
 177       foreach my $package ( $pm_info->packages_inside ) {
 178         next if $package eq 'main';  # main can appear numerous times, ignore
 179         next if $package eq 'DB';    # special debugging package, ignore
 180         next if grep /^_/, split( /::/, $package ); # private package, ignore
 181
 182         my $version = $pm_info->version( $package );
 183
 184         if ( $package eq $prime_package ) {
 185           if ( exists( $prime{$package} ) ) {
 186             # M::B::ModuleInfo will handle this conflict
 187             die "Unexpected conflict in '$package'; multiple versions found.\n";
 188           } else {
 189             $prime{$package}{file} = $mapped_filename;
 190             $prime{$package}{version} = $version if defined( $version );
 191           }
 192         } else {
 193           push( @{$alt{$package}}, {
 194                                     file    => $mapped_filename,
 195                                     version => $version,
 196                                    } );
 197         }
 198       }
 199     }
 200
 201     # Then we iterate over all the packages found above, identifying conflicts
 202     # and selecting the "best" candidate for recording the file & version
 203     # for each package.
 204     foreach my $package ( keys( %alt ) ) {
 205       my $result = $resolve_module_versions->( $alt{$package} );
 206
 207       if ( exists( $prime{$package} ) ) { # primary package selected
 208
 209         if ( $result->{err} ) {
 210         # Use the selected primary package, but there are conflicting
 211         # errors among multiple alternative packages that need to be
 212         # reported
 213           log_info {
 214             "Found conflicting versions for package '$package'\n" .
 215             "  $prime{$package}{file} ($prime{$package}{version})\n" .
 216             $result->{err}
 217           };
 218
 219         } elsif ( defined( $result->{version} ) ) {
 220         # There is a primary package selected, and exactly one
 221         # alternative package
 222
 223         if ( exists( $prime{$package}{version} ) &&
 224              defined( $prime{$package}{version} ) ) {
 225           # Unless the version of the primary package agrees with the
 226           # version of the alternative package, report a conflict
 227           if ( $compare_versions->(
 228                  $prime{$package}{version}, '!=', $result->{version}
 229                )
 230              ) {
 231
 232             log_info {
 233               "Found conflicting versions for package '$package'\n" .
 234               "  $prime{$package}{file} ($prime{$package}{version})\n" .
 235               "  $result->{file} ($result->{version})\n"
 236             };
 237           }
 238
 239         } else {
 240           # The prime package selected has no version so, we choose to
 241           # use any alternative package that does have a version
 242           $prime{$package}{file}    = $result->{file};
 243           $prime{$package}{version} = $result->{version};
 244         }
 245
 246         } else {
 247         # no alt package found with a version, but we have a prime
 248         # package so we use it whether it has a version or not
 249         }
 250
 251       } else { # No primary package was selected, use the best alternative
 252
 253         if ( $result->{err} ) {
 254           log_info {
 255             "Found conflicting versions for package '$package'\n" .
 256             $result->{err}
 257           };
 258         }
 259
 260         # Despite possible conflicting versions, we choose to record
 261         # something rather than nothing
 262         $prime{$package}{file}    = $result->{file};
 263         $prime{$package}{version} = $result->{version}
 264           if defined( $result->{version} );
 265       }
 266     }
 267
 268     # Normalize versions.  Can't use exists() here because of bug in YAML::Node.
 269     # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
 270     for (grep defined $_->{version}, values %prime) {
 271       $_->{version} = $normalize_version->( $_->{version} );
 272     }
 273
 274     return \%prime;
 275   }
 276 }
 277
 278
 279 sub _init {
 280   my $class    = shift;
 281   my $module   = shift;
 282   my $filename = shift;
 283   my %props = @_;
 284
 285   my( %valid_props, @valid_props );
 286   @valid_props = qw( collect_pod inc );
 287   @valid_props{@valid_props} = delete( @props{@valid_props} );
 288   warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
 289
 290   my %data = (
 291     module       => $module,
 292     filename     => $filename,
 293     version      => undef,
 294     packages     => [],
 295     versions     => {},
 296     pod          => {},
 297     pod_headings => [],
 298     collect_pod  => 0,
 299
 300     %valid_props,
 301   );
 302
 303   my $self = bless(\%data, $class);
 304
 305   $self->_parse_file();
 306
 307   unless($self->{module} and length($self->{module})) {
 308     my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
 309     if($f =~ /\.pm$/) {
 310       $f =~ s/\..+$//;
 311       my @candidates = grep /$f$/, @{$self->{packages}};
 312       $self->{module} = shift(@candidates); # punt
 313     }
 314     else {
 315       if(grep /main/, @{$self->{packages}}) {
 316         $self->{module} = 'main';
 317       }
 318       else {
 319         $self->{module} = $self->{packages}[0] || '';
 320       }
 321     }
 322   }
 323
 324   $self->{version} = $self->{versions}{$self->{module}}
 325       if defined( $self->{module} );
 326
 327   return $self;
 328 }
 329
 330 # class method
 331 sub _do_find_module {
 332   my $class   = shift;
 333   my $module  = shift || die 'find_module_by_name() requires a package name';
 334   my $dirs    = shift || \@INC;
 335
 336   my $file = File::Spec->catfile(split( /::/, $module));
 337   foreach my $dir ( @$dirs ) {
 338     my $testfile = File::Spec->catfile($dir, $file);
 339     return [ File::Spec->rel2abs( $testfile ), $dir ]
 340         if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
 341     return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
 342         if -e "$testfile.pm";
 343   }
 344   return;
 345 }
 346
 347 # class method
 348 sub find_module_by_name {
 349   my $found = shift()->_do_find_module(@_) or return;
 350   return $found->[0];
 351 }
 352
 353 # class method
 354 sub find_module_dir_by_name {
 355   my $found = shift()->_do_find_module(@_) or return;
 356   return $found->[1];
 357 }
 358
 359
 360 # given a line of perl code, attempt to parse it if it looks like a
 361 # $VERSION assignment, returning sigil, full name, & package name
 362 sub _parse_version_expression {
 363   my $self = shift;
 364   my $line = shift;
 365
 366   my( $sig, $var, $pkg );
 367   if ( $line =~ $VERS_REGEXP ) {
 368     ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
 369     if ( $pkg ) {
 370       $pkg = ($pkg eq '::') ? 'main' : $pkg;
 371       $pkg =~ s/::$//;
 372     }
 373   }
 374
 375   return ( $sig, $var, $pkg );
 376 }
 377
 378 sub _parse_file {
 379   my $self = shift;
 380
 381   my $filename = $self->{filename};
 382   my $fh = IO::File->new( $filename )
 383     or die( "Can't open '$filename': $!" );
 384
 385   $self->_parse_fh($fh);
 386 }
 387
 388 sub _parse_fh {
 389   my ($self, $fh) = @_;
 390
 391   my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
 392   my( @pkgs, %vers, %pod, @pod );
 393   my $pkg = 'main';
 394   my $pod_sect = '';
 395   my $pod_data = '';
 396
 397   while (defined( my $line = <$fh> )) {
 398     my $line_num = $.;
 399
 400     chomp( $line );
 401     next if $line =~ /^\s*#/;
 402
 403     $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
 404
 405     # Would be nice if we could also check $in_string or something too
 406     last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
 407
 408     if ( $in_pod || $line =~ /^=cut/ ) {
 409
 410       if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
 411         push( @pod, $1 );
 412         if ( $self->{collect_pod} && length( $pod_data ) ) {
 413           $pod{$pod_sect} = $pod_data;
 414           $pod_data = '';
 415         }
 416         $pod_sect = $1;
 417
 418
 419       } elsif ( $self->{collect_pod} ) {
 420         $pod_data .= "$line\n";
 421
 422       }
 423
 424     } else {
 425
 426       $pod_sect = '';
 427       $pod_data = '';
 428
 429       # parse $line to see if it's a $VERSION declaration
 430       my( $vers_sig, $vers_fullname, $vers_pkg ) =
 431           $self->_parse_version_expression( $line );
 432
 433       if ( $line =~ $PKG_REGEXP ) {
 434         $pkg = $1;
 435         push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
 436         $vers{$pkg} = (defined $2 ? $2 : undef)  unless exists( $vers{$pkg} );
 437         $need_vers = defined $2 ? 0 : 1;
 438
 439       # VERSION defined with full package spec, i.e. $Module::VERSION
 440       } elsif ( $vers_fullname && $vers_pkg ) {
 441         push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
 442         $need_vers = 0 if $vers_pkg eq $pkg;
 443
 444         unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
 445           $vers{$vers_pkg} =
 446             $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 447         } else {
 448           # Warn unless the user is using the "$VERSION = eval
 449           # $VERSION" idiom (though there are probably other idioms
 450           # that we should watch out for...)
 451           warn <<"EOM" unless $line =~ /=\s*eval/;
 452 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
 453 ignoring subsequent declaration on line $line_num.
 454 EOM
 455         }
 456
 457       # first non-comment line in undeclared package main is VERSION
 458       } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
 459         $need_vers = 0;
 460         my $v =
 461           $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 462         $vers{$pkg} = $v;
 463         push( @pkgs, 'main' );
 464
 465       # first non-comment line in undeclared package defines package main
 466       } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
 467         $need_vers = 1;
 468         $vers{main} = '';
 469         push( @pkgs, 'main' );
 470
 471       # only keep if this is the first $VERSION seen
 472       } elsif ( $vers_fullname && $need_vers ) {
 473         $need_vers = 0;
 474         my $v =
 475           $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 476
 477
 478         unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
 479           $vers{$pkg} = $v;
 480         } else {
 481           warn <<"EOM";
 482 Package '$pkg' already declared with version '$vers{$pkg}'
 483 ignoring new version '$v' on line $line_num.
 484 EOM
 485         }
 486
 487       }
 488
 489     }
 490
 491   }
 492
 493   if ( $self->{collect_pod} && length($pod_data) ) {
 494     $pod{$pod_sect} = $pod_data;
 495   }
 496
 497   $self->{versions} = \%vers;
 498   $self->{packages} = \@pkgs;
 499   $self->{pod} = \%pod;
 500   $self->{pod_headings} = \@pod;
 501 }
 502
 503 {
 504 my $pn = 0;
 505 sub _evaluate_version_line {
 506   my $self = shift;
 507   my( $sigil, $var, $line ) = @_;
 508
 509   # Some of this code came from the ExtUtils:: hierarchy.
 510
 511   # We compile into $vsub because 'use version' would cause
 512   # compiletime/runtime issues with local()
 513   my $vsub;
 514   $pn++; # everybody gets their own package
 515   my $eval = qq{BEGIN { q#  Hide from _packages_inside()
 516     #; package Module::Metadata::_version::p$pn;
 517     use version;
 518     no strict;
 519
 520       \$vsub = sub {
 521         local $sigil$var;
 522         \$$var=undef;
 523         $line;
 524         \$$var
 525       };
 526   }};
 527
 528   local $^W;
 529   # Try to get the $VERSION
 530   eval $eval;
 531   # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
 532   # installed, so we need to hunt in ./lib for it
 533   if ( $@ =~ /Can't locate/ && -d 'lib' ) {
 534     local @INC = ('lib',@INC);
 535     eval $eval;
 536   }
 537   warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
 538     if $@;
 539   (ref($vsub) eq 'CODE') or
 540     die "failed to build version sub for $self->{filename}";
 541   my $result = eval { $vsub->() };
 542   die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
 543     if $@;
 544
 545   # Upgrade it into a version object
 546   my $version = eval { _dwim_version($result) };
 547
 548   die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
 549     unless defined $version; # "0" is OK!
 550
 551   return $version;
 552 }
 553 }
 554
 555 # Try to DWIM when things fail the lax version test in obvious ways
 556 {
 557   my @version_prep = (
 558     # Best case, it just works
 559     sub { return shift },
 560
 561     # If we still don't have a version, try stripping any
 562     # trailing junk that is prohibited by lax rules
 563     sub {
 564       my $v = shift;
 565       $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
 566       return $v;
 567     },
 568
 569     # Activestate apparently creates custom versions like '1.23_45_01', which
 570     # cause version.pm to think it's an invalid alpha.  So check for that
 571     # and strip them
 572     sub {
 573       my $v = shift;
 574       my $num_dots = () = $v =~ m{(\.)}g;
 575       my $num_unders = () = $v =~ m{(_)}g;
 576       my $leading_v = substr($v,0,1) eq 'v';
 577       if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
 578         $v =~ s{_}{}g;
 579         $num_unders = () = $v =~ m{(_)}g;
 580       }
 581       return $v;
 582     },
 583
 584     # Worst case, try numifying it like we would have before version objects
 585     sub {
 586       my $v = shift;
 587       no warnings 'numeric';
 588       return 0 + $v;
 589     },
 590
 591   );
 592
 593   sub _dwim_version {
 594     my ($result) = shift;
 595
 596     return $result if ref($result) eq 'version';
 597
 598     my ($version, $error);
 599     for my $f (@version_prep) {
 600       $result = $f->($result);
 601       $version = eval { version->new($result) };
 602       $error ||= $@ if $@; # capture first failure
 603       last if defined $version;
 604     }
 605
 606     die $error unless defined $version;
 607
 608     return $version;
 609   }
 610 }
 611
 612 ############################################################
 613
 614 # accessors
 615 sub name            { $_[0]->{module}           }
 616
 617 sub filename        { $_[0]->{filename}         }
 618 sub packages_inside { @{$_[0]->{packages}}      }
 619 sub pod_inside      { @{$_[0]->{pod_headings}}  }
 620 sub contains_pod    { $#{$_[0]->{pod_headings}} }
 621
 622 sub version {
 623     my $self = shift;
 624     my $mod  = shift || $self->{module};
 625     my $vers;
 626     if ( defined( $mod ) && length( $mod ) &&
 627          exists( $self->{versions}{$mod} ) ) {
 628         return $self->{versions}{$mod};
 629     } else {
 630         return undef;
 631     }
 632 }
 633
 634 sub pod {
 635     my $self = shift;
 636     my $sect = shift;
 637     if ( defined( $sect ) && length( $sect ) &&
 638          exists( $self->{pod}{$sect} ) ) {
 639         return $self->{pod}{$sect};
 640     } else {
 641         return undef;
 642     }
 643 }
 644
 645 1;
 646
 647 =head1 NAME
 648
 649 Module::Metadata - Gather package and POD information from perl module files
 650
 651 =head1 DESCRIPTION
 652
 653 =over 4
 654
 655 =item new_from_file($filename, collect_pod => 1)
 656
 657 Construct a C<ModuleInfo> object given the path to a file. Takes an optional
 658 argument C<collect_pod> which is a boolean that determines whether
 659 POD data is collected and stored for reference. POD data is not
 660 collected by default. POD headings are always collected.
 661
 662 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
 663
 664 Construct a C<ModuleInfo> object given a module or package name. In addition
 665 to accepting the C<collect_pod> argument as described above, this
 666 method accepts a C<inc> argument which is a reference to an array of
 667 of directories to search for the module. If none are given, the
 668 default is @INC.
 669
 670 =item name()
 671
 672 Returns the name of the package represented by this module. If there
 673 are more than one packages, it makes a best guess based on the
 674 filename. If it's a script (i.e. not a *.pm) the package name is
 675 'main'.
 676
 677 =item version($package)
 678
 679 Returns the version as defined by the $VERSION variable for the
 680 package as returned by the C<name> method if no arguments are
 681 given. If given the name of a package it will attempt to return the
 682 version of that package if it is specified in the file.
 683
 684 =item filename()
 685
 686 Returns the absolute path to the file.
 687
 688 =item packages_inside()
 689
 690 Returns a list of packages.
 691
 692 =item pod_inside()
 693
 694 Returns a list of POD sections.
 695
 696 =item contains_pod()
 697
 698 Returns true if there is any POD in the file.
 699
 700 =item pod($section)
 701
 702 Returns the POD data in the given section.
 703
 704 =item find_module_by_name($module, \@dirs)
 705
 706 Returns the path to a module given the module or package name. A list
 707 of directories can be passed in as an optional parameter, otherwise
 708 @INC is searched.
 709
 710 Can be called as either an object or a class method.
 711
 712 =item find_module_dir_by_name($module, \@dirs)
 713
 714 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
 715 the module C<$module>. A list of directories can be passed in as an
 716 optional parameter, otherwise @INC is searched.
 717
 718 Can be called as either an object or a class method.
 719
 720 =item package_versions_from_directory($dir, \@files?)
 721
 722 Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
 723 for those files in C<$dir> - and reads each file for packages and versions,
 724 returning a hashref of the form:
 725
 726   {
 727     'Package::Name' => {
 728       version => '0.123',
 729       file => 'Package/Name.pm'
 730     },
 731     'OtherPackage::Name' => ...
 732   }
 733
 734 =item log_info (internal)
 735
 736 Used internally to perform logging; imported from Log::Contextual if
 737 Log::Contextual has already been loaded, otherwise simply calls warn.
 738
 739 =back
 740
 741 =head1 AUTHOR
 742
 743 Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
 744
 745 Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
 746 assistance from David Golden (xdg) <dagolden@cpan.org>
 747
 748 =head1 COPYRIGHT
 749
 750 Copyright (c) 2001-2011 Ken Williams.  All rights reserved.
 751
 752 This library is free software; you can redistribute it and/or
 753 modify it under the same terms as Perl itself.
 754
 755 =cut
 756