minor fixups
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema.pm
CommitLineData
a02675cd 1package DBIx::Class::Schema;
2
3use strict;
4use warnings;
aa562407 5
4981dc70 6use DBIx::Class::Exception;
701da8c4 7use Carp::Clan qw/^DBIx::Class/;
551e711a 8use Scalar::Util ();
c9d2e0a2 9use File::Spec;
ddc0a6c8 10use Sub::Name ();
329d7385 11use Module::Find();
a02675cd 12
41a6f8c0 13use base qw/DBIx::Class/;
a02675cd 14
0dc79249 15__PACKAGE__->mk_classdata('class_mappings' => {});
16__PACKAGE__->mk_classdata('source_registrations' => {});
1e10a11d 17__PACKAGE__->mk_classdata('storage_type' => '::DBI');
d7156e50 18__PACKAGE__->mk_classdata('storage');
82cc0386 19__PACKAGE__->mk_classdata('exception_action');
4b946902 20__PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
e6c747fd 21__PACKAGE__->mk_classdata('default_resultset_attributes' => {});
a02675cd 22
c2da098a 23=head1 NAME
24
25DBIx::Class::Schema - composable schemas
26
27=head1 SYNOPSIS
28
24d67825 29 package Library::Schema;
c2da098a 30 use base qw/DBIx::Class::Schema/;
bab77431 31
829517d4 32 # load all Result classes in Library/Schema/Result/
33 __PACKAGE__->load_namespaces();
c2da098a 34
829517d4 35 package Library::Schema::Result::CD;
d88ecca6 36 use base qw/DBIx::Class::Core/;
37
38 __PACKAGE__->load_components(qw/InflateColumn::DateTime/); # for example
24d67825 39 __PACKAGE__->table('cd');
c2da098a 40
5d9076f2 41 # Elsewhere in your code:
24d67825 42 my $schema1 = Library::Schema->connect(
a3d93194 43 $dsn,
44 $user,
45 $password,
ef131d82 46 { AutoCommit => 1 },
a3d93194 47 );
bab77431 48
24d67825 49 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
c2da098a 50
829517d4 51 # fetch objects using Library::Schema::Result::DVD
24d67825 52 my $resultset = $schema1->resultset('DVD')->search( ... );
53 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
c2da098a 54
55=head1 DESCRIPTION
56
a3d93194 57Creates database classes based on a schema. This is the recommended way to
58use L<DBIx::Class> and allows you to use more than one concurrent connection
59with your classes.
429bd4f1 60
03312470 61NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
2053ab2a 62carefully, as DBIx::Class does things a little differently. Note in
03312470 63particular which module inherits off which.
64
829517d4 65=head1 SETUP METHODS
c2da098a 66
829517d4 67=head2 load_namespaces
87c4e602 68
27f01d1f 69=over 4
70
829517d4 71=item Arguments: %options?
27f01d1f 72
73=back
076652e8 74
829517d4 75 __PACKAGE__->load_namespaces();
66d9ef6b 76
829517d4 77 __PACKAGE__->load_namespaces(
78 result_namespace => 'Res',
79 resultset_namespace => 'RSet',
80 default_resultset_class => '+MyDB::Othernamespace::RSet',
81 );
076652e8 82
829517d4 83With no arguments, this method uses L<Module::Find> to load all your
84Result classes from a sub-namespace F<Result> under your Schema class'
85namespace. Eg. With a Schema of I<MyDB::Schema> all files in
86I<MyDB::Schema::Result> are assumed to be Result classes.
c2da098a 87
829517d4 88It also finds all ResultSet classes in the namespace F<ResultSet> and
89loads them into the appropriate Result classes using for you. The
90matching is done by assuming the package name of the ResultSet class
91is the same as that of the Result class.
74b92d9a 92
672687db 93You will be warned if ResultSet classes are discovered for which there
829517d4 94are no matching Result classes like this:
87c4e602 95
829517d4 96 load_namespaces found ResultSet class $classname with no corresponding Result class
27f01d1f 97
829517d4 98If a Result class is found to already have a ResultSet class set using
99L</resultset_class> to some other class, you will be warned like this:
27f01d1f 100
829517d4 101 We found ResultSet class '$rs_class' for '$result', but it seems
102 that you had already set '$result' to use '$rs_set' instead
076652e8 103
829517d4 104Both of the sub-namespaces are configurable if you don't like the defaults,
105via the options C<result_namespace> and C<resultset_namespace>.
076652e8 106
829517d4 107If (and only if) you specify the option C<default_resultset_class>, any found
108Result classes for which we do not find a corresponding
109ResultSet class will have their C<resultset_class> set to
110C<default_resultset_class>.
076652e8 111
829517d4 112All of the namespace and classname options to this method are relative to
113the schema classname by default. To specify a fully-qualified name, prefix
114it with a literal C<+>.
2a4d9487 115
829517d4 116Examples:
2a4d9487 117
829517d4 118 # load My::Schema::Result::CD, My::Schema::Result::Artist,
119 # My::Schema::ResultSet::CD, etc...
120 My::Schema->load_namespaces;
2a4d9487 121
829517d4 122 # Override everything to use ugly names.
123 # In this example, if there is a My::Schema::Res::Foo, but no matching
124 # My::Schema::RSets::Foo, then Foo will have its
125 # resultset_class set to My::Schema::RSetBase
126 My::Schema->load_namespaces(
127 result_namespace => 'Res',
128 resultset_namespace => 'RSets',
129 default_resultset_class => 'RSetBase',
130 );
2a4d9487 131
829517d4 132 # Put things in other namespaces
133 My::Schema->load_namespaces(
134 result_namespace => '+Some::Place::Results',
135 resultset_namespace => '+Another::Place::RSets',
136 );
2a4d9487 137
829517d4 138If you'd like to use multiple namespaces of each type, simply use an arrayref
139of namespaces for that option. In the case that the same result
140(or resultset) class exists in multiple namespaces, the latter entries in
141your list of namespaces will override earlier ones.
2a4d9487 142
829517d4 143 My::Schema->load_namespaces(
144 # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
145 result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
146 resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
147 );
2a4d9487 148
149=cut
150
829517d4 151# Pre-pends our classname to the given relative classname or
152# class namespace, unless there is a '+' prefix, which will
153# be stripped.
154sub _expand_relative_name {
155 my ($class, $name) = @_;
156 return if !$name;
157 $name = $class . '::' . $name if ! ($name =~ s/^\+//);
158 return $name;
2a4d9487 159}
160
f3405058 161# Finds all modules in the supplied namespace, or if omitted in the
162# namespace of $class. Untaints all findings as they can be assumed
163# to be safe
164sub _findallmod {
165 my $proto = shift;
166 my $ns = shift || ref $proto || $proto;
167
168 my @mods = Module::Find::findallmod($ns);
169
170 # try to untaint module names. mods where this fails
171 # are left alone so we don't have to change the old behavior
172 no locale; # localized \w doesn't untaint expression
173 return map { $_ =~ m/^( (?:\w+::)* \w+ )$/x ? $1 : $_ } @mods;
174}
175
829517d4 176# returns a hash of $shortname => $fullname for every package
b488020e 177# found in the given namespaces ($shortname is with the $fullname's
178# namespace stripped off)
829517d4 179sub _map_namespaces {
180 my ($class, @namespaces) = @_;
6eec9003 181
829517d4 182 my @results_hash;
183 foreach my $namespace (@namespaces) {
184 push(
185 @results_hash,
186 map { (substr($_, length "${namespace}::"), $_) }
f3405058 187 $class->_findallmod($namespace)
829517d4 188 );
0dc79249 189 }
27f01d1f 190
829517d4 191 @results_hash;
ea20d0fd 192}
193
b488020e 194# returns the result_source_instance for the passed class/object,
195# or dies with an informative message (used by load_namespaces)
196sub _ns_get_rsrc_instance {
197 my $class = shift;
198 my $rs = ref ($_[0]) || $_[0];
199
200 if ($rs->can ('result_source_instance') ) {
201 return $rs->result_source_instance;
202 }
203 else {
204 $class->throw_exception (
205 "Attempt to load_namespaces() class $rs failed - are you sure this is a real Result Class?"
206 );
207 }
208}
209
829517d4 210sub load_namespaces {
211 my ($class, %args) = @_;
0dc79249 212
829517d4 213 my $result_namespace = delete $args{result_namespace} || 'Result';
214 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
215 my $default_resultset_class = delete $args{default_resultset_class};
0dc79249 216
829517d4 217 $class->throw_exception('load_namespaces: unknown option(s): '
218 . join(q{,}, map { qq{'$_'} } keys %args))
219 if scalar keys %args;
0dc79249 220
829517d4 221 $default_resultset_class
222 = $class->_expand_relative_name($default_resultset_class);
9b1ba0f2 223
829517d4 224 for my $arg ($result_namespace, $resultset_namespace) {
225 $arg = [ $arg ] if !ref($arg) && $arg;
9b1ba0f2 226
829517d4 227 $class->throw_exception('load_namespaces: namespace arguments must be '
228 . 'a simple string or an arrayref')
229 if ref($arg) ne 'ARRAY';
9b1ba0f2 230
829517d4 231 $_ = $class->_expand_relative_name($_) for (@$arg);
232 }
ea20d0fd 233
829517d4 234 my %results = $class->_map_namespaces(@$result_namespace);
235 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
27f01d1f 236
829517d4 237 my @to_register;
238 {
239 no warnings 'redefine';
240 local *Class::C3::reinitialize = sub { };
241 use warnings 'redefine';
27f01d1f 242
3988ce40 243 # ensure classes are loaded and attached in inheritance order
3d27f771 244 $class->ensure_class_loaded($_) foreach(values %results);
3988ce40 245 my %inh_idx;
246 my @subclass_last = sort {
247
248 ($inh_idx{$a} ||=
249 scalar @{mro::get_linear_isa( $results{$a} )}
250 )
251
252 <=>
253
254 ($inh_idx{$b} ||=
255 scalar @{mro::get_linear_isa( $results{$b} )}
256 )
257
258 } keys(%results);
259
3d27f771 260 foreach my $result (@subclass_last) {
829517d4 261 my $result_class = $results{$result};
82b01c38 262
829517d4 263 my $rs_class = delete $resultsets{$result};
b488020e 264 my $rs_set = $class->_ns_get_rsrc_instance ($result_class)->resultset_class;
3988ce40 265
829517d4 266 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
3d27f771 267 if($rs_class && $rs_class ne $rs_set) {
341d5ede 268 carp "We found ResultSet class '$rs_class' for '$result', but it seems "
829517d4 269 . "that you had already set '$result' to use '$rs_set' instead";
270 }
271 }
272 elsif($rs_class ||= $default_resultset_class) {
273 $class->ensure_class_loaded($rs_class);
b488020e 274 $class->_ns_get_rsrc_instance ($result_class)->resultset_class($rs_class);
829517d4 275 }
82b01c38 276
b488020e 277 my $source_name = $class->_ns_get_rsrc_instance ($result_class)->source_name || $result;
0e6c5d58 278
279 push(@to_register, [ $source_name, $result_class ]);
829517d4 280 }
281 }
ea20d0fd 282
829517d4 283 foreach (sort keys %resultsets) {
341d5ede 284 carp "load_namespaces found ResultSet class $_ with no "
829517d4 285 . 'corresponding Result class';
286 }
ea20d0fd 287
829517d4 288 Class::C3->reinitialize;
289 $class->register_class(@$_) for (@to_register);
ea20d0fd 290
829517d4 291 return;
ea20d0fd 292}
293
87c4e602 294=head2 load_classes
295
27f01d1f 296=over 4
297
298=item Arguments: @classes?, { $namespace => [ @classes ] }+
299
300=back
076652e8 301
1ab61457 302L</load_classes> is an alternative method to L</load_namespaces>, both of
303which serve similar purposes, each with different advantages and disadvantages.
304In the general case you should use L</load_namespaces>, unless you need to
305be able to specify that only specific classes are loaded at runtime.
829517d4 306
82b01c38 307With no arguments, this method uses L<Module::Find> to find all classes under
308the schema's namespace. Otherwise, this method loads the classes you specify
309(using L<use>), and registers them (using L</"register_class">).
076652e8 310
2053ab2a 311It is possible to comment out classes with a leading C<#>, but note that perl
312will think it's a mistake (trying to use a comment in a qw list), so you'll
313need to add C<no warnings 'qw';> before your load_classes call.
5ce32fc1 314
829517d4 315If any classes found do not appear to be Result class files, you will
316get the following warning:
317
318 Failed to load $comp_class. Can't find source_name method. Is
319 $comp_class really a full DBIC result class? Fix it, move it elsewhere,
320 or make your load_classes call more specific.
321
2053ab2a 322Example:
82b01c38 323
324 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
75d07914 325 # etc. (anything under the My::Schema namespace)
82b01c38 326
327 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
328 # not Other::Namespace::LinerNotes nor My::Schema::Track
329 My::Schema->load_classes(qw/ CD Artist #Track /, {
330 Other::Namespace => [qw/ Producer #LinerNotes /],
331 });
332
076652e8 333=cut
334
a02675cd 335sub load_classes {
5ce32fc1 336 my ($class, @params) = @_;
bab77431 337
5ce32fc1 338 my %comps_for;
bab77431 339
5ce32fc1 340 if (@params) {
341 foreach my $param (@params) {
342 if (ref $param eq 'ARRAY') {
343 # filter out commented entries
344 my @modules = grep { $_ !~ /^#/ } @$param;
bab77431 345
5ce32fc1 346 push (@{$comps_for{$class}}, @modules);
347 }
348 elsif (ref $param eq 'HASH') {
349 # more than one namespace possible
350 for my $comp ( keys %$param ) {
351 # filter out commented entries
352 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
353
354 push (@{$comps_for{$comp}}, @modules);
355 }
356 }
357 else {
358 # filter out commented entries
359 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
360 }
361 }
362 } else {
bc0c9800 363 my @comp = map { substr $_, length "${class}::" }
f3405058 364 $class->_findallmod;
5ce32fc1 365 $comps_for{$class} = \@comp;
41a6f8c0 366 }
5ce32fc1 367
e6efde04 368 my @to_register;
369 {
370 no warnings qw/redefine/;
371 local *Class::C3::reinitialize = sub { };
372 foreach my $prefix (keys %comps_for) {
373 foreach my $comp (@{$comps_for{$prefix}||[]}) {
374 my $comp_class = "${prefix}::${comp}";
c037c03a 375 $class->ensure_class_loaded($comp_class);
bab77431 376
89271e56 377 my $snsub = $comp_class->can('source_name');
378 if(! $snsub ) {
341d5ede 379 carp "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific.";
89271e56 380 next;
381 }
382 $comp = $snsub->($comp_class) || $comp;
383
93405cf0 384 push(@to_register, [ $comp, $comp_class ]);
bfb2bd4f 385 }
5ce32fc1 386 }
a02675cd 387 }
e6efde04 388 Class::C3->reinitialize;
389
390 foreach my $to (@to_register) {
391 $class->register_class(@$to);
392 # if $class->can('result_source_instance');
393 }
a02675cd 394}
395
829517d4 396=head2 storage_type
2374c5ff 397
398=over 4
399
829517d4 400=item Arguments: $storage_type|{$storage_type, \%args}
401
402=item Return value: $storage_type|{$storage_type, \%args}
403
404=item Default value: DBIx::Class::Storage::DBI
2374c5ff 405
406=back
407
829517d4 408Set the storage class that will be instantiated when L</connect> is called.
409If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
95787afe 410assumed by L</connect>.
2374c5ff 411
829517d4 412You want to use this to set subclasses of L<DBIx::Class::Storage::DBI>
95787afe 413in cases where the appropriate subclass is not autodetected.
85bd0538 414
829517d4 415If your storage type requires instantiation arguments, those are
416defined as a second argument in the form of a hashref and the entire
417value needs to be wrapped into an arrayref or a hashref. We support
418both types of refs here in order to play nice with your
419Config::[class] or your choice. See
420L<DBIx::Class::Storage::DBI::Replicated> for an example of this.
0f4ec1d2 421
829517d4 422=head2 exception_action
f017c022 423
829517d4 424=over 4
0f4ec1d2 425
829517d4 426=item Arguments: $code_reference
f017c022 427
829517d4 428=item Return value: $code_reference
85bd0538 429
829517d4 430=item Default value: None
2374c5ff 431
829517d4 432=back
f017c022 433
829517d4 434If C<exception_action> is set for this class/object, L</throw_exception>
435will prefer to call this code reference with the exception as an argument,
436rather than L<DBIx::Class::Exception/throw>.
f017c022 437
829517d4 438Your subroutine should probably just wrap the error in the exception
439object/class of your choosing and rethrow. If, against all sage advice,
440you'd like your C<exception_action> to suppress a particular exception
441completely, simply have it return true.
f017c022 442
829517d4 443Example:
f017c022 444
829517d4 445 package My::Schema;
446 use base qw/DBIx::Class::Schema/;
447 use My::ExceptionClass;
448 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
449 __PACKAGE__->load_classes;
2374c5ff 450
829517d4 451 # or:
452 my $schema_obj = My::Schema->connect( .... );
453 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
0f4ec1d2 454
829517d4 455 # suppress all exceptions, like a moron:
456 $schema_obj->exception_action(sub { 1 });
25fb14bd 457
829517d4 458=head2 stacktrace
f017c022 459
829517d4 460=over 4
2374c5ff 461
829517d4 462=item Arguments: boolean
2374c5ff 463
829517d4 464=back
2374c5ff 465
829517d4 466Whether L</throw_exception> should include stack trace information.
467Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}>
468is true.
0f4ec1d2 469
829517d4 470=head2 sqlt_deploy_hook
0f4ec1d2 471
829517d4 472=over
0f4ec1d2 473
829517d4 474=item Arguments: $sqlt_schema
2374c5ff 475
829517d4 476=back
2374c5ff 477
829517d4 478An optional sub which you can declare in your own Schema class that will get
479passed the L<SQL::Translator::Schema> object when you deploy the schema via
480L</create_ddl_dir> or L</deploy>.
0f4ec1d2 481
829517d4 482For an example of what you can do with this, see
483L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
fdcd8145 484
2d7d8459 485Note that sqlt_deploy_hook is called by L</deployment_statements>, which in turn
486is called before L</deploy>. Therefore the hook can be used only to manipulate
487the L<SQL::Translator::Schema> object before it is turned into SQL fed to the
488database. If you want to execute post-deploy statements which can not be generated
489by L<SQL::Translator>, the currently suggested method is to overload L</deploy>
490and use L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
491
829517d4 492=head1 METHODS
2374c5ff 493
829517d4 494=head2 connect
87c4e602 495
27f01d1f 496=over 4
497
829517d4 498=item Arguments: @connectinfo
429bd4f1 499
d601dc88 500=item Return Value: $new_schema
27f01d1f 501
502=back
076652e8 503
829517d4 504Creates and returns a new Schema object. The connection info set on it
505is used to create a new instance of the storage backend and set it on
506the Schema object.
1c133e22 507
829517d4 508See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific
5d52945a 509syntax on the C<@connectinfo> argument, or L<DBIx::Class::Storage> in
829517d4 510general.
1c133e22 511
5d52945a 512Note that C<connect_info> expects an arrayref of arguments, but
faaba25f 513C<connect> does not. C<connect> wraps its arguments in an arrayref
5d52945a 514before passing them to C<connect_info>.
515
4c7d99ca 516=head3 Overloading
517
518C<connect> is a convenience method. It is equivalent to calling
519$schema->clone->connection(@connectinfo). To write your own overloaded
520version, overload L</connection> instead.
521
076652e8 522=cut
523
829517d4 524sub connect { shift->clone->connection(@_) }
e678398e 525
829517d4 526=head2 resultset
77254782 527
27f01d1f 528=over 4
529
829517d4 530=item Arguments: $source_name
82b01c38 531
829517d4 532=item Return Value: $resultset
27f01d1f 533
534=back
13765dad 535
829517d4 536 my $rs = $schema->resultset('DVD');
82b01c38 537
829517d4 538Returns the L<DBIx::Class::ResultSet> object for the registered source
539name.
77254782 540
541=cut
542
829517d4 543sub resultset {
544 my ($self, $moniker) = @_;
73d47f9f 545 $self->throw_exception('resultset() expects a source name')
546 unless defined $moniker;
829517d4 547 return $self->source($moniker)->resultset;
b7951443 548}
549
829517d4 550=head2 sources
6b43ba5f 551
552=over 4
553
829517d4 554=item Return Value: @source_names
6b43ba5f 555
556=back
557
829517d4 558 my @source_names = $schema->sources;
6b43ba5f 559
829517d4 560Lists names of all the sources registered on this Schema object.
6b43ba5f 561
829517d4 562=cut
161fb223 563
829517d4 564sub sources { return keys %{shift->source_registrations}; }
106d5f3b 565
829517d4 566=head2 source
87c4e602 567
27f01d1f 568=over 4
569
829517d4 570=item Arguments: $source_name
66d9ef6b 571
829517d4 572=item Return Value: $result_source
27f01d1f 573
574=back
82b01c38 575
829517d4 576 my $source = $schema->source('Book');
85f78622 577
829517d4 578Returns the L<DBIx::Class::ResultSource> object for the registered
579source name.
66d9ef6b 580
581=cut
582
829517d4 583sub source {
584 my ($self, $moniker) = @_;
585 my $sreg = $self->source_registrations;
586 return $sreg->{$moniker} if exists $sreg->{$moniker};
587
588 # if we got here, they probably passed a full class name
589 my $mapped = $self->class_mappings->{$moniker};
590 $self->throw_exception("Can't find source for ${moniker}")
591 unless $mapped && exists $sreg->{$mapped};
592 return $sreg->{$mapped};
161fb223 593}
594
829517d4 595=head2 class
87c4e602 596
27f01d1f 597=over 4
598
829517d4 599=item Arguments: $source_name
66d9ef6b 600
829517d4 601=item Return Value: $classname
27f01d1f 602
603=back
82b01c38 604
829517d4 605 my $class = $schema->class('CD');
606
607Retrieves the Result class name for the given source name.
66d9ef6b 608
609=cut
610
829517d4 611sub class {
612 my ($self, $moniker) = @_;
613 return $self->source($moniker)->result_class;
614}
08b515f1 615
4012acd8 616=head2 txn_do
08b515f1 617
4012acd8 618=over 4
08b515f1 619
4012acd8 620=item Arguments: C<$coderef>, @coderef_args?
08b515f1 621
4012acd8 622=item Return Value: The return value of $coderef
08b515f1 623
4012acd8 624=back
08b515f1 625
4012acd8 626Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
627returning its result (if any). Equivalent to calling $schema->storage->txn_do.
628See L<DBIx::Class::Storage/"txn_do"> for more information.
08b515f1 629
4012acd8 630This interface is preferred over using the individual methods L</txn_begin>,
631L</txn_commit>, and L</txn_rollback> below.
08b515f1 632
f9f06ae0 633WARNING: If you are connected with C<< AutoCommit => 0 >> the transaction is
281719d2 634considered nested, and you will still need to call L</txn_commit> to write your
f9f06ae0 635changes when appropriate. You will also want to connect with C<< auto_savepoint =>
6361 >> to get partial rollback to work, if the storage driver for your database
281719d2 637supports it.
638
f9f06ae0 639Connecting with C<< AutoCommit => 1 >> is recommended.
281719d2 640
4012acd8 641=cut
08b515f1 642
4012acd8 643sub txn_do {
644 my $self = shift;
08b515f1 645
4012acd8 646 $self->storage or $self->throw_exception
647 ('txn_do called on $schema without storage');
08b515f1 648
4012acd8 649 $self->storage->txn_do(@_);
650}
66d9ef6b 651
6936e902 652=head2 txn_scope_guard
75c8a7ab 653
89028f42 654Runs C<txn_scope_guard> on the schema's storage. See
655L<DBIx::Class::Storage/txn_scope_guard>.
75c8a7ab 656
b85be4c1 657=cut
658
1bc193ac 659sub txn_scope_guard {
660 my $self = shift;
661
662 $self->storage or $self->throw_exception
663 ('txn_scope_guard called on $schema without storage');
664
665 $self->storage->txn_scope_guard(@_);
666}
667
4012acd8 668=head2 txn_begin
a62cf8d4 669
4012acd8 670Begins a transaction (does nothing if AutoCommit is off). Equivalent to
671calling $schema->storage->txn_begin. See
672L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
27f01d1f 673
4012acd8 674=cut
82b01c38 675
4012acd8 676sub txn_begin {
677 my $self = shift;
27f01d1f 678
4012acd8 679 $self->storage or $self->throw_exception
680 ('txn_begin called on $schema without storage');
a62cf8d4 681
4012acd8 682 $self->storage->txn_begin;
683}
a62cf8d4 684
4012acd8 685=head2 txn_commit
a62cf8d4 686
4012acd8 687Commits the current transaction. Equivalent to calling
688$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
689for more information.
a62cf8d4 690
4012acd8 691=cut
a62cf8d4 692
4012acd8 693sub txn_commit {
694 my $self = shift;
a62cf8d4 695
4012acd8 696 $self->storage or $self->throw_exception
697 ('txn_commit called on $schema without storage');
a62cf8d4 698
4012acd8 699 $self->storage->txn_commit;
700}
70634260 701
4012acd8 702=head2 txn_rollback
a62cf8d4 703
4012acd8 704Rolls back the current transaction. Equivalent to calling
705$schema->storage->txn_rollback. See
706L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
a62cf8d4 707
708=cut
709
4012acd8 710sub txn_rollback {
711 my $self = shift;
a62cf8d4 712
19630353 713 $self->storage or $self->throw_exception
4012acd8 714 ('txn_rollback called on $schema without storage');
a62cf8d4 715
4012acd8 716 $self->storage->txn_rollback;
a62cf8d4 717}
718
829517d4 719=head2 storage
66d9ef6b 720
829517d4 721 my $storage = $schema->storage;
04786a4c 722
829517d4 723Returns the L<DBIx::Class::Storage> object for this Schema. Grab this
724if you want to turn on SQL statement debugging at runtime, or set the
725quote character. For the default storage, the documentation can be
726found in L<DBIx::Class::Storage::DBI>.
66d9ef6b 727
87c4e602 728=head2 populate
729
27f01d1f 730=over 4
731
16c5f7d3 732=item Arguments: $source_name, \@data;
27f01d1f 733
829517d4 734=item Return value: \@$objects | nothing
735
27f01d1f 736=back
a37a4697 737
16c5f7d3 738Pass this method a resultsource name, and an arrayref of
739arrayrefs. The arrayrefs should contain a list of column names,
740followed by one or many sets of matching data for the given columns.
741
744076d8 742In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
743to insert the data, as this is a fast method. However, insert_bulk currently
744assumes that your datasets all contain the same type of values, using scalar
745references in a column in one row, and not in another will probably not work.
746
747Otherwise, each set of data is inserted into the database using
16c5f7d3 748L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
749objects is returned.
82b01c38 750
751i.e.,
a37a4697 752
24d67825 753 $schema->populate('Artist', [
754 [ qw/artistid name/ ],
755 [ 1, 'Popular Band' ],
756 [ 2, 'Indie Band' ],
a62cf8d4 757 ...
758 ]);
d4daee7b 759
5a93e138 760Since wantarray context is basically the same as looping over $rs->create(...)
761you won't see any performance benefits and in this case the method is more for
762convenience. Void context sends the column information directly to storage
763using <DBI>s bulk insert method. So the performance will be much better for
764storages that support this method.
765
766Because of this difference in the way void context inserts rows into your
767database you need to note how this will effect any loaded components that
768override or augment insert. For example if you are using a component such
769as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use
770wantarray context if you want the PKs automatically created.
a37a4697 771
772=cut
773
774sub populate {
775 my ($self, $name, $data) = @_;
c4e67d31 776 if(my $rs = $self->resultset($name)) {
777 if(defined wantarray) {
778 return $rs->populate($data);
779 } else {
780 $rs->populate($data);
54e0bd06 781 }
c4e67d31 782 } else {
783 $self->throw_exception("$name is not a resultset");
8b93a938 784 }
a37a4697 785}
786
829517d4 787=head2 connection
788
789=over 4
790
791=item Arguments: @args
792
793=item Return Value: $new_schema
794
795=back
796
797Similar to L</connect> except sets the storage object and connection
798data in-place on the Schema class. You should probably be calling
799L</connect> to get a proper Schema object instead.
800
4c7d99ca 801=head3 Overloading
802
803Overload C<connection> to change the behaviour of C<connect>.
829517d4 804
805=cut
806
807sub connection {
808 my ($self, @info) = @_;
809 return $self if !@info && $self->storage;
d4daee7b 810
829517d4 811 my ($storage_class, $args) = ref $self->storage_type ?
812 ($self->_normalize_storage_type($self->storage_type),{}) : ($self->storage_type, {});
d4daee7b 813
829517d4 814 $storage_class = 'DBIx::Class::Storage'.$storage_class
815 if $storage_class =~ m/^::/;
82202206 816 eval { $self->ensure_class_loaded ($storage_class) };
829517d4 817 $self->throw_exception(
818 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
819 ) if $@;
820 my $storage = $storage_class->new($self=>$args);
821 $storage->connect_info(\@info);
822 $self->storage($storage);
823 return $self;
824}
825
826sub _normalize_storage_type {
827 my ($self, $storage_type) = @_;
828 if(ref $storage_type eq 'ARRAY') {
829 return @$storage_type;
830 } elsif(ref $storage_type eq 'HASH') {
831 return %$storage_type;
832 } else {
833 $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
834 }
835}
836
837=head2 compose_namespace
82cc0386 838
839=over 4
840
829517d4 841=item Arguments: $target_namespace, $additional_base_class?
842
843=item Retur Value: $new_schema
844
845=back
846
847For each L<DBIx::Class::ResultSource> in the schema, this method creates a
848class in the target namespace (e.g. $target_namespace::CD,
849$target_namespace::Artist) that inherits from the corresponding classes
850attached to the current schema.
851
852It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
853new $schema object. If C<$additional_base_class> is given, the new composed
854classes will inherit from first the corresponding classe from the current
855schema then the base class.
856
857For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
858
859 $schema->compose_namespace('My::DB', 'Base::Class');
860 print join (', ', @My::DB::CD::ISA) . "\n";
861 print join (', ', @My::DB::Artist::ISA) ."\n";
862
863will produce the output
864
865 My::Schema::CD, Base::Class
866 My::Schema::Artist, Base::Class
867
868=cut
869
870# this might be oversimplified
871# sub compose_namespace {
872# my ($self, $target, $base) = @_;
873
874# my $schema = $self->clone;
875# foreach my $moniker ($schema->sources) {
876# my $source = $schema->source($moniker);
877# my $target_class = "${target}::${moniker}";
878# $self->inject_base(
879# $target_class => $source->result_class, ($base ? $base : ())
880# );
881# $source->result_class($target_class);
882# $target_class->result_source_instance($source)
883# if $target_class->can('result_source_instance');
884# $schema->register_source($moniker, $source);
885# }
886# return $schema;
887# }
888
889sub compose_namespace {
890 my ($self, $target, $base) = @_;
891 my $schema = $self->clone;
892 {
893 no warnings qw/redefine/;
894# local *Class::C3::reinitialize = sub { };
895 foreach my $moniker ($schema->sources) {
896 my $source = $schema->source($moniker);
897 my $target_class = "${target}::${moniker}";
898 $self->inject_base(
899 $target_class => $source->result_class, ($base ? $base : ())
900 );
901 $source->result_class($target_class);
902 $target_class->result_source_instance($source)
903 if $target_class->can('result_source_instance');
904 $schema->register_source($moniker, $source);
905 }
906 }
907# Class::C3->reinitialize();
908 {
909 no strict 'refs';
910 no warnings 'redefine';
911 foreach my $meth (qw/class source resultset/) {
8637bb24 912 *{"${target}::${meth}"} = Sub::Name::subname "${target}::${meth}" =>
829517d4 913 sub { shift->schema->$meth(@_) };
914 }
915 }
916 return $schema;
917}
918
919sub setup_connection_class {
920 my ($class, $target, @info) = @_;
921 $class->inject_base($target => 'DBIx::Class::DB');
922 #$target->load_components('DB');
923 $target->connection(@info);
924}
925
926=head2 svp_begin
927
928Creates a new savepoint (does nothing outside a transaction).
929Equivalent to calling $schema->storage->svp_begin. See
930L<DBIx::Class::Storage::DBI/"svp_begin"> for more information.
931
932=cut
933
934sub svp_begin {
935 my ($self, $name) = @_;
936
937 $self->storage or $self->throw_exception
938 ('svp_begin called on $schema without storage');
939
940 $self->storage->svp_begin($name);
941}
942
943=head2 svp_release
944
945Releases a savepoint (does nothing outside a transaction).
946Equivalent to calling $schema->storage->svp_release. See
947L<DBIx::Class::Storage::DBI/"svp_release"> for more information.
948
949=cut
950
951sub svp_release {
952 my ($self, $name) = @_;
953
954 $self->storage or $self->throw_exception
955 ('svp_release called on $schema without storage');
82cc0386 956
829517d4 957 $self->storage->svp_release($name);
958}
82cc0386 959
829517d4 960=head2 svp_rollback
db5dc233 961
829517d4 962Rollback to a savepoint (does nothing outside a transaction).
963Equivalent to calling $schema->storage->svp_rollback. See
964L<DBIx::Class::Storage::DBI/"svp_rollback"> for more information.
82cc0386 965
829517d4 966=cut
82cc0386 967
829517d4 968sub svp_rollback {
969 my ($self, $name) = @_;
82cc0386 970
829517d4 971 $self->storage or $self->throw_exception
972 ('svp_rollback called on $schema without storage');
82cc0386 973
829517d4 974 $self->storage->svp_rollback($name);
975}
db5dc233 976
829517d4 977=head2 clone
613397e7 978
84c5863b 979=over 4
613397e7 980
829517d4 981=item Return Value: $new_schema
613397e7 982
983=back
984
829517d4 985Clones the schema and its associated result_source objects and returns the
986copy.
987
988=cut
989
990sub clone {
991 my ($self) = @_;
992 my $clone = { (ref $self ? %$self : ()) };
993 bless $clone, (ref $self || $self);
994
995 $clone->class_mappings({ %{$clone->class_mappings} });
996 $clone->source_registrations({ %{$clone->source_registrations} });
997 foreach my $moniker ($self->sources) {
998 my $source = $self->source($moniker);
999 my $new = $source->new($source);
1000 # we use extra here as we want to leave the class_mappings as they are
1001 # but overwrite the source_registrations entry with the new source
1002 $clone->register_extra_source($moniker => $new);
1003 }
1004 $clone->storage->set_schema($clone) if $clone->storage;
1005 return $clone;
1006}
613397e7 1007
5160b401 1008=head2 throw_exception
701da8c4 1009
75d07914 1010=over 4
82b01c38 1011
ebc77b53 1012=item Arguments: $message
82b01c38 1013
1014=back
1015
1016Throws an exception. Defaults to using L<Carp::Clan> to report errors from
db5dc233 1017user's perspective. See L</exception_action> for details on overriding
4b946902 1018this method's behavior. If L</stacktrace> is turned on, C<throw_exception>'s
1019default behavior will provide a detailed stack trace.
701da8c4 1020
1021=cut
1022
1023sub throw_exception {
82cc0386 1024 my $self = shift;
4981dc70 1025
1026 DBIx::Class::Exception->throw($_[0], $self->stacktrace)
1027 if !$self->exception_action || !$self->exception_action->(@_);
701da8c4 1028}
1029
dfccde48 1030=head2 deploy
1c339d71 1031
82b01c38 1032=over 4
1033
10976519 1034=item Arguments: \%sqlt_args, $dir
82b01c38 1035
1036=back
1037
1038Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 1039
10976519 1040See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1041The most common value for this would be C<< { add_drop_table => 1 } >>
1042to have the SQL produced include a C<DROP TABLE> statement for each table
1043created. For quoting purposes supply C<quote_table_names> and
3e82fc27 1044C<quote_field_names>.
51bace1c 1045
499adf63 1046Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1047ref or an array ref, containing a list of source to deploy. If present, then
0e2c6809 1048only the sources listed will get deployed. Furthermore, you can use the
1049C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1050FK.
499adf63 1051
1c339d71 1052=cut
1053
1054sub deploy {
6e73ac25 1055 my ($self, $sqltargs, $dir) = @_;
1c339d71 1056 $self->throw_exception("Can't deploy without storage") unless $self->storage;
6e73ac25 1057 $self->storage->deploy($self, undef, $sqltargs, $dir);
1c339d71 1058}
1059
0e0ce6c1 1060=head2 deployment_statements
1061
1062=over 4
1063
10976519 1064=item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
0e0ce6c1 1065
829517d4 1066=item Return value: $listofstatements
1067
0e0ce6c1 1068=back
1069
10976519 1070A convenient shortcut to
1071C<< $self->storage->deployment_statements($self, @args) >>.
1072Returns the SQL statements used by L</deploy> and
1073L<DBIx::Class::Schema::Storage/deploy>.
0e0ce6c1 1074
1075=cut
1076
1077sub deployment_statements {
7ad93f5a 1078 my $self = shift;
0e0ce6c1 1079
1080 $self->throw_exception("Can't generate deployment statements without a storage")
1081 if not $self->storage;
1082
7ad93f5a 1083 $self->storage->deployment_statements($self, @_);
0e0ce6c1 1084}
1085
6dfbe2f8 1086=head2 create_ddl_dir
c0f61310 1087
1088=over 4
1089
10976519 1090=item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
c0f61310 1091
1092=back
1093
10976519 1094A convenient shortcut to
1095C<< $self->storage->create_ddl_dir($self, @args) >>.
c9d2e0a2 1096
10976519 1097Creates an SQL file based on the Schema, for each of the specified
1098database types, in the given directory.
c9d2e0a2 1099
c0f61310 1100=cut
1101
6e73ac25 1102sub create_ddl_dir {
e673f011 1103 my $self = shift;
1104
1105 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1106 $self->storage->create_ddl_dir($self, @_);
1107}
1108
e63a82f7 1109=head2 ddl_filename
9b83fccd 1110
c9d2e0a2 1111=over 4
1112
99a74c4a 1113=item Arguments: $database-type, $version, $directory, $preversion
c9d2e0a2 1114
829517d4 1115=item Return value: $normalised_filename
1116
c9d2e0a2 1117=back
1118
99a74c4a 1119 my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
c9d2e0a2 1120
1121This method is called by C<create_ddl_dir> to compose a file name out of
1122the supplied directory, database type and version number. The default file
1123name format is: C<$dir$schema-$version-$type.sql>.
9b83fccd 1124
c9d2e0a2 1125You may override this method in your schema if you wish to use a different
1126format.
9b83fccd 1127
1acfef8e 1128 WARNING
1129
1130 Prior to DBIx::Class version 0.08100 this method had a different signature:
1131
1132 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1133
1134 In recent versions variables $dir and $version were reversed in order to
1135 bring the signature in line with other Schema/Storage methods. If you
1136 really need to maintain backward compatibility, you can do the following
1137 in any overriding methods:
1138
1139 ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1140
9b83fccd 1141=cut
1142
6e73ac25 1143sub ddl_filename {
99a74c4a 1144 my ($self, $type, $version, $dir, $preversion) = @_;
e673f011 1145
99a74c4a 1146 my $filename = ref($self);
1147 $filename =~ s/::/-/g;
1148 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1149 $filename =~ s/$version/$preversion-$version/ if($preversion);
d4daee7b 1150
99a74c4a 1151 return $filename;
e673f011 1152}
1153
4146e3da 1154=head2 thaw
1155
829517d4 1156Provided as the recommended way of thawing schema objects. You can call
4146e3da 1157C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1158reference to any schema, so are rather useless
1159
1160=cut
1161
1162sub thaw {
1163 my ($self, $obj) = @_;
1164 local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1165 return Storable::thaw($obj);
1166}
1167
1168=head2 freeze
1169
1170This doesn't actualy do anything more than call L<Storable/freeze>, it is just
1171provided here for symetry.
1172
d2f3e87b 1173=cut
1174
4146e3da 1175sub freeze {
1176 return Storable::freeze($_[1]);
1177}
1178
1179=head2 dclone
1180
1477a478 1181=over 4
1182
1183=item Arguments: $object
1184
1185=item Return Value: dcloned $object
1186
1187=back
1188
9e9ecfda 1189Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1190objects so their references to the schema object
1191(which itself is B<not> cloned) are properly maintained.
4146e3da 1192
1193=cut
1194
1195sub dclone {
1196 my ($self, $obj) = @_;
1197 local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1198 return Storable::dclone($obj);
1199}
1200
93e4d41a 1201=head2 schema_version
1202
829517d4 1203Returns the current schema class' $VERSION in a normalised way.
93e4d41a 1204
1205=cut
1206
1207sub schema_version {
1208 my ($self) = @_;
1209 my $class = ref($self)||$self;
1210
1211 # does -not- use $schema->VERSION
1212 # since that varies in results depending on if version.pm is installed, and if
1213 # so the perl or XS versions. If you want this to change, bug the version.pm
1214 # author to make vpp and vxs behave the same.
1215
1216 my $version;
1217 {
1218 no strict 'refs';
1219 $version = ${"${class}::VERSION"};
1220 }
1221 return $version;
1222}
1223
829517d4 1224
1225=head2 register_class
1226
1227=over 4
1228
1229=item Arguments: $moniker, $component_class
1230
1231=back
1232
1233This method is called by L</load_namespaces> and L</load_classes> to install the found classes into your Schema. You should be using those instead of this one.
1234
1235You will only need this method if you have your Result classes in
1236files which are not named after the packages (or all in the same
1237file). You may also need it to register classes at runtime.
1238
1239Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1240calling:
1241
1242 $schema->register_source($moniker, $component_class->result_source_instance);
1243
1244=cut
1245
1246sub register_class {
1247 my ($self, $moniker, $to_register) = @_;
1e36ef62 1248 $self->register_source($moniker => $to_register->result_source_instance);
829517d4 1249}
1250
1251=head2 register_source
1252
1253=over 4
1254
1255=item Arguments: $moniker, $result_source
1256
1257=back
1258
1259This method is called by L</register_class>.
1260
1261Registers the L<DBIx::Class::ResultSource> in the schema with the given
1262moniker.
1263
1264=cut
1265
1266sub register_source {
1267 my $self = shift;
1268
1269 $self->_register_source(@_);
1270}
1271
98cabed3 1272=head2 unregister_source
1273
1274=over 4
1275
1276=item Arguments: $moniker
1277
1278=back
1279
1280Removes the L<DBIx::Class::ResultSource> from the schema for the given moniker.
1281
1282=cut
1283
1284sub unregister_source {
1285 my $self = shift;
1286
1287 $self->_unregister_source(@_);
1288}
1289
829517d4 1290=head2 register_extra_source
1291
1292=over 4
1293
1294=item Arguments: $moniker, $result_source
1295
1296=back
1297
1298As L</register_source> but should be used if the result class already
1299has a source and you want to register an extra one.
1300
1301=cut
1302
1303sub register_extra_source {
1304 my $self = shift;
1305
1306 $self->_register_source(@_, { extra => 1 });
1307}
1308
1309sub _register_source {
1310 my ($self, $moniker, $source, $params) = @_;
1311
6d4f9d94 1312 my $orig_source = $source;
2461ae19 1313
0e6c5d58 1314 $source = $source->new({ %$source, source_name => $moniker });
2461ae19 1315 $source->schema($self);
551e711a 1316 Scalar::Util::weaken($source->{schema}) if ref($self);
2461ae19 1317
1318 my $rs_class = $source->result_class;
829517d4 1319
1320 my %reg = %{$self->source_registrations};
1321 $reg{$moniker} = $source;
1322 $self->source_registrations(\%reg);
1323
829517d4 1324 return if ($params->{extra});
5dfe40b8 1325 return unless defined($rs_class) && $rs_class->can('result_source_instance');
829517d4 1326
2461ae19 1327 my %map = %{$self->class_mappings};
f18d2d04 1328 if (
1329 exists $map{$rs_class}
1330 and
1331 $map{$rs_class} ne $moniker
1332 and
1333 $rs_class->result_source_instance ne $orig_source
1334 ) {
2461ae19 1335 carp "$rs_class already has a source, use register_extra_source for additional sources";
829517d4 1336 }
2461ae19 1337 $map{$rs_class} = $moniker;
1338 $self->class_mappings(\%map);
829517d4 1339}
1340
1341sub _unregister_source {
1342 my ($self, $moniker) = @_;
1343 my %reg = %{$self->source_registrations};
1344
1345 my $source = delete $reg{$moniker};
1346 $self->source_registrations(\%reg);
1347 if ($source->result_class) {
1348 my %map = %{$self->class_mappings};
1349 delete $map{$source->result_class};
1350 $self->class_mappings(\%map);
1351 }
1352}
1353
1354
1355=head2 compose_connection (DEPRECATED)
1356
1357=over 4
1358
1359=item Arguments: $target_namespace, @db_info
1360
1361=item Return Value: $new_schema
1362
1363=back
1364
1365DEPRECATED. You probably wanted compose_namespace.
1366
1367Actually, you probably just wanted to call connect.
1368
1369=begin hidden
1370
1371(hidden due to deprecation)
1372
1373Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1374calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1375then injects the L<DBix::Class::ResultSetProxy> component and a
1376resultset_instance classdata entry on all the new classes, in order to support
1377$target_namespaces::$class->search(...) method calls.
1378
1379This is primarily useful when you have a specific need for class method access
1380to a connection. In normal usage it is preferred to call
1381L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1382on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1383more information.
1384
1385=end hidden
1386
1387=cut
1388
1389{
1390 my $warn;
1391
1392 sub compose_connection {
1393 my ($self, $target, @info) = @_;
1394
341d5ede 1395 carp "compose_connection deprecated as of 0.08000"
829517d4 1396 unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
1397
1398 my $base = 'DBIx::Class::ResultSetProxy';
1399 eval "require ${base};";
1400 $self->throw_exception
1401 ("No arguments to load_classes and couldn't load ${base} ($@)")
1402 if $@;
d4daee7b 1403
829517d4 1404 if ($self eq $target) {
1405 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1406 foreach my $moniker ($self->sources) {
1407 my $source = $self->source($moniker);
1408 my $class = $source->result_class;
1409 $self->inject_base($class, $base);
1410 $class->mk_classdata(resultset_instance => $source->resultset);
1411 $class->mk_classdata(class_resolver => $self);
1412 }
1413 $self->connection(@info);
1414 return $self;
1415 }
d4daee7b 1416
829517d4 1417 my $schema = $self->compose_namespace($target, $base);
1418 {
1419 no strict 'refs';
1420 my $name = join '::', $target, 'schema';
1421 *$name = Sub::Name::subname $name, sub { $schema };
1422 }
d4daee7b 1423
829517d4 1424 $schema->connection(@info);
1425 foreach my $moniker ($schema->sources) {
1426 my $source = $schema->source($moniker);
1427 my $class = $source->result_class;
1428 #warn "$moniker $class $source ".$source->storage;
1429 $class->mk_classdata(result_source_instance => $source);
1430 $class->mk_classdata(resultset_instance => $source->resultset);
1431 $class->mk_classdata(class_resolver => $schema);
1432 }
1433 return $schema;
1434 }
1435}
1436
a02675cd 14371;
c2da098a 1438
c2da098a 1439=head1 AUTHORS
1440
daec44b8 1441Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 1442
1443=head1 LICENSE
1444
1445You may distribute this code under the same terms as Perl itself.
1446
1447=cut