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