From: Ian Beckwith Date: Thu, 17 Apr 2008 19:52:26 +0000 (+0100) Subject: Imported Upstream version 0.14 X-Git-Tag: upstream/0.14^0 X-Git-Url: http://erislabs.net/gitweb/?p=libwww-opensearch-perl.git;a=commitdiff_plain;h=8a4c5378ad9614e2d4d066968b85f215fd5671d3 Imported Upstream version 0.14 --- diff --git a/Changes b/Changes index d14ce4c..5244f70 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension WWW::OpenSearch +0.14 Thu Apr 17 2008 + - Handle broken LWP 5.810 in Makefile.PL + 0.13 Fri Dec 21 2007 - Fix pod coverage (Ian Beckwith) diff --git a/META.yml b/META.yml index 701f1bf..f2ebbb1 100644 --- a/META.yml +++ b/META.yml @@ -1,26 +1,27 @@ ---- -abstract: Search A9 OpenSearch compatible engines -author: - - Brian Cassidy -build_requires: +--- +abstract: 'Search A9 OpenSearch compatible engines' +author: + - 'Brian Cassidy ' +build_requires: Test::More: 0 distribution_type: module -generated_by: Module::Install version 0.68 +generated_by: 'Module::Install version 0.71' license: perl -meta-spec: +meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: WWW-OpenSearch -no_index: - directory: +no_index: + directory: - inc - t -requires: +requires: Data::Page: 2 Encode: 0 - LWP: 5.6 + LWP: 5.60 URI: 0 URI::Template: 0 XML::Feed: 0.08 XML::LibXML: 1.58 -version: 0.13 + perl: 5.8.1 +version: 0.14 diff --git a/Makefile.PL b/Makefile.PL index 167bf65..f24bf8d 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,14 +1,19 @@ -use inc::Module::Install 0.68; +use inc::Module::Install 0.71; if ( -e 'MANIFEST.SKIP' ) { system( 'pod2text lib/WWW/OpenSearch.pm > README' ); } +perl_version '5.008001'; + name 'WWW-OpenSearch'; all_from 'lib/WWW/OpenSearch.pm'; +# handle broken LWP 5.810 +my $broken_lwp = eval { require LWP; LWP->VERSION eq '5.810'; }; + requires 'Data::Page' => 2.00; -requires 'LWP' => 5.60; +requires 'LWP' => ( $broken_lwp ? '5.811' : '5.60' ); requires 'XML::Feed' => 0.08; requires 'XML::LibXML' => 1.58; requires 'Encode'; diff --git a/README b/README index 856668d..6f15746 100644 --- a/README +++ b/README @@ -63,7 +63,7 @@ AUTHOR Tatsuhiko Miyagawa COPYRIGHT AND LICENSE - Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy + Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 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/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm index 3a490fb..36a3ccf 100644 --- a/inc/Module/Install/AutoInstall.pm +++ b/inc/Module/Install/AutoInstall.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/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/Include.pm b/inc/Module/Install/Include.pm index 001d0c6..85bc75b 100644 --- a/inc/Module/Install/Include.pm +++ b/inc/Module/Install/Include.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/WWW/OpenSearch.pm b/lib/WWW/OpenSearch.pm index 5bc3da3..c87071d 100644 --- a/lib/WWW/OpenSearch.pm +++ b/lib/WWW/OpenSearch.pm @@ -14,7 +14,7 @@ use Encode (); __PACKAGE__->mk_accessors( qw( description_url agent description ) ); -our $VERSION = '0.13'; +our $VERSION = '0.14'; =head1 NAME @@ -103,7 +103,7 @@ Tatsuhiko Miyagawa Emiyagawa@bulknews.netE =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/WWW/OpenSearch/Agent.pm b/lib/WWW/OpenSearch/Agent.pm index 1b95c0a..19fa3d9 100644 --- a/lib/WWW/OpenSearch/Agent.pm +++ b/lib/WWW/OpenSearch/Agent.pm @@ -38,7 +38,7 @@ An alias for request() =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/WWW/OpenSearch/Description.pm b/lib/WWW/OpenSearch/Description.pm index 8af4bd8..41d7212 100644 --- a/lib/WWW/OpenSearch/Description.pm +++ b/lib/WWW/OpenSearch/Description.pm @@ -133,7 +133,7 @@ whose type is equal to $type. =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/WWW/OpenSearch/Image.pm b/lib/WWW/OpenSearch/Image.pm index 01dafe4..6690f42 100644 --- a/lib/WWW/OpenSearch/Image.pm +++ b/lib/WWW/OpenSearch/Image.pm @@ -45,7 +45,7 @@ WWW::OpenSearch::Image - Object to represent an image =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/WWW/OpenSearch/Query.pm b/lib/WWW/OpenSearch/Query.pm index b75ba77..e177bb4 100644 --- a/lib/WWW/OpenSearch/Query.pm +++ b/lib/WWW/OpenSearch/Query.pm @@ -41,7 +41,7 @@ WWW::OpenSearch::Query - Object to represent a sample query =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/WWW/OpenSearch/Request.pm b/lib/WWW/OpenSearch/Request.pm index ffe7d1b..9a4ffaf 100644 --- a/lib/WWW/OpenSearch/Request.pm +++ b/lib/WWW/OpenSearch/Request.pm @@ -45,7 +45,7 @@ WWW::OpenSearch::Request - Encapsulate an opensearch request =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/WWW/OpenSearch/Response.pm b/lib/WWW/OpenSearch/Response.pm index 97efcd0..d7eafb0 100644 --- a/lib/WWW/OpenSearch/Response.pm +++ b/lib/WWW/OpenSearch/Response.pm @@ -94,7 +94,7 @@ is equal to $type. =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/WWW/OpenSearch/Url.pm b/lib/WWW/OpenSearch/Url.pm index 7c04b82..e08c4f4 100644 --- a/lib/WWW/OpenSearch/Url.pm +++ b/lib/WWW/OpenSearch/Url.pm @@ -53,7 +53,7 @@ WWW::OpenSearch::Url - Object to represent a target URL =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Tatsuhiko Miyagawa and Brian Cassidy +Copyright 2008 by Tatsuhiko Miyagawa and Brian Cassidy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.