r49143 - in /trunk/libaspect-perl: ./ debian/ lib/ lib/Aspect/ lib/Aspect/Hook/ lib/Aspect/Library/ lib/Aspect/Pointcut/ t/ t/lib/Aspect/Pointcut/tests/ t/lib/Sub/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue Dec 22 03:28:08 UTC 2009
Author: jawnsy-guest
Date: Tue Dec 22 03:27:59 2009
New Revision: 49143
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49143
Log:
* New upstream release
* Now needs Sub::Uplevel 0.2002
* Rewrite control short description
Added:
trunk/libaspect-perl/t/02_caller.t
- copied unchanged from r49142, branches/upstream/libaspect-perl/current/t/02_caller.t
Removed:
trunk/libaspect-perl/t/lib/Sub/
Modified:
trunk/libaspect-perl/Changes
trunk/libaspect-perl/MANIFEST
trunk/libaspect-perl/META.yml
trunk/libaspect-perl/Makefile.PL
trunk/libaspect-perl/debian/changelog
trunk/libaspect-perl/debian/control
trunk/libaspect-perl/lib/Aspect.pm
trunk/libaspect-perl/lib/Aspect/Advice.pm
trunk/libaspect-perl/lib/Aspect/AdviceContext.pm
trunk/libaspect-perl/lib/Aspect/Hook/LexWrap.pm
trunk/libaspect-perl/lib/Aspect/Library/Listenable.pm
trunk/libaspect-perl/lib/Aspect/Library/Memoize.pm
trunk/libaspect-perl/lib/Aspect/Library/Singleton.pm
trunk/libaspect-perl/lib/Aspect/Library/TestClass.pm
trunk/libaspect-perl/lib/Aspect/Library/Wormhole.pm
trunk/libaspect-perl/lib/Aspect/Modular.pm
trunk/libaspect-perl/lib/Aspect/Pointcut.pm
trunk/libaspect-perl/lib/Aspect/Pointcut/AndOp.pm
trunk/libaspect-perl/lib/Aspect/Pointcut/BinOp.pm
trunk/libaspect-perl/lib/Aspect/Pointcut/Call.pm
trunk/libaspect-perl/lib/Aspect/Pointcut/Cflow.pm
trunk/libaspect-perl/lib/Aspect/Pointcut/NotOp.pm
trunk/libaspect-perl/lib/Aspect/Pointcut/OrOp.pm
trunk/libaspect-perl/lib/Aspect/Weaver.pm
trunk/libaspect-perl/t/01_all.t
trunk/libaspect-perl/t/lib/Aspect/Pointcut/tests/Call.pm
Modified: trunk/libaspect-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/Changes?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/Changes (original)
+++ trunk/libaspect-perl/Changes Tue Dec 22 03:27:59 2009
@@ -1,18 +1,22 @@
Revision history for Perl extension Aspect
-0.21 Tue 21 Jul 2009
+0.22 Mon 21 Dec 2009
+ - Part one of an upcoming series of major upgrades
+ - Migrating to Sub::Uplevel to remove our custom CORE::GLOBAL::caller
+
+0.21 Tue 21 Jul 2009
- Bumped the version to 0.21 so the Hook::LexWrap module indexes
-0.16 Tue 19 May 2009
+0.16 Tue 19 May 2009
- Moved out Aspect::Library::Profiler into a standalone distribution
-0.15 Thu Jul 24 23:02:11 CEST 2008 (Marcel Gruenauer <marcel at cpan.org>)
+0.15 Thu Jul 24 23:02:11 CEST 2008 (Marcel Gruenauer <marcel at cpan.org>)
- fixed version in all modules. *sigh*
-0.14 Thu Jul 24 22:46:43 CEST 2008 (Marcel Gruenauer <marcel at cpan.org>)
+0.14 Thu Jul 24 22:46:43 CEST 2008 (Marcel Gruenauer <marcel at cpan.org>)
- fixed dist style
-0.13 Thu Jul 24 18:22:15 CEST 2008 (Marcel Gruenauer <marcel at cpan.org>)
+0.13 Thu Jul 24 18:22:15 CEST 2008 (Marcel Gruenauer <marcel at cpan.org>)
- Made sure every module has a $VERSION
- updated MANIFEST and MANIFEST.SKIP
- removed META.yml as it is being generated by Module::Install
@@ -30,7 +34,7 @@
- updated MANIFEST
- updated t/perlcriticrc
-0.12 Sat, 24 Mar 2007 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
+0.12 Sat, 24 Mar 2007 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
- You can now attach advice to subs in main:: package, see Advice tests
- Made everything easier to install by including dependencies required for
testing
@@ -41,23 +45,23 @@
Advice tests
- Removed old warning from Makefile.PL
-0.11 Tue, 03 Aug 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
+0.11 Tue, 03 Aug 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
- Fixed problem in upgrading from 0.08, CPAN.pm was getting confused on
Advice and Modular, because they had no version numbers, and undef is
smaller than 0.08. (merlyn)
- Lowered dependency on Test::Class to 0.03
-0.10 Fri, 30 Jul 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
+0.10 Fri, 30 Jul 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
- No longer a developer release
- Added Listenable reusable aspect
- Added subject_params() support for TestClass library aspect
-0.09_03 Tue, 06 Jul 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
+0.09_03 Tue, 06 Jul 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
- Added Carp::Heavy to list of untouchables in Weaver.pm, to avoid Carp
dumping core
- Test::Class aspect allows for customizing IUT through init_subject_state
-0.09_02 Sat, 06 Mar 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
+0.09_02 Sat, 06 Mar 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
- AdviceContext now has the original code, so you can do AspectJ-style
around advice. You can call the original code from before or after
advice. Added AdviceContext::run_original.
@@ -65,7 +69,7 @@
- Added Test::Class helper aspect
- Started using Devel::Symdump
-0.09_01 Sat, 06 Mar 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
+0.09_01 Sat, 06 Mar 2004 00:00:00 +0100 (Ran Eilam <ran.eilam at gmail.com>)
- Released for review by participants in YAPC::Israel 2004
- New syntax is incompatible with old
- New maintainer, Ran Eilam
@@ -81,7 +85,7 @@
- Moved reusable aspects to Aspect::Library
- regression: Aspect exported subs generate join points again
-0.07 Wed, 31 Jul 2002 22:42:27 +0200 (Marcel Gruenauer <marcel at cpan.org>)
+0.07 Wed, 31 Jul 2002 22:42:27 +0200 (Marcel Gruenauer <marcel at cpan.org>)
- The distribution has been adapted for use with perl5.8.0.
C<Hook::LexWrap> is now a core module, but there was a problem with
context (wantarray) handling with Aspect::Memoize. Sorry about the perl
@@ -95,12 +99,12 @@
something I have to think about.
- Tests now use Test::More
-0.07 Fri, 15 Mar 2002 09:04:51 +0100 (Marcel Gruenauer <marcel at cpan.org>)
+0.07 Fri, 15 Mar 2002 09:04:51 +0100 (Marcel Gruenauer <marcel at cpan.org>)
- symbols exported from Aspect.pm now don't generate join points. So I
added Aspect::import() and modified Aspect::JoinPoint::enum() to check
for %Aspect::exp_syms.
-0.06 Fri, 26 Oct 2001 16:42:51 +0200 (Marcel Gruenauer <marcel at cpan.org>)
+0.06 Fri, 26 Oct 2001 16:42:51 +0200 (Marcel Gruenauer <marcel at cpan.org>)
- added around() function to Aspect.pm
- added Aspect::Profiled
- added Aspect::Attribute interface to creating advice
@@ -109,25 +113,25 @@
- added cookbook recipes for bounds checking and change tracking, plus
sample programs
-0.05 Thu, 11 Oct 2001 09:44:50 +0200 (Marcel Gruenauer <marcel at cpan.org>)
+0.05 Thu, 11 Oct 2001 09:44:50 +0200 (Marcel Gruenauer <marcel at cpan.org>)
- removed dependency on Data::Denter
-0.04 Mon, 01 Oct 2001 18:33:00 +0200 (Marcel Gruenauer <marcel at cpan.org>)
+0.04 Mon, 01 Oct 2001 18:33:00 +0200 (Marcel Gruenauer <marcel at cpan.org>)
- removed the patched Hook::LexWrap now that 0.20 is out which fixes all
the problems of 0.10
- added documentation (a recurring theme, never finishes)
-0.03 Sun, 30 Sep 2001 19:43:56 +0200 (Marcel Gruenauer <marcel at cpan.org>)
+0.03 Sun, 30 Sep 2001 19:43:56 +0200 (Marcel Gruenauer <marcel at cpan.org>)
- added documentation
- Included a patched Hook::LexWrap that fixes a bug with wantarray
preservation in subroutine wrappers. Will be removed if and when Damian
approves of the patch or otherwise fixes the bug.
-0.02 Fri, 28 Sep 2001 12:59:06 +0200 (Marcel Gruenauer <marcel at cpan.org>)
+0.02 Fri, 28 Sep 2001 12:59:06 +0200 (Marcel Gruenauer <marcel at cpan.org>)
- added documentation
- added '$::thisjp' global variable
- added modular memoization aspect: Aspect::Memoize
- added modular tracing aspect: Aspect::Trace
-0.01 Fri, 28 Sep 2001 10:36:08 +0200 (Marcel Gruenauer <marcel at cpan.org>)
+0.01 Fri, 28 Sep 2001 10:36:08 +0200 (Marcel Gruenauer <marcel at cpan.org>)
- original version
Modified: trunk/libaspect-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/MANIFEST?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/MANIFEST (original)
+++ trunk/libaspect-perl/MANIFEST Tue Dec 22 03:27:59 2009
@@ -41,6 +41,7 @@
META.yml
README
t/01_all.t
+t/02_caller.t
t/97_meta.t
t/98_pod.t
t/99_pmv.t
@@ -59,7 +60,6 @@
t/lib/Aspect/tests/Advice.pm
t/lib/Aspect/tests/AdviceContext.pm
t/lib/Aspect/tests/Weaver.pm
-t/lib/Sub/Uplevel.pm
t/lib/Test/Builder/Tester.pm
t/lib/Test/Builder/Tester/Color.pm
t/lib/Test/Class.pm
Modified: trunk/libaspect-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/META.yml?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/META.yml (original)
+++ trunk/libaspect-perl/META.yml Tue Dec 22 03:27:59 2009
@@ -24,9 +24,10 @@
- xt
requires:
Devel::Symdump: 2.04
+ Sub::Uplevel: 0.2002
perl: 5.8.2
resources:
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.21
+version: 0.22
Modified: trunk/libaspect-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/Makefile.PL?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/Makefile.PL (original)
+++ trunk/libaspect-perl/Makefile.PL Tue Dec 22 03:27:59 2009
@@ -2,5 +2,6 @@
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
Modified: trunk/libaspect-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/debian/changelog?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/debian/changelog (original)
+++ trunk/libaspect-perl/debian/changelog Tue Dec 22 03:27:59 2009
@@ -1,3 +1,11 @@
+libaspect-perl (0.22-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Now needs Sub::Uplevel 0.2002
+ * Rewrite control short description
+
+ -- Jonathan Yu <jawnsy at cpan.org> Mon, 21 Dec 2009 19:14:08 -0500
+
libaspect-perl (0.21-2) unstable; urgency=low
[ Christoph Berg ]
Modified: trunk/libaspect-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/debian/control?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/debian/control (original)
+++ trunk/libaspect-perl/debian/control Tue Dec 22 03:27:59 2009
@@ -2,10 +2,11 @@
Section: perl
Priority: optional
Build-Depends: debhelper (>= 7.0.50)
-Build-Depends-Indep: perl (>= 5.8.2), libdevel-symdump-perl (>= 2.04),
- libtest-cpan-meta-perl, libtest-pod-perl (>= 1.26),
- libpod-simple-perl (>= 3.07), libtest-class-perl (>= 0.28),
- libperl-minimumversion-perl, libtest-minimumversion-perl
+Build-Depends-Indep: perl, libdevel-symdump-perl (>= 2.04),
+ perl (>= 5.10.1) | libpod-simple-perl (>= 3.07), libtest-cpan-meta-perl,
+ libtest-pod-perl (>= 1.26), libtest-class-perl (>= 0.28),
+ libperl-minimumversion-perl, libtest-minimumversion-perl,
+ libsub-uplevel-perl (>= 0.2002)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Jonathan Yu <jawnsy at cpan.org>,
gregor herrmann <gregoa at debian.org>, Ryan Niebur <ryan at debian.org>
@@ -16,15 +17,15 @@
Package: libaspect-perl
Architecture: all
-Depends: ${perl:Depends}, ${misc:Depends}, perl (>= 5.8.2)
+Depends: ${perl:Depends}, ${misc:Depends}, libsub-uplevel-perl (>= 0.2002)
Suggests: libbenchmark-timer-perl
-Description: Aspect-oriented Programming for Perl
+Description: module for Aspect-Oriented Programming in Perl
Aspect-oriented Programming (AOP) is a programming method developed by Xerox
PARC and others. The basic idea is that in complex class systems there are
certain aspects or behaviors that cannot normally be expressed in a coherent,
concise and precise way. One example of such aspects are design patterns,
which combine various kinds of classes to produce a common type of behavior.
- Another is logging. See http://www.aosd.net for more info.
+ Another is logging. For more information, see <URL:http://www.aosd.net>.
.
The Perl Aspect module is focused on subroutine matching and wrapping. It
allows you to select collections of subroutines using a flexible pointcut
Modified: trunk/libaspect-perl/lib/Aspect.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect.pm (original)
+++ trunk/libaspect-perl/lib/Aspect.pm Tue Dec 22 03:27:59 2009
@@ -3,19 +3,19 @@
use 5.008002;
use strict;
use warnings;
-use Carp 'croak';
+use Carp ();
use Exporter ();
use Aspect::Advice ();
use Aspect::Pointcut::Call ();
use Aspect::Pointcut::Cflow ();
-our $VERSION = '0.21';
+our $VERSION = '0.22';
our @ISA = 'Exporter';
-our @EXPORT = qw(aspect before after call cflow);
+our @EXPORT = qw{ aspect before after call cflow };
# Internal data storage
-my @Aspect_Store = undef;
-my @Advice_Store = undef;
+my @ASPECT = undef;
+my @ADVICE = undef;
sub aspect {
my ($name, @params) = @_;
@@ -24,7 +24,7 @@
my $aspect = $name->new(@params);
# If called in void context, aspect is for life
- push @Aspect_Store, $aspect unless defined wantarray;
+ push @ASPECT, $aspect unless defined wantarray;
return $aspect;
}
@@ -49,14 +49,15 @@
my $advice = Aspect::Advice->new(@_);
# If called in void context, advice is for life
- push @Advice_Store, $advice unless defined wantarray;
+ push @ADVICE, $advice unless defined wantarray;
+
return $advice;
}
sub runtime_use {
my $package = shift;
eval "use $package;";
- croak "Cannot use [$package]: $@" if $@;
+ Carp::croak("Cannot use [$package]: $@") if $@;
}
1;
@@ -72,32 +73,33 @@
=head1 SYNOPSIS
package Person;
+
sub create { ... }
sub set_name { ... }
sub get_address { ... }
-
+
package main;
use Aspect;
-
+
# using reusable aspects
aspect Singleton => 'Person::create'; # let there be only one Person
aspect Profiled => call qr/^Person::set_/; # profile calls to setters
-
+
# append extra argument when Person::get_address is called:
# the instance of the calling Company object, iff get_address
# is in the call flow of Company::get_employee_addresses.
# aspect will live as long as $wormhole reference is in scope
$aspect = aspect Wormhole => 'Company::make_report', 'Person::get_address';
-
+
# writing your own advice
$pointcut = call qr/^Person::[gs]et_/; # defines a collection of events
-
+
# advice will live as long as $before is in scope
$before = before { print "g/set will soon be called" } $pointcut;
-
+
# advice will live forever, because it is created in void context
after { print "g/set has just been called" } $pointcut;
-
+
before
{ print "get will soon be called, if in call flow of Tester::run_tests" }
call qr/^Person::get_/ & cflow tester => 'Tester::run_tests';
@@ -404,7 +406,7 @@
package Automobile;
...
sub compute_mileage { ... }
-
+
package Van;
use base 'Automobile';
Modified: trunk/libaspect-perl/lib/Aspect/Advice.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Advice.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Advice.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Advice.pm Tue Dec 22 03:27:59 2009
@@ -6,7 +6,7 @@
use Aspect::AdviceContext;
use Aspect::Weaver;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
sub new {
my ($class, $type, $code, $pointcut) = @_;
Modified: trunk/libaspect-perl/lib/Aspect/AdviceContext.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/AdviceContext.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/AdviceContext.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/AdviceContext.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
sub new {
Modified: trunk/libaspect-perl/lib/Aspect/Hook/LexWrap.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Hook/LexWrap.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Hook/LexWrap.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Hook/LexWrap.pm Tue Dec 22 03:27:59 2009
@@ -1,96 +1,126 @@
package Aspect::Hook::LexWrap;
+use 5.006;
use strict;
use warnings;
-use 5.006;
-use Carp::Heavy; # added by eilara as hack around caller() core dump
-use Carp;
+use Carp::Heavy (); # added by eilara as hack around caller() core dump
+use Carp ();
+use Sub::Uplevel ();
+our $VERSION = '0.22';
-our $VERSION = '0.21';
+sub wrap {
+ my ($typeglob, $pre, $post) = @_;
-
-*CORE::GLOBAL::caller = sub {
- my ($height) = ($_[0]||0);
- my $i=1;
- my $name_cache;
- while (1) {
- my @caller = CORE::caller($i++) or return;
- $caller[3] = $name_cache if $name_cache;
- $name_cache = $caller[0] eq 'Aspect::Hook::LexWrap' ? $caller[3] : '';
- next if $name_cache || $height-- != 0;
- return wantarray ? @_ ? @caller : @caller[0..2] : $caller[0];
- }
-};
-
-{
- no strict 'refs';
- sub import { *{caller()."::wrap"} = \&wrap }
-}
-
-sub wrap (*@) {
- my ($typeglob, %wrapper) = @_;
+ # Check and normalise the typeglob
$typeglob = (ref $typeglob || $typeglob =~ /::/)
? $typeglob
: caller()."::$typeglob";
- no strict 'refs';
- my $original = ref $typeglob eq 'CODE' && $typeglob
- || *$typeglob{CODE}
- || croak "Can't wrap non-existent subroutine ", $typeglob;
- croak "'$_' value is not a subroutine reference"
- foreach grep {$wrapper{$_} && ref $wrapper{$_} ne 'CODE'}
- qw(pre post);
+ no strict 'refs';
+ my $original = ref $typeglob eq 'CODE' ? $typeglob : *$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");
+ }
+ 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?
no warnings 'redefine';
- my ($caller, $unwrap) = *CORE::GLOBAL::caller{CODE};
- my $prototype = prototype($original)? '('. prototype($original). ')': '';
- # any way to set prototypes other than eval?
- my $imposter;
- eval '$imposter = sub '. $prototype. q{{
- if ($unwrap) { goto &$original }
+ my $prototype = prototype($original);
+ $prototype = defined($prototype) ? "($prototype)" : '';
+ my $imposter = eval "sub $prototype " . q{{
+ if ( $unwrap ) { goto &$original }
my ($return, $prereturn);
- if (wantarray) {
+ if ( wantarray ) {
$prereturn = $return = [];
- () = $wrapper{pre}->(\@_, $original, $return) if $wrapper{pre};
- if (ref $return eq 'ARRAY' && $return == $prereturn && !@$return) {
- $return = [ &$original(@_) ];
- () = $wrapper{post}->(\@_, $original, $return)
- if $wrapper{post};
+ () = $pre->(
+ \@_, $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 = $wrapper{pre}->(\@_, $original, $return) if $wrapper{pre};
- unless ($prereturn) {
- $return = &$original(@_);
- $dummy = scalar $wrapper{post}->(\@_, $original, $return)
- if $wrapper{post};
+ return ref $return eq 'ARRAY'
+ ? @$return
+ : ( $return );
+
+ } elsif ( defined wantarray ) {
+ $return = bless sub {
+ $prereturn = 1
+ }, 'Aspect::Hook::LexWrap::Cleanup';
+ my $dummy = $pre->(
+ \@_, $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';
- $wrapper{pre}->(\@_, $original, $return) if $wrapper{pre};
- unless ($prereturn) {
- &$original(@_);
- $wrapper{post}->(\@_, $original, $return)
- if $wrapper{post};
+
+ } 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;
}
return;
}
}};
- ref $typeglob eq 'CODE' and return defined wantarray
- ? $imposter
- : carp "Uselessly wrapped subroutine reference in void context";
+ 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;
- return bless sub{ $unwrap=1 }, 'Aspect::Hook::LexWrap::Cleanup';
+ return bless sub {
+ $unwrap = 1
+ }, 'Aspect::Hook::LexWrap::Cleanup';
}
package Aspect::Hook::LexWrap::Cleanup;
sub DESTROY { $_[0]->() }
-use overload
+
+use overload
q{""} => sub { undef },
q{0+} => sub { undef },
q{bool} => sub { undef };
@@ -107,15 +137,16 @@
=head1 DESCRIPTION
-This is Hook::LexWrap with a small change: instead of getting C<(@_,
-$return)> as their parameters, wrappers get C<(\@_, $original, $return)>.
+This is Hook::LexWrap with a small change: instead of getting C<(@_, $return)>
+as their parameters, wrappers get C<(\@_, $original, $return)>.
+
This allows you to inject and remove parameters for the wrapped sub, and
to call the original sub from the wrapper. Both are unsupported in the
original.
-=head1 ORIGINAL AUTHOR
+=head1 AUTHOR
-Damian Conway (damian at conway.org)
+Damian Conway <damian at conway.org>
=head1 SEE ALSO
Modified: trunk/libaspect-perl/lib/Aspect/Library/Listenable.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Library/Listenable.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Library/Listenable.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Library/Listenable.pm Tue Dec 22 03:27:59 2009
@@ -10,7 +10,7 @@
use Aspect;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base qw(Aspect::Modular Exporter);
Modified: trunk/libaspect-perl/lib/Aspect/Library/Memoize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Library/Memoize.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Library/Memoize.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Library/Memoize.pm Tue Dec 22 03:27:59 2009
@@ -7,7 +7,7 @@
use Aspect;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Modular';
Modified: trunk/libaspect-perl/lib/Aspect/Library/Singleton.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Library/Singleton.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Library/Singleton.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Library/Singleton.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
use Aspect;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Modular';
Modified: trunk/libaspect-perl/lib/Aspect/Library/TestClass.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Library/TestClass.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Library/TestClass.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Library/TestClass.pm Tue Dec 22 03:27:59 2009
@@ -6,7 +6,7 @@
use Test::Class;
use Aspect;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Modular';
Modified: trunk/libaspect-perl/lib/Aspect/Library/Wormhole.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Library/Wormhole.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Library/Wormhole.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Library/Wormhole.pm Tue Dec 22 03:27:59 2009
@@ -6,7 +6,7 @@
use Aspect;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Modular';
Modified: trunk/libaspect-perl/lib/Aspect/Modular.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Modular.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Modular.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Modular.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
# creating --------------------------------------------------------------------
Modified: trunk/libaspect-perl/lib/Aspect/Pointcut.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Pointcut.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Pointcut.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Pointcut.pm Tue Dec 22 03:27:59 2009
@@ -9,7 +9,7 @@
use Data::Dumper;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use overload
Modified: trunk/libaspect-perl/lib/Aspect/Pointcut/AndOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Pointcut/AndOp.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Pointcut/AndOp.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Pointcut/AndOp.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Pointcut::BinOp';
Modified: trunk/libaspect-perl/lib/Aspect/Pointcut/BinOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Pointcut/BinOp.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Pointcut/BinOp.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Pointcut/BinOp.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Pointcut';
Modified: trunk/libaspect-perl/lib/Aspect/Pointcut/Call.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Pointcut/Call.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Pointcut/Call.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Pointcut/Call.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Pointcut';
Modified: trunk/libaspect-perl/lib/Aspect/Pointcut/Cflow.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Pointcut/Cflow.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Pointcut/Cflow.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Pointcut/Cflow.pm Tue Dec 22 03:27:59 2009
@@ -6,7 +6,7 @@
use Aspect::AdviceContext;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Pointcut';
Modified: trunk/libaspect-perl/lib/Aspect/Pointcut/NotOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Pointcut/NotOp.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Pointcut/NotOp.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Pointcut/NotOp.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Pointcut';
Modified: trunk/libaspect-perl/lib/Aspect/Pointcut/OrOp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Pointcut/OrOp.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Pointcut/OrOp.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Pointcut/OrOp.pm Tue Dec 22 03:27:59 2009
@@ -5,7 +5,7 @@
use Carp;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
use base 'Aspect::Pointcut::BinOp';
Modified: trunk/libaspect-perl/lib/Aspect/Weaver.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/lib/Aspect/Weaver.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/lib/Aspect/Weaver.pm (original)
+++ trunk/libaspect-perl/lib/Aspect/Weaver.pm Tue Dec 22 03:27:59 2009
@@ -1,38 +1,42 @@
package Aspect::Weaver;
+use 5.006;
use strict;
use warnings;
-use Carp;
-use Aspect::Hook::LexWrap;
-use Devel::Symdump;
+use Carp ();
+use Devel::Symdump ();
+use Aspect::Hook::LexWrap ();
-
-our $VERSION = '0.21';
-
+our $VERSION = '0.22';
my %UNTOUCHABLES = 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
);
-sub new { bless {}, shift }
+sub new {
+ bless {}, shift;
+}
sub get_sub_names {
local $_;
- # TODO: need to filter Aspect exportable functions!
- return
- map { Devel::Symdump->new($_)->functions }
- grep { !/^Aspect::/ }
- grep { !$UNTOUCHABLES{$_} }
- (Devel::Symdump->rnew->packages, 'main');
+ # TODO: Need to filter Aspect exportable functions!
+ return map {
+ Devel::Symdump->new($_)->functions
+ } grep {
+ ! /^Aspect::/
+ } grep {
+ ! $UNTOUCHABLES{$_}
+ } ( Devel::Symdump->rnew->packages, 'main' );
}
sub install {
- my ($self, $type, $sub_name, $code) = @_;
- return wrap
- $sub_name,
- ($type eq 'before'? 'pre': 'post'),
- $code;
+ my ($self, $type, $name, $code) = @_;
+ if ( $type eq 'before' ) {
+ return Aspect::Hook::LexWrap::wrap( $name, $code, undef );
+ } else {
+ return Aspect::Hook::LexWrap::wrap( $name, undef, $code );
+ }
}
1;
Modified: trunk/libaspect-perl/t/01_all.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/t/01_all.t?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/t/01_all.t (original)
+++ trunk/libaspect-perl/t/01_all.t Tue Dec 22 03:27:59 2009
@@ -18,7 +18,7 @@
croak "Cannot use [$package]: $@" if $@;
}
-my @test_class_names;
+my @classes;
BEGIN {
my @ALL_TESTS = qw(
@@ -39,14 +39,18 @@
\( $2 || '')
}/;
- @test_class_names = $thing eq 'Aspect::tests::'? @ALL_TESTS: ($thing);
+ @classes = $thing eq 'Aspect::tests::' ? @ALL_TESTS : ($thing);
- runtime_use $_ for @test_class_names;
+ runtime_use $_ for @classes;
}
-Test::Class->runtests(@test_class_names);
+Test::Class->runtests(@classes);
1;
+
+__END__
+
+=pod
=head1 NAME
@@ -56,7 +60,7 @@
# run all tests
perl run_tests.pl
-
+
# a specific test case, no need to prefix with Aspect:: or add the tests:: part
perl run_tests.pl Weaver
perl run_tests.pl Pointcut::Call
Modified: trunk/libaspect-perl/t/lib/Aspect/Pointcut/tests/Call.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libaspect-perl/t/lib/Aspect/Pointcut/tests/Call.pm?rev=49143&op=diff
==============================================================================
--- trunk/libaspect-perl/t/lib/Aspect/Pointcut/tests/Call.pm (original)
+++ trunk/libaspect-perl/t/lib/Aspect/Pointcut/tests/Call.pm Tue Dec 22 03:27:59 2009
@@ -8,7 +8,7 @@
use base qw(Test::Class);
-my ($good_method, $bad_method) = qw(
+my ($good_method, $bad_method) = qw(
SomePackage::some_method
SomePackage::no_method
);
@@ -24,10 +24,10 @@
sub pointcut_ok {
my ($self, %assertions) = @_;
- for my $type (keys %assertions) {
+ for my $type ( keys %assertions ) {
my $subject = Aspect::Pointcut::Call->new($assertions{$type});
- ok $subject->match_define($good_method), "$type match";
- ok !$subject->match_define($bad_method), "$type no match";
+ ok( $subject->match_define($good_method), "$type match" );
+ ok( ! $subject->match_define($bad_method), "$type no match" );
}
}
More information about the Pkg-perl-cvs-commits
mailing list