Remove anonymous blesses to avoid major speed hit on Fedora Core 5, or 'the anti...
[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
12 __PACKAGE__->load_components(qw/ResultSetProxy/);
13
14 {
15     no warnings 'once';
16     *dbi_commit = \&txn_commit;
17     *dbi_rollback = \&txn_rollback;
18 }
19
20 sub storage { shift->schema_instance(@_)->storage; }
21
22 =head1 NAME
23
24 DBIx::Class::DB - (DEPRECATED) classdata schema component
25
26 =head1 SYNOPSIS
27
28   package MyDB;
29
30   use base qw/DBIx::Class/;
31   __PACKAGE__->load_components('DB');
32
33   __PACKAGE__->connection('dbi:...', 'user', 'pass', \%attrs);
34
35   package MyDB::MyTable;
36
37   use base qw/MyDB/;
38   __PACKAGE__->load_components('Core'); # just load this in MyDB if it will
39                                         # always be there
40
41   ...
42
43 =head1 DESCRIPTION
44
45 This class is designed to support the Class::DBI connection-as-classdata style
46 for DBIx::Class. You are *strongly* recommended to use a DBIx::Class::Schema
47 instead; DBIx::Class::DB will not undergo new development and will be moved
48 to being a CDBICompat-only component before 1.0.
49
50 =head1 METHODS
51
52 =head2 storage
53
54 Sets or gets the storage backend. Defaults to L<DBIx::Class::Storage::DBI>.
55
56 =head2 class_resolver
57
58 ****DEPRECATED****
59
60 Sets or gets the class to use for resolving a class. Defaults to
61 L<DBIx::Class::ClassResolver::Passthrough>, which returns whatever you give
62 it. See resolve_class below.
63
64 =cut
65
66 __PACKAGE__->mk_classdata('class_resolver' =>
67                           'DBIx::Class::ClassResolver::PassThrough');
68
69 =head2 connection
70
71   __PACKAGE__->connection($dsn, $user, $pass, $attrs);
72
73 Specifies the arguments that will be passed to DBI->connect(...) to
74 instantiate the class dbh when required.
75
76 =cut
77
78 sub connection {
79   my ($class, @info) = @_;
80   $class->setup_schema_instance unless $class->can('schema_instance');
81   $class->schema_instance->connection(@info);
82 }
83
84 =head2 setup_schema_instance
85
86 Creates a class method ->schema_instance which contains a DBIx::Class::Schema;
87 all class-method operations are proxies through to this object. If you don't
88 call ->connection in your DBIx::Class::DB subclass at load time you *must*
89 call ->setup_schema_instance in order for subclasses to find the schema and
90 register themselves with it.
91
92 =cut
93
94 sub setup_schema_instance {
95   my $class = shift;
96   my $schema = {};
97   bless $schema, 'DBIx::Class::Schema';
98   $class->mk_classdata('schema_instance' => $schema);
99 }
100
101 =head2 txn_begin
102
103 Begins a transaction (does nothing if AutoCommit is off).
104
105 =cut
106
107 sub txn_begin { shift->schema_instance->txn_begin(@_); }
108
109 =head2 txn_commit
110
111 Commits the current transaction.
112
113 =cut
114
115 sub txn_commit { shift->schema_instance->txn_commit(@_); }
116
117 =head2 txn_rollback
118
119 Rolls back the current transaction.
120
121 =cut
122
123 sub txn_rollback { shift->schema_instance->txn_rollback(@_); }
124
125 =head2 txn_do
126
127 Executes a block of code transactionally. If this code reference
128 throws an exception, the transaction is rolled back and the exception
129 is rethrown. See L<DBIx::Class::Schema/"txn_do"> for more details.
130
131 =cut
132
133 sub txn_do { shift->schema_instance->txn_do(@_); }
134
135 {
136   my $warn;
137
138   sub resolve_class {
139     warn "resolve_class deprecated as of 0.04999_02" unless $warn++;
140     return shift->class_resolver->class(@_);
141   }
142 }
143
144 =head2 resultset_instance
145
146 Returns an instance of a resultset for this class - effectively
147 mapping the L<Class::DBI> connection-as-classdata paradigm into the
148 native L<DBIx::Class::ResultSet> system.
149
150 =cut
151
152 sub resultset_instance {
153   my $class = ref $_[0] || $_[0];
154   my $source = $class->result_source_instance;
155   if ($source->result_class ne $class) {
156     $source = $source->new($source);
157     $source->result_class($class);
158   }
159   return $source->resultset;
160 }
161
162 =head2 resolve_class
163
164 ****DEPRECATED****
165
166 See L<class_resolver>
167
168 =head2 dbi_commit
169
170 ****DEPRECATED****
171
172 Alias for L<txn_commit>
173
174 =head2 dbi_rollback
175
176 ****DEPRECATED****
177
178 Alias for L<txn_rollback>
179
180 =head1 AUTHORS
181
182 Matt S. Trout <mst@shadowcatsystems.co.uk>
183
184 =head1 LICENSE
185
186 You may distribute this code under the same terms as Perl itself.
187
188 =cut
189
190 1;