r53991 - in /branches/upstream/libdevel-declare-perl/current: ./ inc/Module/ inc/Module/Install/ lib/Devel/ lib/Devel/Declare/MethodInstaller/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue Mar 9 20:36:36 UTC 2010
Author: jawnsy-guest
Date: Tue Mar 9 20:36:28 2010
New Revision: 53991
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=53991
Log:
[svn-upgrade] Integrating new upstream version, libdevel-declare-perl (0.006000)
Added:
branches/upstream/libdevel-declare-perl/current/t/ctx-simple-like-mxms.t
Modified:
branches/upstream/libdevel-declare-perl/current/Changes
branches/upstream/libdevel-declare-perl/current/Declare.xs
branches/upstream/libdevel-declare-perl/current/MANIFEST
branches/upstream/libdevel-declare-perl/current/META.yml
branches/upstream/libdevel-declare-perl/current/inc/Module/Install.pm
branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Base.pm
branches/upstream/libdevel-declare-perl/current/inc/Module/Install/MakeMaker.pm
branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Makefile.pm
branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Metadata.pm
branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare.pm
branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare/MethodInstaller/Simple.pm
branches/upstream/libdevel-declare-perl/current/t/debug.t
branches/upstream/libdevel-declare-perl/current/t/fail.t
Modified: branches/upstream/libdevel-declare-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/Changes?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/Changes (original)
+++ branches/upstream/libdevel-declare-perl/current/Changes Tue Mar 9 20:36:28 2010
@@ -1,4 +1,7 @@
Changes for Devel-Declare
+
+0.006000 - 09 Mar 2010
+ - Make things work on perl 5.11.2 and newer (Zefram).
0.005011 - 14 Aug 2009
- Add tests for not interpreting various things as barewords when they
Modified: branches/upstream/libdevel-declare-perl/current/Declare.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/Declare.xs?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/Declare.xs (original)
+++ branches/upstream/libdevel-declare-perl/current/Declare.xs Tue Mar 9 20:36:28 2010
@@ -7,6 +7,12 @@
#include <stdio.h>
#include <string.h>
+#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
+#define PERL_DECIMAL_VERSION \
+ PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#define PERL_VERSION_GE(r,v,s) \
+ (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+
#ifndef Newx
# define Newx(v,n,t) New(0,v,n,t)
#endif /* !Newx */
@@ -17,6 +23,8 @@
#define DD_DEBUG_UPDATED_LINESTR (dd_debug & DD_DEBUGf_UPDATED_LINESTR)
#define DD_DEBUG_TRACE (dd_debug & DD_DEBUGf_TRACE)
static int dd_debug = 0;
+
+#define DD_CONST_VIA_RV2CV PERL_VERSION_GE(5,11,2)
#define LEX_NORMAL 10
#define LEX_INTERPNORMAL 9
@@ -224,41 +232,48 @@
return s - base_s;
}
+static void call_done_declare(pTHX) {
+ dSP;
+
+ if (DD_DEBUG_TRACE) {
+ printf("Deconstructing declare\n");
+ printf("PL_bufptr: %s\n", PL_bufptr);
+ printf("bufend at: %i\n", PL_bufend - PL_bufptr);
+ printf("linestr: %s\n", SvPVX(PL_linestr));
+ printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
+ }
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+
+ call_pv("Devel::Declare::done_declare", G_VOID|G_DISCARD);
+
+ FREETMPS;
+ LEAVE;
+
+ if (DD_DEBUG_TRACE) {
+ printf("PL_bufptr: %s\n", PL_bufptr);
+ printf("bufend at: %i\n", PL_bufend - PL_bufptr);
+ printf("linestr: %s\n", SvPVX(PL_linestr));
+ printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
+ printf("actual len: %i\n", strlen(PL_bufptr));
+ }
+}
+
+static int dd_handle_const(pTHX_ char *name);
+
/* replacement PL_check rv2cv entry */
STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) {
- dSP;
OP* kid;
int dd_flags;
PERL_UNUSED_VAR(user_data);
if (in_declare) {
- if (DD_DEBUG_TRACE) {
- printf("Deconstructing declare\n");
- printf("PL_bufptr: %s\n", PL_bufptr);
- printf("bufend at: %i\n", PL_bufend - PL_bufptr);
- printf("linestr: %s\n", SvPVX(PL_linestr));
- printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
- }
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
-
- call_pv("Devel::Declare::done_declare", G_VOID|G_DISCARD);
-
- FREETMPS;
- LEAVE;
-
- if (DD_DEBUG_TRACE) {
- printf("PL_bufptr: %s\n", PL_bufptr);
- printf("bufend at: %i\n", PL_bufend - PL_bufptr);
- printf("linestr: %s\n", SvPVX(PL_linestr));
- printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
- printf("actual len: %i\n", strlen(PL_bufptr));
- }
+ call_done_declare(aTHX);
return o;
}
@@ -283,6 +298,24 @@
printf("dd_flags are: %i\n", dd_flags);
printf("PL_tokenbuf: %s\n", PL_tokenbuf);
}
+
+#if DD_CONST_VIA_RV2CV
+ if (PL_expect != XOPERATOR) {
+ if (!dd_handle_const(aTHX_ GvNAME(kGVOP_gv)))
+ return o;
+ CopLINE(PL_curcop) = PL_copline;
+ /* The parser behaviour that we're simulating depends on what comes
+ after the declarator. */
+ if (*skipspace(PL_bufptr + strlen(GvNAME(kGVOP_gv))) != '(') {
+ if (in_declare) {
+ call_done_declare(aTHX);
+ } else {
+ dd_linestr_callback(aTHX_ "rv2cv", GvNAME(kGVOP_gv));
+ }
+ }
+ return o;
+ }
+#endif /* DD_CONST_VIA_RV2CV */
dd_linestr_callback(aTHX_ "rv2cv", GvNAME(kGVOP_gv));
@@ -341,33 +374,7 @@
return count;
}
-STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) {
- int dd_flags;
- char* name;
-
- PERL_UNUSED_VAR(user_data);
-
- if (DD_HAVE_PARSER && PL_expect == XOPERATOR) {
- return o;
- }
-
- /* if this is set, we just grabbed a delimited string or something,
- not a bareword, so NO TOUCHY */
-
- if (DD_HAVE_LEX_STUFF)
- return o;
-
- /* don't try and look this up if it's not a string const */
- if (!SvPOK(cSVOPo->op_sv))
- return o;
-
- name = SvPVX(cSVOPo->op_sv);
-
- dd_flags = dd_is_declarator(aTHX_ name);
-
- if (dd_flags == -1)
- return o;
-
+static int dd_handle_const(pTHX_ char *name) {
switch (PL_lex_inwhat) {
case OP_QR:
case OP_MATCH:
@@ -375,14 +382,14 @@
case OP_TRANS:
case OP_BACKTICK:
case OP_STRINGIFY:
- return o;
+ return 0;
break;
default:
break;
}
if (strnEQ(PL_bufptr, "->", 2)) {
- return o;
+ return 0;
}
{
@@ -401,7 +408,7 @@
sv_catpvn(inject, s, d - s);
if ((PL_bufend - d) >= 2 && strnEQ(d, "=>", 2)) {
- return o;
+ return 0;
}
sv_catpv(inject, d);
@@ -413,8 +420,44 @@
dd_linestr_callback(aTHX_ "const", name);
+ return 1;
+}
+
+#if !DD_CONST_VIA_RV2CV
+
+STATIC OP *dd_ck_const(pTHX_ OP *o, void *user_data) {
+ int dd_flags;
+ char* name;
+
+ PERL_UNUSED_VAR(user_data);
+
+ if (DD_HAVE_PARSER && PL_expect == XOPERATOR) {
+ return o;
+ }
+
+ /* if this is set, we just grabbed a delimited string or something,
+ not a bareword, so NO TOUCHY */
+
+ if (DD_HAVE_LEX_STUFF)
+ return o;
+
+ /* don't try and look this up if it's not a string const */
+ if (!SvPOK(cSVOPo->op_sv))
+ return o;
+
+ name = SvPVX(cSVOPo->op_sv);
+
+ dd_flags = dd_is_declarator(aTHX_ name);
+
+ if (dd_flags == -1)
+ return o;
+
+ dd_handle_const(aTHX_ name);
+
return o;
}
+
+#endif /* !DD_CONST_VIA_RV2CV */
static int initialized = 0;
@@ -428,7 +471,9 @@
if (!initialized++) {
hook_op_check(OP_RV2CV, dd_ck_rv2cv, NULL);
hook_op_check(OP_ENTEREVAL, dd_ck_entereval, NULL);
+#if !DD_CONST_VIA_RV2CV
hook_op_check(OP_CONST, dd_ck_const, NULL);
+#endif /* !DD_CONST_VIA_RV2CV */
}
filter_add(dd_filter_realloc, NULL);
Modified: branches/upstream/libdevel-declare-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/MANIFEST?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/MANIFEST (original)
+++ branches/upstream/libdevel-declare-perl/current/MANIFEST Tue Mar 9 20:36:28 2010
@@ -16,6 +16,7 @@
t/00load.t
t/build_sub_installer.t
t/combi.t
+t/ctx-simple-like-mxms.t
t/ctx-simple.t
t/debug.pl
t/debug.t
Modified: branches/upstream/libdevel-declare-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/META.yml?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/META.yml (original)
+++ branches/upstream/libdevel-declare-perl/current/META.yml Tue Mar 9 20:36:28 2010
@@ -11,7 +11,7 @@
ExtUtils::Depends: 0.302
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.91'
+generated_by: 'Module::Install version 0.92'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -30,4 +30,4 @@
resources:
license: http://dev.perl.org/licenses/
repository: git://github.com/rafl/devel-declare.git
-version: 0.005011
+version: 0.006000
Modified: branches/upstream/libdevel-declare-perl/current/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/inc/Module/Install.pm?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/inc/Module/Install.pm (original)
+++ branches/upstream/libdevel-declare-perl/current/inc/Module/Install.pm Tue Mar 9 20:36:28 2010
@@ -28,7 +28,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.91';
+ $VERSION = '0.92';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -348,17 +348,24 @@
return $call;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
sub _readperl {
my $string = Module::Install::_read($_[0]);
@@ -379,18 +386,26 @@
return $string;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
+END_NEW
+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]): $!";
+}
+END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
@@ -427,4 +442,4 @@
1;
-# Copyright 2008 - 2009 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
Modified: branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Base.pm?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Base.pm (original)
+++ branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Base.pm Tue Mar 9 20:36:28 2010
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
}
# Suspend handler for "redefined" warnings
Modified: branches/upstream/libdevel-declare-perl/current/inc/Module/Install/MakeMaker.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/inc/Module/Install/MakeMaker.pm?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/inc/Module/Install/MakeMaker.pm (original)
+++ branches/upstream/libdevel-declare-perl/current/inc/Module/Install/MakeMaker.pm Tue Mar 9 20:36:28 2010
@@ -7,12 +7,12 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
-my $makefile;
+my $makefile = undef;
sub WriteMakefile {
my ($self, %args) = @_;
@@ -36,6 +36,12 @@
}
}
+ if (my $prereq = delete($args{BUILD_REQUIRES})) {
+ while (my($k,$v) = each %$prereq) {
+ $self->build_requires($k,$v);
+ }
+ }
+
# put the remaining args to makemaker_args
$self->makemaker_args(%args);
}
Modified: branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Makefile.pm?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Makefile.pm (original)
+++ branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Makefile.pm Tue Mar 9 20:36:28 2010
@@ -7,7 +7,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -34,6 +34,17 @@
}
}
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
sub makemaker_args {
my $self = shift;
my $args = ( $self->{makemaker_args} ||= {} );
@@ -44,7 +55,7 @@
# For mm args that take multiple space-seperated args,
# append an argument to the current list.
sub makemaker_append {
- my $self = sShift;
+ my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{name} = defined $args->{$name}
@@ -130,12 +141,13 @@
# 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+)/ );
+ my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
+ $self->build_requires( 'ExtUtils::MakeMaker' => $v );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
} 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->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
}
@@ -152,42 +164,62 @@
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
+ if ( $self->makemaker(6.10) ) {
$args->{NO_META} = 1;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
- # Merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
- map { @$_ }
+ map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
- ($self->configure_requires, $self->build_requires, $self->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
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # 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} ||= []);
if ($self->bundles) {
foreach my $bundle (@{ $self->bundles }) {
my ($file, $dir) = @$bundle;
push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
+ delete $build_prereq->{$file}; #Delete from build prereqs only
}
+ }
+
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
}
$args->{INSTALLDIRS} = $self->installdirs;
@@ -265,4 +297,4 @@
__END__
-#line 394
+#line 426
Modified: branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Metadata.pm?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Metadata.pm (original)
+++ branches/upstream/libdevel-declare-perl/current/inc/Module/Install/Metadata.pm Tue Mar 9 20:36:28 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -230,6 +230,8 @@
die("The path '$file' does not exist, or is not a file");
}
+ $self->{values}{all_from} = $file;
+
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
@@ -385,11 +387,10 @@
}
}
-sub perl_version_from {
- my $self = shift;
+sub _extract_perl_version {
if (
- Module::Install::_read($_[0]) =~ m/
- ^
+ $_[0] =~ m/
+ ^\s*
(?:use|require) \s*
v?
([\d_\.]+)
@@ -398,6 +399,16 @@
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
@@ -425,13 +436,12 @@
}
}
-sub license_from {
- my $self = shift;
+sub _extract_license {
if (
- Module::Install::_read($_[0]) =~ m/
+ $_[0] =~ m/
(
=head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
+ (?:licen[cs]e|licensing|copyrights?|legal)\b
.*?
)
(=head\\d.*|=cut.*|)
@@ -439,7 +449,8 @@
/ixms ) {
my $license_text = $1;
my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+ '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,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
@@ -456,20 +467,32 @@
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
+ $pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
- $self->license($license);
- return 1;
+ return $license;
}
}
- }
-
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
+ } else {
+ return;
+ }
+}
+
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
}
sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ 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
+ )>#gx;
my %links;
@links{@links}=();
@links=keys %links;
@@ -485,7 +508,7 @@
return 0;
}
if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
+ warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
Modified: branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare.pm?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare.pm (original)
+++ branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare.pm Tue Mar 9 20:36:28 2010
@@ -4,7 +4,7 @@
use warnings;
use 5.008001;
-our $VERSION = '0.005011';
+our $VERSION = '0.006000';
use constant DECLARE_NAME => 1;
use constant DECLARE_PROTO => 2;
Modified: branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare/MethodInstaller/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare/MethodInstaller/Simple.pm?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare/MethodInstaller/Simple.pm (original)
+++ branches/upstream/libdevel-declare-perl/current/lib/Devel/Declare/MethodInstaller/Simple.pm Tue Mar 9 20:36:28 2010
@@ -7,7 +7,7 @@
use strict;
use warnings;
-our $VERSION = '0.003005';
+our $VERSION = '0.006000';
sub install_methodhandler {
my $class = shift;
Added: branches/upstream/libdevel-declare-perl/current/t/ctx-simple-like-mxms.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/t/ctx-simple-like-mxms.t?rev=53991&op=file
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/t/ctx-simple-like-mxms.t (added)
+++ branches/upstream/libdevel-declare-perl/current/t/ctx-simple-like-mxms.t Tue Mar 9 20:36:28 2010
@@ -1,0 +1,60 @@
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+# This test script is derived from a MooseX::Method::Signatures test,
+# which is sensitive to some details of Devel::Declare behaviour that
+# ctx-simple.t is not. In particular, the use of a paren immediately
+# following the declarator, constructing a parenthesised function call,
+# invokes a different parser path.
+
+use Devel::Declare ();
+use Devel::Declare::Context::Simple ();
+use B::Hooks::EndOfScope qw(on_scope_end);
+
+sub inject_after_scope($) {
+ my ($inject) = @_;
+ on_scope_end {
+ my $line = Devel::Declare::get_linestr();
+ return unless defined $line;
+ my $offset = Devel::Declare::get_linestr_offset();
+ substr($line, $offset, 0) = $inject;
+ Devel::Declare::set_linestr($line);
+ };
+}
+
+sub mtfnpy_parser(@) {
+ my $ctx = Devel::Declare::Context::Simple->new(into => __PACKAGE__);
+ $ctx->init(@_);
+ $ctx->skip_declarator;
+ my $name = $ctx->strip_name;
+ die "No name\n" unless defined $name;
+ my $proto = $ctx->strip_proto;
+ die "Wrong declarator\n" unless $ctx->declarator eq "mtfnpy";
+ $ctx->inject_if_block(qq[BEGIN { @{[__PACKAGE__]}::inject_after_scope(', q[${name}]);') } unshift \@_, "${proto}";], "(sub ");
+ my $compile_stash = $ctx->get_curstash_name;
+ $ctx->shadow(sub {
+ my ($code, $name, @args) = @_;
+ no strict "refs";
+ *{"${compile_stash}::${name}"} = $code;
+ });
+}
+
+BEGIN {
+ Devel::Declare->setup_for(__PACKAGE__, {
+ mtfnpy => { const => \&mtfnpy_parser },
+ });
+ *mtfnpy = sub {};
+}
+
+mtfnpy foo (extra) {
+ is scalar(@_), 4;
+ is $_[0], "extra";
+ is $_[1], "a";
+ is $_[2], "b";
+ is $_[3], "c";
+}
+
+foo(qw(a b c));
+
+1;
Modified: branches/upstream/libdevel-declare-perl/current/t/debug.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/t/debug.t?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/t/debug.t (original)
+++ branches/upstream/libdevel-declare-perl/current/t/debug.t Tue Mar 9 20:36:28 2010
@@ -1,7 +1,13 @@
use strict;
use warnings;
-use Test::More tests => 1;
+use Test::More;
+
+BEGIN {
+ if($] eq "5.011002") {
+ plan skip_all => "line debugging broken on 5.11.2";
+ }
+}
use Cwd qw/cwd/;
use FindBin qw/$Bin/;
@@ -25,4 +31,5 @@
like($output, qr/method new {}, sub {my \$self = shift;/,
"replaced line string visible in debug lines");
-1;
+
+done_testing;
Modified: branches/upstream/libdevel-declare-perl/current/t/fail.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-declare-perl/current/t/fail.t?rev=53991&op=diff
==============================================================================
--- branches/upstream/libdevel-declare-perl/current/t/fail.t (original)
+++ branches/upstream/libdevel-declare-perl/current/t/fail.t Tue Mar 9 20:36:28 2010
@@ -1,23 +1,31 @@
-use Devel::Declare;
+use strict;
+use warnings;
+use Test::More 'no_plan';
use Devel::Declare::MethodInstaller::Simple;
-BEGIN { Devel::Declare::MethodInstaller::Simple->install_methodhandler(name => 'method', into => 'main') };
-
-use Test::More 'no_plan';
+BEGIN {
+ Devel::Declare::MethodInstaller::Simple->install_methodhandler(
+ name => 'method',
+ into => __PACKAGE__,
+ );
+}
TODO: {
- local $TODO='Method does not throw proper errors for bad parens yet';
+ local $TODO = 'Method does not throw proper errors for bad parens yet';
+
eval 'method main ( { return "foo" }';
- like($@,qr/Prototype\snot\sterminated/,'Missing end parens');
+ like($@, qr/Prototype\snot\sterminated/, 'Missing end parens');
eval 'method main ) { return "foo" }';
- like($@,qr/Illegal\sdeclaration\sof\ssubroutine/,'Missing start parens');
+ like($@, qr/Illegal\sdeclaration\sof\ssubroutine/, 'Missing start parens');
};
TODO: {
- local $TODO='method does not disallow invalid sub names';
- eval 'method 1main() { return "foo" }','Sub starting with a number';
- like($@,qr/Illegal\sdeclaration\sof\sanonymous\ssubroutine/);
- eval 'method møø() { return "foo" }','Sub with unicode';
- like($@,qr/Illegal\sdeclaration\sof\ssubroutine\smain\:\:m/);
-};
+ local $TODO = 'method does not disallow invalid sub names';
+
+ eval 'method 1main() { return "foo" }';
+ like($@, qr/Illegal\sdeclaration\sof\sanonymous\ssubroutine/, 'starting with a number');
+
+ eval 'method møø() { return "foo" }';
+ like($@, qr/Illegal\sdeclaration\sof\ssubroutine\smain\:\:m/, 'with unicode');
+};
More information about the Pkg-perl-cvs-commits
mailing list