File Coverage

blib/lib/Mock/Quick/Object/Control.pm
Criterion Covered Total %
statement 39 39 100.0
branch 2 2 100.0
condition 2 2 100.0
subroutine 13 13 100.0
pod 6 7 85.7
total 62 63 98.4


line stmt bran cond sub pod time code
1             package Mock::Quick::Object::Control;
2 7     7   36 use strict;
  7         11  
  7         505  
3 7     7   37 use warnings;
  7         13  
  7         162  
4 7     7   42 use Mock::Quick::Util;
  7         11  
  7         576  
5 7     7   37 use Mock::Quick::Object;
  7         12  
  7         298  
6 7     7   36 use Mock::Quick::Method;
  7         19  
  7         3441  
7              
8             our %META;
9              
10 258     258 0 1398 sub target { shift->{target} }
11              
12             sub new {
13 101     101 1 154 my $class = shift;
14 101         128 my ( $target ) = @_;
15 101         498 return bless( { target => $target }, $class );
16             }
17              
18             sub set_methods {
19 2     2 1 398 my $self = shift;
20 2         7 my %params = @_;
21 2         9 for my $key ( keys %params ) {
22 2         17 $self->target->{$key} = Mock::Quick::Method->new( $params{$key} );
23             }
24             }
25              
26             sub set_attributes {
27 1     1 1 5 my $self = shift;
28 1         4 my %params = @_;
29 1         3 for my $key ( keys %params ) {
30 1         3 $self->target->{$key} = $params{$key};
31             }
32             }
33              
34             sub clear {
35 2     2 1 6 my $self = shift;
36 2         5 for my $field ( @_ ) {
37 2         6 delete $self->target->{$field};
38 2         7 delete $self->metrics->{$field};
39             }
40             }
41              
42             sub strict {
43 92     92 1 3736 my $self = shift;
44 92 100       228 ($META{$self->target}->{strict}) = @_ if @_;
45 92         184 return $META{$self->target}->{strict};
46             }
47              
48             sub metrics {
49 70     70 1 95 my $self = shift;
50 70   100     127 $META{$self->target}->{metrics} ||= {};
51 70         142 return $META{$self->target}->{metrics};
52             }
53              
54             sub _clean {
55 13     13   26 my $self = shift;
56 13         37 delete $META{$self->target};
57             }
58              
59             purge_util();
60              
61             1;
62              
63             __END__
64              
65             =head1 NAME
66              
67             Mock::Quick::Object::Control - Control a mocked object after creation
68              
69             =head1 DESCRIPTION
70              
71             Control a mocked object after creation.
72              
73             =head1 SYNOPSIS
74              
75             my $obj = Mock::Quick::Object->new( ... );
76             my $control = Mock::Quick::Object::Control->new( $obj );
77              
78             $control->set_methods( foo => sub { 'foo' });
79             $control->set_attributes( bar => 'baz' );
80              
81             # Make an attribute exist so that it can be used for get/set operations.
82             $control->set_attributes( empty => undef );
83              
84             =head1 METHODS
85              
86             =over 4
87              
88             =item $control = $CLASS->new( $obj )
89              
90             =item $control->set_methods( name => sub { ... }, ... )
91              
92             Set/Create methods
93              
94             =item $control->set_attributes( name => $val, ... )
95              
96             Set/Create attributes (simple get/set accessors)
97              
98             =item $control->clear( $name1, $name2, ... )
99              
100             Remove attributes/methods.
101              
102             =item $control->strict( $BOOL )
103              
104             Enable/Disable strict mode.
105              
106             =item $data = $control->metrics()
107              
108             Returns a hash where keys are method names, and values are the number of times
109             the method has been called. When a method is altered or removed the key is
110             deleted.
111              
112             =back
113              
114             =head1 AUTHORS
115              
116             Chad Granum L<exodist7@gmail.com>
117              
118             =head1 COPYRIGHT
119              
120             Copyright (C) 2011 Chad Granum
121              
122             Mock-Quick is free software; Standard perl licence.
123              
124             Mock-Quick is distributed in the hope that it will be useful, but WITHOUT ANY
125             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
126             PARTICULAR PURPOSE. See the license for more details.