lib/DBIx/Class/Schema.pm

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