view release on metacpan or  search on metacpan

lib/DBIx/Class/Schema.pm  view on Meta::CPAN

package DBIx::Class::Schema;

use strict;
use warnings;

use base 'DBIx::Class';

use DBIx::Class::Carp;
use Try::Tiny;
use Scalar::Util qw/weaken blessed/;
use DBIx::Class::_Util qw(refcount quote_sub is_exception scope_guard);
use Devel::GlobalDestruction;
use namespace::clean;

__PACKAGE__->mk_classdata('class_mappings' => {});
__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);
__PACKAGE__->mk_classdata('default_resultset_attributes' => {});

=head1 NAME

DBIx::Class::Schema - composable schemas

=head1 SYNOPSIS

  package Library::Schema;
  use base qw/DBIx::Class::Schema/;

  # load all Result classes in Library/Schema/Result/
  __PACKAGE__->load_namespaces();

  package Library::Schema::Result::CD;
  use base qw/DBIx::Class::Core/;

  __PACKAGE__->load_components(qw/InflateColumn::DateTime/); # for example
  __PACKAGE__->table('cd');

  # Elsewhere in your code:
  my $schema1 = Library::Schema->connect(
    $dsn,
    $user,
    $password,
    { AutoCommit => 1 },
  );

  my $schema2 = Library::Schema->connect($coderef_returning_dbh);

  # fetch objects using Library::Schema::Result::DVD
  my $resultset = $schema1->resultset('DVD')->search( ... );
  my @dvd_objects = $schema2->resultset('DVD')->search( ... );

=head1 DESCRIPTION

Creates database classes based on a schema. This is the recommended way to
use L<DBIx::Class> and allows you to use more than one concurrent connection
with your classes.

NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
carefully, as DBIx::Class does things a little differently. Note in
particular which module inherits off which.

=head1 SETUP METHODS

=head2 load_namespaces

=over 4

lib/DBIx/Class/Schema.pm  view on Meta::CPAN

=cut

sub register_class {
  my ($self, $source_name, $to_register) = @_;
  $self->register_source($source_name => $to_register->result_source_instance);
}

=head2 register_source

=over 4

=item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>

=back

This method is called by L</register_class>.

Registers the L<DBIx::Class::ResultSource> in the schema with the given
source name.

=cut

sub register_source { shift->_register_source(@_) }

=head2 unregister_source

=over 4

=item Arguments: $source_name

=back

Removes the L<DBIx::Class::ResultSource> from the schema for the given source name.

=cut

sub unregister_source { shift->_unregister_source(@_) }

=head2 register_extra_source

=over 4

=item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>

=back

As L</register_source> but should be used if the result class already
has a source and you want to register an extra one.

=cut

sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }

sub _register_source {
  my ($self, $source_name, $source, $params) = @_;

  $source = $source->new({ %$source, source_name => $source_name });

  $source->schema($self);
  weaken $source->{schema} if ref($self);

  my %reg = %{$self->source_registrations};
  $reg{$source_name} = $source;
  $self->source_registrations(\%reg);

  return $source if $params->{extra};

  my $rs_class = $source->result_class;
  if ($rs_class and my $rsrc = try { $rs_class->result_source_instance } ) {
    my %map = %{$self->class_mappings};
    if (
      exists $map{$rs_class}
        and
      $map{$rs_class} ne $source_name
        and
      $rsrc ne $_[2]  # orig_source
    ) {
      carp
        "$rs_class already had a registered source which was replaced by this call. "
      . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
      . 'something wrong.'
      ;
    }

    $map{$rs_class} = $source_name;
    $self->class_mappings(\%map);
  }

  return $source;
}

my $global_phase_destroy;
sub DESTROY {
  ### NO detected_reinvoked_destructor check
  ### This code very much relies on being called multuple times

  return if $global_phase_destroy ||= in_global_destruction;

  my $self = shift;
  my $srcs = $self->source_registrations;

  for my $source_name (keys %$srcs) {
    # find first source that is not about to be GCed (someone other than $self
    # holds a reference to it) and reattach to it, weakening our own link
    #
    # during global destruction (if we have not yet bailed out) this should throw
    # which will serve as a signal to not try doing anything else
    # however beware - on older perls the exception seems randomly untrappable
    # due to some weird race condition during thread joining :(((
    if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
      local $@;
      eval {
        $srcs->{$source_name}->schema($self);
        weaken $srcs->{$source_name};
        1;
      } or do {
        $global_phase_destroy = 1;
      };

      last;
    }
  }
}

sub _unregister_source {
    my ($self, $source_name) = @_;
    my %reg = %{$self->source_registrations};

    my $source = delete $reg{$source_name};
    $self->source_registrations(\%reg);
    if ($source->result_class) {
        my %map = %{$self->class_mappings};
        delete $map{$source->result_class};
        $self->class_mappings(\%map);
    }
}


=head2 compose_connection (DEPRECATED)

=over 4

=item Arguments: $target_namespace, @db_info

=item Return Value: $new_schema

=back

DEPRECATED. You probably wanted compose_namespace.

Actually, you probably just wanted to call connect.

=begin hidden

(hidden due to deprecation)

Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
then injects the L<DBix::Class::ResultSetProxy> 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
to a connection. In normal usage it is preferred to call
L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
more information.

=end hidden

=cut

sub compose_connection {
  my ($self, $target, @info) = @_;