@@ -5,6 +5,7 @@ all_from "github-growler.pl"; install_script "github-growler.pl"; requires 'App::Cache'; +requires 'Config::IniFiles'; requires 'Mac::Growl'; requires 'LWP::Simple'; requires 'URI'; Makefile.PL @@ -2,7 +2,13 @@ use strict; use warnings; use 5.008001; + +use FindBin; +use lib "$FindBin::Bin/lib"; +use local::lib "$FindBin::Bin/extlib"; + use App::Cache; +use Config::IniFiles; use Encode; use Mac::Growl; use File::Copy; @@ -10,6 +16,7 @@ use LWP::Simple; use URI; use XML::Feed; +our $VERSION = "1.0"; $XML::Atom::ForceUnicode = 1; my %events = ( @@ -30,13 +37,13 @@ my $AppDomain = "net.bulknews.GitHubGrowler"; my $AppName = "Github Growler"; my @events = ((keys %events), "Misc"); -Mac::Growl::RegisterNotifications($AppName, [ @events, 'Error' ], \@events); +Mac::Growl::RegisterNotifications($AppName, [ @events, 'Fatal Error', 'Error' ], [ @events, 'Fatal Error' ]); my $TempDir = "$ENV{HOME}/Library/Caches/$AppDomain"; mkdir $TempDir, 0777 unless -e $TempDir; my $AppIcon = "$TempDir/octocat.png"; -copy "octocat.png", $AppIcon; +copy "$FindBin::Bin/data/octocat.png", $AppIcon; my $Cache = App::Cache->new({ ttl => 60*60*24, application => $AppName }); my %Seen; @@ -73,12 +80,23 @@ sub read_preference { return $value; } -sub get_github_token { - chomp(my $user = `git config github.user`); - chomp(my $token = `git config github.token`); +sub die_notice { + my $msg = shift; + Mac::Growl::PostNotification($AppName, "Fatal Error", $AppName, $msg, 1, 0, $AppIcon); + die $msg; +} +sub get_github_token { + my($user, $token); + + eval { + my $config = Config::IniFiles->new(-file => "$ENV{HOME}/.gitconfig"); + $user = $config->val('github', 'user'); + $token = $config->val('github', 'token'); + }; + unless ($user && $token) { - die "Can't find .gitconfig entries for github.user and github.token\n"; + die_notice("GitHub config not found: See http://github.com/guides/local-github-config and set them"); } return ($user, $token); github-growler.pl @@ -17,12 +17,10 @@ package Module::Install; # 3. The ./inc/ version of Module::Install loads # } -BEGIN { - require 5.004; -} +use 5.005; use strict 'vars'; -use vars qw{$VERSION}; +use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or @@ -30,7 +28,10 @@ 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.79'; + $VERSION = '0.91'; + + # Storage for the pseudo-singleton + $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; @@ -69,15 +70,26 @@ END_DIE # 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 ) { + my $s = (stat($0))[9]; + + # If the modification time is only slightly in the future, + # sleep briefly to remove the problem. + my $a = $s - time; + if ( $a > 0 and $a < 5 ) { sleep 5 } + + # Too far in the future, throw an error. + my $t = time; + if ( $s > $t ) { die <<"END_DIE" } -Your installer $0 has a modification time in the future. +Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE +} @@ -121,14 +133,22 @@ sub autoload { $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { - # delegate back to parent dirs + # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; - unless ( uc($1) eq $1 ) { - unshift @_, ( $self, $1 ); - goto &{$self->can('call')}; + my $method = $1; + if ( uc($method) eq $method ) { + # Do nothing + return; + } elsif ( $method =~ /^_/ and $self->can($method) ) { + # Dispatch to the root M:I class + return $self->$method(@_); } + + # Dispatch to the appropriate plugin + unshift @_, ( $self, $1 ); + goto &{$self->can('call')}; }; } @@ -153,6 +173,9 @@ sub import { delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; + # Save to the singleton + $MAIN = $self; + return 1; } @@ -166,8 +189,7 @@ sub preload { my @exts = @{$self->{extensions}}; unless ( @exts ) { - my $admin = $self->{admin}; - @exts = $admin->load_all_extensions; + @exts = $self->{admin}->load_all_extensions; } my %seen; @@ -250,7 +272,7 @@ END_DIE sub load_extensions { my ($self, $path, $top) = @_; - unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { + unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } @@ -314,7 +336,7 @@ sub find_extensions { ##################################################################### -# Utility Functions +# Common Utility Functions sub _caller { my $depth = 0; @@ -328,31 +350,70 @@ sub _caller { sub _read { local *FH; - open FH, "< $_[0]" or die "open($_[0]): $!"; - my $str = do { local $/; <FH> }; + if ( $] >= 5.006 ) { + open( FH, '<', $_[0] ) or die "open($_[0]): $!"; + } else { + open( FH, "< $_[0]" ) or die "open($_[0]): $!"; + } + my $string = do { local $/; <FH> }; close FH or die "close($_[0]): $!"; - return $str; + return $string; +} + +sub _readperl { + my $string = Module::Install::_read($_[0]); + $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; + $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; + $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; + return $string; +} + +sub _readpod { + my $string = Module::Install::_read($_[0]); + $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; + return $string if $_[0] =~ /\.pod\z/; + $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; + $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; + $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; + $string =~ s/^\n+//s; + return $string; } sub _write { local *FH; - open FH, "> $_[0]" or die "open($_[0]): $!"; - foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } + if ( $] >= 5.006 ) { + open( FH, '>', $_[0] ) or die "open($_[0]): $!"; + } else { + open( FH, "> $_[0]" ) or die "open($_[0]): $!"; + } + foreach ( 1 .. $#_ ) { + print FH $_[$_] or die "print($_[0]): $!"; + } close FH or die "close($_[0]): $!"; } # _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 $d =()= $s =~ /(\.)/g; + if ( $d >= 2 ) { + # Normalise multipart versions + $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; + } + $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; + my @v = map { + $_ . '0' x (3 - length $_) + } $s =~ /(\d{1,3})\D?/g; + $l = $l . '.' . join '', @v if @v; return $l + 0; } +sub _cmp ($$) { + _version($_[0]) <=> _version($_[1]); +} + # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( @@ -360,7 +421,7 @@ sub _CLASS ($) { and ! ref $_[0] and - $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s + $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } inc/Module/Install.pm @@ -1,7 +1,11 @@ #line 1 package Module::Install::Base; -$VERSION = '0.79'; +use strict 'vars'; +use vars qw{$VERSION}; +BEGIN { + $VERSION = '0.91'; +} # Suspend handler for "redefined" warnings BEGIN { @@ -9,54 +13,56 @@ BEGIN { $SIG{__WARN__} = sub { $w }; } -### This is the ONLY module that shouldn't have strict on -# use strict; - -#line 41 +#line 42 sub new { - my ($class, %args) = @_; - - foreach my $method ( qw(call load) ) { - *{"$class\::$method"} = sub { - shift()->_top->$method(@_); - } unless defined &{"$class\::$method"}; - } - - bless( \%args, $class ); + my $class = shift; + unless ( defined &{"${class}::call"} ) { + *{"${class}::call"} = sub { shift->_top->call(@_) }; + } + unless ( defined &{"${class}::load"} ) { + *{"${class}::load"} = sub { shift->_top->load(@_) }; + } + bless { @_ }, $class; } #line 61 sub AUTOLOAD { - my $self = shift; - local $@; - my $autoload = eval { $self->_top->autoload } or return; - goto &$autoload; + local $@; + my $func = eval { shift->_top->autoload } or return; + goto &$func; } -#line 76 +#line 75 -sub _top { $_[0]->{_top} } +sub _top { + $_[0]->{_top}; +} -#line 89 +#line 90 sub admin { - $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; + $_[0]->_top->{admin} + or + Module::Install::Base::FakeAdmin->new; } -#line 101 +#line 106 sub is_admin { - $_[0]->admin->VERSION; + $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; -my $Fake; -sub new { $Fake ||= bless(\@_, $_[0]) } +my $fake; + +sub new { + $fake ||= bless(\@_, $_[0]); +} sub AUTOLOAD {} @@ -69,4 +75,4 @@ BEGIN { 1; -#line 146 +#line 154 inc/Module/Install/Base.pm @@ -2,18 +2,16 @@ package Module::Install::Can; use strict; -use Module::Install::Base; -use Config (); -### This adds a 5.005 Perl version dependency. -### This is a bug and will be fixed. -use File::Spec (); -use ExtUtils::MakeMaker (); - -use vars qw{$VERSION $ISCORE @ISA}; +use Config (); +use File::Spec (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); + +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } # check if we can load some module @@ -80,4 +78,4 @@ if ( $^O eq 'cygwin' ) { __END__ -#line 158 +#line 156 inc/Module/Install/Can.pm @@ -2,13 +2,13 @@ package Module::Install::Fetch; use strict; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub get_file { inc/Module/Install/Fetch.pm @@ -2,14 +2,14 @@ package Module::Install::Makefile; use strict 'vars'; -use Module::Install::Base; -use ExtUtils::MakeMaker (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } @@ -114,17 +114,32 @@ sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; - # Make sure we have a new enough - require ExtUtils::MakeMaker; + # Check the current Perl version + my $perl_version = $self->perl_version; + if ( $perl_version ) { + eval "use $perl_version; 1" + or die "ERROR: perl: Version $] is installed, " + . "but we need version >= $perl_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. + # Make sure we have a new enough MakeMaker + require ExtUtils::MakeMaker; - $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { + # 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->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + } else { + # Allow legacy-compatibility with 5.005 by depending on the + # most recent EU:MM that supported 5.005. + $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 ); + $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); + } - # Generate the + # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; @@ -133,7 +148,7 @@ sub write { if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } - if ($] >= 5.005) { + if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } @@ -147,7 +162,7 @@ sub write { delete $args->{SIGN}; } - # merge both kinds of requires into prereq_pm + # Merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } @@ -250,4 +265,4 @@ sub postamble { __END__ -#line 379 +#line 394 inc/Module/Install/Makefile.pm @@ -2,15 +2,19 @@ package Module::Install::Metadata; use strict 'vars'; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } +my @boolean_keys = qw{ + sign +}; + my @scalar_keys = qw{ name module_name @@ -37,16 +41,43 @@ my @resource_keys = qw{ repository }; +my @array_keys = qw{ + keywords +}; + sub Meta { shift } +sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } +sub Meta_ArrayKeys { @array_keys } + +foreach my $key ( @boolean_keys ) { + *$key = sub { + my $self = shift; + if ( defined wantarray and not @_ ) { + return $self->{values}->{$key}; + } + $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); + return $self; + }; +} foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; - return $self->{values}{$key} if defined wantarray and !@_; - $self->{values}{$key} = shift; + return $self->{values}->{$key} if defined wantarray and !@_; + $self->{values}->{$key} = shift; + return $self; + }; +} + +foreach my $key ( @array_keys ) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} if defined wantarray and !@_; + $self->{values}->{$key} ||= []; + push @{$self->{values}->{$key}}, @_; return $self; }; } @@ -55,12 +86,12 @@ foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { - return () unless $self->{values}{resources}; + return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } - @{ $self->{values}{resources} }; + @{ $self->{values}->{resources} }; } - return $self->{values}{resources}{$key} unless @_; + return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); @@ -69,54 +100,19 @@ foreach my $key ( @resource_keys ) { }; } -sub requires { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}{requires} }, [ $module, $version ]; - } - $self->{values}{requires}; -} - -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}; -} - -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}; +foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} unless @_; + my @added; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @added, [ $module, $version ]; + } + push @{ $self->{values}->{$key} }, @added; + return map {@$_} @added; + }; } # Resource handling @@ -135,29 +131,22 @@ sub resources { 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} ||= []; + push @{ $self->{values}->{resources} }, [ $name, $value ]; } - $self->{values}{resources}; + $self->{values}->{resources}; } # 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') } -sub install_as_cpan { $_[0]->installdirs('site') } -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; -} +sub install_as_core { $_[0]->installdirs('perl') } +sub install_as_cpan { $_[0]->installdirs('site') } +sub install_as_site { $_[0]->installdirs('site') } +sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; @@ -165,13 +154,13 @@ sub dynamic_config { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } - $self->{values}{dynamic_config} = $_[0] ? 1 : 0; + $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; - return $self->{values}{perl_version} unless @_; + return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); @@ -184,20 +173,41 @@ sub perl_version { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } - $self->{values}{perl_version} = $version; + $self->{values}->{perl_version} = $version; } +#Stolen from M::B +my %license_urls = ( + perl => 'http://dev.perl.org/licenses/', + apache => 'http://apache.org/licenses/LICENSE-2.0', + artistic => 'http://opensource.org/licenses/artistic-license.php', + artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', + lgpl => 'http://opensource.org/licenses/lgpl-license.php', + lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', + lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', + bsd => 'http://opensource.org/licenses/bsd-license.php', + gpl => 'http://opensource.org/licenses/gpl-license.php', + gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', + gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', + mit => 'http://opensource.org/licenses/mit-license.php', + mozilla => 'http://opensource.org/licenses/mozilla1.1.php', + open_source => undef, + unrestricted => undef, + restrictive => undef, + unknown => undef, +); + sub license { my $self = shift; - return $self->{values}{license} unless @_; + return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); - $self->{values}{license} = $license; + $self->{values}->{license} = $license; # Automatically fill in license URLs - if ( $license eq 'perl' ) { - $self->resources( license => 'http://dev.perl.org/licenses/' ); + if ( $license_urls{$license} ) { + $self->resources( license => $license_urls{$license} ); } return 1; @@ -239,7 +249,7 @@ sub all_from { sub provides { my $self = shift; - my $provides = ( $self->{values}{provides} ||= {} ); + my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } @@ -268,7 +278,7 @@ sub auto_provides { sub feature { my $self = shift; my $name = shift; - my $features = ( $self->{values}{features} ||= [] ); + my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { @@ -296,16 +306,16 @@ 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} } : (); } sub no_index { my $self = shift; my $type = shift; - push @{ $self->{values}{no_index}{$type} }, @_ if $type; - return $self->{values}{no_index}; + push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; + return $self->{values}->{no_index}; } sub read { @@ -429,21 +439,21 @@ sub license_from { /ixms ) { 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, - 'LGPL' => 'lgpl', 1, - 'BSD' => 'bsd', 1, - 'Artistic' => 'artistic', 1, - 'MIT' => 'mit', 1, - 'proprietary' => 'proprietary', 0, + 'under the same (?:terms|license) as (?:perl|the perl programming language) 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, + '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; @@ -458,10 +468,18 @@ sub license_from { return 'unknown'; } +sub _extract_bugtracker { + my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g; + my %links; + @links{@links}=(); + @links=keys %links; + return @links; +} + sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); - my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; + my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; @@ -476,17 +494,40 @@ sub bugtracker_from { return 1; } +sub requires_from { + my $self = shift; + my $content = Module::Install::_readperl($_[0]); + my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; + while ( @requires ) { + my $module = shift @requires; + my $version = shift @requires; + $self->requires( $module => $version ); + } +} + +sub test_requires_from { + my $self = shift; + my $content = Module::Install::_readperl($_[0]); + my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; + while ( @requires ) { + my $module = shift @requires; + my $version = shift @requires; + $self->test_requires( $module => $version ); + } +} + # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; - $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; + $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { - $v = $v + 0; # Numify + # Numify + $v = $v + 0; } return $v; } @@ -496,17 +537,57 @@ sub _perl_version { ###################################################################### -# MYMETA.yml Support +# MYMETA Support sub WriteMyMeta { - $_[0]->write_mymeta; + die "WriteMyMeta has been deprecated"; +} + +sub write_mymeta_yaml { + my $self = shift; + + # We need YAML::Tiny to write the MYMETA.yml file + unless ( eval { require YAML::Tiny; 1; } ) { + return 1; + } + + # Generate the data + my $meta = $self->_write_mymeta_data or return 1; + + # Save as the MYMETA.yml file + print "Writing MYMETA.yml\n"; + YAML::Tiny::DumpFile('MYMETA.yml', $meta); } -sub write_mymeta { +sub write_mymeta_json { my $self = shift; - + + # We need JSON to write the MYMETA.json file + unless ( eval { require JSON; 1; } ) { + return 1; + } + + # Generate the data + my $meta = $self->_write_mymeta_data or return 1; + + # Save as the MYMETA.yml file + print "Writing MYMETA.json\n"; + Module::Install::_write( + 'MYMETA.json', + JSON->new->pretty(1)->canonical->encode($meta), + ); +} + +sub _write_mymeta_data { + my $self = shift; + # If there's no existing META.yml there is nothing we can do - return unless -f 'META.yml'; + return undef unless -f 'META.yml'; + + # We need Parse::CPAN::Meta to load the file + unless ( eval { require Parse::CPAN::Meta; 1; } ) { + return undef; + } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; @@ -523,8 +604,7 @@ sub write_mymeta { } # Load the advisory META.yml file - require YAML::Tiny; - my @yaml = YAML::Tiny::LoadFile('META.yml'); + my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs @@ -538,8 +618,7 @@ sub write_mymeta { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } - # Save as the MYMETA.yml file - YAML::Tiny::DumpFile('MYMETA.yml', $meta); + return $meta; } 1; inc/Module/Install/Metadata.pm @@ -2,13 +2,13 @@ package Module::Install::Scripts; use strict 'vars'; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub install_script { inc/Module/Install/Scripts.pm @@ -2,12 +2,12 @@ package Module::Install::Win32; use strict; -use Module::Install::Base; +use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; - @ISA = qw{Module::Install::Base}; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; } inc/Module/Install/Win32.pm @@ -2,11 +2,11 @@ package Module::Install::WriteAll; use strict; -use Module::Install::Base; +use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91';; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } @@ -22,7 +22,6 @@ sub WriteAll { ); $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}; @@ -30,11 +29,32 @@ sub WriteAll { $self->makemaker_args( PL_FILES => {} ); } + # Until ExtUtils::MakeMaker support MYMETA.yml, make sure + # we clean it up properly ourself. + $self->realclean_files('MYMETA.yml'); + if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } + + # The Makefile write process adds a couple of dependencies, + # so write the META.yml files after the Makefile. + if ( $args{meta} ) { + $self->Meta->write; + } + + # Experimental support for MYMETA + if ( $ENV{X_MYMETA} ) { + if ( $ENV{X_MYMETA} eq 'JSON' ) { + $self->Meta->write_mymeta_json; + } else { + $self->Meta->write_mymeta_yaml; + } + } + + return 1; } 1; inc/Module/Install/WriteAll.pm ce0e694fc684af3babbd5e925100d64883e5b4f1 Tatsuhiko Miyagawa miyagawa@bulknews.net http://github.com/miyagawa/github-growler/commit/ba2b9d2065b1f16d1c1d4c1f048367214cfb28b8 ba2b9d2065b1f16d1c1d4c1f048367214cfb28b8 2009-06-13T02:40:40-07:00 2009-06-13T02:40:40-07:00 Use Config::IniFiles instead of 'git' command since it might not be in PATH. Gives error message with sticky Growl notification. ba38a8608ec97be76cb1fd9943e1b51e488c8005 Tatsuhiko Miyagawa miyagawa@bulknews.net