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