remove_columns now deletes columns from _columns fixing has_columns false positives
[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
ea20d0fd 172=head2 resultset
173
27f01d1f 174=over 4
175
ebc77b53 176=item Arguments: $moniker
27f01d1f 177
d601dc88 178=item Return Value: $result_set
82b01c38 179
27f01d1f 180=back
82b01c38 181
24d67825 182 my $rs = $schema->resultset('DVD');
ea20d0fd 183
82b01c38 184Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
ea20d0fd 185
186=cut
187
188sub resultset {
0dc79249 189 my ($self, $moniker) = @_;
190 return $self->source($moniker)->resultset;
ea20d0fd 191}
192
87c4e602 193=head2 load_classes
194
27f01d1f 195=over 4
196
197=item Arguments: @classes?, { $namespace => [ @classes ] }+
198
199=back
076652e8 200
82b01c38 201With no arguments, this method uses L<Module::Find> to find all classes under
202the schema's namespace. Otherwise, this method loads the classes you specify
203(using L<use>), and registers them (using L</"register_class">).
076652e8 204
2053ab2a 205It is possible to comment out classes with a leading C<#>, but note that perl
206will think it's a mistake (trying to use a comment in a qw list), so you'll
207need to add C<no warnings 'qw';> before your load_classes call.
5ce32fc1 208
2053ab2a 209Example:
82b01c38 210
211 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
75d07914 212 # etc. (anything under the My::Schema namespace)
82b01c38 213
214 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
215 # not Other::Namespace::LinerNotes nor My::Schema::Track
216 My::Schema->load_classes(qw/ CD Artist #Track /, {
217 Other::Namespace => [qw/ Producer #LinerNotes /],
218 });
219
076652e8 220=cut
221
a02675cd 222sub load_classes {
5ce32fc1 223 my ($class, @params) = @_;
bab77431 224
5ce32fc1 225 my %comps_for;
bab77431 226
5ce32fc1 227 if (@params) {
228 foreach my $param (@params) {
229 if (ref $param eq 'ARRAY') {
230 # filter out commented entries
231 my @modules = grep { $_ !~ /^#/ } @$param;
bab77431 232
5ce32fc1 233 push (@{$comps_for{$class}}, @modules);
234 }
235 elsif (ref $param eq 'HASH') {
236 # more than one namespace possible
237 for my $comp ( keys %$param ) {
238 # filter out commented entries
239 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
240
241 push (@{$comps_for{$comp}}, @modules);
242 }
243 }
244 else {
245 # filter out commented entries
246 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
247 }
248 }
249 } else {
41a6f8c0 250 eval "require Module::Find;";
bc0c9800 251 $class->throw_exception(
252 "No arguments to load_classes and couldn't load Module::Find ($@)"
253 ) if $@;
254 my @comp = map { substr $_, length "${class}::" }
255 Module::Find::findallmod($class);
5ce32fc1 256 $comps_for{$class} = \@comp;
41a6f8c0 257 }
5ce32fc1 258
e6efde04 259 my @to_register;
260 {
261 no warnings qw/redefine/;
262 local *Class::C3::reinitialize = sub { };
263 foreach my $prefix (keys %comps_for) {
264 foreach my $comp (@{$comps_for{$prefix}||[]}) {
265 my $comp_class = "${prefix}::${comp}";
c037c03a 266 $class->ensure_class_loaded($comp_class);
bab77431 267 $comp_class->source_name($comp) unless $comp_class->source_name;
268
269 push(@to_register, [ $comp_class->source_name, $comp_class ]);
bfb2bd4f 270 }
5ce32fc1 271 }
a02675cd 272 }
e6efde04 273 Class::C3->reinitialize;
274
275 foreach my $to (@to_register) {
276 $class->register_class(@$to);
277 # if $class->can('result_source_instance');
278 }
a02675cd 279}
280
87c4e602 281=head2 compose_connection
282
27f01d1f 283=over 4
284
ebc77b53 285=item Arguments: $target_namespace, @db_info
429bd4f1 286
d601dc88 287=item Return Value: $new_schema
27f01d1f 288
289=back
076652e8 290
2053ab2a 291Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
292calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
293then injects the L<DBix::Class::ResultSetProxy> component and a
294resultset_instance classdata entry on all the new classes, in order to support
82b01c38 295$target_namespaces::$class->search(...) method calls.
296
297This is primarily useful when you have a specific need for class method access
298to a connection. In normal usage it is preferred to call
299L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
300on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
301more information.
54540863 302
076652e8 303=cut
304
a02675cd 305sub compose_connection {
ea20d0fd 306 my ($self, $target, @info) = @_;
80c90f5d 307 my $base = 'DBIx::Class::ResultSetProxy';
8ef144ff 308 eval "require ${base};";
bc0c9800 309 $self->throw_exception
310 ("No arguments to load_classes and couldn't load ${base} ($@)")
311 if $@;
be381829 312
313 if ($self eq $target) {
314 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
315 foreach my $moniker ($self->sources) {
316 my $source = $self->source($moniker);
317 my $class = $source->result_class;
318 $self->inject_base($class, $base);
319 $class->mk_classdata(resultset_instance => $source->resultset);
320 $class->mk_classdata(class_resolver => $self);
321 }
50041f3c 322 $self->connection(@info);
be381829 323 return $self;
324 }
325
66d9ef6b 326 my $schema = $self->compose_namespace($target, $base);
ecceadff 327 {
328 no strict 'refs';
329 *{"${target}::schema"} = sub { $schema };
330 }
331
66d9ef6b 332 $schema->connection(@info);
0dc79249 333 foreach my $moniker ($schema->sources) {
334 my $source = $schema->source($moniker);
335 my $class = $source->result_class;
336 #warn "$moniker $class $source ".$source->storage;
8c49f629 337 $class->mk_classdata(result_source_instance => $source);
ea20d0fd 338 $class->mk_classdata(resultset_instance => $source->resultset);
66d9ef6b 339 $class->mk_classdata(class_resolver => $schema);
bfb2bd4f 340 }
341 return $schema;
e678398e 342}
343
77254782 344=head2 compose_namespace
345
27f01d1f 346=over 4
347
348=item Arguments: $target_namespace, $additional_base_class?
82b01c38 349
d601dc88 350=item Return Value: $new_schema
27f01d1f 351
352=back
13765dad 353
82b01c38 354For each L<DBIx::Class::ResultSource> in the schema, this method creates a
355class in the target namespace (e.g. $target_namespace::CD,
356$target_namespace::Artist) that inherits from the corresponding classes
357attached to the current schema.
77254782 358
82b01c38 359It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
360new $schema object. If C<$additional_base_class> is given, the new composed
361classes will inherit from first the corresponding classe from the current
362schema then the base class.
363
2053ab2a 364For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
82b01c38 365
366 $schema->compose_namespace('My::DB', 'Base::Class');
367 print join (', ', @My::DB::CD::ISA) . "\n";
368 print join (', ', @My::DB::Artist::ISA) ."\n";
369
2053ab2a 370will produce the output
82b01c38 371
372 My::Schema::CD, Base::Class
373 My::Schema::Artist, Base::Class
77254782 374
375=cut
376
e678398e 377sub compose_namespace {
66d9ef6b 378 my ($self, $target, $base) = @_;
379 my %reg = %{ $self->source_registrations };
11b78bd6 380 my %target;
381 my %map;
66d9ef6b 382 my $schema = $self->clone;
e9100ff7 383 {
384 no warnings qw/redefine/;
385 local *Class::C3::reinitialize = sub { };
386 foreach my $moniker ($schema->sources) {
387 my $source = $schema->source($moniker);
388 my $target_class = "${target}::${moniker}";
389 $self->inject_base(
390 $target_class => $source->result_class, ($base ? $base : ())
391 );
392 $source->result_class($target_class);
9d3d5af3 393 $target_class->result_source_instance($source)
394 if $target_class->can('result_source_instance');
e9100ff7 395 }
b7951443 396 }
e9100ff7 397 Class::C3->reinitialize();
11b78bd6 398 {
399 no strict 'refs';
1edaf6fe 400 foreach my $meth (qw/class source resultset/) {
401 *{"${target}::${meth}"} =
402 sub { shift->schema->$meth(@_) };
403 }
11b78bd6 404 }
bfb2bd4f 405 return $schema;
b7951443 406}
407
87c4e602 408=head2 setup_connection_class
409
27f01d1f 410=over 4
411
ebc77b53 412=item Arguments: $target, @info
27f01d1f 413
414=back
076652e8 415
82b01c38 416Sets up a database connection class to inject between the schema and the
417subclasses that the schema creates.
429bd4f1 418
076652e8 419=cut
420
b7951443 421sub setup_connection_class {
422 my ($class, $target, @info) = @_;
63e9583a 423 $class->inject_base($target => 'DBIx::Class::DB');
424 #$target->load_components('DB');
b7951443 425 $target->connection(@info);
426}
427
87c4e602 428=head2 connection
429
27f01d1f 430=over 4
431
ebc77b53 432=item Arguments: @args
66d9ef6b 433
d601dc88 434=item Return Value: $new_schema
27f01d1f 435
436=back
82b01c38 437
438Instantiates a new Storage object of type
439L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
440$storage->connect_info. Sets the connection in-place on the schema. See
441L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
66d9ef6b 442
443=cut
444
445sub connection {
446 my ($self, @info) = @_;
e59d3e5b 447 return $self if !@info && $self->storage;
1e10a11d 448 my $storage_class = $self->storage_type;
449 $storage_class = 'DBIx::Class::Storage'.$storage_class
450 if $storage_class =~ m/^::/;
8ef144ff 451 eval "require ${storage_class};";
bc0c9800 452 $self->throw_exception(
453 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
454 ) if $@;
66d9ef6b 455 my $storage = $storage_class->new;
456 $storage->connect_info(\@info);
457 $self->storage($storage);
458 return $self;
459}
460
87c4e602 461=head2 connect
462
27f01d1f 463=over 4
464
ebc77b53 465=item Arguments: @info
66d9ef6b 466
d601dc88 467=item Return Value: $new_schema
27f01d1f 468
469=back
82b01c38 470
471This is a convenience method. It is equivalent to calling
472$schema->clone->connection(@info). See L</connection> and L</clone> for more
473information.
66d9ef6b 474
475=cut
476
08b515f1 477sub connect { shift->clone->connection(@_) }
478
479=head2 txn_begin
480
82b01c38 481Begins a transaction (does nothing if AutoCommit is off). Equivalent to
482calling $schema->storage->txn_begin. See
483L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
08b515f1 484
485=cut
486
487sub txn_begin { shift->storage->txn_begin }
488
489=head2 txn_commit
490
82b01c38 491Commits the current transaction. Equivalent to calling
492$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
493for more information.
08b515f1 494
495=cut
496
497sub txn_commit { shift->storage->txn_commit }
498
499=head2 txn_rollback
500
82b01c38 501Rolls back the current transaction. Equivalent to calling
502$schema->storage->txn_rollback. See
503L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
08b515f1 504
505=cut
506
507sub txn_rollback { shift->storage->txn_rollback }
66d9ef6b 508
a62cf8d4 509=head2 txn_do
510
27f01d1f 511=over 4
512
ebc77b53 513=item Arguments: C<$coderef>, @coderef_args?
82b01c38 514
d601dc88 515=item Return Value: The return value of $coderef
27f01d1f 516
517=back
a62cf8d4 518
82b01c38 519Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
520returning its result (if any). If an exception is caught, a rollback is issued
521and the exception is rethrown. If the rollback fails, (i.e. throws an
522exception) an exception is thrown that includes a "Rollback failed" message.
a62cf8d4 523
524For example,
525
24d67825 526 my $author_rs = $schema->resultset('Author')->find(1);
70634260 527 my @titles = qw/Night Day It/;
a62cf8d4 528
529 my $coderef = sub {
a62cf8d4 530 # If any one of these fails, the entire transaction fails
70634260 531 $author_rs->create_related('books', {
24d67825 532 title => $_
533 }) foreach (@titles);
a62cf8d4 534
24d67825 535 return $author->books;
a62cf8d4 536 };
537
538 my $rs;
539 eval {
70634260 540 $rs = $schema->txn_do($coderef);
a62cf8d4 541 };
542
70634260 543 if ($@) { # Transaction failed
544 die "something terrible has happened!" #
545 if ($@ =~ /Rollback failed/); # Rollback failed
546
547 deal_with_failed_transaction();
a62cf8d4 548 }
549
82b01c38 550In a nested transaction (calling txn_do() from within a txn_do() coderef) only
551the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
552the Schema's storage, and txn_do() can be called in void, scalar and list
553context and it will behave as expected.
a62cf8d4 554
555=cut
556
557sub txn_do {
558 my ($self, $coderef, @args) = @_;
559
19630353 560 $self->storage or $self->throw_exception
561 ('txn_do called on $schema without storage');
171dadd7 562 ref $coderef eq 'CODE' or $self->throw_exception
563 ('$coderef must be a CODE reference');
a62cf8d4 564
565 my (@return_values, $return_value);
566
567 $self->txn_begin; # If this throws an exception, no rollback is needed
568
e7f2b7d5 569 my $wantarray = wantarray; # Need to save this since the context
75d07914 570 # inside the eval{} block is independent
571 # of the context that called txn_do()
a62cf8d4 572 eval {
82b01c38 573
24d67825 574 # Need to differentiate between scalar/list context to allow for
575 # returning a list in scalar context to get the size of the list
a62cf8d4 576 if ($wantarray) {
eeb34228 577 # list context
a62cf8d4 578 @return_values = $coderef->(@args);
eeb34228 579 } elsif (defined $wantarray) {
580 # scalar context
a62cf8d4 581 $return_value = $coderef->(@args);
eeb34228 582 } else {
583 # void context
584 $coderef->(@args);
a62cf8d4 585 }
586 $self->txn_commit;
587 };
588
589 if ($@) {
590 my $error = $@;
591
592 eval {
593 $self->txn_rollback;
594 };
595
596 if ($@) {
597 my $rollback_error = $@;
598 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
599 $self->throw_exception($error) # propagate nested rollback
75d07914 600 if $rollback_error =~ /$exception_class/;
a62cf8d4 601
bc0c9800 602 $self->throw_exception(
603 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
604 );
a62cf8d4 605 } else {
606 $self->throw_exception($error); # txn failed but rollback succeeded
607 }
608 }
609
610 return $wantarray ? @return_values : $return_value;
611}
612
66d9ef6b 613=head2 clone
614
27f01d1f 615=over 4
616
d601dc88 617=item Return Value: $new_schema
27f01d1f 618
619=back
82b01c38 620
66d9ef6b 621Clones the schema and its associated result_source objects and returns the
622copy.
623
624=cut
625
626sub clone {
627 my ($self) = @_;
04786a4c 628 my $clone = { (ref $self ? %$self : ()) };
629 bless $clone, (ref $self || $self);
630
66d9ef6b 631 foreach my $moniker ($self->sources) {
632 my $source = $self->source($moniker);
633 my $new = $source->new($source);
634 $clone->register_source($moniker => $new);
635 }
636 return $clone;
637}
638
87c4e602 639=head2 populate
640
27f01d1f 641=over 4
642
ebc77b53 643=item Arguments: $moniker, \@data;
27f01d1f 644
645=back
a37a4697 646
647Populates the source registered with the given moniker with the supplied data.
82b01c38 648@data should be a list of listrefs -- the first containing column names, the
649second matching values.
650
651i.e.,
a37a4697 652
24d67825 653 $schema->populate('Artist', [
654 [ qw/artistid name/ ],
655 [ 1, 'Popular Band' ],
656 [ 2, 'Indie Band' ],
a62cf8d4 657 ...
658 ]);
a37a4697 659
660=cut
661
662sub populate {
663 my ($self, $name, $data) = @_;
664 my $rs = $self->resultset($name);
665 my @names = @{shift(@$data)};
84e3c114 666 my @created;
a37a4697 667 foreach my $item (@$data) {
668 my %create;
669 @create{@names} = @$item;
84e3c114 670 push(@created, $rs->create(\%create));
a37a4697 671 }
84e3c114 672 return @created;
a37a4697 673}
674
5160b401 675=head2 throw_exception
701da8c4 676
75d07914 677=over 4
82b01c38 678
ebc77b53 679=item Arguments: $message
82b01c38 680
681=back
682
683Throws an exception. Defaults to using L<Carp::Clan> to report errors from
684user's perspective.
701da8c4 685
686=cut
687
688sub throw_exception {
689 my ($self) = shift;
690 croak @_;
691}
692
ec6704d4 693=head2 deploy (EXPERIMENTAL)
1c339d71 694
82b01c38 695=over 4
696
6e73ac25 697=item Arguments: $sqlt_args, $dir
82b01c38 698
699=back
700
701Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 702
703Note that this feature is currently EXPERIMENTAL and may not work correctly
704across all databases, or fully handle complex relationships.
1c339d71 705
51bace1c 706See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
707common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
708produced include a DROP TABLE statement for each table created.
709
1c339d71 710=cut
711
712sub deploy {
6e73ac25 713 my ($self, $sqltargs, $dir) = @_;
1c339d71 714 $self->throw_exception("Can't deploy without storage") unless $self->storage;
6e73ac25 715 $self->storage->deploy($self, undef, $sqltargs, $dir);
1c339d71 716}
717
c0f61310 718=head2 create_ddl_dir (EXPERIMENTAL)
719
720=over 4
721
722=item Arguments: \@databases, $version, $directory, $sqlt_args
723
724=back
725
726Creates an SQL file based on the Schema, for each of the specified
727database types, in the given directory.
728
729Note that this feature is currently EXPERIMENTAL and may not work correctly
730across all databases, or fully handle complex relationships.
731
732=cut
733
6e73ac25 734sub create_ddl_dir {
e673f011 735 my $self = shift;
736
737 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
738 $self->storage->create_ddl_dir($self, @_);
739}
740
9b83fccd 741=head2 ddl_filename (EXPERIMENTAL)
742
743 my $filename = $table->ddl_filename($type, $dir, $version)
744
745Creates a filename for a SQL file based on the table class name. Not
746intended for direct end user use.
747
748=cut
749
6e73ac25 750sub ddl_filename {
e673f011 751 my ($self, $type, $dir, $version) = @_;
752
753 my $filename = ref($self);
9e7b9292 754 $filename =~ s/::/-/;
e673f011 755 $filename = "$dir$filename-$version-$type.sql";
756
757 return $filename;
758}
759
a02675cd 7601;
c2da098a 761
c2da098a 762=head1 AUTHORS
763
daec44b8 764Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 765
766=head1 LICENSE
767
768You may distribute this code under the same terms as Perl itself.
769
770=cut