804ff67a752b7e20c4a90bd85d0cc8e440fe6465
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / DB.pm
1 package DBIx::Class::DB;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class/;
7 use DBIx::Class::Schema;
8 use DBIx::Class::Storage::DBI;
9 use DBIx::Class::ClassResolver::PassThrough;
10 use DBI;
11 use Scalar::Util 'blessed';
12 use namespace::clean;
13
14 unless ($INC{"DBIx/Class/CDBICompat.pm"}) {
15   warn "IMPORTANT: DBIx::Class::DB is DEPRECATED AND *WILL* BE REMOVED. DO NOT USE.\n";
16 }
17
18 __PACKAGE__->load_components(qw/ResultSetProxy/);
19
20 sub storage { shift->schema_instance(@_)->storage; }
21 sub dbi_commit { shift->txn_commit(@_) }
22 sub dbi_rollback { shift->txn_rollback(@_) }
23
24 =head1 NAME
25
26 DBIx::Class::DB - (DEPRECATED) classdata schema component
27
28 =head1 DESCRIPTION
29
30 This class is designed to support the Class::DBI connection-as-classdata style
31 for DBIx::Class. You are *strongly* recommended to use a DBIx::Class::Schema
32 instead; DBIx::Class::DB will not undergo new development and will be moved
33 to being a CDBICompat-only component before 1.0. In order to discourage further
34 use, documentation has been removed as of 0.08000
35
36 =begin HIDE_BECAUSE_THIS_CLASS_IS_DEPRECATED
37
38 =head1 METHODS
39
40 =head2 storage
41
42 Sets or gets the storage backend. Defaults to L<DBIx::Class::Storage::DBI>.
43
44 =head2 class_resolver
45
46 ****DEPRECATED****
47
48 Sets or gets the class to use for resolving a class. Defaults to
49 L<DBIx::Class::ClassResolver::Passthrough>, which returns whatever you give
50 it. See resolve_class below.
51
52 =cut
53
54 __PACKAGE__->mk_classdata('class_resolver' =>
55                           'DBIx::Class::ClassResolver::PassThrough');
56
57 =head2 connection
58
59   __PACKAGE__->connection($dsn, $user, $pass, $attrs);
60
61 Specifies the arguments that will be passed to DBI->connect(...) to
62 instantiate the class dbh when required.
63
64 =cut
65
66 sub connection {
67   my ($class, @info) = @_;
68   $class->setup_schema_instance unless $class->can('schema_instance');
69   $class->schema_instance->connection(@info);
70 }
71
72 =head2 setup_schema_instance
73
74 Creates a class method ->schema_instance which contains a DBIx::Class::Schema;
75 all class-method operations are proxies through to this object. If you don't
76 call ->connection in your DBIx::Class::DB subclass at load time you *must*
77 call ->setup_schema_instance in order for subclasses to find the schema and
78 register themselves with it.
79
80 =cut
81
82 sub setup_schema_instance {
83   my $class = shift;
84   my $schema = {};
85   bless $schema, 'DBIx::Class::Schema';
86   $class->mk_classdata('schema_instance' => $schema);
87 }
88
89 =head2 txn_begin
90
91 Begins a transaction (does nothing if AutoCommit is off).
92
93 =cut
94
95 sub txn_begin { shift->schema_instance->txn_begin(@_); }
96
97 =head2 txn_commit
98
99 Commits the current transaction.
100
101 =cut
102
103 sub txn_commit { shift->schema_instance->txn_commit(@_); }
104
105 =head2 txn_rollback
106
107 Rolls back the current transaction.
108
109 =cut
110
111 sub txn_rollback { shift->schema_instance->txn_rollback(@_); }
112
113 =head2 txn_do
114
115 Executes a block of code transactionally. If this code reference
116 throws an exception, the transaction is rolled back and the exception
117 is rethrown. See L<DBIx::Class::Schema/"txn_do"> for more details.
118
119 =cut
120
121 sub txn_do { shift->schema_instance->txn_do(@_); }
122
123 {
124   my $warn;
125
126   sub resolve_class {
127     warn "resolve_class deprecated as of 0.04999_02" unless $warn++;
128     return shift->class_resolver->class(@_);
129   }
130 }
131
132 =head2 resultset_instance
133
134 Returns an instance of a resultset for this class - effectively
135 mapping the L<Class::DBI> connection-as-classdata paradigm into the
136 native L<DBIx::Class::ResultSet> system.
137
138 =cut
139
140 sub resultset_instance {
141   $_[0]->result_source_instance->resultset
142 }
143
144 =head2 result_source_instance
145
146 Returns an instance of the result source for this class
147
148 =cut
149
150 __PACKAGE__->mk_classdata('_result_source_instance' => []);
151
152 # Yep. this is horrific. Basically what's happening here is that
153 # (with good reason) DBIx::Class::Schema copies the result source for
154 # registration. Because we have a retarded setup order forced on us we need
155 # to actually make our ->result_source_instance -be- the source used, and we
156 # need to get the source name and schema into ourselves. So this makes it
157 # happen.
158
159 sub _maybe_attach_source_to_schema {
160   my ($class, $source) = @_;
161   if (my $meth = $class->can('schema_instance')) {
162     if (my $schema = $class->$meth) {
163       $schema->register_class($class, $class);
164       my $new_source = $schema->source($class);
165       %$source = %$new_source;
166       $schema->source_registrations->{$class} = $source;
167     }
168   }
169 }
170
171 sub result_source_instance {
172   my $class = shift;
173   $class = ref $class || $class;
174
175   if (@_) {
176     my $source = $_[0];
177     $class->_result_source_instance([$source, $class]);
178     $class->_maybe_attach_source_to_schema($source);
179     return $source;
180   }
181
182   my($source, $result_class) = @{$class->_result_source_instance};
183   return unless blessed $source;
184
185   if ($result_class ne $class) {  # new class
186     # Give this new class its own source and register it.
187     $source = $source->new({
188         %$source,
189         source_name  => $class,
190         result_class => $class
191     } );
192     $class->_result_source_instance([$source, $class]);
193     $class->_maybe_attach_source_to_schema($source);
194   }
195   return $source;
196 }
197
198 =head2 resolve_class
199
200 ****DEPRECATED****
201
202 See L</class_resolver>
203
204 =head2 dbi_commit
205
206 ****DEPRECATED****
207
208 Alias for L</txn_commit>
209
210 =head2 dbi_rollback
211
212 ****DEPRECATED****
213
214 Alias for L</txn_rollback>
215
216 =end HIDE_BECAUSE_THIS_CLASS_IS_DEPRECATED
217
218 =head1 AUTHORS
219
220 Matt S. Trout <mst@shadowcatsystems.co.uk>
221
222 =head1 LICENSE
223
224 You may distribute this code under the same terms as Perl itself.
225
226 =cut
227
228 1;