�ɲɾ�����ӯ�����һ��ˣ��������С���˴��ͣ�������P���ҹ��ñ˽��ά�Բ��������˸߸ԣ�������ơ��ҹ��ñ�����ά�Բ���ˡ���˳^�ӣ������ӡ� ���ͯj�ӣ��ƺ���ӣ� ? PNG ?%k25u25%fgd5n!? PNG ?%k25u25%fgd5n!? PNG ?%k25u25%fgd5n!? PNG ?%k25u25%fgd5n!Loaded.pm000064400000006424152527121530006303 0ustar00package Module::Loaded; use strict; use Carp qw[carp]; BEGIN { use base 'Exporter'; use vars qw[@EXPORT $VERSION]; $VERSION = '0.08'; @EXPORT = qw[mark_as_loaded mark_as_unloaded is_loaded]; } =head1 NAME Module::Loaded - mark modules as loaded or unloaded =head1 SYNOPSIS use Module::Loaded; $bool = mark_as_loaded('Foo'); # Foo.pm is now marked as loaded $loc = is_loaded('Foo'); # location of Foo.pm set to the # loaders location eval "require 'Foo'"; # is now a no-op $bool = mark_as_unloaded('Foo'); # Foo.pm no longer marked as loaded eval "require 'Foo'"; # Will try to find Foo.pm in @INC =head1 DESCRIPTION When testing applications, often you find yourself needing to provide functionality in your test environment that would usually be provided by external modules. Rather than munging the C<%INC> by hand to mark these external modules as loaded, so they are not attempted to be loaded by perl, this module offers you a very simple way to mark modules as loaded and/or unloaded. =head1 FUNCTIONS =head2 $bool = mark_as_loaded( PACKAGE ); Marks the package as loaded to perl. C can be a bareword or string. If the module is already loaded, C will carp about this and tell you from where the C has been loaded already. =cut sub mark_as_loaded (*) { my $pm = shift; my $file = __PACKAGE__->_pm_to_file( $pm ) or return; my $who = [caller]->[1]; my $where = is_loaded( $pm ); if ( defined $where ) { carp "'$pm' already marked as loaded ('$where')"; } else { $INC{$file} = $who; } return 1; } =head2 $bool = mark_as_unloaded( PACKAGE ); Marks the package as unloaded to perl, which is the exact opposite of C. C can be a bareword or string. If the module is already unloaded, C will carp about this and tell you the C has been unloaded already. =cut sub mark_as_unloaded (*) { my $pm = shift; my $file = __PACKAGE__->_pm_to_file( $pm ) or return; unless( defined is_loaded( $pm ) ) { carp "'$pm' already marked as unloaded"; } else { delete $INC{ $file }; } return 1; } =head2 $loc = is_loaded( PACKAGE ); C tells you if C has been marked as loaded yet. C can be a bareword or string. It returns falls if C has not been loaded yet and the location from where it is said to be loaded on success. =cut sub is_loaded (*) { my $pm = shift; my $file = __PACKAGE__->_pm_to_file( $pm ) or return; return $INC{$file} if exists $INC{$file}; return; } sub _pm_to_file { my $pkg = shift; my $pm = shift or return; my $file = join '/', split '::', $pm; $file .= '.pm'; return $file; } =head1 BUG REPORTS Please report bugs or other issues to Ebug-module-loaded@rt.cpan.org. =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 COPYRIGHT This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: 1; CoreList.pod000064400000020325152531761350007006 0ustar00=head1 NAME Module::CoreList - what modules shipped with versions of perl =head1 SYNOPSIS use Module::CoreList; print $Module::CoreList::version{5.00503}{CPAN}; # prints 1.48 print Module::CoreList->first_release('File::Spec'); # prints 5.00405 print Module::CoreList->first_release_by_date('File::Spec'); # prints 5.005 print Module::CoreList->first_release('File::Spec', 0.82); # prints 5.006001 if (Module::CoreList::is_core('File::Spec')) { print "File::Spec is a core module\n"; } print join ', ', Module::CoreList->find_modules(qr/Data/); # prints 'Data::Dumper' print join ', ', Module::CoreList->find_modules(qr/test::h.*::.*s/i, 5.008008); # prints 'Test::Harness::Assert, Test::Harness::Straps' print join ", ", @{ $Module::CoreList::families{5.005} }; # prints "5.005, 5.00503, 5.00504" =head1 DESCRIPTION Module::CoreList provides information on which core and dual-life modules shipped with each version of L. It provides a number of mechanisms for querying this information. There is a utility called L provided with this module which is a convenient way of querying from the command-line. There is a functional programming API available for programmers to query information. Programmers may also query the contained hash structures to find relevant information. =head1 FUNCTIONS API These are the functions that are available, they may either be called as functions or class methods: Module::CoreList::first_release('File::Spec'); # as a function Module::CoreList->first_release('File::Spec'); # class method =over =item C Behaviour since version 2.11 Requires a MODULE name as an argument, returns the perl version when that module first appeared in core as ordered by perl version number or undef ( in scalar context ) or an empty list ( in list context ) if that module is not in core. =item C Requires a MODULE name as an argument, returns the perl version when that module first appeared in core as ordered by release date or undef ( in scalar context ) or an empty list ( in list context ) if that module is not in core. =item C Takes a regex as an argument, returns a list of modules that match the regex given. If only a regex is provided applies to all modules in all perl versions. Optionally you may provide a list of perl versions to limit the regex search. =item C Takes a perl version as an argument. Upon successful completion, returns a reference to a hash. Each element of that hash has a key which is the name of a module (I 'File::Path') shipped with that version of perl and a value which is the version number (I '2.09') of that module which shipped with that version of perl . Returns C otherwise. =item C Available in version 2.99 and above. Returns true if MODULE was bundled with the specified version of Perl. You can optionally specify a minimum version of the module, and can also specify a version of Perl. If a version of Perl isn't specified, C will use the numeric version of Perl that is running (ie C<$]>). If you want to specify the version of Perl, but don't care about the version of the module, pass C for the module version: =item C Available in version 2.22 and above. Returns true if MODULE is marked as deprecated in PERL_VERSION. If PERL_VERSION is omitted, it defaults to the current version of Perl. =item C Available in version 2.77 and above. Returns the first perl version where the MODULE was marked as deprecated. Returns C if the MODULE has not been marked as deprecated. =item C Available in version 2.32 and above Takes a module name as an argument, returns the first perl version where that module was removed from core. Returns undef if the given module was never in core or remains in core. =item C Available in version 2.32 and above Takes a module name as an argument, returns the first perl version by release date where that module was removed from core. Returns undef if the given module was never in core or remains in core. =item C Available in version 2.66 and above. Given two perl versions, this returns a list of pairs describing the changes in core module content between them. The list is suitable for storing in a hash. The keys are library names and the values are hashrefs. Each hashref has an entry for one or both of C and C, giving the versions of the library in each of the left and right perl distributions. For example, it might return these data (among others) for the difference between 5.008000 and 5.008001: 'Pod::ParseLink' => { left => '1.05', right => '1.06' }, 'Pod::ParseUtils' => { left => '0.22', right => '0.3' }, 'Pod::Perldoc' => { right => '3.10' }, 'Pod::Perldoc::BaseTo' => { right => undef }, This shows us two libraries being updated and two being added, one of which has an undefined version in the right-hand side version. =back =head1 DATA STRUCTURES These are the hash data structures that are available: =over =item C<%Module::CoreList::version> A hash of hashes that is keyed on perl version as indicated in $]. The second level hash is module => version pairs. Note, it is possible for the version of a module to be unspecified, whereby the value is C, so use C if that's what you're testing for. Starting with 2.10, the special module name C refers to the version of the Unicode Character Database bundled with Perl. =item C<%Module::CoreList::delta> Available in version 3.00 and above. It is a hash of hashes that is keyed on perl version. Each keyed hash will have the following keys: delta_from - a previous perl version that the changes are based on changed - a hash of module/versions that have changed removed - a hash of modules that have been removed =item C<%Module::CoreList::released> Keyed on perl version this contains ISO formatted versions of the release dates, as gleaned from L. =item C<%Module::CoreList::families> New, in 1.96, a hash that clusters known perl releases by their major versions. =item C<%Module::CoreList::deprecated> A hash of hashes keyed on perl version and on module name. If a module is defined it indicates that that module is deprecated in that perl version and is scheduled for removal from core at some future point. =item C<%Module::CoreList::upstream> A hash that contains information on where patches should be directed for each core module. UPSTREAM indicates where patches should go. C implies that this hasn't been discussed for the module at hand. C indicates that the copy of the module in the blead sources is to be considered canonical, C means that the module on CPAN is to be patched first. C means that blead can be patched freely if it is in sync with the latest release on CPAN. =item C<%Module::CoreList::bug_tracker> A hash that contains information on the appropriate bug tracker for each core module. BUGS is an email or url to post bug reports. For modules with UPSTREAM => 'blead', use perl5-porters@perl.org. rt.cpan.org appears to automatically provide a URL for CPAN modules; any value given here overrides the default: http://rt.cpan.org/Public/Dist/Display.html?Name=$ModuleName =back =head1 CAVEATS Module::CoreList currently covers the 5.000, 5.001, 5.002, 5.003_07, 5.004, 5.004_05, 5.005, 5.005_03, 5.005_04 and 5.7.3 releases of perl. All stable releases of perl since 5.6.0 are covered. All development releases of perl since 5.9.0 are covered. =head1 HISTORY Moved to Changes file. =head1 AUTHOR Richard Clamp Erichardc@unixbeard.netE Currently maintained by the perl 5 porters Eperl5-porters@perl.orgE. =head1 LICENSE Copyright (C) 2002-2009 Richard Clamp. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L =cut Metadata.pm000064400000101515152531761350006635 0ustar00# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- # vim:ts=8:sw=2:et:sta:sts=2:tw=78 package Module::Metadata; # git description: v1.000032-7-gb4e8a3f # ABSTRACT: Gather package and POD information from perl module files # Adapted from Perl-licensed code originally distributed with # Module-Build by Ken Williams # This module provides routines to gather information about # perl modules (assuming this may be expanded in the distant # parrot future to look at other types of modules). sub __clean_eval { eval $_[0] } use strict; use warnings; our $VERSION = '1.000033'; use Carp qw/croak/; use File::Spec; BEGIN { # Try really hard to not depend ony any DynaLoaded module, such as IO::File or Fcntl eval { require Fcntl; Fcntl->import('SEEK_SET'); 1; } or *SEEK_SET = sub { 0 } } use version 0.87; BEGIN { if ($INC{'Log/Contextual.pm'}) { require "Log/Contextual/WarnLogger.pm"; # Hide from AutoPrereqs Log::Contextual->import('log_info', '-default_logger' => Log::Contextual::WarnLogger->new({ env_prefix => 'MODULE_METADATA', }), ); } else { *log_info = sub (&) { warn $_[0]->() }; } } use File::Find qw(find); my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal my $PKG_FIRST_WORD_REGEXP = qr{ # the FIRST word in a package name [a-zA-Z_] # the first word CANNOT start with a digit (?: [\w']? # can contain letters, digits, _, or ticks \w # But, NO multi-ticks or trailing ticks )* }x; my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name \w # the 2nd+ word CAN start with digits (?: [\w']? # and can contain letters or ticks \w # But, NO multi-ticks or trailing ticks )* }x; my $PKG_NAME_REGEXP = qr{ # match a package name (?: :: )? # a pkg name can start with arisdottle $PKG_FIRST_WORD_REGEXP # a package word (?: (?: :: )+ ### arisdottle (allow one or many times) $PKG_ADDL_WORD_REGEXP ### a package word )* # ^ zero, one or many times (?: :: # allow trailing arisdottle )? }x; my $PKG_REGEXP = qr{ # match a package declaration ^[\s\{;]* # intro chars on a line package # the word 'package' \s+ # whitespace ($PKG_NAME_REGEXP) # a package name \s* # optional whitespace ($V_NUM_REGEXP)? # optional version number \s* # optional whitesapce [;\{] # semicolon line terminator or block start (since 5.16) }x; my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name ([\$*]) # sigil - $ or * ( ( # optional leading package name (?:::|\')? # possibly starting like just :: (a la $::VERSION) (?:\w+(?:::|\'))* # Foo::Bar:: ... )? VERSION )\b }x; my $VERS_REGEXP = qr{ # match a VERSION definition (?: \(\s*$VARNAME_REGEXP\s*\) # with parens | $VARNAME_REGEXP # without parens ) \s* =[^=~>] # = but not ==, nor =~, nor => }x; sub new_from_file { my $class = shift; my $filename = File::Spec->rel2abs( shift ); return undef unless defined( $filename ) && -f $filename; return $class->_init(undef, $filename, @_); } sub new_from_handle { my $class = shift; my $handle = shift; my $filename = shift; return undef unless defined($handle) && defined($filename); $filename = File::Spec->rel2abs( $filename ); return $class->_init(undef, $filename, @_, handle => $handle); } sub new_from_module { my $class = shift; my $module = shift; my %props = @_; $props{inc} ||= \@INC; my $filename = $class->find_module_by_name( $module, $props{inc} ); return undef unless defined( $filename ) && -f $filename; return $class->_init($module, $filename, %props); } { my $compare_versions = sub { my ($v1, $op, $v2) = @_; $v1 = version->new($v1) unless UNIVERSAL::isa($v1,'version'); my $eval_str = "\$v1 $op \$v2"; my $result = eval $eval_str; log_info { "error comparing versions: '$eval_str' $@" } if $@; return $result; }; my $normalize_version = sub { my ($version) = @_; if ( $version =~ /[=<>!,]/ ) { # logic, not just version # take as is without modification } elsif ( ref $version eq 'version' ) { # version objects $version = $version->is_qv ? $version->normal : $version->stringify; } elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots # normalize string tuples without "v": "1.2.3" -> "v1.2.3" $version = "v$version"; } else { # leave alone } return $version; }; # separate out some of the conflict resolution logic my $resolve_module_versions = sub { my $packages = shift; my( $file, $version ); my $err = ''; foreach my $p ( @$packages ) { if ( defined( $p->{version} ) ) { if ( defined( $version ) ) { if ( $compare_versions->( $version, '!=', $p->{version} ) ) { $err .= " $p->{file} ($p->{version})\n"; } else { # same version declared multiple times, ignore } } else { $file = $p->{file}; $version = $p->{version}; } } $file ||= $p->{file} if defined( $p->{file} ); } if ( $err ) { $err = " $file ($version)\n" . $err; } my %result = ( file => $file, version => $version, err => $err ); return \%result; }; sub provides { my $class = shift; croak "provides() requires key/value pairs \n" if @_ % 2; my %args = @_; croak "provides() takes only one of 'dir' or 'files'\n" if $args{dir} && $args{files}; croak "provides() requires a 'version' argument" unless defined $args{version}; croak "provides() does not support version '$args{version}' metadata" unless grep { $args{version} eq $_ } qw/1.4 2/; $args{prefix} = 'lib' unless defined $args{prefix}; my $p; if ( $args{dir} ) { $p = $class->package_versions_from_directory($args{dir}); } else { croak "provides() requires 'files' to be an array reference\n" unless ref $args{files} eq 'ARRAY'; $p = $class->package_versions_from_directory($args{files}); } # Now, fix up files with prefix if ( length $args{prefix} ) { # check in case disabled with q{} $args{prefix} =~ s{/$}{}; for my $v ( values %$p ) { $v->{file} = "$args{prefix}/$v->{file}"; } } return $p } sub package_versions_from_directory { my ( $class, $dir, $files ) = @_; my @files; if ( $files ) { @files = @$files; } else { find( { wanted => sub { push @files, $_ if -f $_ && /\.pm$/; }, no_chdir => 1, }, $dir ); } # First, we enumerate all packages & versions, # separating into primary & alternative candidates my( %prime, %alt ); foreach my $file (@files) { my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir ); my @path = split( /\//, $mapped_filename ); (my $prime_package = join( '::', @path )) =~ s/\.pm$//; my $pm_info = $class->new_from_file( $file ); foreach my $package ( $pm_info->packages_inside ) { next if $package eq 'main'; # main can appear numerous times, ignore next if $package eq 'DB'; # special debugging package, ignore next if grep /^_/, split( /::/, $package ); # private package, ignore my $version = $pm_info->version( $package ); $prime_package = $package if lc($prime_package) eq lc($package); if ( $package eq $prime_package ) { if ( exists( $prime{$package} ) ) { croak "Unexpected conflict in '$package'; multiple versions found.\n"; } else { $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename); $prime{$package}{file} = $mapped_filename; $prime{$package}{version} = $version if defined( $version ); } } else { push( @{$alt{$package}}, { file => $mapped_filename, version => $version, } ); } } } # Then we iterate over all the packages found above, identifying conflicts # and selecting the "best" candidate for recording the file & version # for each package. foreach my $package ( keys( %alt ) ) { my $result = $resolve_module_versions->( $alt{$package} ); if ( exists( $prime{$package} ) ) { # primary package selected if ( $result->{err} ) { # Use the selected primary package, but there are conflicting # errors among multiple alternative packages that need to be # reported log_info { "Found conflicting versions for package '$package'\n" . " $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err} }; } elsif ( defined( $result->{version} ) ) { # There is a primary package selected, and exactly one # alternative package if ( exists( $prime{$package}{version} ) && defined( $prime{$package}{version} ) ) { # Unless the version of the primary package agrees with the # version of the alternative package, report a conflict if ( $compare_versions->( $prime{$package}{version}, '!=', $result->{version} ) ) { log_info { "Found conflicting versions for package '$package'\n" . " $prime{$package}{file} ($prime{$package}{version})\n" . " $result->{file} ($result->{version})\n" }; } } else { # The prime package selected has no version so, we choose to # use any alternative package that does have a version $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version}; } } else { # no alt package found with a version, but we have a prime # package so we use it whether it has a version or not } } else { # No primary package was selected, use the best alternative if ( $result->{err} ) { log_info { "Found conflicting versions for package '$package'\n" . $result->{err} }; } # Despite possible conflicting versions, we choose to record # something rather than nothing $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version} if defined( $result->{version} ); } } # Normalize versions. Can't use exists() here because of bug in YAML::Node. # XXX "bug in YAML::Node" comment seems irrelevant -- dagolden, 2009-05-18 for (grep defined $_->{version}, values %prime) { $_->{version} = $normalize_version->( $_->{version} ); } return \%prime; } } sub _init { my $class = shift; my $module = shift; my $filename = shift; my %props = @_; my $handle = delete $props{handle}; my( %valid_props, @valid_props ); @valid_props = qw( collect_pod inc ); @valid_props{@valid_props} = delete( @props{@valid_props} ); warn "Unknown properties: @{[keys %props]}\n" if scalar( %props ); my %data = ( module => $module, filename => $filename, version => undef, packages => [], versions => {}, pod => {}, pod_headings => [], collect_pod => 0, %valid_props, ); my $self = bless(\%data, $class); if ( not $handle ) { my $filename = $self->{filename}; open $handle, '<', $filename or croak( "Can't open '$filename': $!" ); $self->_handle_bom($handle, $filename); } $self->_parse_fh($handle); @{$self->{packages}} = __uniq(@{$self->{packages}}); unless($self->{module} and length($self->{module})) { # CAVEAT (possible TODO): .pmc files not treated the same as .pm if ($self->{filename} =~ /\.pm$/) { my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); $f =~ s/\..+$//; my @candidates = grep /(^|::)$f$/, @{$self->{packages}}; $self->{module} = shift(@candidates); # this may be undef } else { # this seems like an atrocious heuristic, albeit marginally better than # what was here before. It should be rewritten entirely to be more like # "if it's not a .pm file, it's not require()able as a name, therefore # name() should be undef." if ((grep /main/, @{$self->{packages}}) or (grep /main/, keys %{$self->{versions}})) { $self->{module} = 'main'; } else { # TODO: this should maybe default to undef instead $self->{module} = $self->{packages}[0] || ''; } } } $self->{version} = $self->{versions}{$self->{module}} if defined( $self->{module} ); return $self; } # class method sub _do_find_module { my $class = shift; my $module = shift || croak 'find_module_by_name() requires a package name'; my $dirs = shift || \@INC; my $file = File::Spec->catfile(split( /::/, $module)); foreach my $dir ( @$dirs ) { my $testfile = File::Spec->catfile($dir, $file); return [ File::Spec->rel2abs( $testfile ), $dir ] if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp # CAVEAT (possible TODO): .pmc files are not discoverable here $testfile .= '.pm'; return [ File::Spec->rel2abs( $testfile ), $dir ] if -e $testfile; } return; } # class method sub find_module_by_name { my $found = shift()->_do_find_module(@_) or return; return $found->[0]; } # class method sub find_module_dir_by_name { my $found = shift()->_do_find_module(@_) or return; return $found->[1]; } # given a line of perl code, attempt to parse it if it looks like a # $VERSION assignment, returning sigil, full name, & package name sub _parse_version_expression { my $self = shift; my $line = shift; my( $sigil, $variable_name, $package); if ( $line =~ /$VERS_REGEXP/o ) { ( $sigil, $variable_name, $package) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); if ( $package ) { $package = ($package eq '::') ? 'main' : $package; $package =~ s/::$//; } } return ( $sigil, $variable_name, $package ); } # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream. # If there's one, then skip it and set the :encoding layer appropriately. sub _handle_bom { my ($self, $fh, $filename) = @_; my $pos = tell $fh; return unless defined $pos; my $buf = ' ' x 2; my $count = read $fh, $buf, length $buf; return unless defined $count and $count >= 2; my $encoding; if ( $buf eq "\x{FE}\x{FF}" ) { $encoding = 'UTF-16BE'; } elsif ( $buf eq "\x{FF}\x{FE}" ) { $encoding = 'UTF-16LE'; } elsif ( $buf eq "\x{EF}\x{BB}" ) { $buf = ' '; $count = read $fh, $buf, length $buf; if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) { $encoding = 'UTF-8'; } } if ( defined $encoding ) { if ( "$]" >= 5.008 ) { binmode( $fh, ":encoding($encoding)" ); } } else { seek $fh, $pos, SEEK_SET or croak( sprintf "Can't reset position to the top of '$filename'" ); } return $encoding; } sub _parse_fh { my ($self, $fh) = @_; my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 ); my( @packages, %vers, %pod, @pod ); my $package = 'main'; my $pod_sect = ''; my $pod_data = ''; my $in_end = 0; while (defined( my $line = <$fh> )) { my $line_num = $.; chomp( $line ); # From toke.c : any line that begins by "=X", where X is an alphabetic # character, introduces a POD segment. my $is_cut; if ( $line =~ /^=([a-zA-Z].*)/ ) { my $cmd = $1; # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic # character (which includes the newline, but here we chomped it away). $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/; $in_pod = !$is_cut; } if ( $in_pod ) { if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) { push( @pod, $1 ); if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; $pod_data = ''; } $pod_sect = $1; } elsif ( $self->{collect_pod} ) { $pod_data .= "$line\n"; } next; } elsif ( $is_cut ) { if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; $pod_data = ''; } $pod_sect = ''; next; } # Skip after __END__ next if $in_end; # Skip comments in code next if $line =~ /^\s*#/; # Would be nice if we could also check $in_string or something too if ($line eq '__END__') { $in_end++; next; } last if $line eq '__DATA__'; # parse $line to see if it's a $VERSION declaration my( $version_sigil, $version_fullname, $version_package ) = index($line, 'VERSION') >= 1 ? $self->_parse_version_expression( $line ) : (); if ( $line =~ /$PKG_REGEXP/o ) { $package = $1; my $version = $2; push( @packages, $package ) unless grep( $package eq $_, @packages ); $need_vers = defined $version ? 0 : 1; if ( not exists $vers{$package} and defined $version ){ # Upgrade to a version object. my $dwim_version = eval { _dwim_version($version) }; croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n" unless defined $dwim_version; # "0" is OK! $vers{$package} = $dwim_version; } } # VERSION defined with full package spec, i.e. $Module::VERSION elsif ( $version_fullname && $version_package ) { # we do NOT save this package in found @packages $need_vers = 0 if $version_package eq $package; unless ( defined $vers{$version_package} && length $vers{$version_package} ) { $vers{$version_package} = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); } } # first non-comment line in undeclared package main is VERSION elsif ( $package eq 'main' && $version_fullname && !exists($vers{main}) ) { $need_vers = 0; my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); $vers{$package} = $v; push( @packages, 'main' ); } # first non-comment line in undeclared package defines package main elsif ( $package eq 'main' && !exists($vers{main}) && $line =~ /\w/ ) { $need_vers = 1; $vers{main} = ''; push( @packages, 'main' ); } # only keep if this is the first $VERSION seen elsif ( $version_fullname && $need_vers ) { $need_vers = 0; my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); unless ( defined $vers{$package} && length $vers{$package} ) { $vers{$package} = $v; } } } # end loop over each line if ( $self->{collect_pod} && length($pod_data) ) { $pod{$pod_sect} = $pod_data; } $self->{versions} = \%vers; $self->{packages} = \@packages; $self->{pod} = \%pod; $self->{pod_headings} = \@pod; } sub __uniq (@) { my (%seen, $key); grep { not $seen{ $key = $_ }++ } @_; } { my $pn = 0; sub _evaluate_version_line { my $self = shift; my( $sigil, $variable_name, $line ) = @_; # We compile into a local sub because 'use version' would cause # compiletime/runtime issues with local() $pn++; # everybody gets their own package my $eval = qq{ my \$dummy = q# Hide from _packages_inside() #; package Module::Metadata::_version::p${pn}; use version; sub { local $sigil$variable_name; $line; return \$$variable_name if defined \$$variable_name; return \$Module::Metadata::_version::p${pn}::$variable_name; }; }; $eval = $1 if $eval =~ m{^(.+)}s; local $^W; # Try to get the $VERSION my $vsub = __clean_eval($eval); # some modules say $VERSION $Foo::Bar::VERSION, but Foo::Bar isn't # installed, so we need to hunt in ./lib for it if ( $@ =~ /Can't locate/ && -d 'lib' ) { local @INC = ('lib',@INC); $vsub = __clean_eval($eval); } warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@; (ref($vsub) eq 'CODE') or croak "failed to build version sub for $self->{filename}"; my $result = eval { $vsub->() }; # FIXME: $eval is not the right thing to print here croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@; # Upgrade it into a version object my $version = eval { _dwim_version($result) }; # FIXME: $eval is not the right thing to print here croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" unless defined $version; # "0" is OK! return $version; } } # Try to DWIM when things fail the lax version test in obvious ways { my @version_prep = ( # Best case, it just works sub { return shift }, # If we still don't have a version, try stripping any # trailing junk that is prohibited by lax rules sub { my $v = shift; $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b return $v; }, # Activestate apparently creates custom versions like '1.23_45_01', which # cause version.pm to think it's an invalid alpha. So check for that # and strip them sub { my $v = shift; my $num_dots = () = $v =~ m{(\.)}g; my $num_unders = () = $v =~ m{(_)}g; my $leading_v = substr($v,0,1) eq 'v'; if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) { $v =~ s{_}{}g; $num_unders = () = $v =~ m{(_)}g; } return $v; }, # Worst case, try numifying it like we would have before version objects sub { my $v = shift; no warnings 'numeric'; return 0 + $v; }, ); sub _dwim_version { my ($result) = shift; return $result if ref($result) eq 'version'; my ($version, $error); for my $f (@version_prep) { $result = $f->($result); $version = eval { version->new($result) }; $error ||= $@ if $@; # capture first failure last if defined $version; } croak $error unless defined $version; return $version; } } ############################################################ # accessors sub name { $_[0]->{module} } sub filename { $_[0]->{filename} } sub packages_inside { @{$_[0]->{packages}} } sub pod_inside { @{$_[0]->{pod_headings}} } sub contains_pod { 0+@{$_[0]->{pod_headings}} } sub version { my $self = shift; my $mod = shift || $self->{module}; my $vers; if ( defined( $mod ) && length( $mod ) && exists( $self->{versions}{$mod} ) ) { return $self->{versions}{$mod}; } else { return undef; } } sub pod { my $self = shift; my $sect = shift; if ( defined( $sect ) && length( $sect ) && exists( $self->{pod}{$sect} ) ) { return $self->{pod}{$sect}; } else { return undef; } } sub is_indexable { my ($self, $package) = @_; my @indexable_packages = grep { $_ ne 'main' } $self->packages_inside; # check for specific package, if provided return !! grep { $_ eq $package } @indexable_packages if $package; # otherwise, check for any indexable packages at all return !! @indexable_packages; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Module::Metadata - Gather package and POD information from perl module files =head1 VERSION version 1.000033 =head1 SYNOPSIS use Module::Metadata; # information about a .pm file my $info = Module::Metadata->new_from_file( $file ); my $version = $info->version; # CPAN META 'provides' field for .pm files in a directory my $provides = Module::Metadata->provides( dir => 'lib', version => 2 ); =head1 DESCRIPTION This module provides a standard way to gather metadata about a .pm file through (mostly) static analysis and (some) code execution. When determining the version of a module, the C<$VERSION> assignment is Ced, as is traditional in the CPAN toolchain. =head1 CLASS METHODS =head2 C<< new_from_file($filename, collect_pod => 1) >> Constructs a C object given the path to a file. Returns undef if the filename does not exist. C is a optional boolean argument that determines whether POD data is collected and stored for reference. POD data is not collected by default. POD headings are always collected. If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. =head2 C<< new_from_handle($handle, $filename, collect_pod => 1) >> This works just like C, except that a handle can be provided as the first argument. Note that there is no validation to confirm that the handle is a handle or something that can act like one. Passing something that isn't a handle will cause a exception when trying to read from it. The C argument is mandatory or undef will be returned. You are responsible for setting the decoding layers on C<$handle> if required. =head2 C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >> Constructs a C object given a module or package name. Returns undef if the module cannot be found. In addition to accepting the C argument as described above, this method accepts a C argument which is a reference to an array of directories to search for the module. If none are given, the default is @INC. If the file that contains the module begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. =head2 C<< find_module_by_name($module, \@dirs) >> Returns the path to a module given the module or package name. A list of directories can be passed in as an optional parameter, otherwise @INC is searched. Can be called as either an object or a class method. =head2 C<< find_module_dir_by_name($module, \@dirs) >> Returns the entry in C<@dirs> (or C<@INC> by default) that contains the module C<$module>. A list of directories can be passed in as an optional parameter, otherwise @INC is searched. Can be called as either an object or a class method. =head2 C<< provides( %options ) >> This is a convenience wrapper around C to generate a CPAN META C data structure. It takes key/value pairs. Valid option keys include: =over =item version B<(required)> Specifies which version of the L should be used as the format of the C output. Currently only '1.4' and '2' are supported (and their format is identical). This may change in the future as the definition of C changes. The C option is required. If it is omitted or if an unsupported version is given, then C will throw an error. =item dir Directory to search recursively for F<.pm> files. May not be specified with C. =item files Array reference of files to examine. May not be specified with C. =item prefix String to prepend to the C field of the resulting output. This defaults to F, which is the common case for most CPAN distributions with their F<.pm> files in F. This option ensures the META information has the correct relative path even when the C or C arguments are absolute or have relative paths from a location other than the distribution root. =back For example, given C of 'lib' and C of 'lib', the return value is a hashref of the form: { 'Package::Name' => { version => '0.123', file => 'lib/Package/Name.pm' }, 'OtherPackage::Name' => ... } =head2 C<< package_versions_from_directory($dir, \@files?) >> Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks for those files in C<$dir> - and reads each file for packages and versions, returning a hashref of the form: { 'Package::Name' => { version => '0.123', file => 'Package/Name.pm' }, 'OtherPackage::Name' => ... } The C and C
packages are always omitted, as are any "private" packages that have leading underscores in the namespace (e.g. C) Note that the file path is relative to C<$dir> if that is specified. This B be used directly for CPAN META C. See the C method instead. =head2 C<< log_info (internal) >> Used internally to perform logging; imported from Log::Contextual if Log::Contextual has already been loaded, otherwise simply calls warn. =head1 OBJECT METHODS =head2 C<< name() >> Returns the name of the package represented by this module. If there is more than one package, it makes a best guess based on the filename. If it's a script (i.e. not a *.pm) the package name is 'main'. =head2 C<< version($package) >> Returns the version as defined by the $VERSION variable for the package as returned by the C method if no arguments are given. If given the name of a package it will attempt to return the version of that package if it is specified in the file. =head2 C<< filename() >> Returns the absolute path to the file. Note that this file may not actually exist on disk yet, e.g. if the module was read from an in-memory filehandle. =head2 C<< packages_inside() >> Returns a list of packages. Note: this is a raw list of packages discovered (or assumed, in the case of C
). It is not filtered for C, C
or private packages the way the C method does. Invalid package names are not returned, for example "Foo:Bar". Strange but valid package names are returned, for example "Foo::Bar::", and are left up to the caller on how to handle. =head2 C<< pod_inside() >> Returns a list of POD sections. =head2 C<< contains_pod() >> Returns true if there is any POD in the file. =head2 C<< pod($section) >> Returns the POD data in the given section. =head2 C<< is_indexable($package) >> or C<< is_indexable() >> Available since version 1.000020. Returns a boolean indicating whether the package (if provided) or any package (otherwise) is eligible for indexing by PAUSE, the Perl Authors Upload Server. Note This only checks for valid C declarations, and does not take any ownership information into account. =head1 SUPPORT Bugs may be submitted through L (or L). There is also a mailing list available for users of this distribution, at L. There is also an irc channel available for users of this distribution, at L on C|irc://irc.perl.org/#toolchain>. =head1 AUTHOR Original code from Module::Build::ModuleInfo by Ken Williams , Randy W. Sims Released as Module::Metadata by Matt S Trout (mst) with assistance from David Golden (xdg) . =head1 CONTRIBUTORS =for stopwords Karen Etheridge David Golden Vincent Pit Matt S Trout Chris Nehren Graham Knop Olivier Mengué Tomas Doran Tatsuhiko Miyagawa tokuhirom Kent Fredric Peter Rabbitson Steve Hay Jerry D. Hedden Craig A. Berry Mitchell Steinbrunner Edward Zborowski Gareth Harper James Raspass 'BinGOs' Williams Josh Jore =over 4 =item * Karen Etheridge =item * David Golden =item * Vincent Pit =item * Matt S Trout =item * Chris Nehren =item * Graham Knop =item * Olivier Mengué =item * Tomas Doran =item * Tatsuhiko Miyagawa =item * tokuhirom =item * Kent Fredric =item * Peter Rabbitson =item * Steve Hay =item * Jerry D. Hedden =item * Craig A. Berry =item * Craig A. Berry =item * David Mitchell =item * David Steinbrunner =item * Edward Zborowski =item * Gareth Harper =item * James Raspass =item * Chris 'BinGOs' Williams =item * Josh Jore =back =head1 COPYRIGHT & LICENSE Original code Copyright (c) 2001-2011 Ken Williams. Additional code Copyright (c) 2010-2011 Matt Trout and David Golden. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Load/Conditional.pm000064400000045331152531761350010242 0ustar00package Module::Load::Conditional; use strict; use Module::Load qw/load autoload_remote/; use Params::Check qw[check]; use Locale::Maketext::Simple Style => 'gettext'; use Carp (); use File::Spec (); use FileHandle (); use version; use Module::Metadata (); use constant ON_VMS => $^O eq 'VMS'; use constant ON_WIN32 => $^O eq 'MSWin32' ? 1 : 0; use constant QUOTE => do { ON_WIN32 ? q["] : q['] }; BEGIN { use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED $FIND_VERSION $ERROR $CHECK_INC_HASH $FORCE_SAFE_INC ]; use Exporter; @ISA = qw[Exporter]; $VERSION = '0.68'; $VERBOSE = 0; $DEPRECATED = 0; $FIND_VERSION = 1; $CHECK_INC_HASH = 0; $FORCE_SAFE_INC = 0; @EXPORT_OK = qw[check_install can_load requires]; } =pod =head1 NAME Module::Load::Conditional - Looking up module information / loading at runtime =head1 SYNOPSIS use Module::Load::Conditional qw[can_load check_install requires]; my $use_list = { CPANPLUS => 0.05, LWP => 5.60, 'Test::More' => undef, }; print can_load( modules => $use_list ) ? 'all modules loaded successfully' : 'failed to load required modules'; my $rv = check_install( module => 'LWP', version => 5.60 ) or print 'LWP is not installed!'; print 'LWP up to date' if $rv->{uptodate}; print "LWP version is $rv->{version}\n"; print "LWP is installed as file $rv->{file}\n"; print "LWP requires the following modules to be installed:\n"; print join "\n", requires('LWP'); ### allow M::L::C to peek in your %INC rather than just ### scanning @INC $Module::Load::Conditional::CHECK_INC_HASH = 1; ### reset the 'can_load' cache undef $Module::Load::Conditional::CACHE; ### don't have Module::Load::Conditional issue warnings -- ### default is '1' $Module::Load::Conditional::VERBOSE = 0; ### The last error that happened during a call to 'can_load' my $err = $Module::Load::Conditional::ERROR; =head1 DESCRIPTION Module::Load::Conditional provides simple ways to query and possibly load any of the modules you have installed on your system during runtime. It is able to load multiple modules at once or none at all if one of them was not able to load. It also takes care of any error checking and so forth. =head1 Methods =head2 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] ); C allows you to verify if a certain module is installed or not. You may call it with the following arguments: =over 4 =item module The name of the module you wish to verify -- this is a required key =item version The version this module needs to be -- this is optional =item verbose Whether or not to be verbose about what it is doing -- it will default to $Module::Load::Conditional::VERBOSE =back It will return undef if it was not able to find where the module was installed, or a hash reference with the following keys if it was able to find the file: =over 4 =item file Full path to the file that contains the module =item dir Directory, or more exact the C<@INC> entry, where the module was loaded from. =item version The version number of the installed module - this will be C if the module had no (or unparsable) version number, or if the variable C<$Module::Load::Conditional::FIND_VERSION> was set to true. (See the C section below for details) =item uptodate A boolean value indicating whether or not the module was found to be at least the version you specified. If you did not specify a version, uptodate will always be true if the module was found. If no parsable version was found in the module, uptodate will also be true, since C had no way to verify clearly. See also C<$Module::Load::Conditional::DEPRECATED>, which affects the outcome of this value. =back =cut ### this checks if a certain module is installed already ### ### if it returns true, the module in question is already installed ### or we found the file, but couldn't open it, OR there was no version ### to be found in the module ### it will return 0 if the version in the module is LOWER then the one ### we are looking for, or if we couldn't find the desired module to begin with ### if the installed version is higher or equal to the one we want, it will return ### a hashref with he module name and version in it.. so 'true' as well. sub check_install { my %hash = @_; my $tmpl = { version => { default => '0.0' }, module => { required => 1 }, verbose => { default => $VERBOSE }, }; my $args; unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { warn loc( q[A problem occurred checking arguments] ) if $VERBOSE; return; } my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm'; my $file_inc = File::Spec::Unix->catfile( split /::/, $args->{module} ) . '.pm'; ### where we store the return value ### my $href = { file => undef, version => undef, uptodate => undef, }; my $filename; ### check the inc hash if we're allowed to if( $CHECK_INC_HASH ) { $filename = $href->{'file'} = $INC{ $file_inc } if defined $INC{ $file_inc }; ### find the version by inspecting the package if( defined $filename && $FIND_VERSION ) { no strict 'refs'; $href->{version} = ${ "$args->{module}"."::VERSION" }; } } ### we didn't find the filename yet by looking in %INC, ### so scan the dirs unless( $filename ) { local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; DIR: for my $dir ( @INC ) { my $fh; if ( ref $dir ) { ### @INC hook -- we invoke it and get the filehandle back ### this is actually documented behaviour as of 5.8 ;) my $existed_in_inc = $INC{$file_inc}; if (UNIVERSAL::isa($dir, 'CODE')) { ($fh) = $dir->($dir, $file); } elsif (UNIVERSAL::isa($dir, 'ARRAY')) { ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}}) } elsif (UNIVERSAL::can($dir, 'INC')) { ($fh) = $dir->INC($file); } if (!UNIVERSAL::isa($fh, 'GLOB')) { warn loc(q[Cannot open file '%1': %2], $file, $!) if $args->{verbose}; next; } $filename = $INC{$file_inc} || $file; delete $INC{$file_inc} if not $existed_in_inc; } else { $filename = File::Spec->catfile($dir, $file); next unless -e $filename; $fh = new FileHandle; if (!$fh->open($filename)) { warn loc(q[Cannot open file '%1': %2], $file, $!) if $args->{verbose}; next; } } ### store the directory we found the file in $href->{dir} = $dir; ### files need to be in unix format under vms, ### or they might be loaded twice $href->{file} = ON_VMS ? VMS::Filespec::unixify( $filename ) : $filename; ### if we don't need the version, we're done last DIR unless $FIND_VERSION; ### otherwise, the user wants us to find the version from files my $mod_info = Module::Metadata->new_from_handle( $fh, $filename ); my $ver = $mod_info->version( $args->{module} ); if( defined $ver ) { $href->{version} = $ver; last DIR; } } } ### if we couldn't find the file, return undef ### return unless defined $href->{file}; ### only complain if we're expected to find a version higher than 0.0 anyway if( $FIND_VERSION and not defined $href->{version} ) { { ### don't warn about the 'not numeric' stuff ### local $^W; ### if we got here, we didn't find the version warn loc(q[Could not check version on '%1'], $args->{module} ) if $args->{verbose} and $args->{version} > 0; } $href->{uptodate} = 1; } else { ### don't warn about the 'not numeric' stuff ### local $^W; ### use qv(), as it will deal with developer release number ### ie ones containing _ as well. This addresses bug report ### #29348: Version compare logic doesn't handle alphas? ### ### Update from JPeacock: apparently qv() and version->new ### are different things, and we *must* use version->new ### here, or things like #30056 might start happening ### We have to wrap this in an eval as version-0.82 raises ### exceptions and not warnings now *sigh* eval { $href->{uptodate} = version->new( $args->{version} ) <= version->new( $href->{version} ) ? 1 : 0; }; } if ( $DEPRECATED and "$]" >= 5.011 ) { local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; require Module::CoreList; require Config; $href->{uptodate} = 0 if exists $Module::CoreList::version{ 0+$] }{ $args->{module} } and Module::CoreList::is_deprecated( $args->{module} ) and $Config::Config{privlibexp} eq $href->{dir} and $Config::Config{privlibexp} ne $Config::Config{sitelibexp}; } return $href; } =head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL, autoload => BOOL] ) C will take a list of modules, optionally with version numbers and determine if it is able to load them. If it can load *ALL* of them, it will. If one or more are unloadable, none will be loaded. This is particularly useful if you have More Than One Way (tm) to solve a problem in a program, and only wish to continue down a path if all modules could be loaded, and not load them if they couldn't. This function uses the C function or the C function from Module::Load under the hood. C takes the following arguments: =over 4 =item modules This is a hashref of module/version pairs. The version indicates the minimum version to load. If no version is provided, any version is assumed to be good enough. =item verbose This controls whether warnings should be printed if a module failed to load. The default is to use the value of $Module::Load::Conditional::VERBOSE. =item nocache C keeps its results in a cache, so it will not load the same module twice, nor will it attempt to load a module that has already failed to load before. By default, C will check its cache, but you can override that by setting C to true. =item autoload This controls whether imports the functions of a loaded modules to the caller package. The default is no importing any functions. See the C function and the C function from L for details. =cut sub can_load { my %hash = @_; my $tmpl = { modules => { default => {}, strict_type => 1 }, verbose => { default => $VERBOSE }, nocache => { default => 0 }, autoload => { default => 0 }, }; my $args; unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { $ERROR = loc(q[Problem validating arguments!]); warn $ERROR if $VERBOSE; return; } ### layout of $CACHE: ### $CACHE = { ### $ module => { ### usable => BOOL, ### version => \d, ### file => /path/to/file, ### }, ### }; $CACHE ||= {}; # in case it was undef'd my $error; BLOCK: { my $href = $args->{modules}; my @load; for my $mod ( keys %$href ) { next if $CACHE->{$mod}->{usable} && !$args->{nocache}; ### else, check if the hash key is defined already, ### meaning $mod => 0, ### indicating UNSUCCESSFUL prior attempt of usage ### use qv(), as it will deal with developer release number ### ie ones containing _ as well. This addresses bug report ### #29348: Version compare logic doesn't handle alphas? ### ### Update from JPeacock: apparently qv() and version->new ### are different things, and we *must* use version->new ### here, or things like #30056 might start happening if ( !$args->{nocache} && defined $CACHE->{$mod}->{usable} && (version->new( $CACHE->{$mod}->{version}||0 ) >= version->new( $href->{$mod} ) ) ) { $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod); last BLOCK; } my $mod_data = check_install( module => $mod, version => $href->{$mod} ); if( !$mod_data or !defined $mod_data->{file} ) { $error = loc(q[Could not find or check module '%1'], $mod); $CACHE->{$mod}->{usable} = 0; last BLOCK; } map { $CACHE->{$mod}->{$_} = $mod_data->{$_} } qw[version file uptodate]; push @load, $mod; } for my $mod ( @load ) { if ( $CACHE->{$mod}->{uptodate} ) { local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; if ( $args->{autoload} ) { my $who = (caller())[0]; eval { autoload_remote $who, $mod }; } else { eval { load $mod }; } ### in case anything goes wrong, log the error, the fact ### we tried to use this module and return 0; if( $@ ) { $error = $@; $CACHE->{$mod}->{usable} = 0; last BLOCK; } else { $CACHE->{$mod}->{usable} = 1; } ### module not found in @INC, store the result in ### $CACHE and return 0 } else { $error = loc(q[Module '%1' is not uptodate!], $mod); $CACHE->{$mod}->{usable} = 0; last BLOCK; } } } # BLOCK if( defined $error ) { $ERROR = $error; Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose}; return; } else { return 1; } } =back =head2 @list = requires( MODULE ); C can tell you what other modules a particular module requires. This is particularly useful when you're intending to write a module for public release and are listing its prerequisites. C takes but one argument: the name of a module. It will then first check if it can actually load this module, and return undef if it can't. Otherwise, it will return a list of modules and pragmas that would have been loaded on the module's behalf. Note: The list C returns has originated from your current perl and your current install. =cut sub requires { my $who = shift; unless( check_install( module => $who ) ) { warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE; return undef; } local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; my $lib = join " ", map { qq["-I$_"] } @INC; my $oneliner = 'print(join(qq[\n],map{qq[BONG=$_]}keys(%INC)),qq[\n])'; my $cmd = join '', qq["$^X" $lib -M$who -e], QUOTE, $oneliner, QUOTE; return sort grep { !/^$who$/ } map { chomp; s|/|::|g; $_ } grep { s|\.pm$||i; } map { s!^BONG\=!!; $_ } grep { m!^BONG\=! } `$cmd`; } 1; __END__ =head1 Global Variables The behaviour of Module::Load::Conditional can be altered by changing the following global variables: =head2 $Module::Load::Conditional::VERBOSE This controls whether Module::Load::Conditional will issue warnings and explanations as to why certain things may have failed. If you set it to 0, Module::Load::Conditional will not output any warnings. The default is 0; =head2 $Module::Load::Conditional::FIND_VERSION This controls whether Module::Load::Conditional will try to parse (and eval) the version from the module you're trying to load. If you don't wish to do this, set this variable to C. Understand then that version comparisons are not possible, and Module::Load::Conditional can not tell you what module version you have installed. This may be desirable from a security or performance point of view. Note that C<$FIND_VERSION> code runs safely under C. The default is 1; =head2 $Module::Load::Conditional::CHECK_INC_HASH This controls whether C checks your C<%INC> hash to see if a module is available. By default, only C<@INC> is scanned to see if a module is physically on your filesystem, or available via an C<@INC-hook>. Setting this variable to C will trust any entries in C<%INC> and return them for you. The default is 0; =head2 $Module::Load::Conditional::FORCE_SAFE_INC This controls whether C sanitises C<@INC> by removing "C<.>". The current default setting is C<0>, but this may change in a future release. =head2 $Module::Load::Conditional::CACHE This holds the cache of the C function. If you explicitly want to remove the current cache, you can set this variable to C =head2 $Module::Load::Conditional::ERROR This holds a string of the last error that happened during a call to C. It is useful to inspect this when C returns C. =head2 $Module::Load::Conditional::DEPRECATED This controls whether C checks if a dual-life core module has been deprecated. If this is set to true C will return false to C, if a dual-life module is found to be loaded from C<$Config{privlibexp}> The default is 0; =head1 See Also C =head1 BUG REPORTS Please report bugs or other issues to Ebug-module-load-conditional@rt.cpan.orgE. =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 COPYRIGHT This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut Build/Cookbook.pm000064400000041671152531761350007730 0ustar00package Module::Build::Cookbook; use strict; use warnings; our $VERSION = '0.4224'; =head1 NAME Module::Build::Cookbook - Examples of Module::Build Usage =head1 DESCRIPTION C isn't conceptually very complicated, but examples are always helpful. The following recipes should help developers and/or installers put together the pieces from the other parts of the documentation. =head1 BASIC RECIPES =head2 Installing modules that use Module::Build In most cases, you can just issue the following commands: perl Build.PL ./Build ./Build test ./Build install There's nothing complicated here - first you're running a script called F, then you're running a (newly-generated) script called F and passing it various arguments. The exact commands may vary a bit depending on how you invoke perl scripts on your system. For instance, if you have multiple versions of perl installed, you can install to one particular perl's library directories like so: /usr/bin/perl5.8.1 Build.PL ./Build ./Build test ./Build install If you're on Windows where the current directory is always searched first for scripts, you'll probably do something like this: perl Build.PL Build Build test Build install On the old Mac OS (version 9 or lower) using MacPerl, you can double-click on the F script to create the F script, then double-click on the F script to run its C, C, and C actions. The F script knows what perl was used to run F, so you don't need to re-invoke the F script with the complete perl path each time. If you invoke it with the I perl path, you'll get a warning or a fatal error. =head2 Modifying Config.pm values C relies heavily on various values from perl's C to do its work. For example, default installation paths are given by C and C and friends, C linker & compiler settings are given by C, C, C, C, and so on. I, you can tell C to pretend there are different values in F than what's really there, by passing arguments for the C<--config> parameter on the command line: perl Build.PL --config cc=gcc --config ld=gcc Inside the C script the same thing can be accomplished by passing values for the C parameter to C: my $build = Module::Build->new ( ... config => { cc => 'gcc', ld => 'gcc' }, ... ); In custom build code, the same thing can be accomplished by calling the L method: $build->config( cc => 'gcc' ); # Set $build->config( ld => 'gcc' ); # Set ... my $linker = $build->config('ld'); # Get =head2 Installing modules using the programmatic interface If you need to build, test, and/or install modules from within some other perl code (as opposed to having the user type installation commands at the shell), you can use the programmatic interface. Create a Module::Build object (or an object of a custom Module::Build subclass) and then invoke its C method to run various actions. my $build = Module::Build->new ( module_name => 'Foo::Bar', license => 'perl', requires => { 'Some::Module' => '1.23' }, ); $build->dispatch('build'); $build->dispatch('test', verbose => 1); $build->dispatch('install'); The first argument to C is the name of the action, and any following arguments are named parameters. This is the interface we use to test Module::Build itself in the regression tests. =head2 Installing to a temporary directory To create packages for package managers like RedHat's C or Debian's C, you may need to install to a temporary directory first and then create the package from that temporary installation. To do this, specify the C parameter to the C action: ./Build install --destdir /tmp/my-package-1.003 This essentially just prepends all the installation paths with the F directory. =head2 Installing to a non-standard directory To install to a non-standard directory (for example, if you don't have permission to install in the system-wide directories), you can use the C or C parameters: ./Build install --install_base /foo/bar See L for a much more complete discussion of how installation paths are determined. =head2 Installing in the same location as ExtUtils::MakeMaker With the introduction of C<--prefix> in Module::Build 0.28 and C in C 6.31 its easy to get them both to install to the same locations. First, ensure you have at least version 0.28 of Module::Build installed and 6.31 of C. Prior versions have differing (and in some cases quite strange) installation behaviors. The following installation flags are equivalent between C and C. MakeMaker Module::Build PREFIX=... --prefix ... INSTALL_BASE=... --install_base ... DESTDIR=... --destdir ... LIB=... --install_path lib=... INSTALLDIRS=... --installdirs ... INSTALLDIRS=perl --installdirs core UNINST=... --uninst ... INC=... --extra_compiler_flags ... POLLUTE=1 --extra_compiler_flags -DPERL_POLLUTE For example, if you are currently installing C modules with this command: perl Makefile.PL PREFIX=~ make test make install UNINST=1 You can install into the same location with Module::Build using this: perl Build.PL --prefix ~ ./Build test ./Build install --uninst 1 =head3 C vs C The behavior of C is complicated and depends on how your Perl is configured. The resulting installation locations will vary from machine to machine and even different installations of Perl on the same machine. Because of this, it's difficult to document where C will place your modules. In contrast, C has predictable, easy to explain installation locations. Now that C and C both have C there is little reason to use C other than to preserve your existing installation locations. If you are starting a fresh Perl installation we encourage you to use C. If you have an existing installation installed via C, consider moving it to an installation structure matching C and using that instead. =head2 Running a single test file C supports running a single test, which enables you to track down errors more quickly. Use the following format: ./Build test --test_files t/mytest.t In addition, you may want to run the test in verbose mode to get more informative output: ./Build test --test_files t/mytest.t --verbose 1 I run this so frequently that I define the following shell alias: alias t './Build test --verbose 1 --test_files' So then I can just execute C to run a single test. =head1 ADVANCED RECIPES =head2 Making a CPAN.pm-compatible distribution New versions of CPAN.pm understand how to use a F script, but old versions don't. If authors want to help users who have old versions, some form of F should be supplied. The easiest way to accomplish this is to use the C parameter to C<< Module::Build->new() >> in the C script, which can create various flavors of F during the C action. As a best practice, we recommend using the "traditional" style of F unless your distribution has needs that can't be accomplished that way. The C module, which is part of C's distribution, is responsible for creating these Fs. Please see L for the details. =head2 Changing the order of the build process The C property specifies the steps C will take when building a distribution. To change the build order, change the order of the entries in that property: # Process pod files first my @e = @{$build->build_elements}; my ($i) = grep {$e[$_] eq 'pod'} 0..$#e; unshift @e, splice @e, $i, 1; Currently, C has the following default value: [qw( PL support pm xs pod script )] Do take care when altering this property, since there may be non-obvious (and non-documented!) ordering dependencies in the C code. =head2 Adding new file types to the build process Sometimes you might have extra types of files that you want to install alongside the standard types like F<.pm> and F<.pod> files. For instance, you might have a F file containing some data related to the C module and you'd like for it to end up as F somewhere in perl's C<@INC> path so C can access it easily at runtime. The following code from a sample C file demonstrates how to accomplish this: use Module::Build; my $build = Module::Build->new ( module_name => 'Foo::Bar', ...other stuff here... ); $build->add_build_element('dat'); $build->create_build_script; This will find all F<.dat> files in the F directory, copy them to the F directory during the C action, and install them during the C action. If your extra files aren't located in the C directory in your distribution, you can explicitly say where they are, just as you'd do with F<.pm> or F<.pod> files: use Module::Build; my $build = new Module::Build ( module_name => 'Foo::Bar', dat_files => {'some/dir/Bar.dat' => 'lib/Foo/Bar.dat'}, ...other stuff here... ); $build->add_build_element('dat'); $build->create_build_script; If your extra files actually need to be created on the user's machine, or if they need some other kind of special processing, you'll probably want to subclass C and create a special method to process them, named C: use Module::Build; my $class = Module::Build->subclass(code => <<'EOF'); sub process_dat_files { my $self = shift; ... locate and process *.dat files, ... and create something in blib/lib/ } EOF my $build = $class->new ( module_name => 'Foo::Bar', ...other stuff here... ); $build->add_build_element('dat'); $build->create_build_script; If your extra files don't go in F but in some other place, see L<"Adding new elements to the install process"> for how to actually get them installed. Please note that these examples use some capabilities of Module::Build that first appeared in version 0.26. Before that it could still be done, but the simple cases took a bit more work. =head2 Adding new elements to the install process By default, Module::Build creates seven subdirectories of the F directory during the build process: F, F, F, F