explained a cryptic error message
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Schema.pm
CommitLineData
a02675cd 1package DBIx::Class::Schema;
2
3use strict;
4use warnings;
aa562407 5
701da8c4 6use Carp::Clan qw/^DBIx::Class/;
a917fb06 7use Scalar::Util qw/weaken/;
a02675cd 8
41a6f8c0 9use base qw/DBIx::Class/;
a02675cd 10
0dc79249 11__PACKAGE__->mk_classdata('class_mappings' => {});
12__PACKAGE__->mk_classdata('source_registrations' => {});
1e10a11d 13__PACKAGE__->mk_classdata('storage_type' => '::DBI');
d7156e50 14__PACKAGE__->mk_classdata('storage');
a02675cd 15
c2da098a 16=head1 NAME
17
18DBIx::Class::Schema - composable schemas
19
20=head1 SYNOPSIS
21
24d67825 22 package Library::Schema;
c2da098a 23 use base qw/DBIx::Class::Schema/;
bab77431 24
24d67825 25 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
26 __PACKAGE__->load_classes(qw/CD Book DVD/);
c2da098a 27
24d67825 28 package Library::Schema::CD;
03312470 29 use base qw/DBIx::Class/;
77254782 30 __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
24d67825 31 __PACKAGE__->table('cd');
c2da098a 32
5d9076f2 33 # Elsewhere in your code:
24d67825 34 my $schema1 = Library::Schema->connect(
a3d93194 35 $dsn,
36 $user,
37 $password,
24d67825 38 { AutoCommit => 0 },
a3d93194 39 );
bab77431 40
24d67825 41 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
c2da098a 42
24d67825 43 # fetch objects using Library::Schema::DVD
44 my $resultset = $schema1->resultset('DVD')->search( ... );
45 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
c2da098a 46
47=head1 DESCRIPTION
48
a3d93194 49Creates database classes based on a schema. This is the recommended way to
50use L<DBIx::Class> and allows you to use more than one concurrent connection
51with your classes.
429bd4f1 52
03312470 53NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
2053ab2a 54carefully, as DBIx::Class does things a little differently. Note in
03312470 55particular which module inherits off which.
56
c2da098a 57=head1 METHODS
58
87c4e602 59=head2 register_class
60
27f01d1f 61=over 4
62
ebc77b53 63=item Arguments: $moniker, $component_class
27f01d1f 64
65=back
076652e8 66
71f9df37 67Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
2053ab2a 68calling:
66d9ef6b 69
181a28f4 70 $schema->register_source($moniker, $component_class->result_source_instance);
076652e8 71
c2da098a 72=cut
73
a02675cd 74sub register_class {
0dc79249 75 my ($self, $moniker, $to_register) = @_;
76 $self->register_source($moniker => $to_register->result_source_instance);
74b92d9a 77}
78
87c4e602 79=head2 register_source
80
27f01d1f 81=over 4
82
ebc77b53 83=item Arguments: $moniker, $result_source
27f01d1f 84
85=back
076652e8 86
82b01c38 87Registers the L<DBIx::Class::ResultSource> in the schema with the given
88moniker.
076652e8 89
90=cut
91
0dc79249 92sub register_source {
93 my ($self, $moniker, $source) = @_;
94 my %reg = %{$self->source_registrations};
95 $reg{$moniker} = $source;
96 $self->source_registrations(\%reg);
97 $source->schema($self);
a917fb06 98 weaken($source->{schema}) if ref($self);
0dc79249 99 if ($source->result_class) {
100 my %map = %{$self->class_mappings};
101 $map{$source->result_class} = $moniker;
102 $self->class_mappings(\%map);
103 }
75d07914 104}
a02675cd 105
bfb2bd4f 106=head2 class
107
27f01d1f 108=over 4
82b01c38 109
ebc77b53 110=item Arguments: $moniker
27f01d1f 111
d601dc88 112=item Return Value: $classname
27f01d1f 113
114=back
82b01c38 115
2053ab2a 116Retrieves the result class name for the given moniker. For example:
82b01c38 117
118 my $class = $schema->class('CD');
bfb2bd4f 119
120=cut
121
122sub class {
0dc79249 123 my ($self, $moniker) = @_;
124 return $self->source($moniker)->result_class;
bfb2bd4f 125}
126
ea20d0fd 127=head2 source
128
27f01d1f 129=over 4
130
ebc77b53 131=item Arguments: $moniker
27f01d1f 132
d601dc88 133=item Return Value: $result_source
82b01c38 134
27f01d1f 135=back
82b01c38 136
24d67825 137 my $source = $schema->source('Book');
ea20d0fd 138
82b01c38 139Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
ea20d0fd 140
141=cut
142
143sub source {
0dc79249 144 my ($self, $moniker) = @_;
145 my $sreg = $self->source_registrations;
146 return $sreg->{$moniker} if exists $sreg->{$moniker};
147
148 # if we got here, they probably passed a full class name
149 my $mapped = $self->class_mappings->{$moniker};
701da8c4 150 $self->throw_exception("Can't find source for ${moniker}")
0dc79249 151 unless $mapped && exists $sreg->{$mapped};
152 return $sreg->{$mapped};
ea20d0fd 153}
154
0dc79249 155=head2 sources
156
27f01d1f 157=over 4
158
d601dc88 159=item Return Value: @source_monikers
27f01d1f 160
161=back
82b01c38 162
163Returns the source monikers of all source registrations on this schema.
2053ab2a 164For example:
82b01c38 165
166 my @source_monikers = $schema->sources;
0dc79249 167
168=cut
169
170sub sources { return keys %{shift->source_registrations}; }
171
9b1ba0f2 172=head2 storage
173
174 my $storage = $schema->storage;
175
176Returns the L<DBIx::Class::Storage> object for this Schema.
177
ea20d0fd 178=head2 resultset
179
27f01d1f 180=over 4
181
ebc77b53 182=item Arguments: $moniker
27f01d1f 183
d601dc88 184=item Return Value: $result_set
82b01c38 185
27f01d1f 186=back
82b01c38 187
24d67825 188 my $rs = $schema->resultset('DVD');
ea20d0fd 189
82b01c38 190Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
ea20d0fd 191
192=cut
193
194sub resultset {
0dc79249 195 my ($self, $moniker) = @_;
196 return $self->source($moniker)->resultset;
ea20d0fd 197}
198
87c4e602 199=head2 load_classes
200
27f01d1f 201=over 4
202
203=item Arguments: @classes?, { $namespace => [ @classes ] }+
204
205=back
076652e8 206
82b01c38 207With no arguments, this method uses L<Module::Find> to find all classes under
208the schema's namespace. Otherwise, this method loads the classes you specify
209(using L<use>), and registers them (using L</"register_class">).
076652e8 210
2053ab2a 211It is possible to comment out classes with a leading C<#>, but note that perl
212will think it's a mistake (trying to use a comment in a qw list), so you'll
213need to add C<no warnings 'qw';> before your load_classes call.
5ce32fc1 214
2053ab2a 215Example:
82b01c38 216
217 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
75d07914 218 # etc. (anything under the My::Schema namespace)
82b01c38 219
220 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
221 # not Other::Namespace::LinerNotes nor My::Schema::Track
222 My::Schema->load_classes(qw/ CD Artist #Track /, {
223 Other::Namespace => [qw/ Producer #LinerNotes /],
224 });
225
076652e8 226=cut
227
a02675cd 228sub load_classes {
5ce32fc1 229 my ($class, @params) = @_;
bab77431 230
5ce32fc1 231 my %comps_for;
bab77431 232
5ce32fc1 233 if (@params) {
234 foreach my $param (@params) {
235 if (ref $param eq 'ARRAY') {
236 # filter out commented entries
237 my @modules = grep { $_ !~ /^#/ } @$param;
bab77431 238
5ce32fc1 239 push (@{$comps_for{$class}}, @modules);
240 }
241 elsif (ref $param eq 'HASH') {
242 # more than one namespace possible
243 for my $comp ( keys %$param ) {
244 # filter out commented entries
245 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
246
247 push (@{$comps_for{$comp}}, @modules);
248 }
249 }
250 else {
251 # filter out commented entries
252 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
253 }
254 }
255 } else {
41a6f8c0 256 eval "require Module::Find;";
bc0c9800 257 $class->throw_exception(
258 "No arguments to load_classes and couldn't load Module::Find ($@)"
259 ) if $@;
260 my @comp = map { substr $_, length "${class}::" }
261 Module::Find::findallmod($class);
5ce32fc1 262 $comps_for{$class} = \@comp;
41a6f8c0 263 }
5ce32fc1 264
e6efde04 265 my @to_register;
266 {
267 no warnings qw/redefine/;
268 local *Class::C3::reinitialize = sub { };
269 foreach my $prefix (keys %comps_for) {
270 foreach my $comp (@{$comps_for{$prefix}||[]}) {
271 my $comp_class = "${prefix}::${comp}";
83542a7d 272 { # try to untaint module name. mods where this fails
273 # are left alone so we don't have to change the old behavior
274 no locale; # localized \w doesn't untaint expression
275 if ( $comp_class =~ m/^( (?:\w+::)* \w+ )$/x ) {
276 $comp_class = $1;
277 }
278 }
c037c03a 279 $class->ensure_class_loaded($comp_class);
bab77431 280 $comp_class->source_name($comp) unless $comp_class->source_name;
281
282 push(@to_register, [ $comp_class->source_name, $comp_class ]);
bfb2bd4f 283 }
5ce32fc1 284 }
a02675cd 285 }
e6efde04 286 Class::C3->reinitialize;
287
288 foreach my $to (@to_register) {
289 $class->register_class(@$to);
290 # if $class->can('result_source_instance');
291 }
a02675cd 292}
293
87c4e602 294=head2 compose_connection
295
27f01d1f 296=over 4
297
ebc77b53 298=item Arguments: $target_namespace, @db_info
429bd4f1 299
d601dc88 300=item Return Value: $new_schema
27f01d1f 301
302=back
076652e8 303
2053ab2a 304Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
305calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
306then injects the L<DBix::Class::ResultSetProxy> component and a
307resultset_instance classdata entry on all the new classes, in order to support
82b01c38 308$target_namespaces::$class->search(...) method calls.
309
310This is primarily useful when you have a specific need for class method access
311to a connection. In normal usage it is preferred to call
312L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
313on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
314more information.
54540863 315
076652e8 316=cut
317
a02675cd 318sub compose_connection {
ea20d0fd 319 my ($self, $target, @info) = @_;
80c90f5d 320 my $base = 'DBIx::Class::ResultSetProxy';
8ef144ff 321 eval "require ${base};";
bc0c9800 322 $self->throw_exception
323 ("No arguments to load_classes and couldn't load ${base} ($@)")
324 if $@;
be381829 325
326 if ($self eq $target) {
327 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
328 foreach my $moniker ($self->sources) {
329 my $source = $self->source($moniker);
330 my $class = $source->result_class;
331 $self->inject_base($class, $base);
332 $class->mk_classdata(resultset_instance => $source->resultset);
333 $class->mk_classdata(class_resolver => $self);
334 }
50041f3c 335 $self->connection(@info);
be381829 336 return $self;
337 }
338
66d9ef6b 339 my $schema = $self->compose_namespace($target, $base);
ecceadff 340 {
341 no strict 'refs';
342 *{"${target}::schema"} = sub { $schema };
343 }
344
66d9ef6b 345 $schema->connection(@info);
0dc79249 346 foreach my $moniker ($schema->sources) {
347 my $source = $schema->source($moniker);
348 my $class = $source->result_class;
349 #warn "$moniker $class $source ".$source->storage;
8c49f629 350 $class->mk_classdata(result_source_instance => $source);
ea20d0fd 351 $class->mk_classdata(resultset_instance => $source->resultset);
66d9ef6b 352 $class->mk_classdata(class_resolver => $schema);
bfb2bd4f 353 }
354 return $schema;
e678398e 355}
356
77254782 357=head2 compose_namespace
358
27f01d1f 359=over 4
360
361=item Arguments: $target_namespace, $additional_base_class?
82b01c38 362
d601dc88 363=item Return Value: $new_schema
27f01d1f 364
365=back
13765dad 366
82b01c38 367For each L<DBIx::Class::ResultSource> in the schema, this method creates a
368class in the target namespace (e.g. $target_namespace::CD,
369$target_namespace::Artist) that inherits from the corresponding classes
370attached to the current schema.
77254782 371
82b01c38 372It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
373new $schema object. If C<$additional_base_class> is given, the new composed
374classes will inherit from first the corresponding classe from the current
375schema then the base class.
376
2053ab2a 377For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
82b01c38 378
379 $schema->compose_namespace('My::DB', 'Base::Class');
380 print join (', ', @My::DB::CD::ISA) . "\n";
381 print join (', ', @My::DB::Artist::ISA) ."\n";
382
2053ab2a 383will produce the output
82b01c38 384
385 My::Schema::CD, Base::Class
386 My::Schema::Artist, Base::Class
77254782 387
388=cut
389
e678398e 390sub compose_namespace {
66d9ef6b 391 my ($self, $target, $base) = @_;
392 my %reg = %{ $self->source_registrations };
11b78bd6 393 my %target;
394 my %map;
66d9ef6b 395 my $schema = $self->clone;
e9100ff7 396 {
397 no warnings qw/redefine/;
398 local *Class::C3::reinitialize = sub { };
399 foreach my $moniker ($schema->sources) {
400 my $source = $schema->source($moniker);
401 my $target_class = "${target}::${moniker}";
402 $self->inject_base(
403 $target_class => $source->result_class, ($base ? $base : ())
404 );
405 $source->result_class($target_class);
9d3d5af3 406 $target_class->result_source_instance($source)
407 if $target_class->can('result_source_instance');
e9100ff7 408 }
b7951443 409 }
e9100ff7 410 Class::C3->reinitialize();
11b78bd6 411 {
412 no strict 'refs';
1edaf6fe 413 foreach my $meth (qw/class source resultset/) {
414 *{"${target}::${meth}"} =
415 sub { shift->schema->$meth(@_) };
416 }
11b78bd6 417 }
bfb2bd4f 418 return $schema;
b7951443 419}
420
87c4e602 421=head2 setup_connection_class
422
27f01d1f 423=over 4
424
ebc77b53 425=item Arguments: $target, @info
27f01d1f 426
427=back
076652e8 428
82b01c38 429Sets up a database connection class to inject between the schema and the
430subclasses that the schema creates.
429bd4f1 431
076652e8 432=cut
433
b7951443 434sub setup_connection_class {
435 my ($class, $target, @info) = @_;
63e9583a 436 $class->inject_base($target => 'DBIx::Class::DB');
437 #$target->load_components('DB');
b7951443 438 $target->connection(@info);
439}
440
6b43ba5f 441=head2 storage_type
442
443=over 4
444
445=item Arguments: $storage_type
446
447=item Return Value: $storage_type
448
449=back
450
451Set the storage class that will be instantiated when L</connect> is called.
452If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
453assumed by L</connect>. Defaults to C<::DBI>,
454which is L<DBIx::Class::Storage::DBI>.
455
456You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
457in cases where the appropriate subclass is not autodetected, such as when
458dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
459C<::DBI::Sybase::MSSQL>.
460
87c4e602 461=head2 connection
462
27f01d1f 463=over 4
464
ebc77b53 465=item Arguments: @args
66d9ef6b 466
d601dc88 467=item Return Value: $new_schema
27f01d1f 468
469=back
82b01c38 470
471Instantiates a new Storage object of type
472L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
473$storage->connect_info. Sets the connection in-place on the schema. See
474L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
66d9ef6b 475
476=cut
477
478sub connection {
479 my ($self, @info) = @_;
e59d3e5b 480 return $self if !@info && $self->storage;
1e10a11d 481 my $storage_class = $self->storage_type;
482 $storage_class = 'DBIx::Class::Storage'.$storage_class
483 if $storage_class =~ m/^::/;
8ef144ff 484 eval "require ${storage_class};";
bc0c9800 485 $self->throw_exception(
486 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
487 ) if $@;
66d9ef6b 488 my $storage = $storage_class->new;
489 $storage->connect_info(\@info);
490 $self->storage($storage);
491 return $self;
492}
493
87c4e602 494=head2 connect
495
27f01d1f 496=over 4
497
ebc77b53 498=item Arguments: @info
66d9ef6b 499
d601dc88 500=item Return Value: $new_schema
27f01d1f 501
502=back
82b01c38 503
504This is a convenience method. It is equivalent to calling
505$schema->clone->connection(@info). See L</connection> and L</clone> for more
506information.
66d9ef6b 507
508=cut
509
08b515f1 510sub connect { shift->clone->connection(@_) }
511
512=head2 txn_begin
513
82b01c38 514Begins a transaction (does nothing if AutoCommit is off). Equivalent to
515calling $schema->storage->txn_begin. See
516L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
08b515f1 517
518=cut
519
520sub txn_begin { shift->storage->txn_begin }
521
522=head2 txn_commit
523
82b01c38 524Commits the current transaction. Equivalent to calling
525$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
526for more information.
08b515f1 527
528=cut
529
530sub txn_commit { shift->storage->txn_commit }
531
532=head2 txn_rollback
533
82b01c38 534Rolls back the current transaction. Equivalent to calling
535$schema->storage->txn_rollback. See
536L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
08b515f1 537
538=cut
539
540sub txn_rollback { shift->storage->txn_rollback }
66d9ef6b 541
a62cf8d4 542=head2 txn_do
543
27f01d1f 544=over 4
545
ebc77b53 546=item Arguments: C<$coderef>, @coderef_args?
82b01c38 547
d601dc88 548=item Return Value: The return value of $coderef
27f01d1f 549
550=back
a62cf8d4 551
82b01c38 552Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
553returning its result (if any). If an exception is caught, a rollback is issued
554and the exception is rethrown. If the rollback fails, (i.e. throws an
555exception) an exception is thrown that includes a "Rollback failed" message.
a62cf8d4 556
557For example,
558
24d67825 559 my $author_rs = $schema->resultset('Author')->find(1);
70634260 560 my @titles = qw/Night Day It/;
a62cf8d4 561
562 my $coderef = sub {
a62cf8d4 563 # If any one of these fails, the entire transaction fails
70634260 564 $author_rs->create_related('books', {
24d67825 565 title => $_
566 }) foreach (@titles);
a62cf8d4 567
24d67825 568 return $author->books;
a62cf8d4 569 };
570
571 my $rs;
572 eval {
70634260 573 $rs = $schema->txn_do($coderef);
a62cf8d4 574 };
575
70634260 576 if ($@) { # Transaction failed
577 die "something terrible has happened!" #
578 if ($@ =~ /Rollback failed/); # Rollback failed
579
580 deal_with_failed_transaction();
a62cf8d4 581 }
582
82b01c38 583In a nested transaction (calling txn_do() from within a txn_do() coderef) only
584the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
585the Schema's storage, and txn_do() can be called in void, scalar and list
586context and it will behave as expected.
a62cf8d4 587
588=cut
589
590sub txn_do {
591 my ($self, $coderef, @args) = @_;
592
19630353 593 $self->storage or $self->throw_exception
594 ('txn_do called on $schema without storage');
171dadd7 595 ref $coderef eq 'CODE' or $self->throw_exception
596 ('$coderef must be a CODE reference');
a62cf8d4 597
598 my (@return_values, $return_value);
599
600 $self->txn_begin; # If this throws an exception, no rollback is needed
601
e7f2b7d5 602 my $wantarray = wantarray; # Need to save this since the context
75d07914 603 # inside the eval{} block is independent
604 # of the context that called txn_do()
a62cf8d4 605 eval {
82b01c38 606
24d67825 607 # Need to differentiate between scalar/list context to allow for
608 # returning a list in scalar context to get the size of the list
a62cf8d4 609 if ($wantarray) {
eeb34228 610 # list context
a62cf8d4 611 @return_values = $coderef->(@args);
eeb34228 612 } elsif (defined $wantarray) {
613 # scalar context
a62cf8d4 614 $return_value = $coderef->(@args);
eeb34228 615 } else {
616 # void context
617 $coderef->(@args);
a62cf8d4 618 }
619 $self->txn_commit;
620 };
621
622 if ($@) {
623 my $error = $@;
624
625 eval {
626 $self->txn_rollback;
627 };
628
629 if ($@) {
630 my $rollback_error = $@;
631 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
632 $self->throw_exception($error) # propagate nested rollback
75d07914 633 if $rollback_error =~ /$exception_class/;
a62cf8d4 634
bc0c9800 635 $self->throw_exception(
636 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
637 );
a62cf8d4 638 } else {
639 $self->throw_exception($error); # txn failed but rollback succeeded
640 }
641 }
642
643 return $wantarray ? @return_values : $return_value;
644}
645
66d9ef6b 646=head2 clone
647
27f01d1f 648=over 4
649
d601dc88 650=item Return Value: $new_schema
27f01d1f 651
652=back
82b01c38 653
66d9ef6b 654Clones the schema and its associated result_source objects and returns the
655copy.
656
657=cut
658
659sub clone {
660 my ($self) = @_;
04786a4c 661 my $clone = { (ref $self ? %$self : ()) };
662 bless $clone, (ref $self || $self);
663
66d9ef6b 664 foreach my $moniker ($self->sources) {
665 my $source = $self->source($moniker);
666 my $new = $source->new($source);
667 $clone->register_source($moniker => $new);
668 }
669 return $clone;
670}
671
87c4e602 672=head2 populate
673
27f01d1f 674=over 4
675
16c5f7d3 676=item Arguments: $source_name, \@data;
27f01d1f 677
678=back
a37a4697 679
16c5f7d3 680Pass this method a resultsource name, and an arrayref of
681arrayrefs. The arrayrefs should contain a list of column names,
682followed by one or many sets of matching data for the given columns.
683
684Each set of data is inserted into the database using
685L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
686objects is returned.
82b01c38 687
688i.e.,
a37a4697 689
24d67825 690 $schema->populate('Artist', [
691 [ qw/artistid name/ ],
692 [ 1, 'Popular Band' ],
693 [ 2, 'Indie Band' ],
a62cf8d4 694 ...
695 ]);
a37a4697 696
697=cut
698
699sub populate {
700 my ($self, $name, $data) = @_;
701 my $rs = $self->resultset($name);
702 my @names = @{shift(@$data)};
84e3c114 703 my @created;
a37a4697 704 foreach my $item (@$data) {
705 my %create;
706 @create{@names} = @$item;
84e3c114 707 push(@created, $rs->create(\%create));
a37a4697 708 }
84e3c114 709 return @created;
a37a4697 710}
711
5160b401 712=head2 throw_exception
701da8c4 713
75d07914 714=over 4
82b01c38 715
ebc77b53 716=item Arguments: $message
82b01c38 717
718=back
719
720Throws an exception. Defaults to using L<Carp::Clan> to report errors from
721user's perspective.
701da8c4 722
723=cut
724
725sub throw_exception {
726 my ($self) = shift;
727 croak @_;
728}
729
ec6704d4 730=head2 deploy (EXPERIMENTAL)
1c339d71 731
82b01c38 732=over 4
733
6e73ac25 734=item Arguments: $sqlt_args, $dir
82b01c38 735
736=back
737
738Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 739
740Note that this feature is currently EXPERIMENTAL and may not work correctly
741across all databases, or fully handle complex relationships.
1c339d71 742
51bace1c 743See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
744common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
745produced include a DROP TABLE statement for each table created.
746
1c339d71 747=cut
748
749sub deploy {
6e73ac25 750 my ($self, $sqltargs, $dir) = @_;
1c339d71 751 $self->throw_exception("Can't deploy without storage") unless $self->storage;
6e73ac25 752 $self->storage->deploy($self, undef, $sqltargs, $dir);
1c339d71 753}
754
c0f61310 755=head2 create_ddl_dir (EXPERIMENTAL)
756
757=over 4
758
759=item Arguments: \@databases, $version, $directory, $sqlt_args
760
761=back
762
763Creates an SQL file based on the Schema, for each of the specified
764database types, in the given directory.
765
766Note that this feature is currently EXPERIMENTAL and may not work correctly
767across all databases, or fully handle complex relationships.
768
769=cut
770
6e73ac25 771sub create_ddl_dir {
e673f011 772 my $self = shift;
773
774 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
775 $self->storage->create_ddl_dir($self, @_);
776}
777
9b83fccd 778=head2 ddl_filename (EXPERIMENTAL)
779
780 my $filename = $table->ddl_filename($type, $dir, $version)
781
782Creates a filename for a SQL file based on the table class name. Not
783intended for direct end user use.
784
785=cut
786
6e73ac25 787sub ddl_filename {
e673f011 788 my ($self, $type, $dir, $version) = @_;
789
790 my $filename = ref($self);
9e7b9292 791 $filename =~ s/::/-/;
e673f011 792 $filename = "$dir$filename-$version-$type.sql";
793
794 return $filename;
795}
796
a02675cd 7971;
c2da098a 798
c2da098a 799=head1 AUTHORS
800
daec44b8 801Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 802
803=head1 LICENSE
804
805You may distribute this code under the same terms as Perl itself.
806
807=cut