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