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