r49351 - in /branches/upstream/libaspect-perl/current: ./ lib/ lib/Aspect/ lib/Aspect/Advice/ lib/Aspect/Hook/ lib/Aspect/Library/ lib/Aspect/Pointcut/ t/ t/lib/Aspect/tests/ t/lib/Test/ t/lib/Test/Builder/ t/lib/Test/Class/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Dec 25 14:20:06 UTC 2009
Author: jawnsy-guest
Date: Fri Dec 25 14:19:52 2009
New Revision: 49351
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49351
Log:
[svn-upgrade] Integrating new upstream version, libaspect-perl (0.23)
Added:
branches/upstream/libaspect-perl/current/lib/Aspect/Advice/
branches/upstream/libaspect-perl/current/lib/Aspect/Advice/After.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Advice/Before.pm
branches/upstream/libaspect-perl/current/t/03_context.t
Removed:
branches/upstream/libaspect-perl/current/lib/Aspect/Weaver.pm
branches/upstream/libaspect-perl/current/t/lib/Aspect/tests/Weaver.pm
Modified:
branches/upstream/libaspect-perl/current/Changes
branches/upstream/libaspect-perl/current/MANIFEST
branches/upstream/libaspect-perl/current/META.yml
branches/upstream/libaspect-perl/current/Makefile.PL
branches/upstream/libaspect-perl/current/lib/Aspect.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Advice.pm
branches/upstream/libaspect-perl/current/lib/Aspect/AdviceContext.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Hook/LexWrap.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Library/Listenable.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Library/Memoize.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Library/Singleton.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Library/TestClass.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Library/Wormhole.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Modular.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/AndOp.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/BinOp.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Call.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Cflow.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/NotOp.pm
branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/OrOp.pm
branches/upstream/libaspect-perl/current/t/01_all.t
branches/upstream/libaspect-perl/current/t/02_caller.t
branches/upstream/libaspect-perl/current/t/lib/Test/Builder/Tester.pm
branches/upstream/libaspect-perl/current/t/lib/Test/Class.pm
branches/upstream/libaspect-perl/current/t/lib/Test/Class/MethodInfo.pm
branches/upstream/libaspect-perl/current/t/lib/Test/Exception.pm
Modified: branches/upstream/libaspect-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/Changes?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/Changes (original)
+++ branches/upstream/libaspect-perl/current/Changes Fri Dec 25 14:19:52 2009
@@ -1,4 +1,15 @@
Revision history for Perl extension Aspect
+
+0.23 Thu 24 Dec 2009
+ - Removed the concept of a standalone Aspect::Weaver class
+ - Each Aspect::Advice:: subclass now does most of the setup for the weaving
+ individually, with similar but slightly different implementations.
+ This adds some duplication of code, but removes a lot of architectural
+ complexity. It should make the creation of new types of Advice simpler.
+ - Corrected the versions of the test libs (which went out of sync)
+ - The Hook::LexWrap wrap function is now split into Advice-specific hooks
+ before and after, duplicating some code but making each type simpler and
+ faster.
0.22 Mon 21 Dec 2009
- Part one of an upcoming series of major upgrades
Modified: branches/upstream/libaspect-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/MANIFEST?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/MANIFEST (original)
+++ branches/upstream/libaspect-perl/current/MANIFEST Fri Dec 25 14:19:52 2009
@@ -19,6 +19,8 @@
inc/Module/Install/WriteAll.pm
lib/Aspect.pm
lib/Aspect/Advice.pm
+lib/Aspect/Advice/After.pm
+lib/Aspect/Advice/Before.pm
lib/Aspect/AdviceContext.pm
lib/Aspect/Hook/LexWrap.pm
lib/Aspect/Library/Listenable.pm
@@ -34,7 +36,6 @@
lib/Aspect/Pointcut/Cflow.pm
lib/Aspect/Pointcut/NotOp.pm
lib/Aspect/Pointcut/OrOp.pm
-lib/Aspect/Weaver.pm
LICENSE
Makefile.PL
MANIFEST This list of files
@@ -42,6 +43,7 @@
README
t/01_all.t
t/02_caller.t
+t/03_context.t
t/97_meta.t
t/98_pod.t
t/99_pmv.t
@@ -59,7 +61,6 @@
t/lib/Aspect/Pointcut/tests/Cflow.pm
t/lib/Aspect/tests/Advice.pm
t/lib/Aspect/tests/AdviceContext.pm
-t/lib/Aspect/tests/Weaver.pm
t/lib/Test/Builder/Tester.pm
t/lib/Test/Builder/Tester/Color.pm
t/lib/Test/Class.pm
Modified: branches/upstream/libaspect-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/META.yml?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/META.yml (original)
+++ branches/upstream/libaspect-perl/current/META.yml Fri Dec 25 14:19:52 2009
@@ -6,6 +6,7 @@
ExtUtils::MakeMaker: 6.42
Test::Class: 0.28
Test::More: 0.70
+ Test::NoWarnings: 0.084
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
@@ -30,4 +31,4 @@
ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/Aspect
license: http://dev.perl.org/licenses/
repository: http://svn.ali.as/cpan/trunk/Aspect
-version: 0.22
+version: 0.23
Modified: branches/upstream/libaspect-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/Makefile.PL?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/Makefile.PL (original)
+++ branches/upstream/libaspect-perl/current/Makefile.PL Fri Dec 25 14:19:52 2009
@@ -1,7 +1,8 @@
use inc::Module::Install::DSL 0.91;
all_from lib/Aspect.pm
-requires Devel::Symdump 2.04
-requires Sub::Uplevel 0.2002
-test_requires Test::Class 0.28
-test_requires Test::More 0.70
+requires Devel::Symdump 2.04
+requires Sub::Uplevel 0.2002
+test_requires Test::More 0.70
+test_requires Test::Class 0.28
+test_requires Test::NoWarnings 0.084
Modified: branches/upstream/libaspect-perl/current/lib/Aspect.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect.pm Fri Dec 25 14:19:52 2009
@@ -9,7 +9,7 @@
use Aspect::Pointcut::Call ();
use Aspect::Pointcut::Cflow ();
-our $VERSION = '0.22';
+our $VERSION = '0.23';
our @ISA = 'Exporter';
our @EXPORT = qw{ aspect before after call cflow };
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Advice.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Advice.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Advice.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Advice.pm Fri Dec 25 14:19:52 2009
@@ -3,20 +3,19 @@
use strict;
use warnings;
use Carp;
-use Aspect::AdviceContext;
-use Aspect::Weaver;
+use Aspect::AdviceContext ();
+use Aspect::Advice::After ();
+use Aspect::Advice::Before ();
-our $VERSION = '0.22';
+our $VERSION = '0.23';
sub new {
- my ($class, $type, $code, $pointcut) = @_;
- my $self = bless {
- weaver => Aspect::Weaver->new, # a weaver that will install advice code
- hooks => undef, # list of Hook::LexWrap hooks
- type => $type, # before or after
- code => $code, # the advice code
- pointcut => $pointcut, # the advice pointcut
- }, $class;
+ my $class = "Aspect::Advice::" . ucfirst($_[1]); # Yes, a bit hacky
+ my $self = $class->new(
+ hooks => undef, # List of symbol table hooks
+ code => $_[2], # the advice code
+ pointcut => $_[3], # the advice pointcut
+ );
$self->install;
return $self;
}
@@ -24,72 +23,15 @@
# private ---------------------------------------------------------------------
sub install {
- my $self = shift;
- my $weaver = $self->weaver;
- my $type = $self->type;
- my $pointcut = $self->pointcut;
- my $code = $self->code;
-
- # Find all pointcuts that are statically matched
- # wrap the method with advice code and install the wrapper
- foreach my $sub_name ($weaver->get_sub_names) {
- next unless $pointcut->match_define($sub_name);
- my $wrapped_code = $self->wrap_code($type, $code, $pointcut, $sub_name);
- $self->add_hooks(
- $weaver->install($type, $sub_name, $wrapped_code)
- );
- }
-}
-
-# return wrapper sub to be installed instead of original
-# wrapper sub creates context then calls advice code
-# it runs only if the pointcut answers true to match_run()
-sub wrap_code {
- my ($self, $type, $code, $pointcut, $sub_name) = @_;
-
- return sub {
- # Hacked Hook::LexWrap calls hooks with 3 params
- my ($params, $original, $return_value) = @_;
- my $runtime_context = {};
- return unless $pointcut->match_run($sub_name, $runtime_context);
-
- # Create context for advice code
- my $advice_context = Aspect::AdviceContext->new(
- sub_name => $sub_name,
- type => $type,
- pointcut => $pointcut,
- params => $params,
- return_value => $return_value,
- original => $original,
- %$runtime_context,
- );
-
- # Execute advice code with its context
- if (wantarray)
- { () = &$code($advice_context) }
- elsif (defined wantarray)
- { my $dummy = &$code($advice_context) }
- else
- { &$code($advice_context) }
-
- # If proceeding to original, modify params, else modify return value
- if ($type eq 'before' && $advice_context->proceed)
- { @$params = $advice_context->params }
- else
- { $_[-1] = $advice_context->return_value }
- };
+ die("Method 'install' is not implemented by " . ref($_[0]));
}
sub add_hooks {
push @{shift->{hooks}}, shift;
}
-sub weaver {
- $_[0]->{weaver};
-}
-
sub type {
- $_[0]->{type};
+ die("Method 'type' is not implemented by " . ref($_[0]));
}
sub code {
Added: branches/upstream/libaspect-perl/current/lib/Aspect/Advice/After.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Advice/After.pm?rev=49351&op=file
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Advice/After.pm (added)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Advice/After.pm Fri Dec 25 14:19:52 2009
@@ -1,0 +1,65 @@
+package Aspect::Advice::After;
+
+use strict;
+use warnings;
+use Aspect::Advice ();
+use Aspect::Hook::LexWrap ();
+
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Advice';
+
+sub new {
+ my $class = shift;
+ return bless { @_ }, $class;
+}
+
+# This should never be called by our own code.
+# It only exists for back-compatibility purposes.
+sub type {
+ return 'after';
+}
+
+sub install {
+ my $self = shift;
+ my $pointcut = $self->pointcut;
+ my $code = $self->code;
+
+ # Find all pointcuts that are statically matched
+ # wrap the method with advice code and install the wrapper
+ foreach my $name ( $pointcut->match_all ) {
+ my $wrapped = sub {
+ # Hacked Hook::LexWrap calls hooks with 3 params
+ my ($params, $original, $return_value) = @_;
+ my $runtime_context = {};
+ return unless $pointcut->match_run($name, $runtime_context);
+
+ # Create context for advice code
+ my $advice_context = Aspect::AdviceContext->new(
+ sub_name => $name,
+ type => 'after',
+ pointcut => $pointcut,
+ params => $params,
+ return_value => $return_value,
+ original => $original,
+ %$runtime_context,
+ );
+
+ # Execute advice code with its context
+ if ( wantarray ) {
+ () = &$code($advice_context)
+ } elsif ( defined wantarray ) {
+ my $dummy = &$code($advice_context);
+ } else {
+ &$code($advice_context);
+ }
+
+ # Modify return value
+ $_[-1] = $advice_context->return_value;
+ };
+ $self->add_hooks(
+ Aspect::Hook::LexWrap::after( $name, $wrapped )
+ );
+ }
+}
+
+1;
Added: branches/upstream/libaspect-perl/current/lib/Aspect/Advice/Before.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Advice/Before.pm?rev=49351&op=file
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Advice/Before.pm (added)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Advice/Before.pm Fri Dec 25 14:19:52 2009
@@ -1,0 +1,70 @@
+package Aspect::Advice::Before;
+
+use strict;
+use warnings;
+use Aspect::Advice ();
+use Aspect::Hook::LexWrap ();
+
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Advice';
+
+sub new {
+ my $class = shift;
+ return bless { @_ }, $class;
+}
+
+# This should never be called by our own code.
+# It only exists for back-compatibility purposes.
+sub type {
+ return 'before';
+}
+
+sub install {
+ my $self = shift;
+ my $pointcut = $self->pointcut;
+ my $code = $self->code;
+
+ # Find all pointcuts that are statically matched
+ # wrap the method with advice code and install the wrapper
+ foreach my $name ( $pointcut->match_all ) {
+ my $wrapped = sub {
+ # Hacked Hook::LexWrap calls hooks with 3 params
+ my ($params, $original, $return_value) = @_;
+ my $runtime_context = {};
+ return unless $pointcut->match_run($name, $runtime_context);
+
+ # Create context for advice code
+ my $advice_context = Aspect::AdviceContext->new(
+ sub_name => $name,
+ type => 'before',
+ pointcut => $pointcut,
+ params => $params,
+ return_value => $return_value,
+ original => $original,
+ %$runtime_context,
+ );
+
+ # Execute advice code with its context
+ if ( wantarray ) {
+ () = &$code($advice_context)
+ } elsif ( defined wantarray ) {
+ my $dummy = &$code($advice_context);
+ } else {
+ &$code($advice_context);
+ }
+
+ # If proceeding to original, modify params, else modify return value
+ if ( $advice_context->proceed ) {
+ @$params = $advice_context->params;
+ } else {
+ $_[-1] = $advice_context->return_value;
+ }
+ };
+
+ $self->add_hooks(
+ Aspect::Hook::LexWrap::before( $name, $wrapped )
+ );
+ }
+}
+
+1;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/AdviceContext.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/AdviceContext.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/AdviceContext.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/AdviceContext.pm Fri Dec 25 14:19:52 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.22';
+our $VERSION = '0.23';
sub new {
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Hook/LexWrap.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Hook/LexWrap.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Hook/LexWrap.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Hook/LexWrap.pm Fri Dec 25 14:19:52 2009
@@ -7,27 +7,89 @@
use Carp ();
use Sub::Uplevel ();
-our $VERSION = '0.22';
+our $VERSION = '0.23';
-sub wrap {
- my ($typeglob, $pre, $post) = @_;
+sub before {
+ my ($typeglob, $code) = @_;
# Check and normalise the typeglob
- $typeglob = (ref $typeglob || $typeglob =~ /::/)
- ? $typeglob
- : caller()."::$typeglob";
no strict 'refs';
- my $original = ref $typeglob eq 'CODE' ? $typeglob : *$typeglob{CODE};
+ my $original = *$typeglob{CODE};
unless ( $original ) {
Carp::croak("Can't wrap non-existent subroutine ", $typeglob);
}
# Check the wrappers
- if ( $pre and ref $pre ne 'CODE' ) {
- Carp::croak("'pre' value is not a subroutine reference");
+ unless ( ref $code eq 'CODE' ) {
+ Carp::croak("Code value is not a subroutine reference");
}
- if ( $post and ref $post ne 'CODE' ) {
- Carp::croak("'post' value is not a subroutine reference");
+
+ # State variable for use in the closure (eep)
+ my $unwrap = undef;
+
+ # Any way to set prototypes other than eval?
+ my $prototype = prototype($original);
+ $prototype = defined($prototype) ? "($prototype)" : '';
+
+ # Generate the new function
+ no warnings 'redefine';
+ eval "sub $typeglob $prototype " . q{{
+ if ( $unwrap ) { goto &$original }
+ my ($return, $prereturn);
+ if ( wantarray ) {
+ $prereturn = $return = [];
+ () = $code->( \@_, $original, $return );
+ unless (
+ # It's still an array
+ ref $return eq 'ARRAY'
+ and
+ # It's still the SAME array
+ $return == $prereturn
+ and
+ # It's still empty
+ ! @$return
+ ) {
+ return ref $return eq 'ARRAY'
+ ? @$return
+ : ( $return );
+ }
+
+ } elsif ( defined wantarray ) {
+ $return = bless sub {
+ $prereturn = 1
+ }, 'Aspect::Hook::LexWrap::Cleanup';
+ my $dummy = $code->( \@_, $original, $return );
+ return $return if $prereturn;
+
+ } else {
+ $return = bless sub {
+ $prereturn = 1
+ }, 'Aspect::Hook::LexWrap::Cleanup';
+ $code->( \@_, $original, $return );
+ return if $prereturn;
+ }
+
+ goto &$original;
+ }};
+ die $@ if $@;
+ return bless sub {
+ $unwrap = 1
+ }, 'Aspect::Hook::LexWrap::Cleanup';
+}
+
+sub after {
+ my ($typeglob, $post) = @_;
+
+ # Check and normalise the typeglob
+ no strict 'refs';
+ my $original = *$typeglob{CODE};
+ unless ( $original ) {
+ Carp::croak("Can't wrap non-existent subroutine ", $typeglob);
+ }
+
+ # Check the wrappers
+ if ( ref $post ne 'CODE' ) {
+ Carp::croak("Code is not a subroutine reference");
}
# State variable for use in the closure (eep)
@@ -41,76 +103,36 @@
if ( $unwrap ) { goto &$original }
my ($return, $prereturn);
if ( wantarray ) {
- $prereturn = $return = [];
- () = $pre->(
+ $return = [
+ Sub::Uplevel::uplevel(
+ 1, $original, @_,
+ )
+ ];
+ () = $post->(
\@_, $original, $return
- ) if $pre;
- if (
- # It's still an array
- ref $return eq 'ARRAY'
- and
- # It's still the SAME array
- $return == $prereturn
- and
- # It's still empty
- ! @$return
- ) {
- $return = [
- Sub::Uplevel::uplevel(
- 1, $original, @_,
- )
- ];
- () = $post->(
- \@_, $original, $return
- ) if $post;
- }
+ );
return ref $return eq 'ARRAY'
? @$return
: ( $return );
} elsif ( defined wantarray ) {
- $return = bless sub {
- $prereturn = 1
- }, 'Aspect::Hook::LexWrap::Cleanup';
- my $dummy = $pre->(
+ $return = Sub::Uplevel::uplevel(
+ 1, $original, @_,
+ );
+ my $dummy = scalar $post->(
\@_, $original, $return
- ) if $pre;
- unless ( $prereturn ) {
- $return = Sub::Uplevel::uplevel(
- 1, $original, @_,
- );
- $dummy = scalar $post->(
- \@_, $original, $return
- ) if $post;
- }
+ );
return $return;
} else {
- $return = bless sub {
- $prereturn = 1
- }, 'Aspect::Hook::LexWrap::Cleanup';
- $pre->(
- \@_, $original, $return
- ) if $pre;
- unless ( $prereturn ) {
- Sub::Uplevel::uplevel(
- 1, $original, @_,
- );
- $post->(
- \@_, $original, $return
- ) if $post;
- }
+ Sub::Uplevel::uplevel(
+ 1, $original, @_,
+ );
+ $post->( \@_, $original, [] );
return;
}
}};
- if ( ref $typeglob eq 'CODE' ) {
- unless ( defined wantarray ) {
- Carp::carp("Uselessly wrapped subroutine reference in void context");
- }
- return $imposter;
- }
- *{$typeglob} = $imposter;
- return unless defined wantarray;
+ *$typeglob = $imposter;
return bless sub {
$unwrap = 1
}, 'Aspect::Hook::LexWrap::Cleanup';
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Library/Listenable.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Library/Listenable.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Library/Listenable.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Library/Listenable.pm Fri Dec 25 14:19:52 2009
@@ -6,16 +6,14 @@
use strict;
use warnings;
use Carp;
+use Exporter ();
use Scalar::Util qw(weaken);
use Aspect;
-
-
-our $VERSION = '0.22';
-
-
-use base qw(Aspect::Modular Exporter);
-
-our @EXPORT = qw(add_listener remove_listener);
+use Aspect::Modular ();
+
+our $VERSION = '0.23';
+our @ISA = qw{Aspect::Modular Exporter};
+our @EXPORT = qw{add_listener remove_listener};
sub get_advice {
my ($self, $event_name, $pointcut, %event_params) = @_;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Library/Memoize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Library/Memoize.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Library/Memoize.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Library/Memoize.pm Fri Dec 25 14:19:52 2009
@@ -5,12 +5,10 @@
use Carp;
use Memoize;
use Aspect;
+use Aspect::Modular ();
-
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Modular';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Modular';
sub get_advice {
my ($self, $pointcut) = @_;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Library/Singleton.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Library/Singleton.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Library/Singleton.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Library/Singleton.pm Fri Dec 25 14:19:52 2009
@@ -4,10 +4,10 @@
use warnings;
use Carp;
use Aspect;
+use Aspect::Modular ();
-our $VERSION = '0.22';
-
-use base 'Aspect::Modular';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Modular';
my %Cache;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Library/TestClass.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Library/TestClass.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Library/TestClass.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Library/TestClass.pm Fri Dec 25 14:19:52 2009
@@ -5,12 +5,14 @@
use Carp;
use Test::Class;
use Aspect;
+use Aspect::Modular ();
-our $VERSION = '0.22';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Modular';
-use base 'Aspect::Modular';
-
-sub Test::Class::make_subject { shift->subject_class->new(@_) }
+sub Test::Class::make_subject {
+ shift->subject_class->new(@_);
+}
sub get_advice {
my ($self, $pointcut) = @_;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Library/Wormhole.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Library/Wormhole.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Library/Wormhole.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Library/Wormhole.pm Fri Dec 25 14:19:52 2009
@@ -4,12 +4,10 @@
use warnings;
use Carp;
use Aspect;
+use Aspect::Modular ();
-
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Modular';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Modular';
sub get_advice {
my ($self, $source, $target) = @_;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Modular.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Modular.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Modular.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Modular.pm Fri Dec 25 14:19:52 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.22';
+our $VERSION = '0.23';
# creating --------------------------------------------------------------------
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut.pm Fri Dec 25 14:19:52 2009
@@ -3,20 +3,20 @@
use strict;
use warnings;
use Carp;
+use Data::Dumper ();
+use Devel::Symdump ();
use Aspect::Pointcut::AndOp;
use Aspect::Pointcut::OrOp;
use Aspect::Pointcut::NotOp;
-use Data::Dumper;
-
-our $VERSION = '0.22';
+our $VERSION = '0.23';
use overload
'&' => sub { Aspect::Pointcut::AndOp->new(@_) },
'|' => sub { Aspect::Pointcut::OrOp ->new(@_) },
'!' => sub { Aspect::Pointcut::NotOp->new(@_) },
- '""' => sub { Dumper shift };
+ '""' => sub { Data::Dumper::Dumper shift };
sub new {
my ($class, @spec) = @_;
@@ -35,6 +35,28 @@
}
sub init {}
+
+# weaving methods -------------------------------------------------------------
+
+my %UNTOUCHABLE = map { $_ => 1 } qw(
+ attributes base fields lib strict warnings Carp Carp::Heavy Config CORE
+ CORE::GLOBAL DB DynaLoader Exporter Exporter::Heavy IO IO::Handle UNIVERSAL
+);
+
+# Find the list of all matching subs
+sub match_all {
+ my $self = shift;
+ my @matches = ();
+ foreach my $package ( Devel::Symdump->rnew->packages, 'main' ) {
+ next if $UNTOUCHABLE{$package};
+ next if $package =~ /^Aspect::/;
+ foreach my $name ( Devel::Symdump->new($package)->functions ) {
+ # TODO: Need to filter Aspect exportable functions!
+ push @matches, $name if $self->match_define($name);
+ }
+ }
+ return @matches;
+}
# template methods ------------------------------------------------------------
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/AndOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/AndOp.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/AndOp.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/AndOp.pm Fri Dec 25 14:19:52 2009
@@ -3,18 +3,14 @@
use strict;
use warnings;
use Carp;
+use Aspect::Pointcut::BinOp ();
-
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Pointcut::BinOp';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Pointcut::BinOp';
sub binop { $_[1] && $_[2] }
-
1;
-
__END__
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/BinOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/BinOp.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/BinOp.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/BinOp.pm Fri Dec 25 14:19:52 2009
@@ -3,12 +3,10 @@
use strict;
use warnings;
use Carp;
+use Aspect::Pointcut ();
-
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Pointcut';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Pointcut';
sub init {
my $self = shift;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Call.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Call.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Call.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Call.pm Fri Dec 25 14:19:52 2009
@@ -3,23 +3,21 @@
use strict;
use warnings;
use Carp;
+use Aspect::Pointcut ();
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Pointcut';
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Pointcut';
-
-sub init { shift->{spec} = pop }
+sub init {
+ shift->{spec} = pop;
+}
sub match_define {
my ($self, $sub_name) = @_;
return $self->match($self->{spec}, $sub_name);
}
-
1;
-
__END__
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Cflow.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Cflow.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Cflow.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/Cflow.pm Fri Dec 25 14:19:52 2009
@@ -4,12 +4,10 @@
use warnings;
use Carp;
use Aspect::AdviceContext;
+use Aspect::Pointcut ();
-
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Pointcut';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Pointcut';
sub init {
my $self = shift;
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/NotOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/NotOp.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/NotOp.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/NotOp.pm Fri Dec 25 14:19:52 2009
@@ -3,12 +3,10 @@
use strict;
use warnings;
use Carp;
+use Aspect::Pointcut ();
-
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Pointcut';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Pointcut';
sub init { shift->{op} = pop }
Modified: branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/OrOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/OrOp.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/OrOp.pm (original)
+++ branches/upstream/libaspect-perl/current/lib/Aspect/Pointcut/OrOp.pm Fri Dec 25 14:19:52 2009
@@ -3,18 +3,14 @@
use strict;
use warnings;
use Carp;
+use Aspect::Pointcut::BinOp ();
-
-our $VERSION = '0.22';
-
-
-use base 'Aspect::Pointcut::BinOp';
+our $VERSION = '0.23';
+our @ISA = 'Aspect::Pointcut::BinOp';
sub binop { $_[1] || $_[2] }
-
1;
-
__END__
Modified: branches/upstream/libaspect-perl/current/t/01_all.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/t/01_all.t?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/t/01_all.t (original)
+++ branches/upstream/libaspect-perl/current/t/01_all.t Fri Dec 25 14:19:52 2009
@@ -3,13 +3,16 @@
require 5.008;
use strict;
-use warnings;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
use Carp;
use FindBin;
use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/lib");
use Test::Class;
+# use Test::NoWarnings;
-$| = 1;
$ENV{TEST_VERBOSE} = 0;
sub runtime_use {
@@ -24,7 +27,6 @@
my @ALL_TESTS = qw(
Aspect::Pointcut::tests::Call
Aspect::Pointcut::tests::Cflow
- Aspect::tests::Weaver
Aspect::tests::AdviceContext
Aspect::tests::Advice
Aspect::Library::tests::Singleton
Modified: branches/upstream/libaspect-perl/current/t/02_caller.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/t/02_caller.t?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/t/02_caller.t (original)
+++ branches/upstream/libaspect-perl/current/t/02_caller.t Fri Dec 25 14:19:52 2009
@@ -1,8 +1,12 @@
#!/usr/bin/perl
use strict;
-use warnings;
-use Test::More tests => 8;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+use Test::More tests => 10;
+use Test::NoWarnings;
use Aspect;
my @CALLER = ();
@@ -29,6 +33,7 @@
# Set up the Aspect
my $aspect = before { $BEFORE++ } call 'Bar::bar';
isa_ok( $aspect, 'Aspect::Advice' );
+isa_ok( $aspect, 'Aspect::Advice::Before' );
is( $BEFORE, 0, '$BEFORE is false' );
is( scalar(@CALLER), 0, '@CALLER is empty' );
Added: branches/upstream/libaspect-perl/current/t/03_context.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/t/03_context.t?rev=49351&op=file
==============================================================================
--- branches/upstream/libaspect-perl/current/t/03_context.t (added)
+++ branches/upstream/libaspect-perl/current/t/03_context.t Fri Dec 25 14:19:52 2009
@@ -1,0 +1,69 @@
+#!/usr/bin/perl
+
+# Validates some assumptions by the author about how context and return work
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+use Test::More tests => 28;
+use Test::NoWarnings;
+
+my $array = 0;
+my $scalar = 0;
+my $void = 0;
+
+sub test {
+ is( $array, $_[0], "\$array = $_[0]" );
+ is( $scalar, $_[1], "\$scalar = $_[1]" );
+ is( $void, $_[2], "\$void = $_[2]" );
+}
+
+# Direct usage
+test( 1, 0, 0, context() );
+test( 1, 1, 0, scalar(context()) );
+context();
+test( 1, 1, 1 );
+
+# Plain single indirection
+test( 2, 1, 1, one() );
+test( 2, 2, 1, scalar(one()) );
+one();
+test( 2, 2, 2 );
+
+# Plain explicit indirection
+test( 3, 2, 2, two() );
+test( 3, 3, 2, scalar(two()) );
+two();
+test( 3, 3, 3 );
+
+
+
+
+
+######################################################################
+# Test Functions
+
+sub one {
+ context();
+}
+
+sub two {
+ return context();
+}
+
+sub context {
+ if ( wantarray ) {
+ $array++;
+ return 'foo';
+ } elsif ( defined wantarray ) {
+ $scalar++;
+ return 'bar';
+ } else {
+ $void++;
+ return 'baz';
+ }
+}
+
+1;
Modified: branches/upstream/libaspect-perl/current/t/lib/Test/Builder/Tester.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/t/lib/Test/Builder/Tester.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/t/lib/Test/Builder/Tester.pm (original)
+++ branches/upstream/libaspect-perl/current/t/lib/Test/Builder/Tester.pm Fri Dec 25 14:19:52 2009
@@ -2,7 +2,7 @@
use strict;
use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "0.21";
+$VERSION = "0.23";
use Test::Builder;
use Symbol;
Modified: branches/upstream/libaspect-perl/current/t/lib/Test/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/t/lib/Test/Class.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/t/lib/Test/Class.pm (original)
+++ branches/upstream/libaspect-perl/current/t/lib/Test/Class.pm Fri Dec 25 14:19:52 2009
@@ -14,7 +14,7 @@
use Test::Class::MethodInfo;
-our $VERSION = '0.21';
+our $VERSION = '0.23';
use constant NO_PLAN => "no_plan";
Modified: branches/upstream/libaspect-perl/current/t/lib/Test/Class/MethodInfo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/t/lib/Test/Class/MethodInfo.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/t/lib/Test/Class/MethodInfo.pm (original)
+++ branches/upstream/libaspect-perl/current/t/lib/Test/Class/MethodInfo.pm Fri Dec 25 14:19:52 2009
@@ -6,7 +6,7 @@
use warnings;
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.23';
sub is_method_type {
my ($self, $type) = @_;
Modified: branches/upstream/libaspect-perl/current/t/lib/Test/Exception.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaspect-perl/current/t/lib/Test/Exception.pm?rev=49351&op=diff
==============================================================================
--- branches/upstream/libaspect-perl/current/t/lib/Test/Exception.pm (original)
+++ branches/upstream/libaspect-perl/current/t/lib/Test/Exception.pm Fri Dec 25 14:19:52 2009
@@ -3,13 +3,15 @@
package Test::Exception;
use 5.005;
use strict;
+use Exporter ();
use Test::Builder;
use Sub::Uplevel;
-use base qw(Exporter);
+
+our @ISA = 'Exporter';
use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = '0.21';
+$VERSION = '0.23';
@EXPORT = qw(dies_ok lives_ok throws_ok lives_and);
my $Tester = Test::Builder->new;
More information about the Pkg-perl-cvs-commits
mailing list