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