Redo badly named constant folding arg introduced in 8d73fcd4
[dbsrgits/DBIx-Class-Historic.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);
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 = shift;
1059
1060   if (my $act = $self->exception_action) {
1061     if ($act->(@_)) {
1062       DBIx::Class::Exception->throw(
1063           "Invocation of the exception_action handler installed on $self did *not*"
1064         .' result in an exception. DBIx::Class is unable to function without a reliable'
1065         .' exception mechanism, ensure that exception_action does not hide exceptions'
1066         ." (original error: $_[0])"
1067       );
1068     }
1069
1070     carp_unique (
1071       "The exception_action handler installed on $self returned false instead"
1072     .' of throwing an exception. This behavior has been deprecated, adjust your'
1073     .' handler to always rethrow the supplied error.'
1074     );
1075   }
1076
1077   DBIx::Class::Exception->throw($_[0], $self->stacktrace);
1078 }
1079
1080 =head2 deploy
1081
1082 =over 4
1083
1084 =item Arguments: \%sqlt_args, $dir
1085
1086 =back
1087
1088 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
1089
1090 See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1091 The most common value for this would be C<< { add_drop_table => 1 } >>
1092 to have the SQL produced include a C<DROP TABLE> statement for each table
1093 created. For quoting purposes supply C<quote_identifiers>.
1094
1095 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1096 ref or an array ref, containing a list of source to deploy. If present, then
1097 only the sources listed will get deployed. Furthermore, you can use the
1098 C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1099 FK.
1100
1101 =cut
1102
1103 sub deploy {
1104   my ($self, $sqltargs, $dir) = @_;
1105   $self->throw_exception("Can't deploy without storage") unless $self->storage;
1106   $self->storage->deploy($self, undef, $sqltargs, $dir);
1107 }
1108
1109 =head2 deployment_statements
1110
1111 =over 4
1112
1113 =item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
1114
1115 =item Return Value: $listofstatements
1116
1117 =back
1118
1119 A convenient shortcut to
1120 C<< $self->storage->deployment_statements($self, @args) >>.
1121 Returns the statements used by L</deploy> and
1122 L<DBIx::Class::Storage/deploy>.
1123
1124 =cut
1125
1126 sub deployment_statements {
1127   my $self = shift;
1128
1129   $self->throw_exception("Can't generate deployment statements without a storage")
1130     if not $self->storage;
1131
1132   $self->storage->deployment_statements($self, @_);
1133 }
1134
1135 =head2 create_ddl_dir
1136
1137 =over 4
1138
1139 =item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
1140
1141 =back
1142
1143 A convenient shortcut to
1144 C<< $self->storage->create_ddl_dir($self, @args) >>.
1145
1146 Creates an SQL file based on the Schema, for each of the specified
1147 database types, in the given directory.
1148
1149 =cut
1150
1151 sub create_ddl_dir {
1152   my $self = shift;
1153
1154   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1155   $self->storage->create_ddl_dir($self, @_);
1156 }
1157
1158 =head2 ddl_filename
1159
1160 =over 4
1161
1162 =item Arguments: $database-type, $version, $directory, $preversion
1163
1164 =item Return Value: $normalised_filename
1165
1166 =back
1167
1168   my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
1169
1170 This method is called by C<create_ddl_dir> to compose a file name out of
1171 the supplied directory, database type and version number. The default file
1172 name format is: C<$dir$schema-$version-$type.sql>.
1173
1174 You may override this method in your schema if you wish to use a different
1175 format.
1176
1177  WARNING
1178
1179  Prior to DBIx::Class version 0.08100 this method had a different signature:
1180
1181     my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1182
1183  In recent versions variables $dir and $version were reversed in order to
1184  bring the signature in line with other Schema/Storage methods. If you
1185  really need to maintain backward compatibility, you can do the following
1186  in any overriding methods:
1187
1188     ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1189
1190 =cut
1191
1192 sub ddl_filename {
1193   my ($self, $type, $version, $dir, $preversion) = @_;
1194
1195   require File::Spec;
1196
1197   $version = "$preversion-$version" if $preversion;
1198
1199   my $class = blessed($self) || $self;
1200   $class =~ s/::/-/g;
1201
1202   return File::Spec->catfile($dir, "$class-$version-$type.sql");
1203 }
1204
1205 =head2 thaw
1206
1207 Provided as the recommended way of thawing schema objects. You can call
1208 C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1209 reference to any schema, so are rather useless.
1210
1211 =cut
1212
1213 sub thaw {
1214   my ($self, $obj) = @_;
1215   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1216   return Storable::thaw($obj);
1217 }
1218
1219 =head2 freeze
1220
1221 This doesn't actually do anything beyond calling L<nfreeze|Storable/SYNOPSIS>,
1222 it is just provided here for symmetry.
1223
1224 =cut
1225
1226 sub freeze {
1227   return Storable::nfreeze($_[1]);
1228 }
1229
1230 =head2 dclone
1231
1232 =over 4
1233
1234 =item Arguments: $object
1235
1236 =item Return Value: dcloned $object
1237
1238 =back
1239
1240 Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1241 objects so their references to the schema object
1242 (which itself is B<not> cloned) are properly maintained.
1243
1244 =cut
1245
1246 sub dclone {
1247   my ($self, $obj) = @_;
1248   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1249   return Storable::dclone($obj);
1250 }
1251
1252 =head2 schema_version
1253
1254 Returns the current schema class' $VERSION in a normalised way.
1255
1256 =cut
1257
1258 sub schema_version {
1259   my ($self) = @_;
1260   my $class = ref($self)||$self;
1261
1262   # does -not- use $schema->VERSION
1263   # since that varies in results depending on if version.pm is installed, and if
1264   # so the perl or XS versions. If you want this to change, bug the version.pm
1265   # author to make vpp and vxs behave the same.
1266
1267   my $version;
1268   {
1269     no strict 'refs';
1270     $version = ${"${class}::VERSION"};
1271   }
1272   return $version;
1273 }
1274
1275
1276 =head2 register_class
1277
1278 =over 4
1279
1280 =item Arguments: $source_name, $component_class
1281
1282 =back
1283
1284 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.
1285
1286 You will only need this method if you have your Result classes in
1287 files which are not named after the packages (or all in the same
1288 file). You may also need it to register classes at runtime.
1289
1290 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1291 calling:
1292
1293   $schema->register_source($source_name, $component_class->result_source_instance);
1294
1295 =cut
1296
1297 sub register_class {
1298   my ($self, $source_name, $to_register) = @_;
1299   $self->register_source($source_name => $to_register->result_source_instance);
1300 }
1301
1302 =head2 register_source
1303
1304 =over 4
1305
1306 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1307
1308 =back
1309
1310 This method is called by L</register_class>.
1311
1312 Registers the L<DBIx::Class::ResultSource> in the schema with the given
1313 source name.
1314
1315 =cut
1316
1317 sub register_source { shift->_register_source(@_) }
1318
1319 =head2 unregister_source
1320
1321 =over 4
1322
1323 =item Arguments: $source_name
1324
1325 =back
1326
1327 Removes the L<DBIx::Class::ResultSource> from the schema for the given source name.
1328
1329 =cut
1330
1331 sub unregister_source { shift->_unregister_source(@_) }
1332
1333 =head2 register_extra_source
1334
1335 =over 4
1336
1337 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1338
1339 =back
1340
1341 As L</register_source> but should be used if the result class already
1342 has a source and you want to register an extra one.
1343
1344 =cut
1345
1346 sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
1347
1348 sub _register_source {
1349   my ($self, $source_name, $source, $params) = @_;
1350
1351   $source = $source->new({ %$source, source_name => $source_name });
1352
1353   $source->schema($self);
1354   weaken $source->{schema} if ref($self);
1355
1356   my %reg = %{$self->source_registrations};
1357   $reg{$source_name} = $source;
1358   $self->source_registrations(\%reg);
1359
1360   return $source if $params->{extra};
1361
1362   my $rs_class = $source->result_class;
1363   if ($rs_class and my $rsrc = try { $rs_class->result_source_instance } ) {
1364     my %map = %{$self->class_mappings};
1365     if (
1366       exists $map{$rs_class}
1367         and
1368       $map{$rs_class} ne $source_name
1369         and
1370       $rsrc ne $_[2]  # orig_source
1371     ) {
1372       carp
1373         "$rs_class already had a registered source which was replaced by this call. "
1374       . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
1375       . 'something wrong.'
1376       ;
1377     }
1378
1379     $map{$rs_class} = $source_name;
1380     $self->class_mappings(\%map);
1381   }
1382
1383   return $source;
1384 }
1385
1386 my $global_phase_destroy;
1387 sub DESTROY {
1388   ### NO detected_reinvoked_destructor check
1389   ### This code very much relies on being called multuple times
1390
1391   return if $global_phase_destroy ||= in_global_destruction;
1392
1393   my $self = shift;
1394   my $srcs = $self->source_registrations;
1395
1396   for my $source_name (keys %$srcs) {
1397     # find first source that is not about to be GCed (someone other than $self
1398     # holds a reference to it) and reattach to it, weakening our own link
1399     #
1400     # during global destruction (if we have not yet bailed out) this should throw
1401     # which will serve as a signal to not try doing anything else
1402     # however beware - on older perls the exception seems randomly untrappable
1403     # due to some weird race condition during thread joining :(((
1404     if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
1405       local $@;
1406       eval {
1407         $srcs->{$source_name}->schema($self);
1408         weaken $srcs->{$source_name};
1409         1;
1410       } or do {
1411         $global_phase_destroy = 1;
1412       };
1413
1414       last;
1415     }
1416   }
1417 }
1418
1419 sub _unregister_source {
1420     my ($self, $source_name) = @_;
1421     my %reg = %{$self->source_registrations};
1422
1423     my $source = delete $reg{$source_name};
1424     $self->source_registrations(\%reg);
1425     if ($source->result_class) {
1426         my %map = %{$self->class_mappings};
1427         delete $map{$source->result_class};
1428         $self->class_mappings(\%map);
1429     }
1430 }
1431
1432
1433 =head2 compose_connection (DEPRECATED)
1434
1435 =over 4
1436
1437 =item Arguments: $target_namespace, @db_info
1438
1439 =item Return Value: $new_schema
1440
1441 =back
1442
1443 DEPRECATED. You probably wanted compose_namespace.
1444
1445 Actually, you probably just wanted to call connect.
1446
1447 =begin hidden
1448
1449 (hidden due to deprecation)
1450
1451 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1452 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1453 then injects the L<DBix::Class::ResultSetProxy> component and a
1454 resultset_instance classdata entry on all the new classes, in order to support
1455 $target_namespaces::$class->search(...) method calls.
1456
1457 This is primarily useful when you have a specific need for class method access
1458 to a connection. In normal usage it is preferred to call
1459 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1460 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1461 more information.
1462
1463 =end hidden
1464
1465 =cut
1466
1467 sub compose_connection {
1468   my ($self, $target, @info) = @_;
1469
1470   carp_once "compose_connection deprecated as of 0.08000"
1471     unless $INC{"DBIx/Class/CDBICompat.pm"};
1472
1473   try {
1474     require DBIx::Class::ResultSetProxy;
1475   }
1476   catch {
1477     $self->throw_exception
1478       ("No arguments to load_classes and couldn't load DBIx::Class::ResultSetProxy ($_)")
1479   };
1480
1481   if ($self eq $target) {
1482     # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1483     foreach my $source_name ($self->sources) {
1484       my $source = $self->source($source_name);
1485       my $class = $source->result_class;
1486       $self->inject_base($class, 'DBIx::Class::ResultSetProxy');
1487       $class->mk_classdata(resultset_instance => $source->resultset);
1488       $class->mk_classdata(class_resolver => $self);
1489     }
1490     $self->connection(@info);
1491     return $self;
1492   }
1493
1494   my $schema = $self->compose_namespace($target, 'DBIx::Class::ResultSetProxy');
1495   quote_sub "${target}::schema", '$s', { '$s' => \$schema };
1496
1497   $schema->connection(@info);
1498   foreach my $source_name ($schema->sources) {
1499     my $source = $schema->source($source_name);
1500     my $class = $source->result_class;
1501     #warn "$source_name $class $source ".$source->storage;
1502     $class->mk_classdata(result_source_instance => $source);
1503     $class->mk_classdata(resultset_instance => $source->resultset);
1504     $class->mk_classdata(class_resolver => $schema);
1505   }
1506   return $schema;
1507 }
1508
1509 =head1 FURTHER QUESTIONS?
1510
1511 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1512
1513 =head1 COPYRIGHT AND LICENSE
1514
1515 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1516 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1517 redistribute it and/or modify it under the same terms as the
1518 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1519
1520 =cut
1521
1522 1;