Changes of Revision 21
| [-] | Changed | check_diskio.changes |
|
1 2 -------------------------------------------------------------------3 +Wed Feb 27 11:18:37 UTC 2013 - cs@linux-administrator.com4 +5 +- Update to release 3.2.5 6 +7 +-------------------------------------------------------------------8 Fri Nov 11 13:07:53 UTC 2011 - cs@linux-administrator.com9 10 - Update to release 3.2.4 11 |
||
| [-] | Changed | check_diskio.spec ^ |
|
15 1 2 -%define version 3.2.43 +%define version 3.2.54 %define release 15 %define pkgname check_diskio6 %define _plugindir /usr/lib/nagios/plugins7 8 Version: %{version}9 Release: %{release}10 License: GPL11 -Packager: Matteo Corti <matteo.corti@id.ethz.ch>12 Group: Applications/System13 BuildRoot: %{_tmppath}/%{pkgname}-%{version}-root14 Source: http://www.id.ethz.ch/people/allid_list/corti/%{pkgname}-%{version}.tar.bz215 |
||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/AUTHORS ^ |
| @@ -8,3 +8,4 @@ * Nikolaus Filus for the UOM enhancements * Vitaliy Zhhuta for the help with /proc/diskstats formatting issues * Greg Maples for helping in the partition stripping of LVM volumes +* Anonymous reporter for the temporary file check fix | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/COPYRIGHT ^ |
| @@ -1,4 +1,4 @@ -Copyright (c) 2009 Matteo Corti +Copyright (c) 2007-2013 Matteo Corti, ETH Zurich This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/Changes ^ |
| @@ -1,3 +1,10 @@ +2013-02-26 Matteo Corti <matteo.corti@id.ethz.ch> + * check_diskio: empty temporary files are re-written + +2012-04-14 Matteo Corti <matteo.corti@id.ethz.ch> + + * check_diskio: fixed a minor issue in the option parsing and output + 2011-11-09 Matteo Corti <matteo.corti@id.ethz.ch> * check_diskio: support for 3.x kernels @@ -118,7 +125,7 @@ * Initial release -# $Id: Changes 1275 2011-11-09 15:24:34Z corti $ -# $Revision: 1275 $ +# $Id: Changes 1327 2013-02-26 06:20:01Z corti $ +# $Revision: 1327 $ # $HeadURL: https://svn.id.ethz.ch/nagios_plugins/check_diskio/Changes $ -# $Date: 2011-11-09 16:24:34 +0100 (Wed, 09 Nov 2011) $ +# $Date: 2013-02-26 07:20:01 +0100 (Tue, 26 Feb 2013) $ | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/INSTALL ^ |
| @@ -1,5 +1,34 @@ Build and install check_diskio +Dependences +=========== + +check_diskio depends on several Perl modules: + + * Array::Unique + * English + * File::Slurp + * List::MoreUtils + * Nagios::Plugin + * Nagios::Plugin::Getopt + * Nagios::Plugin::Threshold + * Number::Format + * POSIX + * Readonly + * version + +Perl modules can be found on the "Comprehensive Perl Archive Network" +(CPAN). The "How to install CPAN modules" guide summarizes how these +can be installed + + http://www.cpan.org/modules/INSTALL.html + +On many systems Perl modules are also available as installation +packages (refer to your system documentation on how to install them). + +The 'perl Makefile.PL' command (see below) will list the missing +packages the you will need to install. + Install to /usr/lib/nagios/plugins/contrib ========================================== | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/META.yml ^ |
| @@ -1,5 +1,5 @@ --- -abstract: ~ +abstract: unknown author: - 'Matteo Corti <matteo.corti@id.ethz.ch>' build_requires: @@ -7,18 +7,18 @@ File::Spec: 0 Test::More: 0 configure_requires: - ExtUtils::MakeMaker: 6.42 -distribution_type: module -generated_by: 'Module::Install version 1.01' -license: gpl + ExtUtils::MakeMaker: 0 +dynamic_config: 0 +generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921' +license: open_source meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: check_diskio no_index: directory: - - inc - t + - inc requires: Array::Unique: 0 English: 0 @@ -30,7 +30,5 @@ Number::Format: 0 POSIX: 0 Readonly: 0 - perl: 5.8.0 -resources: - license: http://opensource.org/licenses/gpl-license.php -version: 3.2.4 + perl: 5.00800 +version: v3.2.5 | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/NEWS ^ |
| @@ -1,3 +1,5 @@ +2013-02-26 3.2.5: handles empty temporary files and fixes a minor bug in option + parsing 2011-11-09 3.2.4: supports 3.X kernels 2010-10-20 3.2.3: fixes a bug in the parsing of the statistics file 2010-07-06 3.2.2: fixes a bug which ignored devices specified with -d /dev @@ -27,7 +29,7 @@ 2007-02-23 1.1: removed the max interval check 2007-02-19 1.0: initial release -# $Id: NEWS 1275 2011-11-09 15:24:34Z corti $ -# $Revision: 1275 $ +# $Id: NEWS 1327 2013-02-26 06:20:01Z corti $ +# $Revision: 1327 $ # $HeadURL: https://svn.id.ethz.ch/nagios_plugins/check_diskio/NEWS $ -# $Date: 2011-11-09 16:24:34 +0100 (Wed, 09 Nov 2011) $ +# $Date: 2013-02-26 07:20:01 +0100 (Tue, 26 Feb 2013) $ | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/check_diskio ^ |
| @@ -7,7 +7,7 @@ # # See the INSTALL file for installation instructions # -# Copyright (c) 2007,2008 ETH Zurich. +# Copyright (c) 2007-2013 ETH Zurich. # # This module is free software; you can redistribute it and/or modify it # under the terms of GNU general public license (gpl) version 3. @@ -17,17 +17,17 @@ # enable substitution with: # $ svn propset svn:keywords "Id Revision HeadURL Source Date" # -# $Id: check_diskio 1277 2011-11-09 17:25:43Z corti $ -# $Revision: 1277 $ +# $Id: check_diskio 1327 2013-02-26 06:20:01Z corti $ +# $Revision: 1327 $ # $HeadURL: https://svn.id.ethz.ch/nagios_plugins/check_diskio/check_diskio $ -# $Date: 2011-11-09 18:25:43 +0100 (Wed, 09 Nov 2011) $ +# $Date: 2013-02-26 07:20:01 +0100 (Tue, 26 Feb 2013) $ use 5.00800; use strict; use warnings; -our $VERSION = '3.2.4'; +our $VERSION = '3.2.5'; use Array::Unique; use English qw(-no_match_vars); @@ -186,7 +186,8 @@ . "\n", 1; ## no critic (InputOutput::RequireBriefOpen) - open $TMP_FH, q{>}, $tmp + open $TMP_FH, q{>}, + $tmp or $plugin->nagios_exit( UNKNOWN, "Cannot initialize timer ($tmp): $OS_ERROR" ); @@ -755,7 +756,8 @@ undef $device; ## no critic (InputOutput::RequireBriefOpen) - open $MTAB_FH, q{<}, '/etc/mtab' + open $MTAB_FH, q{<}, + '/etc/mtab' or $plugin->nagios_exit( UNKNOWN, "Cannot open /etc/mtab: $OS_ERROR" ); while (<$MTAB_FH>) { @@ -884,7 +886,7 @@ verbose "Checking: @unique_devices\n"; -##### + ##### # UOM my $multiplier; @@ -897,7 +899,7 @@ # according to the guidelines only [TGMK]B (Bytes) are valid UOM # http://nagiosplug.sourceforge.net/developer-guidelines.html#AEN201 my $perfdata_uom = 'B'; - if ( $format eq 's' || $format =~ /^sector[s]$/mxs ) { + if ( $format eq 's' || $format =~ /^sectors?$/mxs ) { #sectors $multiplier = 1; @@ -905,7 +907,7 @@ $perfdata_uom = q{}; } - elsif ( $format eq 'b' || $format =~ /^bit[s]$/mxs ) { + elsif ( $format eq 'b' || $format =~ /^bits?$/mxs ) { # bits $multiplier = $options->ssize() * $BITS_PER_BYTE; @@ -913,7 +915,7 @@ $perfdata_uom = q{}; } - elsif ( $format eq 'B' || $format =~ /^byte[s]$/mxs ) { + elsif ( $format eq 'B' || $format =~ /^bytes?$/mxs ) { # bytes $multiplier = $options->ssize(); @@ -985,7 +987,7 @@ } -######################## + ######################## # Check the proc entry my $diff; @@ -1016,7 +1018,8 @@ . format_number( $s_write, 0, 0 ) . "\n", 1; - if ( !-f $tmp_files{$device} ) { + # check if the temporary file exists and has some content + if ( !-s $tmp_files{$device} ) { verbose "temporary file not available resetting and waiting\n"; write_timer( $tmp_files{$device}, $s_write, $s_read ); sleep 1; @@ -1119,7 +1122,7 @@ } if ( $options->silent() ) { - $plugin->nagios_exit( OK, ( join ', ', @unique_devices ) . 'OK' ); + $plugin->nagios_exit( OK, ( join ', ', @unique_devices ) . ' OK' ); } else { $plugin->nagios_exit( $status, join ', ', @status_lines, ); | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/check_diskio.pod ^ |
| @@ -14,7 +14,7 @@ =head1 VERSION -Version 3.2.4 +Version 3.2.5 =head1 SYNOPSIS | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/check_diskio.spec ^ |
| @@ -1,12 +1,12 @@ ################################################################################ # File version information: -# $Id: check_diskio.spec 1278 2011-11-09 18:44:34Z corti $ -# $Revision: 1278 $ +# $Id: check_diskio.spec 1327 2013-02-26 06:20:01Z corti $ +# $Revision: 1327 $ # $HeadURL: https://svn.id.ethz.ch/nagios_plugins/check_diskio/check_diskio.spec $ -# $Date: 2011-11-09 19:44:34 +0100 (Wed, 09 Nov 2011) $ +# $Date: 2013-02-26 07:20:01 +0100 (Tue, 26 Feb 2013) $ ################################################################################ -%define version 3.2.4 +%define version 3.2.5 %define release 0 %define sourcename check_diskio %define packagename nagios-plugins-check-diskio | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/Module/Install.pm ^ |
| @@ -22,7 +22,6 @@ use Cwd (); use File::Find (); use File::Path (); -use FindBin; use vars qw{$VERSION $MAIN}; BEGIN { @@ -32,7 +31,7 @@ # 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.95'; + $VERSION = '1.01'; # Storage for the pseudo-singleton $MAIN = undef; @@ -127,6 +126,11 @@ #------------------------------------------------------------- unless ( -f $self->{file} ) { + foreach my $key (keys %INC) { + delete $INC{$key} if $key =~ /Module\/Install/; + } + + local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); @@ -135,12 +139,13 @@ goto &{"$self->{name}::import"}; } + local $^W; *{"${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"}; + delete $INC{'inc/Module/Install.pm'}; + delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; @@ -159,7 +164,21 @@ # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } - $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; + unless ($$sym =~ s/([^:]+)$//) { + # XXX: it looks like we can't retrieve the missing function + # via $$sym (usually $main::AUTOLOAD) in this case. + # I'm still wondering if we should slurp Makefile.PL to + # get some context or not ... + my ($package, $file, $line) = caller; + die <<"EOT"; +Unknown function is found at $file line $line. +Execution of $file aborted due to runtime errors. + +If you're a contributor to a project, you may need to install +some Module::Install extensions from CPAN (or other repository). +If you're a user of a module, please contact the author. +EOT + } my $method = $1; if ( uc($method) eq $method ) { # Do nothing @@ -200,6 +219,7 @@ my $who = $self->_caller; foreach my $name ( sort keys %seen ) { + local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; @@ -210,12 +230,18 @@ sub new { my ($class, %args) = @_; + delete $INC{'FindBin.pm'}; + { + # to suppress the redefine warning + local $SIG{__WARN__} = sub {}; + require FindBin; + } + # 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'; @@ -268,8 +294,10 @@ sub load_extensions { my ($self, $path, $top) = @_; + my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; + $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { @@ -277,12 +305,13 @@ next if $self->{pathnames}{$pkg}; local $@; - my $new = eval { require $file; $pkg->can('new') }; + my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } - $self->{pathnames}{$pkg} = delete $INC{$file}; + $self->{pathnames}{$pkg} = + $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } @@ -438,4 +467,4 @@ 1; -# Copyright 2008 - 2010 Adam Kennedy. +# Copyright 2008 - 2011 Adam Kennedy. | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/Module/Install/Base.pm ^ |
| @@ -4,7 +4,7 @@ use strict 'vars'; use vars qw{$VERSION}; BEGIN { - $VERSION = '0.95'; + $VERSION = '1.01'; } # Suspend handler for "redefined" warnings @@ -51,13 +51,18 @@ #line 106 sub is_admin { - $_[0]->admin->VERSION; + ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; +use vars qw{$VERSION}; +BEGIN { + $VERSION = $Module::Install::Base::VERSION; +} + my $fake; sub new { @@ -75,4 +80,4 @@ 1; -#line 154 +#line 159 | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/Module/Install/Include.pm ^ |
| @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.95'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/Module/Install/MakeMaker.pm ^ |
| @@ -7,7 +7,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.95'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/Module/Install/Makefile.pm ^ |
| @@ -4,10 +4,11 @@ use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); +use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.95'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } @@ -101,24 +102,26 @@ my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { - if ($makemaker_argtype{$key} eq 'ARRAY') { - $args->{$key} = [] unless defined $args->{$key}; - unless (ref $args->{$key} eq 'ARRAY') { - $args->{$key} = [$args->{$key}] + if ($makemaker_argtype{$key}) { + if ($makemaker_argtype{$key} eq 'ARRAY') { + $args->{$key} = [] unless defined $args->{$key}; + unless (ref $args->{$key} eq 'ARRAY') { + $args->{$key} = [$args->{$key}] + } + push @{$args->{$key}}, + ref $new_args{$key} eq 'ARRAY' + ? @{$new_args{$key}} + : $new_args{$key}; } - push @{$args->{$key}}, - ref $new_args{$key} eq 'ARRAY' - ? @{$new_args{$key}} - : $new_args{$key}; - } - elsif ($makemaker_argtype{$key} eq 'HASH') { - $args->{$key} = {} unless defined $args->{$key}; - foreach my $skey (keys %{ $new_args{$key} }) { - $args->{$key}{$skey} = $new_args{$key}{$skey}; + elsif ($makemaker_argtype{$key} eq 'HASH') { + $args->{$key} = {} unless defined $args->{$key}; + foreach my $skey (keys %{ $new_args{$key} }) { + $args->{$key}{$skey} = $new_args{$key}{$skey}; + } + } + elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { + $self->makemaker_append($key => $new_args{$key}); } - } - elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { - $self->makemaker_append($key => $new_args{$key}); } else { if (defined $args->{$key}) { @@ -178,28 +181,22 @@ $self->makemaker_args( INC => shift ); } -my %test_dir = (); - sub _wanted_t { - /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; - if ( $self->tests ) { - die "tests_recursive will not work if tests are already defined"; - } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } - %test_dir = (); + my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; - File::Find::find( \&_wanted_t, $dir ); - if ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { - File::Find::find( \&_wanted_t, 'xt' ); - } - $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); + File::Find::find( + sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, + $dir + ); + $self->tests( join ' ', sort keys %tests ); } sub write { @@ -251,6 +248,9 @@ $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; + } elsif ( $Module::Install::ExtraTests::use_extratests ) { + # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. + # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), @@ -297,13 +297,22 @@ # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; - # Delete bundled dists from prereq_pm - my $subdirs = ($args->{DIR} ||= []); + # Delete bundled dists from prereq_pm, add it to Makefile DIR + my $subdirs = ($args->{DIR} || []); if ($self->bundles) { + my %processed; foreach my $bundle (@{ $self->bundles }) { - my ($file, $dir) = @$bundle; - push @$subdirs, $dir if -d $dir; - delete $build_prereq->{$file}; #Delete from build prereqs only + my ($mod_name, $dist_dir) = @$bundle; + delete $prereq->{$mod_name}; + $dist_dir = File::Basename::basename($dist_dir); # dir for building this module + if (not exists $processed{$dist_dir}) { + if (-d $dist_dir) { + # List as sub-directory to be processed by make + push @$subdirs, $dist_dir; + } + # Else do nothing: the module is already present on the system + $processed{$dist_dir} = undef; + } } } @@ -356,9 +365,9 @@ . ($self->postamble || ''); local *MAKEFILE; - open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; + open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; + eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; <MAKEFILE> }; - close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; @@ -378,7 +387,8 @@ # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; - open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; + seek MAKEFILE, 0, SEEK_SET; + truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; @@ -402,4 +412,4 @@ __END__ -#line 531 +#line 541 | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/Module/Install/Metadata.pm ^ |
| @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.95'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } @@ -178,43 +178,6 @@ $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 @_; - my $license = shift or die( - 'Did not provide a value to license()' - ); - $self->{values}->{license} = $license; - - # Automatically fill in license URLs - if ( $license_urls{$license} ) { - $self->resources( license => $license_urls{$license} ); - } - - return 1; -} - sub all_from { my ( $self, $file ) = @_; @@ -354,6 +317,9 @@ require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); + + # for version integrity check + $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { @@ -364,7 +330,7 @@ { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) - ); + ); } # Add both distribution and module name @@ -479,42 +445,90 @@ } } +#Stolen from M::B +my %license_urls = ( + perl => 'http://dev.perl.org/licenses/', + apache => 'http://apache.org/licenses/LICENSE-2.0', + apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', + 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 @_; + my $license = shift or die( + 'Did not provide a value to license()' + ); + $license = __extract_license($license) || lc $license; + $self->{values}->{license} = $license; + + # Automatically fill in license URLs + if ( $license_urls{$license} ) { + $self->resources( license => $license_urls{$license} ); + } + + return 1; +} + sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ - (=head \d \s+ (?:licen[cs]e|licensing)\b.*?) + (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z - /ixms + /xms ) || __extract_license( ($matched) = $pod =~ m/ - (=head \d \s+ (?:copyrights?|legal)\b.*?) + (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z - /ixms + /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( - 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1, - 'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1, - 'Artistic and GPL' => '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 (?:\d )?programming language)' => 'perl', 1, + '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, + 'Artistic and GPL' => '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, + 'GNU Free Documentation license' => 'unrestricted', 1, + 'GNU Affero General Public License' => 'open_source', 1, + '(?:Free)?BSD license' => 'bsd', 1, + 'Artistic license 2\.0' => 'artistic_2', 1, + 'Artistic license' => 'artistic', 1, + 'Apache (?:Software )?license' => 'apache', 1, + 'GPL' => 'gpl', 1, + 'LGPL' => 'lgpl', 1, + 'BSD' => 'bsd', 1, + 'Artistic' => 'artistic', 1, + 'MIT' => 'mit', 1, + 'Mozilla Public License' => 'mozilla', 1, + 'Q Public License' => 'open_source', 1, + 'OpenSSL License' => 'unrestricted', 1, + 'SSLeay License' => 'unrestricted', 1, + 'zlib License' => 'open_source', 1, + 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; @@ -522,6 +536,7 @@ return $license; } } + return ''; } sub license_from { @@ -536,9 +551,9 @@ sub _extract_bugtracker { my @links = $_[0] =~ m#L<( - \Qhttp://rt.cpan.org/\E[^>]+| - \Qhttp://github.com/\E[\w_]+/[\w_]+/issues| - \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list + https?\Q://rt.cpan.org/\E[^>]+| + https?\Q://github.com/\E[\w_]+/[\w_]+/issues| + https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @@ -602,8 +617,15 @@ return $v; } - - +sub add_metadata { + my $self = shift; + my %hash = @_; + for my $key (keys %hash) { + warn "add_metadata: $key is not prefixed with 'x_'.\n" . + "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; + $self->{values}->{$key} = $hash{$key}; + } +} ###################################################################### | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/Module/Install/Scripts.pm ^ |
| @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.95'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } | ||
| [+] | Changed | check_diskio-3.2.5.tar.bz2/inc/version.pm ^ |
| @@ -7,7 +7,7 @@ use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); -$VERSION = 0.82; +$VERSION = 0.88; $CLASS = 'version'; @@ -124,13 +124,7 @@ *version::qv = \&version::vpp::qv; *version::declare = \&version::vpp::declare; *version::_VERSION = \&version::vpp::_VERSION; - if ($] > 5.009001 && $] < 5.010000) { - no strict 'refs'; - *version::stringify = \&version::vpp::stringify; - *{'version::(""'} = \&version::vpp::stringify; - *version::new = \&version::vpp::new; - } - elsif ($] == 5.010000 || $] == 5.010001) { + if ($] >= 5.009000 && $] < 5.011004) { no strict 'refs'; *version::stringify = \&version::vpp::stringify; *{'version::(""'} = \&version::vpp::stringify; @@ -144,12 +138,8 @@ *version::declare = \&version::vxs::declare; *version::qv = \&version::vxs::qv; *version::_VERSION = \&version::vxs::_VERSION; - if ($] > 5.009001 && $] < 5.010000) { - no strict 'refs'; - *version::stringify = \&version::vxs::stringify; - *{'version::(""'} = \&version::vxs::stringify; - } - elsif ($] == 5.010000 || $] == 5.010001) { + *version::vcmp = \&version::vxs::VCMP; + if ($] >= 5.009000 && $] < 5.011004) { no strict 'refs'; *version::stringify = \&version::vxs::stringify; *{'version::(""'} = \&version::vxs::stringify; @@ -208,14 +198,12 @@ } if (exists($args{'is_strict'})) { - *{$callpkg.'::is_strict'} = - sub {return $class->is_strict(shift)} + *{$callpkg.'::is_strict'} = \&version::is_strict unless defined(&{$callpkg.'::is_strict'}); } if (exists($args{'is_lax'})) { - *{$callpkg.'::is_lax'} = - sub {return $class->is_lax(shift)} + *{$callpkg.'::is_lax'} = \&version::is_lax unless defined(&{$callpkg.'::is_lax'}); } } | ||