use Carp::Clan qw/^DBIx::Class/;
use Scalar::Util qw/weaken/;
+require Module::Find;
use base qw/DBIx::Class/;
sub sources { return keys %{shift->source_registrations}; }
+=head2 storage
+
+ my $storage = $schema->storage;
+
+Returns the L<DBIx::Class::Storage> object for this Schema.
+
=head2 resultset
=over 4
}
}
} else {
- eval "require Module::Find;";
- $class->throw_exception(
- "No arguments to load_classes and couldn't load Module::Find ($@)"
- ) if $@;
my @comp = map { substr $_, length "${class}::" }
Module::Find::findallmod($class);
$comps_for{$class} = \@comp;
=back
This is an alternative to L</load_classes> above which assumes an alternative
-layout for automatic class loading. It assumes that all ResultSource classes
-to be loaded are underneath a sub-namespace of the schema called
-"ResultSource", any corresponding ResultSet classes to be underneath a
-sub-namespace of the schema called "ResultSet", and any corresponing
-Result classes to be underneath a sub-namespace of the schema called "Result".
+layout for automatic class loading. It assumes that all result
+classes are underneath a sub-namespace of the schema called C<Result>, any
+corresponding ResultSet classes are underneath a sub-namespace of the schema
+called C<ResultSet>.
+
+Both of the sub-namespaces are configurable if you don't like the defaults,
+via the options C<result_namespace> and C<resultset_namespace>.
-All of those sub-namespaces are configurable if you don't like the defaults,
-via the options C<resultsource_namespace>, C<resultset_namespace>, and
-C<result_namespace>, respectively.
+If (and only if) you specify the option C<default_resultset_class>, any found
+Result classes for which we do not find a corresponding
+ResultSet class will have their C<resultset_class> set to
+C<default_resultset_class>.
-If (and only if) you specify the option C<default_resultset_base>, any found
-ResultSource classes that have no manually-created corresponding ResultSet
-class will have one created for them in memory in the C<resultset_namespace>,
-based on C<default_resultset_base>.
+C<load_namespaces> takes care of calling C<resultset_class> for you where
+neccessary if you didn't do it for yourself.
All of the namespace and classname options to this method are relative to
the schema classname by default. To specify a fully-qualified name, prefix
it with a literal C<+>.
-This method requires L<Module::Find> to be installed on the system.
+Examples:
-Example:
-
- # load My::Schema::ResultSource::CD, My::Schema::ResultSource::Artist,
+ # load My::Schema::Result::CD, My::Schema::Result::Artist,
# My::Schema::ResultSet::CD, etc...
My::Schema->load_namespaces;
- # Override everything...
+ # Override everything to use ugly names.
+ # In this example, if there is a My::Schema::Res::Foo, but no matching
+ # My::Schema::RSets::Foo, then Foo will have its
+ # resultset_class set to My::Schema::RSetBase
My::Schema->load_namespaces(
- resultsource_namespace => 'RSources',
+ result_namespace => 'Res',
resultset_namespace => 'RSets',
- result_namespace => 'Results',
- default_resultset_base => 'RSetBase',
+ default_resultset_class => 'RSetBase',
);
- # ... and if there is a My::Schema::RSources::Foo, but no matching
- # My::Schema::RSets::Foo, then My::Schema::RSets::Foo will be created
- # for you in memory, based on My::Schema::RSetBase
# Put things in other namespaces
My::Schema->load_namespaces(
- resultsource_namespace => '+Some::Place::RSources',
+ result_namespace => '+Some::Place::Results',
resultset_namespace => '+Another::Place::RSets',
- result_namespace => '+Crazy::Stuff::Results',
- default_resultset_base => '+You::Never::Know::RSetBase',
);
+If you'd like to use multiple namespaces of each type, simply use an arrayref
+of namespaces for that option. In the case that the same result
+(or resultset) class exists in multiple namespaces, the latter entries in
+your list of namespaces will override earlier ones.
+
+ My::Schema->load_namespaces(
+ # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
+ result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
+ resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
+ );
=cut
+# Pre-pends our classname to the given relative classname or
+# class namespace, unless there is a '+' prefix, which will
+# be stripped.
+sub _expand_relative_name {
+ my ($class, $name) = @_;
+ return if !$name;
+ $name = $class . '::' . $name if ! ($name =~ s/^\+//);
+ return $name;
+}
+
+# returns a hash of $shortname => $fullname for every package
+# found in the given namespaces ($shortname is with the $fullname's
+# namespace stripped off)
+sub _map_namespaces {
+ my ($class, @namespaces) = @_;
+
+ my @results_hash;
+ foreach my $namespace (@namespaces) {
+ push(
+ @results_hash,
+ map { (substr($_, length "${namespace}::"), $_) }
+ Module::Find::findallmod($namespace)
+ );
+ }
+
+ @results_hash;
+}
+
sub load_namespaces {
my ($class, %args) = @_;
- my $resultsource_namespace = $args{resultsource_namespace} || 'ResultSource';
- my $resultset_namespace = $args{resultset_namespace} || 'ResultSet';
- my $result_namespace = $args{result_namespace} || 'Result';
- my $default_resultset_base = $args{default_resultset_base};
+ my $result_namespace = delete $args{result_namespace} || 'Result';
+ my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
+ my $default_resultset_class = delete $args{default_resultset_class};
- foreach ($resultsource_namespace, $resultset_namespace,
- $result_namespace, $default_resultset_base) {
- next if !$_;
- $_ = $class . '::' . $_ if !s/^\+//;
- }
+ $class->throw_exception('load_namespaces: unknown option(s): '
+ . join(q{,}, map { qq{'$_'} } keys %args))
+ if scalar keys %args;
- eval "require Module::Find";
- $class->throw_exception("Couldn't load Module::Find ($@)") if $@;
+ $default_resultset_class
+ = $class->_expand_relative_name($default_resultset_class);
- my %sources = map { (substr($_, length "${resultsource_namespace}::"), $_) }
- Module::Find::findallmod($resultsource_namespace);
+ for my $arg ($result_namespace, $resultset_namespace) {
+ $arg = [ $arg ] if !ref($arg) && $arg;
- my %resultsets = map { (substr($_, length "${resultset_namespace}::"), $_) }
- Module::Find::findallmod($resultset_namespace);
+ $class->throw_exception('load_namespaces: namespace arguments must be '
+ . 'a simple string or an arrayref')
+ if ref($arg) ne 'ARRAY';
+
+ $_ = $class->_expand_relative_name($_) for (@$arg);
+ }
- my %results = map { (substr($_, length "${result_namespace}::"), $_) }
- Module::Find::findallmod($result_namespace);
+ my %results = $class->_map_namespaces(@$result_namespace);
+ my %resultsets = $class->_map_namespaces(@$resultset_namespace);
my @to_register;
{
- no warnings qw/redefine/;
+ no warnings 'redefine';
local *Class::C3::reinitialize = sub { };
- use warnings qw/redefine/;
-
- foreach my $source (keys %sources) {
- my $source_class = $sources{$source};
- $class->ensure_class_loaded($source_class);
- $source_class->source_name($source) unless $source_class->source_name;
-
- my $rs_class = delete $resultsets{$source};
- my $rs_set = $source_class->resultset_class;
- if(!$rs_set || $rs_set eq 'DBIx::Class::ResultSet') {
- if($rs_class) {
- $class->ensure_class_loaded($rs_class);
- $source_class->resultset_class($rs_class);
- }
- elsif($default_resultset_base) {
- $class->ensure_class_loaded($default_resultset_base);
- $rs_class = "$resultset_namespace\::$source";
- { no strict qw/refs/; @{"$rs_class\::ISA"} = ($default_resultset_base); }
- $source_class->resultset_class($rs_class);
+ use warnings 'redefine';
+
+ foreach my $result (keys %results) {
+ my $result_class = $results{$result};
+ $class->ensure_class_loaded($result_class);
+ $result_class->source_name($result) unless $result_class->source_name;
+
+ my $rs_class = delete $resultsets{$result};
+ my $rs_set = $result_class->resultset_class;
+ if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
+ if($rs_class && $rs_class ne $rs_set) {
+ warn "We found ResultSet class '$rs_class' for '$result', but it seems "
+ . "that you had already set '$result' to use '$rs_set' instead";
}
}
- elsif($rs_set && $rs_class) {
- warn "We found ResultSet class '$rs_class' for '$source', but it seems "
- . "that you had already set '$source' to use '$rs_set' instead";
+ elsif($rs_class ||= $default_resultset_class) {
+ $class->ensure_class_loaded($rs_class);
+ $result_class->resultset_class($rs_class);
}
- push(@to_register, [ $source_class->source_name, $source_class ]);
+ push(@to_register, [ $result_class->source_name, $result_class ]);
}
}
foreach (sort keys %resultsets) {
warn "load_namespaces found ResultSet class $_ with no "
- . 'corresponding ResultSource';
+ . 'corresponding Result class';
}
Class::C3->reinitialize;
$class->register_class(@$_) for (@to_register);
- foreach my $source (keys %sources) {
- my $r_class = delete $results{$source};
- if($r_class) {
- my $r_set = $class->source($source)->result_class;
- if(!$r_set || $r_set eq $sources{$source}) {
- $class->ensure_class_loaded($r_class);
- $class->source($source)->result_class($r_class);
- }
- else {
- warn "We found Result class '$r_class' for '$source', but it seems "
- . "that you had already set '$source' to use '$r_set' instead";
- }
- }
- }
-
- foreach (sort keys %results) {
- warn "load_namespaces found Result class $_ with no "
- . 'corresponding ResultSource';
- }
-
return;
}
$target->connection(@info);
}
+=head2 storage_type
+
+=over 4
+
+=item Arguments: $storage_type
+
+=item Return Value: $storage_type
+
+=back
+
+Set the storage class that will be instantiated when L</connect> is called.
+If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
+assumed by L</connect>. Defaults to C<::DBI>,
+which is L<DBIx::Class::Storage::DBI>.
+
+You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
+in cases where the appropriate subclass is not autodetected, such as when
+dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
+C<::DBI::Sybase::MSSQL>.
+
=head2 connection
=over 4
Instantiates a new Storage object of type
L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
-$storage->connect_info. Sets the connection in-place on the schema. See
-L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
+$storage->connect_info. Sets the connection in-place on the schema.
+
+See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
+or L<DBIx::Class::Storage> in general.
=cut
sub connect { shift->clone->connection(@_) }
-=head2 txn_begin
-
-Begins a transaction (does nothing if AutoCommit is off). Equivalent to
-calling $schema->storage->txn_begin. See
-L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
+=head2 txn_do
-=cut
+=over 4
-sub txn_begin { shift->storage->txn_begin }
+=item Arguments: C<$coderef>, @coderef_args?
-=head2 txn_commit
+=item Return Value: The return value of $coderef
-Commits the current transaction. Equivalent to calling
-$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
-for more information.
+=back
-=cut
+Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
+returning its result (if any). Equivalent to calling $schema->storage->txn_do.
+See L<DBIx::Class::Storage/"txn_do"> for more information.
-sub txn_commit { shift->storage->txn_commit }
+This interface is preferred over using the individual methods L</txn_begin>,
+L</txn_commit>, and L</txn_rollback> below.
-=head2 txn_rollback
+=cut
-Rolls back the current transaction. Equivalent to calling
-$schema->storage->txn_rollback. See
-L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
+sub txn_do {
+ my $self = shift;
-=cut
+ $self->storage or $self->throw_exception
+ ('txn_do called on $schema without storage');
-sub txn_rollback { shift->storage->txn_rollback }
+ $self->storage->txn_do(@_);
+}
-=head2 txn_do
+=head2 txn_begin
-=over 4
+Begins a transaction (does nothing if AutoCommit is off). Equivalent to
+calling $schema->storage->txn_begin. See
+L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
-=item Arguments: C<$coderef>, @coderef_args?
+=cut
-=item Return Value: The return value of $coderef
+sub txn_begin {
+ my $self = shift;
-=back
+ $self->storage or $self->throw_exception
+ ('txn_begin called on $schema without storage');
-Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
-returning its result (if any). If an exception is caught, a rollback is issued
-and the exception is rethrown. If the rollback fails, (i.e. throws an
-exception) an exception is thrown that includes a "Rollback failed" message.
+ $self->storage->txn_begin;
+}
-For example,
+=head2 txn_commit
- my $author_rs = $schema->resultset('Author')->find(1);
- my @titles = qw/Night Day It/;
+Commits the current transaction. Equivalent to calling
+$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
+for more information.
- my $coderef = sub {
- # If any one of these fails, the entire transaction fails
- $author_rs->create_related('books', {
- title => $_
- }) foreach (@titles);
+=cut
- return $author->books;
- };
+sub txn_commit {
+ my $self = shift;
- my $rs;
- eval {
- $rs = $schema->txn_do($coderef);
- };
+ $self->storage or $self->throw_exception
+ ('txn_commit called on $schema without storage');
- if ($@) { # Transaction failed
- die "something terrible has happened!" #
- if ($@ =~ /Rollback failed/); # Rollback failed
+ $self->storage->txn_commit;
+}
- deal_with_failed_transaction();
- }
+=head2 txn_rollback
-In a nested transaction (calling txn_do() from within a txn_do() coderef) only
-the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
-the Schema's storage, and txn_do() can be called in void, scalar and list
-context and it will behave as expected.
+Rolls back the current transaction. Equivalent to calling
+$schema->storage->txn_rollback. See
+L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
=cut
-sub txn_do {
- my ($self, $coderef, @args) = @_;
+sub txn_rollback {
+ my $self = shift;
$self->storage or $self->throw_exception
- ('txn_do called on $schema without storage');
- ref $coderef eq 'CODE' or $self->throw_exception
- ('$coderef must be a CODE reference');
-
- my (@return_values, $return_value);
-
- $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()
- eval {
-
- # Need to differentiate between scalar/list context to allow for
- # returning a list in scalar context to get the size of the list
- if ($wantarray) {
- # list context
- @return_values = $coderef->(@args);
- } elsif (defined $wantarray) {
- # scalar context
- $return_value = $coderef->(@args);
- } else {
- # void context
- $coderef->(@args);
- }
- $self->txn_commit;
- };
-
- if ($@) {
- my $error = $@;
+ ('txn_rollback called on $schema without storage');
- eval {
- $self->txn_rollback;
- };
-
- if ($@) {
- my $rollback_error = $@;
- my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
- $self->throw_exception($error) # propagate nested rollback
- if $rollback_error =~ /$exception_class/;
-
- $self->throw_exception(
- "Transaction aborted: $error. Rollback failed: ${rollback_error}"
- );
- } else {
- $self->throw_exception($error); # txn failed but rollback succeeded
- }
- }
-
- return $wantarray ? @return_values : $return_value;
+ $self->storage->txn_rollback;
}
=head2 clone
sub clone {
my ($self) = @_;
- my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
+ my $clone = { (ref $self ? %$self : ()) };
+ bless $clone, (ref $self || $self);
+
foreach my $moniker ($self->sources) {
my $source = $self->source($moniker);
my $new = $source->new($source);
=over 4
-=item Arguments: $moniker, \@data;
+=item Arguments: $source_name, \@data;
=back
-Populates the source registered with the given moniker with the supplied data.
-@data should be a list of listrefs -- the first containing column names, the
-second matching values.
+Pass this method a resultsource name, and an arrayref of
+arrayrefs. The arrayrefs should contain a list of column names,
+followed by one or many sets of matching data for the given columns.
+
+Each set of data is inserted into the database using
+L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
+objects is returned.
i.e.,
=over 4
-=item Arguments: $sqlt_args
+=item Arguments: $sqlt_args, $dir
=back
=cut
sub deploy {
- my ($self, $sqltargs) = @_;
+ my ($self, $sqltargs, $dir) = @_;
$self->throw_exception("Can't deploy without storage") unless $self->storage;
- $self->storage->deploy($self, undef, $sqltargs);
+ $self->storage->deploy($self, undef, $sqltargs, $dir);
}
=head2 create_ddl_dir (EXPERIMENTAL)
=cut
-sub create_ddl_dir
-{
+sub create_ddl_dir {
my $self = shift;
$self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
=cut
-sub ddl_filename
-{
+sub ddl_filename {
my ($self, $type, $dir, $version) = @_;
my $filename = ref($self);
You may distribute this code under the same terms as Perl itself.
=cut
-