X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=a1571bc259c241b998e9c0646ff995bb5cd2587c;hb=dfccde48eb29595cf5e960151e3c114a959290b4;hp=1bcd5b396ddf0f7120692783c3293cc057a69d75;hpb=499adf63a229da95792cee478529a7d164f3b44d;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 1bcd5b3..a1571bc 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -3,6 +3,7 @@ package DBIx::Class::Schema; use strict; use warnings; +use DBIx::Class::Exception; use Carp::Clan qw/^DBIx::Class/; use Scalar::Util qw/weaken/; use File::Spec; @@ -15,6 +16,7 @@ __PACKAGE__->mk_classdata('source_registrations' => {}); __PACKAGE__->mk_classdata('storage_type' => '::DBI'); __PACKAGE__->mk_classdata('storage'); __PACKAGE__->mk_classdata('exception_action'); +__PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0); =head1 NAME @@ -94,10 +96,15 @@ moniker. sub register_source { my ($self, $moniker, $source) = @_; + + %$source = %{ $source->new( { %$source, source_name => $moniker }) }; + my %reg = %{$self->source_registrations}; $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}; @@ -106,6 +113,19 @@ sub register_source { } } +sub _unregister_source { + my ($self, $moniker) = @_; + my %reg = %{$self->source_registrations}; + + my $source = delete $reg{$moniker}; + $self->source_registrations(\%reg); + if ($source->result_class) { + my %map = %{$self->class_mappings}; + delete $map{$source->result_class}; + $self->class_mappings(\%map); + } +} + =head2 class =over 4 @@ -276,9 +296,10 @@ sub load_classes { } } $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 ]); + $comp = $comp_class->source_name || $comp; +# $DB::single = 1; + push(@to_register, [ $comp, $comp_class ]); } } } @@ -484,7 +505,8 @@ more information. sub compose_connection { my ($self, $target, @info) = @_; - warn "compose_connection deprecated as of 0.08000" unless $warn++; + warn "compose_connection deprecated as of 0.08000" + unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++); my $base = 'DBIx::Class::ResultSetProxy'; eval "require ${base};"; @@ -559,9 +581,6 @@ will produce the output sub compose_namespace { my ($self, $target, $base) = @_; - my %reg = %{ $self->source_registrations }; - my %target; - my %map; my $schema = $self->clone; { no warnings qw/redefine/; @@ -660,7 +679,6 @@ sub connection { my $storage = $storage_class->new($self); $storage->connect_info(\@info); $self->storage($storage); - $self->on_connect() if($self->can('on_connect')); return $self; } @@ -833,7 +851,15 @@ sub populate { } return @created; } - $self->storage->insert_bulk($self->source($name)->from, \@names, $data); + my @results_to_create; + foreach my $datum (@$data) { + my %result_to_create; + foreach my $index (0..$#names) { + $result_to_create{$names[$index]} = $$datum[$index]; + } + push @results_to_create, \%result_to_create; + } + $rs->populate(\@results_to_create); } =head2 exception_action @@ -846,7 +872,7 @@ sub populate { If C is set for this class/object, L will prefer to call this code reference with the exception as an argument, -rather than its normal action. +rather than its normal C or C action. Your subroutine should probably just wrap the error in the exception object/class of your choosing and rethrow. If, against all sage advice, @@ -868,6 +894,18 @@ Example: # suppress all exceptions, like a moron: $schema_obj->exception_action(sub { 1 }); +=head2 stacktrace + +=over 4 + +=item Arguments: boolean + +=back + +Whether L should include stack trace information. +Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}> +is true. + =head2 throw_exception =over 4 @@ -878,16 +916,19 @@ Example: Throws an exception. Defaults to using L to report errors from user's perspective. See L for details on overriding -this method's behavior. +this method's behavior. If L is turned on, C's +default behavior will provide a detailed stack trace. =cut sub throw_exception { my $self = shift; - croak @_ if !$self->exception_action || !$self->exception_action->(@_); + + DBIx::Class::Exception->throw($_[0], $self->stacktrace) + if !$self->exception_action || !$self->exception_action->(@_); } -=head2 deploy (EXPERIMENTAL) +=head2 deploy =over 4 @@ -897,10 +938,6 @@ sub throw_exception { Attempts to deploy the schema to the current storage using L. -Note that this feature is currently EXPERIMENTAL and may not work correctly -across all databases, or fully handle complex relationships. Saying that, it -has been used successfully by many people, including the core dev team. - See L for a list of values for C<$sqlt_args>. The most common value for this would be C<< { add_drop_table => 1, } >> to have the SQL produced include a DROP TABLE statement for each table created. @@ -988,7 +1025,7 @@ sub ddl_filename { my ($self, $type, $dir, $version, $pversion) = @_; my $filename = ref($self); - $filename =~ s/::/-/; + $filename =~ s/::/-/g; $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql"); $filename =~ s/$version/$pversion-$version/ if($pversion);