ResultSetColumn::func() now returns all results if called in list context
[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
487=for hidden due to deprecation
488
2053ab2a 489Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
490calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
491then injects the L<DBix::Class::ResultSetProxy> component and a
492resultset_instance classdata entry on all the new classes, in order to support
82b01c38 493$target_namespaces::$class->search(...) method calls.
494
495This is primarily useful when you have a specific need for class method access
496to a connection. In normal usage it is preferred to call
497L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
498on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
499more information.
54540863 500
076652e8 501=cut
502
c216324a 503{
504 my $warn;
505
506 sub compose_connection {
507 my ($self, $target, @info) = @_;
508
3943fd63 509 warn "compose_connection deprecated as of 0.08000"
510 unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
c216324a 511
512 my $base = 'DBIx::Class::ResultSetProxy';
513 eval "require ${base};";
514 $self->throw_exception
515 ("No arguments to load_classes and couldn't load ${base} ($@)")
516 if $@;
517
518 if ($self eq $target) {
519 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
520 foreach my $moniker ($self->sources) {
521 my $source = $self->source($moniker);
522 my $class = $source->result_class;
523 $self->inject_base($class, $base);
524 $class->mk_classdata(resultset_instance => $source->resultset);
525 $class->mk_classdata(class_resolver => $self);
526 }
527 $self->connection(@info);
528 return $self;
529 }
530
531 my $schema = $self->compose_namespace($target, $base);
532 {
533 no strict 'refs';
534 *{"${target}::schema"} = sub { $schema };
535 }
536
537 $schema->connection(@info);
538 foreach my $moniker ($schema->sources) {
539 my $source = $schema->source($moniker);
be381829 540 my $class = $source->result_class;
c216324a 541 #warn "$moniker $class $source ".$source->storage;
542 $class->mk_classdata(result_source_instance => $source);
be381829 543 $class->mk_classdata(resultset_instance => $source->resultset);
c216324a 544 $class->mk_classdata(class_resolver => $schema);
be381829 545 }
c216324a 546 return $schema;
bfb2bd4f 547 }
e678398e 548}
549
77254782 550=head2 compose_namespace
551
27f01d1f 552=over 4
553
554=item Arguments: $target_namespace, $additional_base_class?
82b01c38 555
d601dc88 556=item Return Value: $new_schema
27f01d1f 557
558=back
13765dad 559
82b01c38 560For each L<DBIx::Class::ResultSource> in the schema, this method creates a
561class in the target namespace (e.g. $target_namespace::CD,
562$target_namespace::Artist) that inherits from the corresponding classes
563attached to the current schema.
77254782 564
82b01c38 565It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
566new $schema object. If C<$additional_base_class> is given, the new composed
567classes will inherit from first the corresponding classe from the current
568schema then the base class.
569
2053ab2a 570For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
82b01c38 571
572 $schema->compose_namespace('My::DB', 'Base::Class');
573 print join (', ', @My::DB::CD::ISA) . "\n";
574 print join (', ', @My::DB::Artist::ISA) ."\n";
575
2053ab2a 576will produce the output
82b01c38 577
578 My::Schema::CD, Base::Class
579 My::Schema::Artist, Base::Class
77254782 580
581=cut
582
e678398e 583sub compose_namespace {
66d9ef6b 584 my ($self, $target, $base) = @_;
66d9ef6b 585 my $schema = $self->clone;
e9100ff7 586 {
587 no warnings qw/redefine/;
588 local *Class::C3::reinitialize = sub { };
589 foreach my $moniker ($schema->sources) {
590 my $source = $schema->source($moniker);
591 my $target_class = "${target}::${moniker}";
592 $self->inject_base(
593 $target_class => $source->result_class, ($base ? $base : ())
594 );
595 $source->result_class($target_class);
9d3d5af3 596 $target_class->result_source_instance($source)
597 if $target_class->can('result_source_instance');
e9100ff7 598 }
b7951443 599 }
e9100ff7 600 Class::C3->reinitialize();
11b78bd6 601 {
602 no strict 'refs';
1edaf6fe 603 foreach my $meth (qw/class source resultset/) {
604 *{"${target}::${meth}"} =
605 sub { shift->schema->$meth(@_) };
606 }
11b78bd6 607 }
bfb2bd4f 608 return $schema;
b7951443 609}
610
87c4e602 611=head2 setup_connection_class
612
27f01d1f 613=over 4
614
ebc77b53 615=item Arguments: $target, @info
27f01d1f 616
617=back
076652e8 618
82b01c38 619Sets up a database connection class to inject between the schema and the
620subclasses that the schema creates.
429bd4f1 621
076652e8 622=cut
623
b7951443 624sub setup_connection_class {
625 my ($class, $target, @info) = @_;
63e9583a 626 $class->inject_base($target => 'DBIx::Class::DB');
627 #$target->load_components('DB');
b7951443 628 $target->connection(@info);
629}
630
6b43ba5f 631=head2 storage_type
632
633=over 4
634
635=item Arguments: $storage_type
636
637=item Return Value: $storage_type
638
639=back
640
641Set the storage class that will be instantiated when L</connect> is called.
642If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
643assumed by L</connect>. Defaults to C<::DBI>,
644which is L<DBIx::Class::Storage::DBI>.
645
646You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
647in cases where the appropriate subclass is not autodetected, such as when
648dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
649C<::DBI::Sybase::MSSQL>.
650
87c4e602 651=head2 connection
652
27f01d1f 653=over 4
654
ebc77b53 655=item Arguments: @args
66d9ef6b 656
d601dc88 657=item Return Value: $new_schema
27f01d1f 658
659=back
82b01c38 660
661Instantiates a new Storage object of type
662L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
85f78622 663$storage->connect_info. Sets the connection in-place on the schema.
664
665See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
666or L<DBIx::Class::Storage> in general.
66d9ef6b 667
668=cut
669
670sub connection {
671 my ($self, @info) = @_;
e59d3e5b 672 return $self if !@info && $self->storage;
1e10a11d 673 my $storage_class = $self->storage_type;
674 $storage_class = 'DBIx::Class::Storage'.$storage_class
675 if $storage_class =~ m/^::/;
8ef144ff 676 eval "require ${storage_class};";
bc0c9800 677 $self->throw_exception(
678 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
679 ) if $@;
82cc0386 680 my $storage = $storage_class->new($self);
66d9ef6b 681 $storage->connect_info(\@info);
682 $self->storage($storage);
683 return $self;
684}
685
87c4e602 686=head2 connect
687
27f01d1f 688=over 4
689
ebc77b53 690=item Arguments: @info
66d9ef6b 691
d601dc88 692=item Return Value: $new_schema
27f01d1f 693
694=back
82b01c38 695
696This is a convenience method. It is equivalent to calling
697$schema->clone->connection(@info). See L</connection> and L</clone> for more
698information.
66d9ef6b 699
700=cut
701
08b515f1 702sub connect { shift->clone->connection(@_) }
703
4012acd8 704=head2 txn_do
08b515f1 705
4012acd8 706=over 4
08b515f1 707
4012acd8 708=item Arguments: C<$coderef>, @coderef_args?
08b515f1 709
4012acd8 710=item Return Value: The return value of $coderef
08b515f1 711
4012acd8 712=back
08b515f1 713
4012acd8 714Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
715returning its result (if any). Equivalent to calling $schema->storage->txn_do.
716See L<DBIx::Class::Storage/"txn_do"> for more information.
08b515f1 717
4012acd8 718This interface is preferred over using the individual methods L</txn_begin>,
719L</txn_commit>, and L</txn_rollback> below.
08b515f1 720
4012acd8 721=cut
08b515f1 722
4012acd8 723sub txn_do {
724 my $self = shift;
08b515f1 725
4012acd8 726 $self->storage or $self->throw_exception
727 ('txn_do called on $schema without storage');
08b515f1 728
4012acd8 729 $self->storage->txn_do(@_);
730}
66d9ef6b 731
4012acd8 732=head2 txn_begin
a62cf8d4 733
4012acd8 734Begins a transaction (does nothing if AutoCommit is off). Equivalent to
735calling $schema->storage->txn_begin. See
736L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
27f01d1f 737
4012acd8 738=cut
82b01c38 739
4012acd8 740sub txn_begin {
741 my $self = shift;
27f01d1f 742
4012acd8 743 $self->storage or $self->throw_exception
744 ('txn_begin called on $schema without storage');
a62cf8d4 745
4012acd8 746 $self->storage->txn_begin;
747}
a62cf8d4 748
4012acd8 749=head2 txn_commit
a62cf8d4 750
4012acd8 751Commits the current transaction. Equivalent to calling
752$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
753for more information.
a62cf8d4 754
4012acd8 755=cut
a62cf8d4 756
4012acd8 757sub txn_commit {
758 my $self = shift;
a62cf8d4 759
4012acd8 760 $self->storage or $self->throw_exception
761 ('txn_commit called on $schema without storage');
a62cf8d4 762
4012acd8 763 $self->storage->txn_commit;
764}
70634260 765
4012acd8 766=head2 txn_rollback
a62cf8d4 767
4012acd8 768Rolls back the current transaction. Equivalent to calling
769$schema->storage->txn_rollback. See
770L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
a62cf8d4 771
772=cut
773
4012acd8 774sub txn_rollback {
775 my $self = shift;
a62cf8d4 776
19630353 777 $self->storage or $self->throw_exception
4012acd8 778 ('txn_rollback called on $schema without storage');
a62cf8d4 779
4012acd8 780 $self->storage->txn_rollback;
a62cf8d4 781}
782
66d9ef6b 783=head2 clone
784
27f01d1f 785=over 4
786
d601dc88 787=item Return Value: $new_schema
27f01d1f 788
789=back
82b01c38 790
66d9ef6b 791Clones the schema and its associated result_source objects and returns the
792copy.
793
794=cut
795
796sub clone {
797 my ($self) = @_;
04786a4c 798 my $clone = { (ref $self ? %$self : ()) };
799 bless $clone, (ref $self || $self);
800
66d9ef6b 801 foreach my $moniker ($self->sources) {
802 my $source = $self->source($moniker);
803 my $new = $source->new($source);
804 $clone->register_source($moniker => $new);
805 }
82cc0386 806 $clone->storage->set_schema($clone) if $clone->storage;
66d9ef6b 807 return $clone;
808}
809
87c4e602 810=head2 populate
811
27f01d1f 812=over 4
813
16c5f7d3 814=item Arguments: $source_name, \@data;
27f01d1f 815
816=back
a37a4697 817
16c5f7d3 818Pass this method a resultsource name, and an arrayref of
819arrayrefs. The arrayrefs should contain a list of column names,
820followed by one or many sets of matching data for the given columns.
821
744076d8 822In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
823to insert the data, as this is a fast method. However, insert_bulk currently
824assumes that your datasets all contain the same type of values, using scalar
825references in a column in one row, and not in another will probably not work.
826
827Otherwise, each set of data is inserted into the database using
16c5f7d3 828L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
829objects is returned.
82b01c38 830
831i.e.,
a37a4697 832
24d67825 833 $schema->populate('Artist', [
834 [ qw/artistid name/ ],
835 [ 1, 'Popular Band' ],
836 [ 2, 'Indie Band' ],
a62cf8d4 837 ...
838 ]);
5a93e138 839
840Since wantarray context is basically the same as looping over $rs->create(...)
841you won't see any performance benefits and in this case the method is more for
842convenience. Void context sends the column information directly to storage
843using <DBI>s bulk insert method. So the performance will be much better for
844storages that support this method.
845
846Because of this difference in the way void context inserts rows into your
847database you need to note how this will effect any loaded components that
848override or augment insert. For example if you are using a component such
849as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use
850wantarray context if you want the PKs automatically created.
a37a4697 851
852=cut
853
854sub populate {
855 my ($self, $name, $data) = @_;
856 my $rs = $self->resultset($name);
857 my @names = @{shift(@$data)};
54e0bd06 858 if(defined wantarray) {
859 my @created;
860 foreach my $item (@$data) {
861 my %create;
862 @create{@names} = @$item;
863 push(@created, $rs->create(\%create));
864 }
865 return @created;
a37a4697 866 }
8b93a938 867 my @results_to_create;
868 foreach my $datum (@$data) {
869 my %result_to_create;
870 foreach my $index (0..$#names) {
871 $result_to_create{$names[$index]} = $$datum[$index];
872 }
873 push @results_to_create, \%result_to_create;
874 }
875 $rs->populate(\@results_to_create);
a37a4697 876}
877
82cc0386 878=head2 exception_action
879
880=over 4
881
882=item Arguments: $code_reference
883
884=back
885
db5dc233 886If C<exception_action> is set for this class/object, L</throw_exception>
887will prefer to call this code reference with the exception as an argument,
613397e7 888rather than its normal C<croak> or C<confess> action.
db5dc233 889
890Your subroutine should probably just wrap the error in the exception
891object/class of your choosing and rethrow. If, against all sage advice,
892you'd like your C<exception_action> to suppress a particular exception
893completely, simply have it return true.
82cc0386 894
895Example:
896
897 package My::Schema;
898 use base qw/DBIx::Class::Schema/;
899 use My::ExceptionClass;
900 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
901 __PACKAGE__->load_classes;
902
db5dc233 903 # or:
82cc0386 904 my $schema_obj = My::Schema->connect( .... );
905 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
906
db5dc233 907 # suppress all exceptions, like a moron:
908 $schema_obj->exception_action(sub { 1 });
909
613397e7 910=head2 stacktrace
911
84c5863b 912=over 4
613397e7 913
914=item Arguments: boolean
915
916=back
917
4981dc70 918Whether L</throw_exception> should include stack trace information.
4b946902 919Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}>
920is true.
613397e7 921
5160b401 922=head2 throw_exception
701da8c4 923
75d07914 924=over 4
82b01c38 925
ebc77b53 926=item Arguments: $message
82b01c38 927
928=back
929
930Throws an exception. Defaults to using L<Carp::Clan> to report errors from
db5dc233 931user's perspective. See L</exception_action> for details on overriding
4b946902 932this method's behavior. If L</stacktrace> is turned on, C<throw_exception>'s
933default behavior will provide a detailed stack trace.
701da8c4 934
935=cut
936
937sub throw_exception {
82cc0386 938 my $self = shift;
4981dc70 939
940 DBIx::Class::Exception->throw($_[0], $self->stacktrace)
941 if !$self->exception_action || !$self->exception_action->(@_);
701da8c4 942}
943
dfccde48 944=head2 deploy
1c339d71 945
82b01c38 946=over 4
947
6e73ac25 948=item Arguments: $sqlt_args, $dir
82b01c38 949
950=back
951
952Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 953
51bace1c 954See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
955common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
956produced include a DROP TABLE statement for each table created.
957
499adf63 958Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
959ref or an array ref, containing a list of source to deploy. If present, then
960only the sources listed will get deployed.
961
1c339d71 962=cut
963
964sub deploy {
6e73ac25 965 my ($self, $sqltargs, $dir) = @_;
1c339d71 966 $self->throw_exception("Can't deploy without storage") unless $self->storage;
6e73ac25 967 $self->storage->deploy($self, undef, $sqltargs, $dir);
1c339d71 968}
969
c0f61310 970=head2 create_ddl_dir (EXPERIMENTAL)
971
972=over 4
973
c9d2e0a2 974=item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
c0f61310 975
976=back
977
978Creates an SQL file based on the Schema, for each of the specified
c9d2e0a2 979database types, in the given directory. Given a previous version number,
980this will also create a file containing the ALTER TABLE statements to
981transform the previous schema into the current one. Note that these
982statements may contain DROP TABLE or DROP COLUMN statements that can
983potentially destroy data.
984
985The file names are created using the C<ddl_filename> method below, please
986override this method in your schema if you would like a different file
987name format. For the ALTER file, the same format is used, replacing
988$version in the name with "$preversion-$version".
989
990If no arguments are passed, then the following default values are used:
991
992=over 4
993
994=item databases - ['MySQL', 'SQLite', 'PostgreSQL']
995
996=item version - $schema->VERSION
997
998=item directory - './'
999
1000=item preversion - <none>
1001
1002=back
c0f61310 1003
1004Note that this feature is currently EXPERIMENTAL and may not work correctly
1005across all databases, or fully handle complex relationships.
1006
c9d2e0a2 1007WARNING: Please check all SQL files created, before applying them.
1008
c0f61310 1009=cut
1010
6e73ac25 1011sub create_ddl_dir {
e673f011 1012 my $self = shift;
1013
1014 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1015 $self->storage->create_ddl_dir($self, @_);
1016}
1017
9b83fccd 1018=head2 ddl_filename (EXPERIMENTAL)
1019
c9d2e0a2 1020=over 4
1021
1022=item Arguments: $directory, $database-type, $version, $preversion
1023
1024=back
1025
1026 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1027
1028This method is called by C<create_ddl_dir> to compose a file name out of
1029the supplied directory, database type and version number. The default file
1030name format is: C<$dir$schema-$version-$type.sql>.
9b83fccd 1031
c9d2e0a2 1032You may override this method in your schema if you wish to use a different
1033format.
9b83fccd 1034
1035=cut
1036
6e73ac25 1037sub ddl_filename {
c9d2e0a2 1038 my ($self, $type, $dir, $version, $pversion) = @_;
e673f011 1039
1040 my $filename = ref($self);
32be057c 1041 $filename =~ s/::/-/g;
c9d2e0a2 1042 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1043 $filename =~ s/$version/$pversion-$version/ if($pversion);
e673f011 1044
1045 return $filename;
1046}
1047
a02675cd 10481;
c2da098a 1049
c2da098a 1050=head1 AUTHORS
1051
daec44b8 1052Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 1053
1054=head1 LICENSE
1055
1056You may distribute this code under the same terms as Perl itself.
1057
1058=cut