Permalink
Browse files

Added accessor for control object

  • Loading branch information...
1 parent e95645f commit d592a3518c6e13fb35bc9ef3e358b21396075985 @exodist committed Dec 13, 2011
Showing with 57 additions and 2 deletions.
  1. +1 −1 lib/Mock/Quick.pm
  2. +44 −1 lib/Mock/Quick/Class.pm
  3. +12 −0 t/Class.t
View
@@ -8,7 +8,7 @@ use Mock::Quick::Object::Control;
use Mock::Quick::Method;
use Mock::Quick::Util;
-our $VERSION = '1.103';
+our $VERSION = '1.104';
default_export qclass => sub { Mock::Quick::Class->new( @_ ) };
default_export qtakeover => sub { Mock::Quick::Class->takeover( @_ ) };
View
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Mock::Quick::Util;
-use Scalar::Util qw/blessed/;
+use Scalar::Util qw/blessed weaken/;
use Carp qw/croak confess/;
our $ANON = 'AAAAAAAAAA';
@@ -31,6 +31,8 @@ sub takeover {
$self->override( $key => $params{$key} );
}
+ $self->inject_meta();
+
return $self;
}
@@ -53,6 +55,8 @@ sub implement {
$class
);
+ $self->inject_meta();
+
$self->_configure( %params );
return $self;
@@ -77,12 +81,21 @@ alt_meth new => (
my $self = bless( { %params, -package => $package }, $class );
+ $self->inject_meta();
+
$self->_configure( %params );
return $self;
}
);
+sub inject_meta {
+ my $self = shift;
+ my $weak_self = $self;
+ weaken $weak_self;
+ inject( $self->package, 'MQ_CONTROL', sub { $weak_self } );
+}
+
sub _configure {
my $self = shift;
my %params = @_;
@@ -226,6 +239,16 @@ sub DESTROY {
my $self = shift;
return $self->undefine unless $self->is_takeover;
+ my $package = $self->package;
+
+ {
+ no strict 'refs';
+ no warnings 'redefine';
+
+ my $ref = \%{"$package\::"};
+ delete $ref->{MQ_CONTROL};
+ }
+
for my $sub ( keys %{$self} ) {
next if $sub =~ m/^-/;
$self->restore( $sub );
@@ -363,6 +386,26 @@ You can also do this through new()
%overrides
);
+=head1 ACCESSING THE CONTROL OBJECY
+
+While the control object exists, it can be accessed via
+C<YOUR::PACKAGE->MQ_CONTROL()>. It is important to note that this method will
+dissapear whenever the control object you track falls out of scope.
+
+Example (taken from Class.t):
+
+ $obj = $CLASS->new( -takeover => 'Baz' );
+ $obj->override( 'foo', sub {
+ my $class = shift;
+ return "PREFIX: " . $class->MQ_CONTROL->original( 'foo' )->();
+ });
+
+ is( Baz->foo, "PREFIX: foo", "Override and accessed original through MQ_CONTROL" );
+ $obj = undef;
+
+ is( Baz->foo, 'foo', 'original' );
+ ok( !Baz->can('MQ_CONTROL'), "Removed control" );
+
=head1 METHODS
=over 4
View
@@ -105,6 +105,18 @@ tests takeover => sub {
is( Baz->foo, 'new foo', "override" );
$obj = undef;
is( Baz->foo, 'foo', 'original' );
+
+ $obj = $CLASS->new( -takeover => 'Baz' );
+ $obj->override( 'foo', sub {
+ my $class = shift;
+ return "PREFIX: " . $class->MQ_CONTROL->original( 'foo' )->();
+ });
+
+ is( Baz->foo, "PREFIX: foo", "Override and accessed original through MQ_CONTROL" );
+ $obj = undef;
+
+ is( Baz->foo, 'foo', 'original' );
+ ok( !Baz->can('MQ_CONTROL'), "Removed control" );
};
tests implement => sub {

0 comments on commit d592a35

Please sign in to comment.