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);