From: Tels Date: Sat, 16 Apr 2011 13:22:05 +0000 (+0100) Subject: Fix compilation under blead, and require at least 5.006 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6ea94d90d77e87b84ee176b42cce067047362a4c;p=p5sagit%2FDevel-Size.git Fix compilation under blead, and require at least 5.006 Compilation fix from Reini Urban. Also, upgrade Module::Install to 0.71 from 0.68, and regenerate SIGNATURE. --- diff --git a/CHANGES b/CHANGES index e8aaa3b..9a2eb5e 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,10 @@ Revision history for Perl extension Devel::Size. +0.70 2008-03-30 Tels 69 tests + * fix compilation under blead (Thanx Reini Urban!) + * require Perl 5.006 (to stop CPANTESTERS sending bogus reports + about failed compiling on ancient Perls) + 0.69 2007-08-11 Tels 69 tests * fix compilation under Perl v5.9.5 and v5.10 (Thanx Steve Peters!) * clarify the license by specifying Perl v5.8.8's license diff --git a/Makefile.PL b/Makefile.PL index 714a196..caf4519 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,22 +1,24 @@ use strict; +# require at least 5.006, it doesn't even compile under 5.005 +require 5.006; # Load the Module::Install bundled in ./inc/ use inc::Module::Install; -# The name of your distribution name 'Devel-Size'; # Get most of the details from the primary module all_from 'lib/Devel/Size.pm'; requires 'DynaLoader' => 0; +requires 'perl' => 5.006; recommends 'Devel::Size::Report' => 0.11; build_requires 'Test::More' => 0.42; -license 'perl'; +license 'perl'; # from 5.8.8 # It seems not to be possible to specifiy two authors here :/ # Nor does a "maintainer" property exist diff --git a/SIGNATURE b/SIGNATURE index 8ad3332..c1678db 100644 --- a/SIGNATURE +++ b/SIGNATURE @@ -1,5 +1,5 @@ This file contains message digests of all files listed in MANIFEST, -signed via the Module::Signature module, version 0.54. +signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: @@ -14,34 +14,34 @@ not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 199e3cacd2526d5d15e48916d13b7aef6699672d CHANGES +SHA1 72c048477b518b904272a671e1788782c9ef595a CHANGES SHA1 e4296437ed0ab5559b250f6016d52c3b547d672e MANIFEST SHA1 6883c1a98abd5b1c049e389f831e939b79c13ba5 MANIFEST.SKIP -SHA1 2ce5c32d4b38685bc3c98d46472c65632b5f204e META.yml -SHA1 6ed187e4890948dacf792b44ab18fa143a580ace Makefile.PL +SHA1 0da014103e9b00b59688688e60cfc79a533fc75a META.yml +SHA1 6c9a869815fa984597e1e2e2d8404bda9cac8c56 Makefile.PL SHA1 e73e2ea830b69aefd7525f73b1fc06df4bf607f5 README -SHA1 c4c21e25262e74d0f51789302a171ea1fa93832e Size.xs -SHA1 ceac99579ef3914de1936417282842c07d907a6a inc/Module/Install.pm -SHA1 6c9471c92c28e247fb84f4ab7dc277f68b33ea95 inc/Module/Install/Base.pm -SHA1 b2cb1026330e8c4f8533c79569498ab15f189d86 inc/Module/Install/Can.pm -SHA1 78acbad45c4289c228ead2278fc213ddd66bcead inc/Module/Install/Fetch.pm -SHA1 642e5b27f4cbbbe440e5dc05c639f5fb79875fe3 inc/Module/Install/Makefile.pm -SHA1 80d024f3eccf1c825b02b5e59de236b0af7d4bfc inc/Module/Install/Metadata.pm -SHA1 fe6780ea5cfd67c79140699fbd4f0fe262255d57 inc/Module/Install/Win32.pm -SHA1 51d43bffcfd7ffdecb8c8e9f97f3896c31b2e1b2 inc/Module/Install/WriteAll.pm -SHA1 3a771cfbe85a36702ce8386c4dc0635bd461986c lib/Devel/Size.pm -SHA1 b10a47370115165b080e143db320fc9873d24ce1 t/basic.t +SHA1 c8500a5602417e1714f1f4e388fa24e83e9d357d Size.xs +SHA1 d8f6d2df4e75cb9e6e77a8377457f0ececd00e31 inc/Module/Install.pm +SHA1 03590cde5c3de0d0d8a84d2b96917ed1a2cf9a30 inc/Module/Install/Base.pm +SHA1 8ef3c70e905be7d1007b446f21d4eb3ff6ae24cb inc/Module/Install/Can.pm +SHA1 79054604a1cd4e99443b05cbb62832568a204a33 inc/Module/Install/Fetch.pm +SHA1 dfa433f2f41d990946f1b3d68a29299539f2dea6 inc/Module/Install/Makefile.pm +SHA1 72cab336b6be5716aae0a1cb6d9add6c98a7a1f5 inc/Module/Install/Metadata.pm +SHA1 35a62725a7eade0fa617ef2ba4cf2f4d4a69a3fe inc/Module/Install/Win32.pm +SHA1 19dcc6d1e9f02c56d3f6d184642f4cd68aa371e6 inc/Module/Install/WriteAll.pm +SHA1 44bade83bb938b5ec9adeb68dcf343482ea5ccde lib/Devel/Size.pm +SHA1 362d6cb703b599a483563c84062e23b786c25d65 t/basic.t SHA1 dc638392e64661dd07deeba11f67e35650a6384a t/pod.t SHA1 f4ffad1e7160c51cefcd003f88e1deb1c897b344 t/pod_cov.t -SHA1 5cde1f755eaaf29fdffd6885764fc78dedf5d7ae t/recurse.t +SHA1 214b335fb4c2f01f164cae6a49ad738ba3b5dfbd t/recurse.t -----BEGIN PGP SIGNATURE----- -Version: GnuPG v1.4.2 (GNU/Linux) +Version: GnuPG v1.4.6 (GNU/Linux) -iQEVAwUBRr8TY3cLPEOTuEwVAQLUlwf+MxR/N3qd8DCkLKrxBOlINwIifDWou6Hw -TR+14Q1KyurpItruNGqbCKpbhJin9LdynWbbWugJy5waf3WkqCedZ+Kat2fvGoZY -CDypeXf+9yzG23+VKpN3qsXFPemoN7g5Tbvxt2mOXauvEXcOz87agO/DxiAWyfTZ -FVulD2f4ZqOTQZSFio/4uIxn9aqmMLHPGTjOYFKs6XnhfqsvNYtqgfR3Lc61ljGS -WV0NnRDlwthwbttOWn+UaZdQNZMmeVNndVFPy4hBE/VoyqpWarfqvvNVq6I4v+hh -QWfHNPLFqcauVa6E+X17rjQMuKeQ7Y+RcHg24dMbc3NvDL0um+qK3w== -=Db+y +iQEVAwUBR+9H8HcLPEOTuEwVAQKfqgf/Vc3uKJIPtZlBbAKH3lSF5ciaV7W+TWYD +dWOxME+nWAGZWXviZ74oHyIw1t5v8kh7Hjb+/afg5zyOHATzPS0GEY3cCMUmS5bD +AKnijm3p9Ti8f/hDESlfRxDq9FVDMdx3Bq2LtYqwW9P2PMEX82XWvrtB6FuWu9iW +cDTvs059YdxX8WJRpNGaPUZZTEMaXflzP61RR8fhu5Hsa900EOflCQvZMXEj3SVy +zmG5QY/pZ5lG8Bpx8m3zt72/6CB35DnsJBUSfo2sCmlu7c2q/biF4IdCxozw6PKI +Jf4myGKngIxSADpMAAZXN89nrq3AAteh10dJfLLP3hIzYqFaEr2t+A== +=YqJj -----END PGP SIGNATURE----- diff --git a/Size.xs b/Size.xs index de1251e..c69c348 100644 --- a/Size.xs +++ b/Size.xs @@ -198,12 +198,17 @@ UV regex_size(REGEXP *baseregex, HV *tracking_hash) { UV total_size = 0; total_size += sizeof(REGEXP); - /* Note hte size of the paren offset thing */ +#if (PERL_VERSION < 11) + /* Note the size of the paren offset thing */ total_size += sizeof(I32) * baseregex->nparens * 2; total_size += strlen(baseregex->precomp); - +#else + total_size += sizeof(struct regexp); + total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2; + /*total_size += strlen(SvANY(baseregex)->subbeg);*/ +#endif if (go_yell && !regex_whine) { - carp("Devel::Size: Calculated sizes for compiled regexes are incomple, and probably always will be"); + carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be"); regex_whine = 1; } @@ -383,12 +388,14 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { total_size += sizeof(NV); #endif break; +#if (PERL_VERSION < 11) /* Is it a reference? */ case SVt_RV: #ifndef NEW_HEAD_LAYOUT total_size += sizeof(XRV); #endif break; +#endif /* How about a plain string? In which case we need to add in how much has been allocated */ case SVt_PV: diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm index 89a8653..760da11 100644 --- a/inc/Module/Install.pm +++ b/inc/Module/Install.pm @@ -17,20 +17,26 @@ package Module::Install; # 3. The ./inc/ version of Module::Install loads # } -use 5.004; +BEGIN { + require 5.004; +} use strict 'vars'; use vars qw{$VERSION}; BEGIN { - # All Module::Install core packages now require synchronised versions. - # This will be used to ensure we don't accidentally load old or - # different versions of modules. - # 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.68'; + # All Module::Install core packages now require synchronised versions. + # This will be used to ensure we don't accidentally load old or + # different versions of modules. + # 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.71'; } + + + + # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. @@ -38,26 +44,29 @@ BEGIN { # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; -unless ( $INC{$file} ) { - die <<"END_DIE"; +unless ( $INC{$file} ) { die <<"END_DIE" } + Please invoke ${\__PACKAGE__} with: - use inc::${\__PACKAGE__}; + use inc::${\__PACKAGE__}; not: - use ${\__PACKAGE__}; + use ${\__PACKAGE__}; END_DIE -} + + + + # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. -if ( -f $0 and (stat($0))[9] > time ) { - die << "END_DIE"; +if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } + Your installer $0 has a modification time in the future. This is known to create infinite loops in make. @@ -65,7 +74,26 @@ This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE -} + + + + + +# Build.PL was formerly supported, but no longer is due to excessive +# difficulty in implementing every single feature twice. +if ( $0 =~ /Build.PL$/i or -f 'Build.PL' ) { die <<"END_DIE" } + +Module::Install no longer supports Build.PL. + +It was impossible to maintain duel backends, and has been deprecated. + +Please remove all Build.PL files and only use the Makefile.PL installer. + +END_DIE + + + + use Cwd (); use File::Find (); @@ -76,104 +104,106 @@ use FindBin; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { - my $self = shift; - my $who = $self->_caller; - my $cwd = Cwd::cwd(); - my $sym = "${who}::AUTOLOAD"; - $sym->{$cwd} = sub { - my $pwd = Cwd::cwd(); - if ( my $code = $sym->{$pwd} ) { - # delegate back to parent dirs - 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; - }; + my $self = shift; + my $who = $self->_caller; + my $cwd = Cwd::cwd(); + my $sym = "${who}::AUTOLOAD"; + $sym->{$cwd} = sub { + my $pwd = Cwd::cwd(); + if ( my $code = $sym->{$pwd} ) { + # delegate back to parent dirs + 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; + }; } sub import { - my $class = shift; - my $self = $class->new(@_); - my $who = $self->_caller; - - unless ( -f $self->{file} ) { - require "$self->{path}/$self->{dispatch}.pm"; - File::Path::mkpath("$self->{prefix}/$self->{author}"); - $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); - $self->{admin}->init; - @_ = ($class, _self => $self); - goto &{"$self->{name}::import"}; - } - - *{"${who}::AUTOLOAD"} = $self->autoload; - $self->preload; - - # Unregister loader and worker packages so subdirs can use them again - delete $INC{"$self->{file}"}; - delete $INC{"$self->{path}.pm"}; + my $class = shift; + my $self = $class->new(@_); + my $who = $self->_caller; + + unless ( -f $self->{file} ) { + require "$self->{path}/$self->{dispatch}.pm"; + File::Path::mkpath("$self->{prefix}/$self->{author}"); + $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); + $self->{admin}->init; + @_ = ($class, _self => $self); + goto &{"$self->{name}::import"}; + } + + *{"${who}::AUTOLOAD"} = $self->autoload; + $self->preload; + + # Unregister loader and worker packages so subdirs can use them again + delete $INC{"$self->{file}"}; + delete $INC{"$self->{path}.pm"}; + + return 1; } sub preload { - my ($self) = @_; - - unless ( $self->{extensions} ) { - $self->load_extensions( - "$self->{prefix}/$self->{path}", $self - ); - } - - my @exts = @{$self->{extensions}}; - unless ( @exts ) { - my $admin = $self->{admin}; - @exts = $admin->load_all_extensions; - } - - my %seen; - foreach my $obj ( @exts ) { - while (my ($method, $glob) = each %{ref($obj) . '::'}) { - next unless $obj->can($method); - next if $method =~ /^_/; - next if $method eq uc($method); - $seen{$method}++; - } - } - - my $who = $self->_caller; - foreach my $name ( sort keys %seen ) { - *{"${who}::$name"} = sub { - ${"${who}::AUTOLOAD"} = "${who}::$name"; - goto &{"${who}::AUTOLOAD"}; - }; - } + my $self = shift; + unless ( $self->{extensions} ) { + $self->load_extensions( + "$self->{prefix}/$self->{path}", $self + ); + } + + my @exts = @{$self->{extensions}}; + unless ( @exts ) { + my $admin = $self->{admin}; + @exts = $admin->load_all_extensions; + } + + my %seen; + foreach my $obj ( @exts ) { + while (my ($method, $glob) = each %{ref($obj) . '::'}) { + next unless $obj->can($method); + next if $method =~ /^_/; + next if $method eq uc($method); + $seen{$method}++; + } + } + + my $who = $self->_caller; + foreach my $name ( sort keys %seen ) { + *{"${who}::$name"} = sub { + ${"${who}::AUTOLOAD"} = "${who}::$name"; + goto &{"${who}::AUTOLOAD"}; + }; + } } sub new { - my ($class, %args) = @_; - - # ignore the prefix on extension modules built from top level. - my $base_path = Cwd::abs_path($FindBin::Bin); - unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { - delete $args{prefix}; - } - - return $args{_self} if $args{_self}; - - $args{dispatch} ||= 'Admin'; - $args{prefix} ||= 'inc'; - $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); - $args{bundle} ||= 'inc/BUNDLES'; - $args{base} ||= $base_path; - $class =~ s/^\Q$args{prefix}\E:://; - $args{name} ||= $class; - $args{version} ||= $class->VERSION; - unless ( $args{path} ) { - $args{path} = $args{name}; - $args{path} =~ s!::!/!g; - } - $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; - - bless( \%args, $class ); + my ($class, %args) = @_; + + # ignore the prefix on extension modules built from top level. + my $base_path = Cwd::abs_path($FindBin::Bin); + unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { + delete $args{prefix}; + } + + return $args{_self} if $args{_self}; + + $args{dispatch} ||= 'Admin'; + $args{prefix} ||= 'inc'; + $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); + $args{bundle} ||= 'inc/BUNDLES'; + $args{base} ||= $base_path; + $class =~ s/^\Q$args{prefix}\E:://; + $args{name} ||= $class; + $args{version} ||= $class->VERSION; + unless ( $args{path} ) { + $args{path} = $args{name}; + $args{path} =~ s!::!/!g; + } + $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; + $args{wrote} = 0; + + bless( \%args, $class ); } sub call { @@ -184,98 +214,130 @@ sub call { } sub load { - my ($self, $method) = @_; + my ($self, $method) = @_; - $self->load_extensions( - "$self->{prefix}/$self->{path}", $self - ) unless $self->{extensions}; + $self->load_extensions( + "$self->{prefix}/$self->{path}", $self + ) unless $self->{extensions}; - foreach my $obj (@{$self->{extensions}}) { - return $obj if $obj->can($method); - } + foreach my $obj (@{$self->{extensions}}) { + return $obj if $obj->can($method); + } - my $admin = $self->{admin} or die <<"END_DIE"; + my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE - my $obj = $admin->load($method, 1); - push @{$self->{extensions}}, $obj; + my $obj = $admin->load($method, 1); + push @{$self->{extensions}}, $obj; - $obj; + $obj; } sub load_extensions { - my ($self, $path, $top) = @_; - - unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { - unshift @INC, $self->{prefix}; - } - - foreach my $rv ( $self->find_extensions($path) ) { - my ($file, $pkg) = @{$rv}; - next if $self->{pathnames}{$pkg}; - - local $@; - my $new = eval { require $file; $pkg->can('new') }; - unless ( $new ) { - warn $@ if $@; - next; - } - $self->{pathnames}{$pkg} = delete $INC{$file}; - push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); - } - - $self->{extensions} ||= []; + my ($self, $path, $top) = @_; + + unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { + unshift @INC, $self->{prefix}; + } + + foreach my $rv ( $self->find_extensions($path) ) { + my ($file, $pkg) = @{$rv}; + next if $self->{pathnames}{$pkg}; + + local $@; + my $new = eval { require $file; $pkg->can('new') }; + unless ( $new ) { + warn $@ if $@; + next; + } + $self->{pathnames}{$pkg} = delete $INC{$file}; + push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); + } + + $self->{extensions} ||= []; } sub find_extensions { - my ($self, $path) = @_; - - my @found; - File::Find::find( sub { - my $file = $File::Find::name; - return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; - my $subpath = $1; - return if lc($subpath) eq lc($self->{dispatch}); - - $file = "$self->{path}/$subpath.pm"; - my $pkg = "$self->{name}::$subpath"; - $pkg =~ s!/!::!g; - - # If we have a mixed-case package name, assume case has been preserved - # correctly. Otherwise, root through the file to locate the case-preserved - # version of the package name. - if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { - open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; - my $in_pod = 0; - while ( ) { - $in_pod = 1 if /^=\w/; - $in_pod = 0 if /^=cut/; - next if ($in_pod || /^=cut/); # skip pod text - next if /^\s*#/; # and comments - if ( m/^\s*package\s+($pkg)\s*;/i ) { - $pkg = $1; - last; - } - } - close PKGFILE; - } - - push @found, [ $file, $pkg ]; - }, $path ) if -d $path; - - @found; + my ($self, $path) = @_; + + my @found; + File::Find::find( sub { + my $file = $File::Find::name; + return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; + my $subpath = $1; + return if lc($subpath) eq lc($self->{dispatch}); + + $file = "$self->{path}/$subpath.pm"; + my $pkg = "$self->{name}::$subpath"; + $pkg =~ s!/!::!g; + + # If we have a mixed-case package name, assume case has been preserved + # correctly. Otherwise, root through the file to locate the case-preserved + # version of the package name. + if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { + my $content = Module::Install::_read($subpath . '.pm'); + my $in_pod = 0; + foreach ( split //, $content ) { + $in_pod = 1 if /^=\w/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); # skip pod text + next if /^\s*#/; # and comments + if ( m/^\s*package\s+($pkg)\s*;/i ) { + $pkg = $1; + last; + } + } + } + + push @found, [ $file, $pkg ]; + }, $path ) if -d $path; + + @found; } + + + + +##################################################################### +# Utility Functions + sub _caller { - my $depth = 0; - my $call = caller($depth); - while ( $call eq __PACKAGE__ ) { - $depth++; - $call = caller($depth); - } - return $call; + my $depth = 0; + my $call = caller($depth); + while ( $call eq __PACKAGE__ ) { + $depth++; + $call = caller($depth); + } + return $call; +} + +sub _read { + local *FH; + open FH, "< $_[0]" or die "open($_[0]): $!"; + my $str = do { local $/; }; + close FH or die "close($_[0]): $!"; + return $str; +} + +sub _write { + local *FH; + open FH, "> $_[0]" or die "open($_[0]): $!"; + foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } + close FH or die "close($_[0]): $!"; +} + +sub _version { + my $s = shift || 0; + $s =~ s/^(\d+)\.?//; + my $l = $1 || 0; + my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; + $l = $l . '.' . join '', @v if @v; + return $l + 0; } 1; + +# Copyright 2008 Adam Kennedy. diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm index 49dfde6..f07878d 100644 --- a/inc/Module/Install/Base.pm +++ b/inc/Module/Install/Base.pm @@ -1,7 +1,7 @@ #line 1 package Module::Install::Base; -$VERSION = '0.68'; +$VERSION = '0.71'; # Suspend handler for "redefined" warnings BEGIN { diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm index ec66fdb..410a0fc 100644 --- a/inc/Module/Install/Can.pm +++ b/inc/Module/Install/Can.pm @@ -11,7 +11,7 @@ use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.68'; + $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm index e0dd6db..f7cd58e 100644 --- a/inc/Module/Install/Fetch.pm +++ b/inc/Module/Install/Fetch.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.68'; + $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm index 17bd8a7..3bfaf4c 100644 --- a/inc/Module/Install/Makefile.pm +++ b/inc/Module/Install/Makefile.pm @@ -7,7 +7,7 @@ use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.68'; + $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } @@ -37,7 +37,7 @@ sub prompt { sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); - %$args = ( %$args, @_ ) if @_; + %$args = ( %$args, @_ ) if @_; $args; } @@ -63,18 +63,18 @@ sub build_subdirs { sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; - %$clean = ( + %$clean = ( %$clean, - FILES => join(' ', grep length, $clean->{FILES}, @_), + FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { - my $self = shift; + my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; - %$realclean = ( + %$realclean = ( %$realclean, - FILES => join(' ', grep length, $realclean->{FILES}, @_), + FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } @@ -104,8 +104,8 @@ sub tests_recursive { unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } - require File::Find; %test_dir = (); + require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } @@ -114,10 +114,15 @@ sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; + # Make sure we have a new enough + require ExtUtils::MakeMaker; + $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION ); + + # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; - $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); - $args->{VERSION} = $self->version || $self->determine_VERSION($args); + $args->{NAME} = $self->module_name || $self->name; + $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; @@ -142,9 +147,12 @@ sub write { map { @$_ } map { @$_ } grep $_, - ($self->build_requires, $self->requires) + ($self->configure_requires, $self->build_requires, $self->requires) ); + # Remove any reference to perl, PREREQ_PM doesn't support it + delete $args->{PREREQ_PM}->{perl}; + # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { @@ -205,7 +213,7 @@ sub fix_up_makefile { #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. - $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; + $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; @@ -234,4 +242,4 @@ sub postamble { __END__ -#line 363 +#line 371 diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm index f77d68a..3552f86 100644 --- a/inc/Module/Install/Metadata.pm +++ b/inc/Module/Install/Metadata.pm @@ -6,18 +6,30 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.68'; + $VERSION = '0.71'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ - name module_name abstract author version license - distribution_type perl_version tests installdirs + name + module_name + abstract + author + version + license + distribution_type + perl_version + tests + installdirs }; my @tuple_keys = qw{ - build_requires requires recommends bundles + configure_requires + build_requires + requires + recommends + bundles }; sub Meta { shift } @@ -25,44 +37,68 @@ sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { - *$key = sub { - my $self = shift; - return $self->{values}{$key} if defined wantarray and !@_; - $self->{values}{$key} = shift; - return $self; - }; + *$key = sub { + my $self = shift; + return $self->{values}{$key} if defined wantarray and !@_; + $self->{values}{$key} = shift; + return $self; + }; +} + +sub requires { + my $self = shift; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @{ $self->{values}->{requires} }, [ $module, $version ]; + } + $self->{values}{requires}; } -foreach my $key (@tuple_keys) { - *$key = sub { - my $self = shift; - return $self->{values}{$key} unless @_; - - my @rv; - while (@_) { - my $module = shift or last; - my $version = shift || 0; - if ( $module eq 'perl' ) { - $version =~ s{^(\d+)\.(\d+)\.(\d+)} - {$1 + $2/1_000 + $3/1_000_000}e; - $self->perl_version($version); - next; - } - my $rv = [ $module, $version ]; - push @rv, $rv; - } - push @{ $self->{values}{$key} }, @rv; - @rv; - }; +sub build_requires { + my $self = shift; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @{ $self->{values}->{build_requires} }, [ $module, $version ]; + } + $self->{values}{build_requires}; } -# configure_requires is currently a null-op -sub configure_requires { 1 } +sub configure_requires { + my $self = shift; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @{ $self->{values}->{configure_requires} }, [ $module, $version ]; + } + $self->{values}{configure_requires}; +} + +sub recommends { + my $self = shift; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @{ $self->{values}->{recommends} }, [ $module, $version ]; + } + $self->{values}{recommends}; +} + +sub bundles { + my $self = shift; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @{ $self->{values}->{bundles} }, [ $module, $version ]; + } + $self->{values}{bundles}; +} # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. -sub test_requires { shift->build_requires(@_) } -sub install_requires { shift->build_requires(@_) } +sub test_requires { shift->build_requires(@_) } +sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } @@ -71,10 +107,10 @@ sub install_as_site { $_[0]->installdirs('site') } 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; + my $self = shift; + return $self->{'values'}{'sign'} if defined wantarray and ! @_; + $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); + return $self; } sub dynamic_config { @@ -83,254 +119,253 @@ sub dynamic_config { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } - $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; + $self->{values}{dynamic_config} = $_[0] ? 1 : 0; return $self; } 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"; - $file = join('/', 'lib', split(/-/, $name)) . '.pm'; - $file =~ s{.*/}{} unless -e $file; - die "all_from: cannot find $file from $name" unless -e $file; - } - - $self->version_from($file) unless $self->version; - $self->perl_version_from($file) unless $self->perl_version; - - # The remaining probes read from POD sections; if the file - # has an accompanying .pod, use that instead - my $pod = $file; - if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { - $file = $pod; - } - - $self->author_from($file) unless $self->author; - $self->license_from($file) unless $self->license; - $self->abstract_from($file) unless $self->abstract; + my ( $self, $file ) = @_; + + unless ( defined($file) ) { + 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; + } + + # Some methods pull from POD instead of code. + # If there is a matching .pod, use that instead + my $pod = $file; + $pod =~ s/\.pm$/.pod/i; + $pod = $file unless -e $pod; + + # Pull the different values + $self->name_from($file) unless $self->name; + $self->version_from($file) unless $self->version; + $self->perl_version_from($file) unless $self->perl_version; + $self->author_from($pod) unless $self->author; + $self->license_from($pod) unless $self->license; + $self->abstract_from($pod) unless $self->abstract; + + return 1; } sub provides { - my $self = shift; - my $provides = ( $self->{values}{provides} ||= {} ); - %$provides = (%$provides, @_) if @_; - return $provides; + my $self = shift; + my $provides = ( $self->{values}{provides} ||= {} ); + %$provides = (%$provides, @_) if @_; + return $provides; } sub auto_provides { - my $self = shift; - return $self unless $self->is_admin; - - unless (-e 'MANIFEST') { - warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; - return $self; - } - - # Avoid spurious warnings as we are not checking manifest here. - - local $SIG{__WARN__} = sub {1}; - require ExtUtils::Manifest; - local *ExtUtils::Manifest::manicheck = sub { return }; - - require Module::Build; - my $build = Module::Build->new( - dist_name => $self->name, - dist_version => $self->version, - license => $self->license, - ); - $self->provides(%{ $build->find_dist_packages || {} }); + my $self = shift; + return $self unless $self->is_admin; + unless (-e 'MANIFEST') { + warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; + return $self; + } + # Avoid spurious warnings as we are not checking manifest here. + local $SIG{__WARN__} = sub {1}; + require ExtUtils::Manifest; + local *ExtUtils::Manifest::manicheck = sub { return }; + + require Module::Build; + my $build = Module::Build->new( + dist_name => $self->name, + dist_version => $self->version, + license => $self->license, + ); + $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { - my $self = shift; - my $name = shift; - my $features = ( $self->{values}{features} ||= [] ); - - my $mods; - - if ( @_ == 1 and ref( $_[0] ) ) { - # The user used ->feature like ->features by passing in the second - # argument as a reference. Accomodate for that. - $mods = $_[0]; - } else { - $mods = \@_; - } - - my $count = 0; - push @$features, ( - $name => [ - map { - ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ - : @$_ - : $_ - } @$mods - ] - ); - - return @$features; + my $self = shift; + my $name = shift; + my $features = ( $self->{values}{features} ||= [] ); + my $mods; + + if ( @_ == 1 and ref( $_[0] ) ) { + # The user used ->feature like ->features by passing in the second + # argument as a reference. Accomodate for that. + $mods = $_[0]; + } else { + $mods = \@_; + } + + my $count = 0; + push @$features, ( + $name => [ + map { + ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ + } @$mods + ] + ); + + return @$features; } sub features { - my $self = shift; - while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { - $self->feature( $name, @$mods ); - } - return $self->{values}->{features} - ? @{ $self->{values}->{features} } - : (); + my $self = shift; + while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { + $self->feature( $name, @$mods ); + } + return $self->{values}->{features} + ? @{ $self->{values}->{features} } + : (); } sub no_index { - my $self = shift; - my $type = shift; - push @{ $self->{values}{no_index}{$type} }, @_ if $type; - return $self->{values}{no_index}; + my $self = shift; + my $type = shift; + push @{ $self->{values}{no_index}{$type} }, @_ if $type; + return $self->{values}{no_index}; } sub read { - my $self = shift; - $self->include_deps( 'YAML', 0 ); - - require YAML; - my $data = YAML::LoadFile('META.yml'); - - # Call methods explicitly in case user has already set some values. - while ( my ( $key, $value ) = each %$data ) { - next unless $self->can($key); - if ( ref $value eq 'HASH' ) { - while ( my ( $module, $version ) = each %$value ) { - $self->can($key)->($self, $module => $version ); - } - } - else { - $self->can($key)->($self, $value); - } - } - return $self; + my $self = shift; + $self->include_deps( 'YAML::Tiny', 0 ); + + require YAML::Tiny; + my $data = YAML::Tiny::LoadFile('META.yml'); + + # Call methods explicitly in case user has already set some values. + while ( my ( $key, $value ) = each %$data ) { + next unless $self->can($key); + if ( ref $value eq 'HASH' ) { + while ( my ( $module, $version ) = each %$value ) { + $self->can($key)->($self, $module => $version ); + } + } else { + $self->can($key)->($self, $value); + } + } + return $self; } sub write { - my $self = shift; - return $self unless $self->is_admin; - $self->admin->write_meta; - return $self; + my $self = shift; + return $self unless $self->is_admin; + $self->admin->write_meta; + return $self; } sub version_from { - my ( $self, $file ) = @_; - require ExtUtils::MM_Unix; - $self->version( ExtUtils::MM_Unix->parse_version($file) ); + require ExtUtils::MM_Unix; + my ( $self, $file ) = @_; + $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { - my ( $self, $file ) = @_; - require ExtUtils::MM_Unix; - $self->abstract( - bless( - { DISTNAME => $self->name }, - 'ExtUtils::MM_Unix' - )->parse_abstract($file) - ); + require ExtUtils::MM_Unix; + my ( $self, $file ) = @_; + $self->abstract( + bless( + { DISTNAME => $self->name }, + 'ExtUtils::MM_Unix' + )->parse_abstract($file) + ); } -sub _slurp { - my ( $self, $file ) = @_; - - local *FH; - open FH, "< $file" or die "Cannot open $file.pod: $!"; - do { local $/; }; +sub name_from { + my $self = shift; + if ( + Module::Install::_read($_[0]) =~ m/ + ^ \s + package \s* + ([\w:]+) + \s* ; + /ixms + ) { + my $name = $1; + $name =~ s{::}{-}g; + $self->name($name); + } else { + die "Cannot determine name from $_[0]\n"; + return; + } } sub perl_version_from { - my ( $self, $file ) = @_; - - if ( - $self->_slurp($file) =~ m/ - ^ - use \s* - v? - ([\d_\.]+) - \s* ; - /ixms - ) - { - my $v = $1; - $v =~ s{_}{}g; - $self->perl_version($1); - } - else { - warn "Cannot determine perl version info from $file\n"; - return; - } + my $self = shift; + if ( + Module::Install::_read($_[0]) =~ m/ + ^ + use \s* + v? + ([\d_\.]+) + \s* ; + /ixms + ) { + my $perl_version = $1; + $perl_version =~ s{_}{}g; + $self->perl_version($perl_version); + } else { + warn "Cannot determine perl version info from $_[0]\n"; + return; + } } sub author_from { - my ( $self, $file ) = @_; - my $content = $self->_slurp($file); - if ($content =~ m/ - =head \d \s+ (?:authors?)\b \s* - ([^\n]*) - | - =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* - .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* - ([^\n]*) - /ixms) { - my $author = $1 || $2; - $author =~ s{E}{<}g; - $author =~ s{E}{>}g; - $self->author($author); - } - else { - warn "Cannot determine author info from $file\n"; - } + my $self = shift; + my $content = Module::Install::_read($_[0]); + if ($content =~ m/ + =head \d \s+ (?:authors?)\b \s* + ([^\n]*) + | + =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* + .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* + ([^\n]*) + /ixms) { + my $author = $1 || $2; + $author =~ s{E}{<}g; + $author =~ s{E}{>}g; + $self->author($author); + } else { + warn "Cannot determine author info from $_[0]\n"; + } } sub license_from { - my ( $self, $file ) = @_; - - if ( - $self->_slurp($file) =~ m/ - ( - =head \d \s+ - (?:licen[cs]e|licensing|copyright|legal)\b - .*? - ) - (=head\\d.*|=cut.*|) - \z - /ixms - ) - { - my $license_text = $1; - my @phrases = ( - 'under the same (?:terms|license) as perl itself' => 'perl', 1, - 'GNU public license' => 'gpl', 1, - 'GNU lesser public license' => 'gpl', 1, - 'BSD license' => 'bsd', 1, - 'Artistic license' => 'artistic', 1, - 'GPL' => 'gpl', 1, - 'LGPL' => 'lgpl', 1, - 'BSD' => 'bsd', 1, - 'Artistic' => 'artistic', 1, - 'MIT' => 'mit', 1, - 'proprietary' => 'proprietary', 0, - ); - while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { - $pattern =~ s{\s+}{\\s+}g; - if ( $license_text =~ /\b$pattern\b/i ) { - if ( $osi and $license_text =~ /All rights reserved/i ) { - warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; + my $self = shift; + if ( + Module::Install::_read($_[0]) =~ m/ + ( + =head \d \s+ + (?:licen[cs]e|licensing|copyright|legal)\b + .*? + ) + (=head\\d.*|=cut.*|) + \z + /ixms ) { + my $license_text = $1; + my @phrases = ( + 'under the same (?:terms|license) as perl itself' => 'perl', 1, + 'GNU public license' => 'gpl', 1, + 'GNU lesser public license' => 'lgpl', 1, + 'BSD license' => 'bsd', 1, + 'Artistic license' => 'artistic', 1, + 'GPL' => 'gpl', 1, + 'LGPL' => 'lgpl', 1, + 'BSD' => 'bsd', 1, + 'Artistic' => 'artistic', 1, + 'MIT' => 'mit', 1, + 'proprietary' => 'proprietary', 0, + ); + while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { + $pattern =~ s{\s+}{\\s+}g; + if ( $license_text =~ /\b$pattern\b/i ) { + if ( $osi and $license_text =~ /All rights reserved/i ) { + warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; + } + $self->license($license); + return 1; + } } - $self->license($license); - return 1; - } - } - } - - warn "Cannot determine license info from $file\n"; - return 'unknown'; + } + + warn "Cannot determine license info from $_[0]\n"; + return 'unknown'; } 1; diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm index 4f808c7..dcc6f57 100644 --- a/inc/Module/Install/Win32.pm +++ b/inc/Module/Install/Win32.pm @@ -4,11 +4,11 @@ package Module::Install::Win32; use strict; use Module::Install::Base; -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.68'; - $ISCORE = 1; + $VERSION = '0.71'; @ISA = qw{Module::Install::Base}; + $ISCORE = 1; } # determine if the user needs nmake, and download it if needed @@ -16,7 +16,7 @@ sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); - + require Config; return unless ( $^O eq 'MSWin32' and @@ -38,8 +38,7 @@ sub check_nmake { remove => 1, ); - if (!$rv) { - die <<'END_MESSAGE'; + die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- @@ -59,7 +58,7 @@ You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE - } + } 1; diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm index 078797c..13437e6 100644 --- a/inc/Module/Install/WriteAll.pm +++ b/inc/Module/Install/WriteAll.pm @@ -4,40 +4,37 @@ package Module::Install::WriteAll; use strict; use Module::Install::Base; -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.68'; - $ISCORE = 1; + $VERSION = '0.71'; @ISA = qw{Module::Install::Base}; + $ISCORE = 1; } sub WriteAll { - my $self = shift; - my %args = ( - meta => 1, - sign => 0, - inline => 0, - check_nmake => 1, - @_ - ); + my $self = shift; + my %args = ( + meta => 1, + sign => 0, + inline => 0, + check_nmake => 1, + @_, + ); + + $self->sign(1) if $args{sign}; + $self->Meta->write if $args{meta}; + $self->admin->WriteAll(%args) if $self->is_admin; - $self->sign(1) if $args{sign}; - $self->Meta->write if $args{meta}; - $self->admin->WriteAll(%args) if $self->is_admin; + $self->check_nmake if $args{check_nmake}; + unless ( $self->makemaker_args->{PL_FILES} ) { + $self->makemaker_args( PL_FILES => {} ); + } - if ( $0 =~ /Build.PL$/i ) { - $self->Build->write; - } else { - $self->check_nmake if $args{check_nmake}; - unless ( $self->makemaker_args->{'PL_FILES'} ) { - $self->makemaker_args( PL_FILES => {} ); - } - if ($args{inline}) { - $self->Inline->write; - } else { - $self->Makefile->write; - } - } + if ( $args{inline} ) { + $self->Inline->write; + } else { + $self->Makefile->write; + } } 1; diff --git a/lib/Devel/Size.pm b/lib/Devel/Size.pm index 1d8c06a..326b991 100644 --- a/lib/Devel/Size.pm +++ b/lib/Devel/Size.pm @@ -3,6 +3,7 @@ package Devel::Size; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $warn); +require 5.006; require Exporter; require DynaLoader; @@ -25,6 +26,8 @@ $warn = 1; 1; __END__ +=pod + =head1 NAME Devel::Size - Perl extension for finding the memory usage of Perl variables @@ -243,7 +246,7 @@ Maintained now by Tels =head1 COPYRIGHT -Copyright (C) 2005 Dan Sugalski, Copyright (C) 2007 Tels +Copyright (C) 2005 Dan Sugalski, Copyright (C) 2007-2008 Tels This module is free software; you can redistribute it and/or modify it under the same terms as Perl v5.8.8.