@@ -12,6 +12,8 @@ Revision history for autodie * DOCUMENTATION: The closedir() function is properly documented as being included in the :filesys tag. + * BUILD: Upgrade to Module::Intstall 0.77 + 1.992 Sun Sep 7 15:51:32 AUSEST 2008 * BUGFIX: unlink(), rename(), chdir() and closedir() functions Changes @@ -30,7 +30,7 @@ BEGIN { # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. - $VERSION = '0.75'; + $VERSION = '0.77'; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; @@ -125,8 +125,10 @@ sub autoload { goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; - unshift @_, ( $self, $1 ); - goto &{$self->can('call')} unless uc($1) eq $1; + unless ( uc($1) eq $1 ) { + unshift @_, ( $self, $1 ); + goto &{$self->can('call')}; + } }; } @@ -339,7 +341,10 @@ sub _write { close FH or die "close($_[0]): $!"; } -sub _version { +# _version is for processing module versions (eg, 1.03_05) not +# Perl versions (eg, 5.8.1). + +sub _version ($) { my $s = shift || 0; $s =~ s/^(\d+)\.?//; my $l = $1 || 0; @@ -348,6 +353,17 @@ sub _version { return $l + 0; } +# Cloned from Params::Util::_CLASS +sub _CLASS ($) { + ( + defined $_[0] + and + ! ref $_[0] + and + $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s + ) ? $_[0] : undef; +} + 1; # Copyright 2008 Adam Kennedy. inc/Module/Install.pm @@ -1,7 +1,7 @@ #line 1 package Module::Install::Base; -$VERSION = '0.75'; +$VERSION = '0.77'; # Suspend handler for "redefined" warnings BEGIN { @@ -45,6 +45,8 @@ sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } +#line 101 + sub is_admin { $_[0]->admin->VERSION; } @@ -67,4 +69,4 @@ BEGIN { 1; -#line 138 +#line 146 inc/Module/Install/Base.pm @@ -11,7 +11,7 @@ use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } @@ -39,6 +39,7 @@ sub can_run { return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { + next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } @@ -79,4 +80,4 @@ if ( $^O eq 'cygwin' ) { __END__ -#line 157 +#line 158 inc/Module/Install/Can.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } inc/Module/Install/Fetch.pm @@ -7,7 +7,7 @@ use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } @@ -36,9 +36,9 @@ sub prompt { sub makemaker_args { my $self = shift; - my $args = ($self->{makemaker_args} ||= {}); - %$args = ( %$args, @_ ) if @_; - $args; + my $args = ( $self->{makemaker_args} ||= {} ); + %$args = ( %$args, @_ ); + return $args; } # For mm args that take multiple space-seperated args, @@ -116,7 +116,13 @@ sub write { # Make sure we have a new enough require ExtUtils::MakeMaker; - $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION ); + + # MakeMaker can complain about module versions that include + # an underscore, even though its own version may contain one! + # Hence the funny regexp to get rid of it. See RT #35800 + # for details. + + $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); # Generate the my $args = $self->makemaker_args; @@ -175,7 +181,9 @@ sub write { my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { - $args{dist} = $preop; + foreach my $key ( keys %$preop ) { + $args{dist}->{$key} = $preop->{$key}; + } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); @@ -242,4 +250,4 @@ sub postamble { __END__ -#line 371 +#line 379 inc/Module/Install/Makefile.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } @@ -17,9 +17,7 @@ my @scalar_keys = qw{ abstract author version - license distribution_type - perl_version tests installdirs }; @@ -33,11 +31,18 @@ my @tuple_keys = qw{ resources }; -sub Meta { shift } -sub Meta_ScalarKeys { @scalar_keys } -sub Meta_TupleKeys { @tuple_keys } +my @resource_keys = qw{ + homepage + bugtracker + repository +}; + +sub Meta { shift } +sub Meta_ScalarKeys { @scalar_keys } +sub Meta_TupleKeys { @tuple_keys } +sub Meta_ResourceKeys { @resource_keys } -foreach my $key (@scalar_keys) { +foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; @@ -46,12 +51,30 @@ foreach my $key (@scalar_keys) { }; } +foreach my $key ( @resource_keys ) { + *$key = sub { + my $self = shift; + unless ( @_ ) { + return () unless $self->{values}{resources}; + return map { $_->[1] } + grep { $_->[0] eq $key } + @{ $self->{values}{resources} }; + } + return $self->{values}{resources}{$key} unless @_; + my $uri = shift or die( + "Did not provide a value to $key()" + ); + $self->resources( $key => $uri ); + return 1; + }; +} + sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; - push @{ $self->{values}->{requires} }, [ $module, $version ]; + push @{ $self->{values}{requires} }, [ $module, $version ]; } $self->{values}{requires}; } @@ -61,7 +84,7 @@ sub build_requires { while ( @_ ) { my $module = shift or last; my $version = shift || 0; - push @{ $self->{values}->{build_requires} }, [ $module, $version ]; + push @{ $self->{values}{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } @@ -71,9 +94,9 @@ sub configure_requires { while ( @_ ) { my $module = shift or last; my $version = shift || 0; - push @{ $self->{values}->{configure_requires} }, [ $module, $version ]; + push @{ $self->{values}{configure_requires} }, [ $module, $version ]; } - $self->{values}->{configure_requires}; + $self->{values}{configure_requires}; } sub recommends { @@ -81,9 +104,9 @@ sub recommends { while ( @_ ) { my $module = shift or last; my $version = shift || 0; - push @{ $self->{values}->{recommends} }, [ $module, $version ]; + push @{ $self->{values}{recommends} }, [ $module, $version ]; } - $self->{values}->{recommends}; + $self->{values}{recommends}; } sub bundles { @@ -91,26 +114,31 @@ sub bundles { while ( @_ ) { my $module = shift or last; my $version = shift || 0; - push @{ $self->{values}->{bundles} }, [ $module, $version ]; + push @{ $self->{values}{bundles} }, [ $module, $version ]; } - $self->{values}->{bundles}; + $self->{values}{bundles}; } # Resource handling +my %lc_resource = map { $_ => 1 } qw{ + homepage + license + bugtracker + repository +}; + sub resources { my $self = shift; while ( @_ ) { - my $resource = shift or last; - my $value = shift or next; - push @{ $self->{values}->{resources} }, [ $resource, $value ]; + my $name = shift or last; + my $value = shift or next; + if ( $name eq lc $name and ! $lc_resource{$name} ) { + die("Unsupported reserved lowercase resource '$name'"); + } + $self->{values}{resources} ||= []; + push @{ $self->{values}{resources} }, [ $name, $value ]; } - $self->{values}->{resources}; -} - -sub repository { - my $self = shift; - $self->resources( repository => shift ); - return 1; + $self->{values}{resources}; } # Aliases for build_requires that will have alternative @@ -126,30 +154,73 @@ sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; - return $self->{'values'}{'sign'} if defined wantarray and ! @_; - $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); + return $self->{values}{sign} if defined wantarray and ! @_; + $self->{values}{sign} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { - warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; + warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}{dynamic_config} = $_[0] ? 1 : 0; - return $self; + return 1; +} + +sub perl_version { + my $self = shift; + return $self->{values}{perl_version} unless @_; + my $version = shift or die( + "Did not provide a value to perl_version()" + ); + + # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to + # numbers (eg, 5.006001 or 5.008009). + + $version =~ s/^(\d+)\.(\d+)\.(\d+)$/sprintf("%d.%03d%03d",$1,$2,$3)/e; + + $version =~ s/_.+$//; + $version = $version + 0; # Numify + unless ( $version >= 5.005 ) { + die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; + } + $self->{values}{perl_version} = $version; + return 1; +} + +sub license { + my $self = shift; + return $self->{values}{license} unless @_; + my $license = shift or die( + 'Did not provide a value to license()' + ); + $self->{values}{license} = $license; + + # Automatically fill in license URLs + if ( $license eq 'perl' ) { + $self->resources( license => 'http://dev.perl.org/licenses/' ); + } + + return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { - my $name = $self->name - or die "all_from called with no args without setting name() first"; + my $name = $self->name or die( + "all_from called with no args without setting name() first" + ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; - die "all_from: cannot find $file from $name" unless -e $file; + unless ( -e $file ) { + die("all_from cannot find $file from $name"); + } + } + unless ( -f $file ) { + die("The path '$file' does not exist, or is not a file"); } # Some methods pull from POD instead of code. @@ -228,8 +299,8 @@ sub features { while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } - return $self->{values}->{features} - ? @{ $self->{values}->{features} } + return $self->{values}{features} + ? @{ $self->{values}{features} } : (); } @@ -303,7 +374,7 @@ sub name_from { $self->module_name($module_name); } } else { - die "Cannot determine name from $file\n"; + die("Cannot determine name from $file\n"); } } @@ -362,8 +433,12 @@ sub license_from { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, + 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, + 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, + 'GNU library general public license' => 'lgpl', 1, + 'GNU library public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, @@ -389,6 +464,24 @@ sub license_from { return 'unknown'; } +sub bugtracker_from { + my $self = shift; + my $content = Module::Install::_read($_[0]); + my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; + unless ( @links ) { + warn "Cannot determine bugtracker info from $_[0]\n"; + return 0; + } + if ( @links > 1 ) { + warn "Found more than on rt.cpan.org link in $_[0]\n"; + return 0; + } + + # Set the bugtracker + bugtracker( $links[0] ); + return 1; +} + sub install_script { my $self = shift; my $args = $self->makemaker_args; @@ -399,7 +492,7 @@ sub install_script { } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { - die "Cannot find script '$_'"; + die("Cannot find script '$_'"); } } } inc/Module/Install/Metadata.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.77'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } inc/Module/Install/Win32.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.77'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } inc/Module/Install/WriteAll.pm 3fbd1c9a99c654d00f340c9c48d91acad28c5ce0 Paul Fenwick pjf@perltraining.com.au http://github.com/pfenwick/autodie/commit/48b815fb631d205e9870b505081e96ae4611b387 48b815fb631d205e9870b505081e96ae4611b387 2008-09-13T17:45:56-07:00 2008-09-13T17:45:56-07:00 Upgrade to Module::Install 0.77 249a3f8796408095ca8799502ce2ac77fb894c32 Paul Fenwick pjf@perltraining.com.au