Add automatic naming of unique constraints
[dbsrgits/DBIx-Class.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);
393 }
b7951443 394 }
e9100ff7 395 Class::C3->reinitialize();
11b78bd6 396 {
397 no strict 'refs';
1edaf6fe 398 foreach my $meth (qw/class source resultset/) {
399 *{"${target}::${meth}"} =
400 sub { shift->schema->$meth(@_) };
401 }
11b78bd6 402 }
bfb2bd4f 403 return $schema;
b7951443 404}
405
87c4e602 406=head2 setup_connection_class
407
27f01d1f 408=over 4
409
ebc77b53 410=item Arguments: $target, @info
27f01d1f 411
412=back
076652e8 413
82b01c38 414Sets up a database connection class to inject between the schema and the
415subclasses that the schema creates.
429bd4f1 416
076652e8 417=cut
418
b7951443 419sub setup_connection_class {
420 my ($class, $target, @info) = @_;
63e9583a 421 $class->inject_base($target => 'DBIx::Class::DB');
422 #$target->load_components('DB');
b7951443 423 $target->connection(@info);
424}
425
87c4e602 426=head2 connection
427
27f01d1f 428=over 4
429
ebc77b53 430=item Arguments: @args
66d9ef6b 431
d601dc88 432=item Return Value: $new_schema
27f01d1f 433
434=back
82b01c38 435
436Instantiates a new Storage object of type
437L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
438$storage->connect_info. Sets the connection in-place on the schema. See
439L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
66d9ef6b 440
441=cut
442
443sub connection {
444 my ($self, @info) = @_;
e59d3e5b 445 return $self if !@info && $self->storage;
1e10a11d 446 my $storage_class = $self->storage_type;
447 $storage_class = 'DBIx::Class::Storage'.$storage_class
448 if $storage_class =~ m/^::/;
8ef144ff 449 eval "require ${storage_class};";
bc0c9800 450 $self->throw_exception(
451 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
452 ) if $@;
66d9ef6b 453 my $storage = $storage_class->new;
454 $storage->connect_info(\@info);
455 $self->storage($storage);
456 return $self;
457}
458
87c4e602 459=head2 connect
460
27f01d1f 461=over 4
462
ebc77b53 463=item Arguments: @info
66d9ef6b 464
d601dc88 465=item Return Value: $new_schema
27f01d1f 466
467=back
82b01c38 468
469This is a convenience method. It is equivalent to calling
470$schema->clone->connection(@info). See L</connection> and L</clone> for more
471information.
66d9ef6b 472
473=cut
474
08b515f1 475sub connect { shift->clone->connection(@_) }
476
477=head2 txn_begin
478
82b01c38 479Begins a transaction (does nothing if AutoCommit is off). Equivalent to
480calling $schema->storage->txn_begin. See
481L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
08b515f1 482
483=cut
484
485sub txn_begin { shift->storage->txn_begin }
486
487=head2 txn_commit
488
82b01c38 489Commits the current transaction. Equivalent to calling
490$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
491for more information.
08b515f1 492
493=cut
494
495sub txn_commit { shift->storage->txn_commit }
496
497=head2 txn_rollback
498
82b01c38 499Rolls back the current transaction. Equivalent to calling
500$schema->storage->txn_rollback. See
501L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
08b515f1 502
503=cut
504
505sub txn_rollback { shift->storage->txn_rollback }
66d9ef6b 506
a62cf8d4 507=head2 txn_do
508
27f01d1f 509=over 4
510
ebc77b53 511=item Arguments: C<$coderef>, @coderef_args?
82b01c38 512
d601dc88 513=item Return Value: The return value of $coderef
27f01d1f 514
515=back
a62cf8d4 516
82b01c38 517Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
518returning its result (if any). If an exception is caught, a rollback is issued
519and the exception is rethrown. If the rollback fails, (i.e. throws an
520exception) an exception is thrown that includes a "Rollback failed" message.
a62cf8d4 521
522For example,
523
24d67825 524 my $author_rs = $schema->resultset('Author')->find(1);
70634260 525 my @titles = qw/Night Day It/;
a62cf8d4 526
527 my $coderef = sub {
a62cf8d4 528 # If any one of these fails, the entire transaction fails
70634260 529 $author_rs->create_related('books', {
24d67825 530 title => $_
531 }) foreach (@titles);
a62cf8d4 532
24d67825 533 return $author->books;
a62cf8d4 534 };
535
536 my $rs;
537 eval {
70634260 538 $rs = $schema->txn_do($coderef);
a62cf8d4 539 };
540
70634260 541 if ($@) { # Transaction failed
542 die "something terrible has happened!" #
543 if ($@ =~ /Rollback failed/); # Rollback failed
544
545 deal_with_failed_transaction();
a62cf8d4 546 }
547
82b01c38 548In a nested transaction (calling txn_do() from within a txn_do() coderef) only
549the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
550the Schema's storage, and txn_do() can be called in void, scalar and list
551context and it will behave as expected.
a62cf8d4 552
553=cut
554
555sub txn_do {
556 my ($self, $coderef, @args) = @_;
557
171dadd7 558 ref $self or $self->throw_exception
559 ('Cannot execute txn_do as a class method');
560 ref $coderef eq 'CODE' or $self->throw_exception
561 ('$coderef must be a CODE reference');
a62cf8d4 562
563 my (@return_values, $return_value);
564
565 $self->txn_begin; # If this throws an exception, no rollback is needed
566
e7f2b7d5 567 my $wantarray = wantarray; # Need to save this since the context
75d07914 568 # inside the eval{} block is independent
569 # of the context that called txn_do()
a62cf8d4 570 eval {
82b01c38 571
24d67825 572 # Need to differentiate between scalar/list context to allow for
573 # returning a list in scalar context to get the size of the list
a62cf8d4 574 if ($wantarray) {
eeb34228 575 # list context
a62cf8d4 576 @return_values = $coderef->(@args);
eeb34228 577 } elsif (defined $wantarray) {
578 # scalar context
a62cf8d4 579 $return_value = $coderef->(@args);
eeb34228 580 } else {
581 # void context
582 $coderef->(@args);
a62cf8d4 583 }
584 $self->txn_commit;
585 };
586
587 if ($@) {
588 my $error = $@;
589
590 eval {
591 $self->txn_rollback;
592 };
593
594 if ($@) {
595 my $rollback_error = $@;
596 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
597 $self->throw_exception($error) # propagate nested rollback
75d07914 598 if $rollback_error =~ /$exception_class/;
a62cf8d4 599
bc0c9800 600 $self->throw_exception(
601 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
602 );
a62cf8d4 603 } else {
604 $self->throw_exception($error); # txn failed but rollback succeeded
605 }
606 }
607
608 return $wantarray ? @return_values : $return_value;
609}
610
66d9ef6b 611=head2 clone
612
27f01d1f 613=over 4
614
d601dc88 615=item Return Value: $new_schema
27f01d1f 616
617=back
82b01c38 618
66d9ef6b 619Clones the schema and its associated result_source objects and returns the
620copy.
621
622=cut
623
624sub clone {
625 my ($self) = @_;
626 my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
627 foreach my $moniker ($self->sources) {
628 my $source = $self->source($moniker);
629 my $new = $source->new($source);
630 $clone->register_source($moniker => $new);
631 }
632 return $clone;
633}
634
87c4e602 635=head2 populate
636
27f01d1f 637=over 4
638
ebc77b53 639=item Arguments: $moniker, \@data;
27f01d1f 640
641=back
a37a4697 642
643Populates the source registered with the given moniker with the supplied data.
82b01c38 644@data should be a list of listrefs -- the first containing column names, the
645second matching values.
646
647i.e.,
a37a4697 648
24d67825 649 $schema->populate('Artist', [
650 [ qw/artistid name/ ],
651 [ 1, 'Popular Band' ],
652 [ 2, 'Indie Band' ],
a62cf8d4 653 ...
654 ]);
a37a4697 655
656=cut
657
658sub populate {
659 my ($self, $name, $data) = @_;
660 my $rs = $self->resultset($name);
661 my @names = @{shift(@$data)};
84e3c114 662 my @created;
a37a4697 663 foreach my $item (@$data) {
664 my %create;
665 @create{@names} = @$item;
84e3c114 666 push(@created, $rs->create(\%create));
a37a4697 667 }
84e3c114 668 return @created;
a37a4697 669}
670
5160b401 671=head2 throw_exception
701da8c4 672
75d07914 673=over 4
82b01c38 674
ebc77b53 675=item Arguments: $message
82b01c38 676
677=back
678
679Throws an exception. Defaults to using L<Carp::Clan> to report errors from
680user's perspective.
701da8c4 681
682=cut
683
684sub throw_exception {
685 my ($self) = shift;
686 croak @_;
687}
688
ec6704d4 689=head2 deploy (EXPERIMENTAL)
1c339d71 690
82b01c38 691=over 4
692
ebc77b53 693=item Arguments: $sqlt_args
82b01c38 694
695=back
696
697Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 698
699Note that this feature is currently EXPERIMENTAL and may not work correctly
700across all databases, or fully handle complex relationships.
1c339d71 701
702=cut
703
704sub deploy {
cb561d1a 705 my ($self, $sqltargs) = @_;
1c339d71 706 $self->throw_exception("Can't deploy without storage") unless $self->storage;
cb561d1a 707 $self->storage->deploy($self, undef, $sqltargs);
1c339d71 708}
709
c0f61310 710=head2 create_ddl_dir (EXPERIMENTAL)
711
712=over 4
713
714=item Arguments: \@databases, $version, $directory, $sqlt_args
715
716=back
717
718Creates an SQL file based on the Schema, for each of the specified
719database types, in the given directory.
720
721Note that this feature is currently EXPERIMENTAL and may not work correctly
722across all databases, or fully handle complex relationships.
723
724=cut
725
e673f011 726sub create_ddl_dir
727{
728 my $self = shift;
729
730 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
731 $self->storage->create_ddl_dir($self, @_);
732}
733
734sub ddl_filename
735{
736 my ($self, $type, $dir, $version) = @_;
737
738 my $filename = ref($self);
739 $filename =~ s/^.*:://;
740 $filename = "$dir$filename-$version-$type.sql";
741
742 return $filename;
743}
744
a02675cd 7451;
c2da098a 746
c2da098a 747=head1 AUTHORS
748
daec44b8 749Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 750
751=head1 LICENSE
752
753You may distribute this code under the same terms as Perl itself.
754
755=cut
756