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