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