File Coverage

blib/lib/Fey/Object/Schema.pm
Criterion Covered Total %
statement 24 57 42.1
branch 0 16 0.0
condition 0 6 0.0
subroutine 9 18 50.0
pod 9 9 100.0
total 42 106 39.6


line stmt bran cond sub pod time code
1             package Fey::Object::Schema;
2              
3 9     9   45 use strict;
  9         14  
  9         280  
4 9     9   53 use warnings;
  9         16  
  9         277  
5 9     9   41 use namespace::autoclean;
  9         13  
  9         67  
6              
7             our $VERSION = '0.47';
8              
9 9     9   94300 use Fey::Meta::Class::Table;
  9         28  
  9         489  
10 9     9   71 use Try::Tiny;
  9         14  
  9         819  
11              
12 9     9   52 use Moose;
  9         18  
  9         67  
13              
14             sub EnableObjectCaches {
15 0     0 1 0 my $class = shift;
16              
17 0         0 $_->EnableObjectCache() for $class->_TableClasses();
18             }
19              
20             sub DisableObjectCaches {
21 0     0 1 0 my $class = shift;
22              
23 0         0 $_->DisableObjectCache() for $class->_TableClasses();
24             }
25              
26             sub ClearObjectCaches {
27 0     0 1 0 my $class = shift;
28              
29 0         0 $_->ClearObjectCache() for $class->_TableClasses();
30             }
31              
32             sub _TableClasses {
33 0     0   0 my $class = shift;
34              
35 0         0 my $schema = $class->Schema();
36              
37 0         0 return Fey::Meta::Class::Table->ClassForTable( $schema->tables() );
38             }
39              
40             sub RunInTransaction {
41 0     0 1 0 my $class = shift;
42 0         0 my $sub = shift;
43 0   0     0 my $source = shift || $class->DBIManager()->default_source();
44              
45 0         0 my $in_tran;
46              
47 0         0 my $dbh = $source->dbh();
48              
49 0 0 0     0 unless ( $source->allows_nested_transactions()
50             || $dbh->{AutoCommit} ) {
51 0         0 $in_tran = 1;
52             }
53              
54 0         0 my $wantarray = wantarray;
55              
56 0         0 my @r;
57              
58             try {
59 0 0   0   0 $dbh->begin_work()
60             unless $in_tran;
61              
62 0 0       0 if ($wantarray) {
    0          
63 0         0 @r = $sub->();
64             }
65             elsif ( defined $wantarray ) {
66 0         0 $r[0] = $sub->();
67             }
68             else {
69 0         0 $sub->();
70             }
71              
72 0 0       0 $dbh->commit()
73             unless $in_tran;
74             }
75             catch {
76 0 0   0   0 $dbh->rollback
77             unless $in_tran;
78 0         0 die $_;
79 0         0 };
80              
81 0 0       0 return unless defined $wantarray;
82              
83 0 0       0 return $wantarray ? @r : $r[0];
84             }
85              
86             sub Schema {
87 1     1 1 2 my $class = shift;
88              
89 1         4 return $class->meta()->schema();
90             }
91              
92             sub DBIManager {
93 1     1 1 427 my $class = shift;
94              
95 1         4 return $class->meta()->dbi_manager();
96             }
97              
98             sub SetDBIManager {
99 0     0 1 0 my $class = shift;
100              
101 0         0 $class->meta()->set_dbi_manager(@_);
102             }
103              
104             sub SQLFactoryClass {
105 10     10 1 489 my $class = shift;
106              
107 10         67 return $class->meta()->sql_factory_class();
108             }
109              
110             sub SetSQLFactoryClass {
111 0     0 1   my $class = shift;
112              
113 0           $class->meta()->set_sql_factory_class(@_);
114             }
115              
116             __PACKAGE__->meta()->make_immutable( inline_constructor => 0 );
117              
118             1;
119              
120             # ABSTRACT: Base class for schema-based objects
121              
122             __END__
123              
124             =pod
125              
126             =head1 NAME
127              
128             Fey::Object::Schema - Base class for schema-based objects
129              
130             =head1 VERSION
131              
132             version 0.47
133              
134             =head1 SYNOPSIS
135              
136             package MyApp::Schema;
137              
138             use Fey::ORM::Schema;
139              
140             has_schema(...);
141              
142             =head1 DESCRIPTION
143              
144             This class is a the base class for all schema-based objects.
145              
146             =head1 METHODS
147              
148             This class provides the following methods:
149              
150             =head2 $class->EnableObjectCaches()
151              
152             Enables the object class for all of the table classes associated with
153             this class's schema.
154              
155             =head2 $class->DisableObjectCaches()
156              
157             Disables the object class for all of the table classes associated with
158             this class's schema.
159              
160             =head2 $class->ClearObjectCaches()
161              
162             Clears the object class for all of the table classes associated with
163             this class's schema.
164              
165             =head2 $class->RunInTransaction( $coderef, $source )
166              
167             Given a code ref, this method will begin a transaction and execute the
168             coderef. If the coderef runs normally (no exceptions), it commits,
169             otherwise it rolls back and rethrows the error.
170              
171             This method will handle nested transactions gracefully if your
172             DBMS does not. It doesn't emulate actual partial commits, but it
173             does prevent DBI from throwing an error.
174              
175             The second argument can be a L<Fey::DBIManager::Source> object. If no
176             source is specified, then this method will use the default source.
177              
178             =head2 $class->Schema()
179              
180             Returns the L<Fey::Schema> object associated with the class.
181              
182             =head2 $class->DBIManager()
183              
184             Returns the L<Fey::Schema> object associated with the class.
185              
186             =head2 $class->SetDBIManager($manager)
187              
188             Set the L<Fey::DBIManager> object associated with the class. If you
189             don't set one explicitly, then the first call to C<<
190             $class->DBIManager() >> will simply create one by calling C<<
191             Fey::DBIManager->new() >>.
192              
193             =head2 $class->SQLFactoryClass()
194              
195             Returns the SQL factory class associated with the class. This defaults
196             to L<Fey::SQL>.
197              
198             =head2 $class->SetSQLFactoryClass()
199              
200             Set the SQL factory class associated with the class.
201              
202             =head1 AUTHOR
203              
204             Dave Rolsky <autarch@urth.org>
205              
206             =head1 COPYRIGHT AND LICENSE
207              
208             This software is copyright (c) 2011 - 2015 by Dave Rolsky.
209              
210             This is free software; you can redistribute it and/or modify it under
211             the same terms as the Perl 5 programming language system itself.
212              
213             =cut