ResultSetColumn::func() now returns all results if called in list context
[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 DBIx::Class::Exception;
7 use Carp::Clan qw/^DBIx::Class/;
8 use Scalar::Util qw/weaken/;
9 use File::Spec;
10 require Module::Find;
11
12 use base qw/DBIx::Class/;
13
14 __PACKAGE__->mk_classdata('class_mappings' => {});
15 __PACKAGE__->mk_classdata('source_registrations' => {});
16 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
17 __PACKAGE__->mk_classdata('storage');
18 __PACKAGE__->mk_classdata('exception_action');
19 __PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
20 __PACKAGE__->mk_classdata('default_resultset_attributes' => {});
21
22 =head1 NAME
23
24 DBIx::Class::Schema - composable schemas
25
26 =head1 SYNOPSIS
27
28   package Library::Schema;
29   use base qw/DBIx::Class::Schema/;
30
31   # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
32   __PACKAGE__->load_classes(qw/CD Book DVD/);
33
34   package Library::Schema::CD;
35   use base qw/DBIx::Class/;
36   __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
37   __PACKAGE__->table('cd');
38
39   # Elsewhere in your code:
40   my $schema1 = Library::Schema->connect(
41     $dsn,
42     $user,
43     $password,
44     { AutoCommit => 0 },
45   );
46
47   my $schema2 = Library::Schema->connect($coderef_returning_dbh);
48
49   # fetch objects using Library::Schema::DVD
50   my $resultset = $schema1->resultset('DVD')->search( ... );
51   my @dvd_objects = $schema2->resultset('DVD')->search( ... );
52
53 =head1 DESCRIPTION
54
55 Creates database classes based on a schema. This is the recommended way to
56 use L<DBIx::Class> and allows you to use more than one concurrent connection
57 with your classes.
58
59 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
60 carefully, as DBIx::Class does things a little differently. Note in
61 particular which module inherits off which.
62
63 =head1 METHODS
64
65 =head2 register_class
66
67 =over 4
68
69 =item Arguments: $moniker, $component_class
70
71 =back
72
73 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
74 calling:
75
76   $schema->register_source($moniker, $component_class->result_source_instance);
77
78 =cut
79
80 sub register_class {
81   my ($self, $moniker, $to_register) = @_;
82   $self->register_source($moniker => $to_register->result_source_instance);
83 }
84
85 =head2 register_source
86
87 =over 4
88
89 =item Arguments: $moniker, $result_source
90
91 =back
92
93 Registers the L<DBIx::Class::ResultSource> in the schema with the given
94 moniker.
95
96 =cut
97
98 sub register_source {
99   my ($self, $moniker, $source) = @_;
100
101   %$source = %{ $source->new( { %$source, source_name => $moniker }) };
102
103   my %reg = %{$self->source_registrations};
104   $reg{$moniker} = $source;
105   $self->source_registrations(\%reg);
106
107   $source->schema($self);
108
109   weaken($source->{schema}) if ref($self);
110   if ($source->result_class) {
111     my %map = %{$self->class_mappings};
112     $map{$source->result_class} = $moniker;
113     $self->class_mappings(\%map);
114   }
115 }
116
117 sub _unregister_source {
118     my ($self, $moniker) = @_;
119     my %reg = %{$self->source_registrations}; 
120
121     my $source = delete $reg{$moniker};
122     $self->source_registrations(\%reg);
123     if ($source->result_class) {
124         my %map = %{$self->class_mappings};
125         delete $map{$source->result_class};
126         $self->class_mappings(\%map);
127     }
128 }
129
130 =head2 class
131
132 =over 4
133
134 =item Arguments: $moniker
135
136 =item Return Value: $classname
137
138 =back
139
140 Retrieves the result class name for the given moniker. For example:
141
142   my $class = $schema->class('CD');
143
144 =cut
145
146 sub class {
147   my ($self, $moniker) = @_;
148   return $self->source($moniker)->result_class;
149 }
150
151 =head2 source
152
153 =over 4
154
155 =item Arguments: $moniker
156
157 =item Return Value: $result_source
158
159 =back
160
161   my $source = $schema->source('Book');
162
163 Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
164
165 =cut
166
167 sub source {
168   my ($self, $moniker) = @_;
169   my $sreg = $self->source_registrations;
170   return $sreg->{$moniker} if exists $sreg->{$moniker};
171
172   # if we got here, they probably passed a full class name
173   my $mapped = $self->class_mappings->{$moniker};
174   $self->throw_exception("Can't find source for ${moniker}")
175     unless $mapped && exists $sreg->{$mapped};
176   return $sreg->{$mapped};
177 }
178
179 =head2 sources
180
181 =over 4
182
183 =item Return Value: @source_monikers
184
185 =back
186
187 Returns the source monikers of all source registrations on this schema.
188 For example:
189
190   my @source_monikers = $schema->sources;
191
192 =cut
193
194 sub sources { return keys %{shift->source_registrations}; }
195
196 =head2 storage
197
198   my $storage = $schema->storage;
199
200 Returns the L<DBIx::Class::Storage> object for this Schema.
201
202 =head2 resultset
203
204 =over 4
205
206 =item Arguments: $moniker
207
208 =item Return Value: $result_set
209
210 =back
211
212   my $rs = $schema->resultset('DVD');
213
214 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
215
216 =cut
217
218 sub resultset {
219   my ($self, $moniker) = @_;
220   return $self->source($moniker)->resultset;
221 }
222
223 =head2 load_classes
224
225 =over 4
226
227 =item Arguments: @classes?, { $namespace => [ @classes ] }+
228
229 =back
230
231 With no arguments, this method uses L<Module::Find> to find all classes under
232 the schema's namespace. Otherwise, this method loads the classes you specify
233 (using L<use>), and registers them (using L</"register_class">).
234
235 It is possible to comment out classes with a leading C<#>, but note that perl
236 will think it's a mistake (trying to use a comment in a qw list), so you'll
237 need to add C<no warnings 'qw';> before your load_classes call.
238
239 Example:
240
241   My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
242                               # etc. (anything under the My::Schema namespace)
243
244   # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
245   # not Other::Namespace::LinerNotes nor My::Schema::Track
246   My::Schema->load_classes(qw/ CD Artist #Track /, {
247     Other::Namespace => [qw/ Producer #LinerNotes /],
248   });
249
250 =cut
251
252 sub load_classes {
253   my ($class, @params) = @_;
254
255   my %comps_for;
256
257   if (@params) {
258     foreach my $param (@params) {
259       if (ref $param eq 'ARRAY') {
260         # filter out commented entries
261         my @modules = grep { $_ !~ /^#/ } @$param;
262
263         push (@{$comps_for{$class}}, @modules);
264       }
265       elsif (ref $param eq 'HASH') {
266         # more than one namespace possible
267         for my $comp ( keys %$param ) {
268           # filter out commented entries
269           my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
270
271           push (@{$comps_for{$comp}}, @modules);
272         }
273       }
274       else {
275         # filter out commented entries
276         push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
277       }
278     }
279   } else {
280     my @comp = map { substr $_, length "${class}::"  }
281                  Module::Find::findallmod($class);
282     $comps_for{$class} = \@comp;
283   }
284
285   my @to_register;
286   {
287     no warnings qw/redefine/;
288     local *Class::C3::reinitialize = sub { };
289     foreach my $prefix (keys %comps_for) {
290       foreach my $comp (@{$comps_for{$prefix}||[]}) {
291         my $comp_class = "${prefix}::${comp}";
292         { # try to untaint module name. mods where this fails
293           # are left alone so we don't have to change the old behavior
294           no locale; # localized \w doesn't untaint expression
295           if ( $comp_class =~ m/^( (?:\w+::)* \w+ )$/x ) {
296             $comp_class = $1;
297           }
298         }
299         $class->ensure_class_loaded($comp_class);
300
301         $comp = $comp_class->source_name || $comp;
302 #  $DB::single = 1;
303         push(@to_register, [ $comp, $comp_class ]);
304       }
305     }
306   }
307   Class::C3->reinitialize;
308
309   foreach my $to (@to_register) {
310     $class->register_class(@$to);
311     #  if $class->can('result_source_instance');
312   }
313 }
314
315 =head2 load_namespaces
316
317 =over 4
318
319 =item Arguments: %options?
320
321 =back
322
323 This is an alternative to L</load_classes> above which assumes an alternative
324 layout for automatic class loading.  It assumes that all result
325 classes are underneath a sub-namespace of the schema called C<Result>, any
326 corresponding ResultSet classes are underneath a sub-namespace of the schema
327 called C<ResultSet>.
328
329 Both of the sub-namespaces are configurable if you don't like the defaults,
330 via the options C<result_namespace> and C<resultset_namespace>.
331
332 If (and only if) you specify the option C<default_resultset_class>, any found
333 Result classes for which we do not find a corresponding
334 ResultSet class will have their C<resultset_class> set to
335 C<default_resultset_class>.
336
337 C<load_namespaces> takes care of calling C<resultset_class> for you where
338 neccessary if you didn't do it for yourself.
339
340 All of the namespace and classname options to this method are relative to
341 the schema classname by default.  To specify a fully-qualified name, prefix
342 it with a literal C<+>.
343
344 Examples:
345
346   # load My::Schema::Result::CD, My::Schema::Result::Artist,
347   #    My::Schema::ResultSet::CD, etc...
348   My::Schema->load_namespaces;
349
350   # Override everything to use ugly names.
351   # In this example, if there is a My::Schema::Res::Foo, but no matching
352   #   My::Schema::RSets::Foo, then Foo will have its
353   #   resultset_class set to My::Schema::RSetBase
354   My::Schema->load_namespaces(
355     result_namespace => 'Res',
356     resultset_namespace => 'RSets',
357     default_resultset_class => 'RSetBase',
358   );
359
360   # Put things in other namespaces
361   My::Schema->load_namespaces(
362     result_namespace => '+Some::Place::Results',
363     resultset_namespace => '+Another::Place::RSets',
364   );
365
366 If you'd like to use multiple namespaces of each type, simply use an arrayref
367 of namespaces for that option.  In the case that the same result
368 (or resultset) class exists in multiple namespaces, the latter entries in
369 your list of namespaces will override earlier ones.
370
371   My::Schema->load_namespaces(
372     # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
373     result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
374     resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
375   );
376
377 =cut
378
379 # Pre-pends our classname to the given relative classname or
380 #   class namespace, unless there is a '+' prefix, which will
381 #   be stripped.
382 sub _expand_relative_name {
383   my ($class, $name) = @_;
384   return if !$name;
385   $name = $class . '::' . $name if ! ($name =~ s/^\+//);
386   return $name;
387 }
388
389 # returns a hash of $shortname => $fullname for every package
390 #  found in the given namespaces ($shortname is with the $fullname's
391 #  namespace stripped off)
392 sub _map_namespaces {
393   my ($class, @namespaces) = @_;
394
395   my @results_hash;
396   foreach my $namespace (@namespaces) {
397     push(
398       @results_hash,
399       map { (substr($_, length "${namespace}::"), $_) }
400       Module::Find::findallmod($namespace)
401     );
402   }
403
404   @results_hash;
405 }
406
407 sub load_namespaces {
408   my ($class, %args) = @_;
409
410   my $result_namespace = delete $args{result_namespace} || 'Result';
411   my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
412   my $default_resultset_class = delete $args{default_resultset_class};
413
414   $class->throw_exception('load_namespaces: unknown option(s): '
415     . join(q{,}, map { qq{'$_'} } keys %args))
416       if scalar keys %args;
417
418   $default_resultset_class
419     = $class->_expand_relative_name($default_resultset_class);
420
421   for my $arg ($result_namespace, $resultset_namespace) {
422     $arg = [ $arg ] if !ref($arg) && $arg;
423
424     $class->throw_exception('load_namespaces: namespace arguments must be '
425       . 'a simple string or an arrayref')
426         if ref($arg) ne 'ARRAY';
427
428     $_ = $class->_expand_relative_name($_) for (@$arg);
429   }
430
431   my %results = $class->_map_namespaces(@$result_namespace);
432   my %resultsets = $class->_map_namespaces(@$resultset_namespace);
433
434   my @to_register;
435   {
436     no warnings 'redefine';
437     local *Class::C3::reinitialize = sub { };
438     use warnings 'redefine';
439
440     foreach my $result (keys %results) {
441       my $result_class = $results{$result};
442       $class->ensure_class_loaded($result_class);
443       $result_class->source_name($result) unless $result_class->source_name;
444
445       my $rs_class = delete $resultsets{$result};
446       my $rs_set = $result_class->resultset_class;
447       if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
448         if($rs_class && $rs_class ne $rs_set) {
449           warn "We found ResultSet class '$rs_class' for '$result', but it seems "
450              . "that you had already set '$result' to use '$rs_set' instead";
451         }
452       }
453       elsif($rs_class ||= $default_resultset_class) {
454         $class->ensure_class_loaded($rs_class);
455         $result_class->resultset_class($rs_class);
456       }
457
458       push(@to_register, [ $result_class->source_name, $result_class ]);
459     }
460   }
461
462   foreach (sort keys %resultsets) {
463     warn "load_namespaces found ResultSet class $_ with no "
464       . 'corresponding Result class';
465   }
466
467   Class::C3->reinitialize;
468   $class->register_class(@$_) for (@to_register);
469
470   return;
471 }
472
473 =head2 compose_connection (DEPRECATED)
474
475 =over 4
476
477 =item Arguments: $target_namespace, @db_info
478
479 =item Return Value: $new_schema
480
481 =back
482
483 DEPRECATED. You probably wanted compose_namespace.
484
485 Actually, you probably just wanted to call connect.
486
487 =for hidden due to deprecation
488
489 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
490 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
491 then injects the L<DBix::Class::ResultSetProxy> component and a
492 resultset_instance classdata entry on all the new classes, in order to support
493 $target_namespaces::$class->search(...) method calls.
494
495 This is primarily useful when you have a specific need for class method access
496 to a connection. In normal usage it is preferred to call
497 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
498 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
499 more information.
500
501 =cut
502
503 {
504   my $warn;
505
506   sub compose_connection {
507     my ($self, $target, @info) = @_;
508
509     warn "compose_connection deprecated as of 0.08000"
510       unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
511
512     my $base = 'DBIx::Class::ResultSetProxy';
513     eval "require ${base};";
514     $self->throw_exception
515       ("No arguments to load_classes and couldn't load ${base} ($@)")
516         if $@;
517   
518     if ($self eq $target) {
519       # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
520       foreach my $moniker ($self->sources) {
521         my $source = $self->source($moniker);
522         my $class = $source->result_class;
523         $self->inject_base($class, $base);
524         $class->mk_classdata(resultset_instance => $source->resultset);
525         $class->mk_classdata(class_resolver => $self);
526       }
527       $self->connection(@info);
528       return $self;
529     }
530   
531     my $schema = $self->compose_namespace($target, $base);
532     {
533       no strict 'refs';
534       *{"${target}::schema"} = sub { $schema };
535     }
536   
537     $schema->connection(@info);
538     foreach my $moniker ($schema->sources) {
539       my $source = $schema->source($moniker);
540       my $class = $source->result_class;
541       #warn "$moniker $class $source ".$source->storage;
542       $class->mk_classdata(result_source_instance => $source);
543       $class->mk_classdata(resultset_instance => $source->resultset);
544       $class->mk_classdata(class_resolver => $schema);
545     }
546     return $schema;
547   }
548 }
549
550 =head2 compose_namespace
551
552 =over 4
553
554 =item Arguments: $target_namespace, $additional_base_class?
555
556 =item Return Value: $new_schema
557
558 =back
559
560 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
561 class in the target namespace (e.g. $target_namespace::CD,
562 $target_namespace::Artist) that inherits from the corresponding classes
563 attached to the current schema.
564
565 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
566 new $schema object. If C<$additional_base_class> is given, the new composed
567 classes will inherit from first the corresponding classe from the current
568 schema then the base class.
569
570 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
571
572   $schema->compose_namespace('My::DB', 'Base::Class');
573   print join (', ', @My::DB::CD::ISA) . "\n";
574   print join (', ', @My::DB::Artist::ISA) ."\n";
575
576 will produce the output
577
578   My::Schema::CD, Base::Class
579   My::Schema::Artist, Base::Class
580
581 =cut
582
583 sub compose_namespace {
584   my ($self, $target, $base) = @_;
585   my $schema = $self->clone;
586   {
587     no warnings qw/redefine/;
588     local *Class::C3::reinitialize = sub { };
589     foreach my $moniker ($schema->sources) {
590       my $source = $schema->source($moniker);
591       my $target_class = "${target}::${moniker}";
592       $self->inject_base(
593         $target_class => $source->result_class, ($base ? $base : ())
594       );
595       $source->result_class($target_class);
596       $target_class->result_source_instance($source)
597         if $target_class->can('result_source_instance');
598     }
599   }
600   Class::C3->reinitialize();
601   {
602     no strict 'refs';
603     foreach my $meth (qw/class source resultset/) {
604       *{"${target}::${meth}"} =
605         sub { shift->schema->$meth(@_) };
606     }
607   }
608   return $schema;
609 }
610
611 =head2 setup_connection_class
612
613 =over 4
614
615 =item Arguments: $target, @info
616
617 =back
618
619 Sets up a database connection class to inject between the schema and the
620 subclasses that the schema creates.
621
622 =cut
623
624 sub setup_connection_class {
625   my ($class, $target, @info) = @_;
626   $class->inject_base($target => 'DBIx::Class::DB');
627   #$target->load_components('DB');
628   $target->connection(@info);
629 }
630
631 =head2 storage_type
632
633 =over 4
634
635 =item Arguments: $storage_type
636
637 =item Return Value: $storage_type
638
639 =back
640
641 Set the storage class that will be instantiated when L</connect> is called.
642 If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
643 assumed by L</connect>.  Defaults to C<::DBI>,
644 which is L<DBIx::Class::Storage::DBI>.
645
646 You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
647 in cases where the appropriate subclass is not autodetected, such as when
648 dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
649 C<::DBI::Sybase::MSSQL>.
650
651 =head2 connection
652
653 =over 4
654
655 =item Arguments: @args
656
657 =item Return Value: $new_schema
658
659 =back
660
661 Instantiates a new Storage object of type
662 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
663 $storage->connect_info. Sets the connection in-place on the schema.
664
665 See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
666 or L<DBIx::Class::Storage> in general.
667
668 =cut
669
670 sub connection {
671   my ($self, @info) = @_;
672   return $self if !@info && $self->storage;
673   my $storage_class = $self->storage_type;
674   $storage_class = 'DBIx::Class::Storage'.$storage_class
675     if $storage_class =~ m/^::/;
676   eval "require ${storage_class};";
677   $self->throw_exception(
678     "No arguments to load_classes and couldn't load ${storage_class} ($@)"
679   ) if $@;
680   my $storage = $storage_class->new($self);
681   $storage->connect_info(\@info);
682   $self->storage($storage);
683   return $self;
684 }
685
686 =head2 connect
687
688 =over 4
689
690 =item Arguments: @info
691
692 =item Return Value: $new_schema
693
694 =back
695
696 This is a convenience method. It is equivalent to calling
697 $schema->clone->connection(@info). See L</connection> and L</clone> for more
698 information.
699
700 =cut
701
702 sub connect { shift->clone->connection(@_) }
703
704 =head2 txn_do
705
706 =over 4
707
708 =item Arguments: C<$coderef>, @coderef_args?
709
710 =item Return Value: The return value of $coderef
711
712 =back
713
714 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
715 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
716 See L<DBIx::Class::Storage/"txn_do"> for more information.
717
718 This interface is preferred over using the individual methods L</txn_begin>,
719 L</txn_commit>, and L</txn_rollback> below.
720
721 =cut
722
723 sub txn_do {
724   my $self = shift;
725
726   $self->storage or $self->throw_exception
727     ('txn_do called on $schema without storage');
728
729   $self->storage->txn_do(@_);
730 }
731
732 =head2 txn_begin
733
734 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
735 calling $schema->storage->txn_begin. See
736 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
737
738 =cut
739
740 sub txn_begin {
741   my $self = shift;
742
743   $self->storage or $self->throw_exception
744     ('txn_begin called on $schema without storage');
745
746   $self->storage->txn_begin;
747 }
748
749 =head2 txn_commit
750
751 Commits the current transaction. Equivalent to calling
752 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
753 for more information.
754
755 =cut
756
757 sub txn_commit {
758   my $self = shift;
759
760   $self->storage or $self->throw_exception
761     ('txn_commit called on $schema without storage');
762
763   $self->storage->txn_commit;
764 }
765
766 =head2 txn_rollback
767
768 Rolls back the current transaction. Equivalent to calling
769 $schema->storage->txn_rollback. See
770 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
771
772 =cut
773
774 sub txn_rollback {
775   my $self = shift;
776
777   $self->storage or $self->throw_exception
778     ('txn_rollback called on $schema without storage');
779
780   $self->storage->txn_rollback;
781 }
782
783 =head2 clone
784
785 =over 4
786
787 =item Return Value: $new_schema
788
789 =back
790
791 Clones the schema and its associated result_source objects and returns the
792 copy.
793
794 =cut
795
796 sub clone {
797   my ($self) = @_;
798   my $clone = { (ref $self ? %$self : ()) };
799   bless $clone, (ref $self || $self);
800
801   foreach my $moniker ($self->sources) {
802     my $source = $self->source($moniker);
803     my $new = $source->new($source);
804     $clone->register_source($moniker => $new);
805   }
806   $clone->storage->set_schema($clone) if $clone->storage;
807   return $clone;
808 }
809
810 =head2 populate
811
812 =over 4
813
814 =item Arguments: $source_name, \@data;
815
816 =back
817
818 Pass this method a resultsource name, and an arrayref of
819 arrayrefs. The arrayrefs should contain a list of column names,
820 followed by one or many sets of matching data for the given columns. 
821
822 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
823 to insert the data, as this is a fast method. However, insert_bulk currently
824 assumes that your datasets all contain the same type of values, using scalar
825 references in a column in one row, and not in another will probably not work.
826
827 Otherwise, each set of data is inserted into the database using
828 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
829 objects is returned.
830
831 i.e.,
832
833   $schema->populate('Artist', [
834     [ qw/artistid name/ ],
835     [ 1, 'Popular Band' ],
836     [ 2, 'Indie Band' ],
837     ...
838   ]);
839   
840 Since wantarray context is basically the same as looping over $rs->create(...) 
841 you won't see any performance benefits and in this case the method is more for
842 convenience. Void context sends the column information directly to storage
843 using <DBI>s bulk insert method. So the performance will be much better for 
844 storages that support this method.
845
846 Because of this difference in the way void context inserts rows into your 
847 database you need to note how this will effect any loaded components that
848 override or augment insert.  For example if you are using a component such 
849 as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use 
850 wantarray context if you want the PKs automatically created.
851
852 =cut
853
854 sub populate {
855   my ($self, $name, $data) = @_;
856   my $rs = $self->resultset($name);
857   my @names = @{shift(@$data)};
858   if(defined wantarray) {
859     my @created;
860     foreach my $item (@$data) {
861       my %create;
862       @create{@names} = @$item;
863       push(@created, $rs->create(\%create));
864     }
865     return @created;
866   }
867   my @results_to_create;
868   foreach my $datum (@$data) {
869     my %result_to_create;
870     foreach my $index (0..$#names) {
871       $result_to_create{$names[$index]} = $$datum[$index];
872     }
873     push @results_to_create, \%result_to_create;
874   }
875   $rs->populate(\@results_to_create);
876 }
877
878 =head2 exception_action
879
880 =over 4
881
882 =item Arguments: $code_reference
883
884 =back
885
886 If C<exception_action> is set for this class/object, L</throw_exception>
887 will prefer to call this code reference with the exception as an argument,
888 rather than its normal C<croak> or C<confess> action.
889
890 Your subroutine should probably just wrap the error in the exception
891 object/class of your choosing and rethrow.  If, against all sage advice,
892 you'd like your C<exception_action> to suppress a particular exception
893 completely, simply have it return true.
894
895 Example:
896
897    package My::Schema;
898    use base qw/DBIx::Class::Schema/;
899    use My::ExceptionClass;
900    __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
901    __PACKAGE__->load_classes;
902
903    # or:
904    my $schema_obj = My::Schema->connect( .... );
905    $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
906
907    # suppress all exceptions, like a moron:
908    $schema_obj->exception_action(sub { 1 });
909
910 =head2 stacktrace
911
912 =over 4
913
914 =item Arguments: boolean
915
916 =back
917
918 Whether L</throw_exception> should include stack trace information.
919 Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}>
920 is true.
921
922 =head2 throw_exception
923
924 =over 4
925
926 =item Arguments: $message
927
928 =back
929
930 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
931 user's perspective.  See L</exception_action> for details on overriding
932 this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
933 default behavior will provide a detailed stack trace.
934
935 =cut
936
937 sub throw_exception {
938   my $self = shift;
939
940   DBIx::Class::Exception->throw($_[0], $self->stacktrace)
941     if !$self->exception_action || !$self->exception_action->(@_);
942 }
943
944 =head2 deploy
945
946 =over 4
947
948 =item Arguments: $sqlt_args, $dir
949
950 =back
951
952 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
953
954 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
955 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
956 produced include a DROP TABLE statement for each table created.
957
958 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash 
959 ref or an array ref, containing a list of source to deploy. If present, then 
960 only the sources listed will get deployed.
961
962 =cut
963
964 sub deploy {
965   my ($self, $sqltargs, $dir) = @_;
966   $self->throw_exception("Can't deploy without storage") unless $self->storage;
967   $self->storage->deploy($self, undef, $sqltargs, $dir);
968 }
969
970 =head2 create_ddl_dir (EXPERIMENTAL)
971
972 =over 4
973
974 =item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
975
976 =back
977
978 Creates an SQL file based on the Schema, for each of the specified
979 database types, in the given directory. Given a previous version number,
980 this will also create a file containing the ALTER TABLE statements to
981 transform the previous schema into the current one. Note that these
982 statements may contain DROP TABLE or DROP COLUMN statements that can
983 potentially destroy data.
984
985 The file names are created using the C<ddl_filename> method below, please
986 override this method in your schema if you would like a different file
987 name format. For the ALTER file, the same format is used, replacing
988 $version in the name with "$preversion-$version".
989
990 If no arguments are passed, then the following default values are used:
991
992 =over 4
993
994 =item databases  - ['MySQL', 'SQLite', 'PostgreSQL']
995
996 =item version    - $schema->VERSION
997
998 =item directory  - './'
999
1000 =item preversion - <none>
1001
1002 =back
1003
1004 Note that this feature is currently EXPERIMENTAL and may not work correctly
1005 across all databases, or fully handle complex relationships.
1006
1007 WARNING: Please check all SQL files created, before applying them.
1008
1009 =cut
1010
1011 sub create_ddl_dir {
1012   my $self = shift;
1013
1014   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1015   $self->storage->create_ddl_dir($self, @_);
1016 }
1017
1018 =head2 ddl_filename (EXPERIMENTAL)
1019
1020 =over 4
1021
1022 =item Arguments: $directory, $database-type, $version, $preversion
1023
1024 =back
1025
1026   my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1027
1028 This method is called by C<create_ddl_dir> to compose a file name out of
1029 the supplied directory, database type and version number. The default file
1030 name format is: C<$dir$schema-$version-$type.sql>.
1031
1032 You may override this method in your schema if you wish to use a different
1033 format.
1034
1035 =cut
1036
1037 sub ddl_filename {
1038     my ($self, $type, $dir, $version, $pversion) = @_;
1039
1040     my $filename = ref($self);
1041     $filename =~ s/::/-/g;
1042     $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1043     $filename =~ s/$version/$pversion-$version/ if($pversion);
1044
1045     return $filename;
1046 }
1047
1048 1;
1049
1050 =head1 AUTHORS
1051
1052 Matt S. Trout <mst@shadowcatsystems.co.uk>
1053
1054 =head1 LICENSE
1055
1056 You may distribute this code under the same terms as Perl itself.
1057
1058 =cut