File Coverage

blib/lib/Fey/ORM/Mock.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Fey::ORM::Mock;
2             {
3             $Fey::ORM::Mock::VERSION = '0.06';
4             }
5              
6 1     1   34132 use strict;
  1         2  
  1         34  
7 1     1   5 use warnings;
  1         1  
  1         34  
8              
9 1     1   787 use Class::Load qw( load_class );
  1         119811  
  1         119  
10 1     1   1538 use DBD::Mock;
  1         53282  
  1         7  
11 1     1   1750 use Fey::DBIManager;
  0            
  0            
12             use Fey::Object::Mock::Schema;
13             use Fey::Object::Mock::Table;
14             use Fey::ORM::Mock::Recorder;
15             use Fey::ORM::Mock::Seeder;
16             use Fey::Meta::Class::Table;
17              
18             use Moose;
19              
20             has 'schema_class' => (
21             is => 'ro',
22             isa => 'ClassName',
23             required => 1,
24             );
25              
26             has 'recorder' => (
27             is => 'rw',
28             isa => 'Fey::ORM::Mock::Recorder',
29             writer => '_set_recorder',
30             init_arg => undef,
31             );
32              
33             sub BUILD {
34             my $self = shift;
35              
36             $self->_mock_schema();
37              
38             $self->_mock_dbi();
39             }
40              
41             sub _mock_schema {
42             my $self = shift;
43              
44             $self->_replace_superclass( $self->schema_class(),
45             'Fey::Object::Mock::Schema' );
46              
47             my $recorder = Fey::ORM::Mock::Recorder->new();
48             $self->schema_class()->SetRecorder($recorder);
49             $self->_set_recorder($recorder);
50              
51             $self->_mock_table($_) for $self->schema_class()->Schema()->tables();
52             }
53              
54             sub _replace_superclass {
55             my $self = shift;
56             my $class = shift;
57             my $superclass = shift;
58              
59             load_class($class);
60              
61             my $meta = $class->meta();
62              
63             my $was_immutable;
64             if ( $meta->is_immutable() ) {
65             $meta->make_mutable();
66             $was_immutable = 1;
67             }
68              
69             $meta->superclasses($superclass);
70              
71             $self->_reapply_method_modifiers($meta);
72              
73             $meta->make_immutable()
74             if $was_immutable;
75             }
76              
77             sub _reapply_method_modifiers {
78             my $self = shift;
79             my $meta = shift;
80              
81             for my $method (
82             grep { $_->isa('Class::MOP::Method::Wrapped') }
83             map { $meta->get_method($_) } $meta->get_method_list()
84             ) {
85             next
86             if $method->get_original_method()->package_name() eq
87             $meta->name();
88              
89             $meta->remove_method( $method->name() );
90              
91             for my $before ( reverse $method->before_modifiers() ) {
92             $meta->add_before_method_modifier( $method->name() => $before );
93             }
94              
95             for my $after ( $method->after_modifiers() ) {
96             $meta->add_after_method_modifier( $method->name() => $after );
97             }
98              
99             for my $around ( reverse $method->around_modifiers() ) {
100             $meta->add_around_method_modifier( $method->name() => $around );
101             }
102             }
103             }
104              
105             sub _mock_table {
106             my $self = shift;
107             my $table = shift;
108              
109             my $class = Fey::Meta::Class::Table->ClassForTable($table)
110             or return;
111              
112             $self->_replace_superclass( $class, 'Fey::Object::Mock::Table' );
113              
114             my $seed = Fey::ORM::Mock::Seeder->new();
115             $class->SetSeeder($seed);
116             }
117              
118             sub seed_class {
119             my $self = shift;
120             my $class = shift;
121              
122             my $seed = $class->Seeder();
123              
124             $seed->push_values(@_);
125             }
126              
127             sub _mock_dbi {
128             my $self = shift;
129              
130             my $dsn = 'dbi:Mock:';
131              
132             my $dbh = DBI->connect( $dsn, q{}, q{} );
133              
134             my $manager = Fey::DBIManager->new();
135             $manager->add_source( dsn => $dsn, dbh => $dbh );
136              
137             $self->schema_class()->SetDBIManager($manager);
138             }
139              
140             1;
141              
142             # ABSTRACT: Mock Fey::ORM based classes so you can test without a DBMS
143              
144             __END__
145              
146             =pod
147              
148             =head1 NAME
149              
150             Fey::ORM::Mock - Mock Fey::ORM based classes so you can test without a DBMS
151              
152             =head1 VERSION
153              
154             version 0.06
155              
156             =head1 SYNOPSIS
157              
158             use Fey::ORM::Mock;
159             use MyApp::Schema;
160              
161             my $mock = Fey::ORM::Mock->new( schema_class => 'MyApp::Schema' );
162              
163             $mock->seed_class( 'MyApp::User' =>
164             { user_id => 42,
165             name => 'Doug',
166             },
167             ...
168             );
169              
170             # gets seeded data first
171             my $user = User->new( ... );
172              
173             $user = User->insert( ... );
174             $user->update( ... );
175              
176             my @actions = $mock->recorder()->actions_for_class('User');
177              
178             =head1 DESCRIPTION
179              
180             This class lets you mock a set of C<Fey::ORM> based classes. You can
181             seed data for each class's constructor, as well as track all inserts,
182             update, and deletes for each class.
183              
184             This is all done at a higher level than is possible just using
185             C<DBD::Mock>. Instead of dealing with SQL and DBI's data structures,
186             you are able to work with the named attributes of each class.
187              
188             =head1 METHODS
189              
190             This class provides the following methods:
191              
192             =head2 Fey::ORM::Mock->new( schema_class => $class )
193              
194             Given a schema class (one which uses C<Fey::ORM::Schema>), this method
195             adds a mocking layer to the schema class and all of its tables'
196             associated classes. If a table does not have an associated class, it
197             will simply be skipped.
198              
199             It also replaces the schema class's existing C<Fey::DBIManager> object
200             with one that has a single C<DBD::Mock> handle.
201              
202             =head2 $mock->schema_class()
203              
204             The schema class name that was passed to the constructor.
205              
206             =head2 $mock->recorder()
207              
208             Returns the L<Fey::ORM::Mock::Recorder> object that records all
209             inserts, updates, and deletes for tables in this schema.
210              
211             =head2 $mock->seed_class( $class => \%attr, \%attr, ... )
212              
213             This method accepts a class name and one or more hash references. Each
214             hash reference should consist of some or all of the class's attributes
215             and associated values.
216              
217             These seeded hash references will be used the next time C<<
218             $class->new() >> is called without the "_from_query" parameter. This
219             prevents an attempt to fetch data from the database handle.
220              
221             Note that any attribute values you pass to the constructor will
222             override seeded values.
223              
224             =head1 BUGS
225              
226             Please report any bugs or feature requests to
227             C<bug-fey-mock@rt.cpan.org>, or through the web interface at
228             L<http://rt.cpan.org>. I will be notified, and then you'll
229             automatically be notified of progress on your bug as I make changes.
230              
231             =head1 AUTHOR
232              
233             Dave Rolsky <autarch@urth.org>
234              
235             =head1 COPYRIGHT AND LICENSE
236              
237             This software is Copyright (c) 2010 by Dave Rolsky.
238              
239             This is free software, licensed under:
240              
241             The Artistic License 2.0 (GPL Compatible)
242              
243             =cut