package Mock::Quick::Object::Control; use strict; use warnings; use Mock::Quick::Util; use Mock::Quick::Object; use Mock::Quick::Method; our %META; sub target { shift->{target} } sub new { my $class = shift; my ( $target ) = @_; return bless( { target => $target }, $class ); } sub set_methods { my $self = shift; my %params = @_; for my $key ( keys %params ) { $self->target->{$key} = Mock::Quick::Method->new( $params{$key} ); } } sub set_attributes { my $self = shift; my %params = @_; for my $key ( keys %params ) { $self->target->{$key} = $params{$key}; } } sub clear { my $self = shift; for my $field ( @_ ) { delete $self->target->{$field}; delete $self->metrics->{$field}; } } sub strict { my $self = shift; ($META{$self->target}->{strict}) = @_ if @_; return $META{$self->target}->{strict}; } sub metrics { my $self = shift; $META{$self->target}->{metrics} ||= {}; return $META{$self->target}->{metrics}; } sub _clean { my $self = shift; delete $META{$self->target}; } purge_util(); 1; __END__ =head1 NAME Mock::Quick::Object::Control - Control a mocked object after creation =head1 DESCRIPTION Control a mocked object after creation. =head1 SYNOPSIS my $obj = Mock::Quick::Object->new( ... ); my $control = Mock::Quick::Object::Control->new( $obj ); $control->set_methods( foo => sub { 'foo' }); $control->set_attributes( bar => 'baz' ); # Make an attribute exist so that it can be used for get/set operations. $control->set_attributes( empty => undef ); =head1 METHODS =over 4 =item $control = $CLASS->new( $obj ) =item $control->set_methods( name => sub { ... }, ... ) Set/Create methods =item $control->set_attributes( name => $val, ... ) Set/Create attributes (simple get/set accessors) =item $control->clear( $name1, $name2, ... ) Remove attributes/methods. =item $control->strict( $BOOL ) Enable/Disable strict mode. =item $data = $control->metrics() Returns a hash where keys are method names, and values are the number of times the method has been called. When a method is altered or removed the key is deleted. =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2011 Chad Granum Mock-Quick is free software; Standard perl licence. Mock-Quick is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details.