X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=7926e92c4f58a9d7e3c46d8b9a5bb129815238d6;hb=f32eb113ef8eeecae466e2e950382bc4f7c5469d;hp=4f3a5457c1309d56b99d427e705635dbe78e4f8d;hpb=d601dc88fcedcf9b0ef3c17c29556e26179c1cdc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 4f3a545..7926e92 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -4,6 +4,7 @@ use strict; use warnings; use Carp::Clan qw/^DBIx::Class/; +use Scalar::Util qw/weaken/; use base qw/DBIx::Class/; @@ -20,7 +21,7 @@ DBIx::Class::Schema - composable schemas package Library::Schema; use base qw/DBIx::Class::Schema/; - + # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD __PACKAGE__->load_classes(qw/CD Book DVD/); @@ -36,7 +37,7 @@ DBIx::Class::Schema - composable schemas $password, { AutoCommit => 0 }, ); - + my $schema2 = Library::Schema->connect($coderef_returning_dbh); # fetch objects using Library::Schema::DVD @@ -50,7 +51,7 @@ use L and allows you to use more than one concurrent connection with your classes. NB: If you're used to L it's worth reading the L -carefully as DBIx::Class does things a little differently. Note in +carefully, as DBIx::Class does things a little differently. Note in particular which module inherits off which. =head1 METHODS @@ -59,12 +60,12 @@ particular which module inherits off which. =over 4 -=item Arguments: ($moniker, $component_class) +=item Arguments: $moniker, $component_class =back -Registers a class which isa L. Equivalent to -calling +Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to +calling: $schema->register_source($moniker, $component_class->result_source_instance); @@ -79,7 +80,7 @@ sub register_class { =over 4 -=item Arguments: ($moniker, $result_source) +=item Arguments: $moniker, $result_source =back @@ -94,26 +95,25 @@ sub register_source { $reg{$moniker} = $source; $self->source_registrations(\%reg); $source->schema($self); + weaken($source->{schema}) if ref($self); if ($source->result_class) { my %map = %{$self->class_mappings}; $map{$source->result_class} = $moniker; $self->class_mappings(\%map); } -} +} =head2 class =over 4 -=item Arguments: ($moniker) +=item Arguments: $moniker =item Return Value: $classname =back -Retrieves the result class name for the given moniker. - -e.g., +Retrieves the result class name for the given moniker. For example: my $class = $schema->class('CD'); @@ -128,7 +128,7 @@ sub class { =over 4 -=item Arguments: ($moniker) +=item Arguments: $moniker =item Return Value: $result_source @@ -161,8 +161,7 @@ sub source { =back Returns the source monikers of all source registrations on this schema. - -e.g., +For example: my @source_monikers = $schema->sources; @@ -174,7 +173,7 @@ sub sources { return keys %{shift->source_registrations}; } =over 4 -=item Arguments: ($moniker) +=item Arguments: $moniker =item Return Value: $result_set @@ -203,14 +202,14 @@ With no arguments, this method uses L to find all classes under the schema's namespace. Otherwise, this method loads the classes you specify (using L), and registers them (using L). -It is possible to comment out classes with a leading '#', but note that perl -will think it's a mistake (trying to use a comment in a qw list) so you'll -need to add "no warnings 'qw';" before your load_classes call. +It is possible to comment out classes with a leading C<#>, but note that perl +will think it's a mistake (trying to use a comment in a qw list), so you'll +need to add C before your load_classes call. -e.g., +Example: My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist, - # etc. (anything under the My::Schema namespace) + # etc. (anything under the My::Schema namespace) # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but # not Other::Namespace::LinerNotes nor My::Schema::Track @@ -222,15 +221,15 @@ e.g., sub load_classes { my ($class, @params) = @_; - + my %comps_for; - + if (@params) { foreach my $param (@params) { if (ref $param eq 'ARRAY') { # filter out commented entries my @modules = grep { $_ !~ /^#/ } @$param; - + push (@{$comps_for{$class}}, @modules); } elsif (ref $param eq 'HASH') { @@ -264,13 +263,10 @@ sub load_classes { foreach my $prefix (keys %comps_for) { foreach my $comp (@{$comps_for{$prefix}||[]}) { my $comp_class = "${prefix}::${comp}"; - eval "use $comp_class"; # If it fails, assume the user fixed it - if ($@) { - $comp_class =~ s/::/\//g; - die $@ unless $@ =~ /Can't locate.+$comp_class\.pm\sin\s\@INC/; - warn $@ if $@; - } - push(@to_register, [ $comp, $comp_class ]); + $class->ensure_class_loaded($comp_class); + $comp_class->source_name($comp) unless $comp_class->source_name; + + push(@to_register, [ $comp_class->source_name, $comp_class ]); } } } @@ -286,16 +282,16 @@ sub load_classes { =over 4 -=item Arguments: ($target_namespace, @db_info) +=item Arguments: $target_namespace, @db_info =item Return Value: $new_schema =back -Calls L to the target namespace, -calls L(@db_info) on the new schema, then -injects the L component and a resultset_instance -classdata entry on all the new classes in order to support +Calls L to the target namespace, +calls L with @db_info on the new schema, +then injects the L component and a +resultset_instance classdata entry on all the new classes, in order to support $target_namespaces::$class->search(...) method calls. This is primarily useful when you have a specific need for class method access @@ -365,13 +361,13 @@ new $schema object. If C<$additional_base_class> is given, the new composed classes will inherit from first the corresponding classe from the current schema then the base class. -e.g. (for a schema with My::Schema::CD and My::Schema::Artist classes), +For example, for a schema with My::Schema::CD and My::Schema::Artist classes, $schema->compose_namespace('My::DB', 'Base::Class'); print join (', ', @My::DB::CD::ISA) . "\n"; print join (', ', @My::DB::Artist::ISA) ."\n"; -Will produce the output +will produce the output My::Schema::CD, Base::Class My::Schema::Artist, Base::Class @@ -411,7 +407,7 @@ sub compose_namespace { =over 4 -=item Arguments: ($target, @info) +=item Arguments: $target, @info =back @@ -431,7 +427,7 @@ sub setup_connection_class { =over 4 -=item Arguments: (@args) +=item Arguments: @args =item Return Value: $new_schema @@ -464,7 +460,7 @@ sub connection { =over 4 -=item Arguments: (@info) +=item Arguments: @info =item Return Value: $new_schema @@ -512,7 +508,7 @@ sub txn_rollback { shift->storage->txn_rollback } =over 4 -=item Arguments: (C<$coderef>, @coderef_args?) +=item Arguments: C<$coderef>, @coderef_args? =item Return Value: The return value of $coderef @@ -526,12 +522,11 @@ exception) an exception is thrown that includes a "Rollback failed" message. For example, my $author_rs = $schema->resultset('Author')->find(1); + my @titles = qw/Night Day It/; my $coderef = sub { - my ($author, @titles) = @_; - # If any one of these fails, the entire transaction fails - $author->create_related('books', { + $author_rs->create_related('books', { title => $_ }) foreach (@titles); @@ -540,16 +535,14 @@ For example, my $rs; eval { - $rs = $schema->txn_do($coderef, $author_rs, qw/Night Day It/); + $rs = $schema->txn_do($coderef); }; - if ($@) { - my $error = $@; - if ($error =~ /Rollback failed/) { - die "something terrible has happened!"; - } else { - deal_with_failed_transaction(); - } + if ($@) { # Transaction failed + die "something terrible has happened!" # + if ($@ =~ /Rollback failed/); # Rollback failed + + deal_with_failed_transaction(); } In a nested transaction (calling txn_do() from within a txn_do() coderef) only @@ -562,8 +555,6 @@ context and it will behave as expected. sub txn_do { my ($self, $coderef, @args) = @_; - ref $self or $self->throw_exception - ('Cannot execute txn_do as a class method'); ref $coderef eq 'CODE' or $self->throw_exception ('$coderef must be a CODE reference'); @@ -572,8 +563,8 @@ sub txn_do { $self->txn_begin; # If this throws an exception, no rollback is needed my $wantarray = wantarray; # Need to save this since the context - # inside the eval{} block is independent - # of the context that called txn_do() + # inside the eval{} block is independent + # of the context that called txn_do() eval { # Need to differentiate between scalar/list context to allow for @@ -602,7 +593,7 @@ sub txn_do { my $rollback_error = $@; my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION"; $self->throw_exception($error) # propagate nested rollback - if $rollback_error =~ /$exception_class/; + if $rollback_error =~ /$exception_class/; $self->throw_exception( "Transaction aborted: $error. Rollback failed: ${rollback_error}" @@ -643,7 +634,7 @@ sub clone { =over 4 -=item Arguments: ($moniker, \@data); +=item Arguments: $moniker, \@data; =back @@ -677,9 +668,9 @@ sub populate { =head2 throw_exception -=over 4 +=over 4 -=item Arguments: ($message) +=item Arguments: $message =back @@ -697,7 +688,7 @@ sub throw_exception { =over 4 -=item Arguments: ($sqlt_args) +=item Arguments: $sqlt_args =back @@ -714,6 +705,50 @@ sub deploy { $self->storage->deploy($self, undef, $sqltargs); } +=head2 create_ddl_dir (EXPERIMENTAL) + +=over 4 + +=item Arguments: \@databases, $version, $directory, $sqlt_args + +=back + +Creates an SQL file based on the Schema, for each of the specified +database types, in the given directory. + +Note that this feature is currently EXPERIMENTAL and may not work correctly +across all databases, or fully handle complex relationships. + +=cut + +sub create_ddl_dir +{ + my $self = shift; + + $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage; + $self->storage->create_ddl_dir($self, @_); +} + +=head2 ddl_filename (EXPERIMENTAL) + + my $filename = $table->ddl_filename($type, $dir, $version) + +Creates a filename for a SQL file based on the table class name. Not +intended for direct end user use. + +=cut + +sub ddl_filename +{ + my ($self, $type, $dir, $version) = @_; + + my $filename = ref($self); + $filename =~ s/^.*:://; + $filename = "$dir$filename-$version-$type.sql"; + + return $filename; +} + 1; =head1 AUTHORS