lib/DBIx/Class/ResultSourceHandle.pm

   1 package DBIx::Class::ResultSourceHandle;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class/;
   7
   8 use Storable qw/nfreeze thaw/;
   9 use DBIx::Class::Exception;
  10 use Try::Tiny;
  11
  12 use namespace::clean;
  13
  14 use overload
  15     # on some RH perls the following line causes serious performance problem
  16     # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
  17     q/""/ => sub { __PACKAGE__ . ":" . shift->source_moniker; },
  18     fallback => 1;
  19
  20 __PACKAGE__->mk_group_accessors('simple' => qw/schema source_moniker _detached_source/);
  21
  22 # Schema to use when thawing.
  23 our $thaw_schema;
  24
  25 =head1 NAME
  26
  27 DBIx::Class::ResultSourceHandle - Serializable pointers to ResultSource instances
  28
  29 =head1 DESCRIPTION
  30
  31 Currently instances of this class are used to allow proper serialization of
  32 L<ResultSources|DBIx::Class::ResultSource> (which may contain unserializable
  33 elements like C<CODE> references).
  34
  35 Originally this module was used to remove the fixed link between
  36 L<Rows|DBIx::Class::Row>/L<ResultSets|DBIx::Class::ResultSet> and the actual
  37 L<result source objects|DBIx::Class::ResultSource> in order to obviate the need
  38 of keeping a L<schema instance|DBIx::Class::Schema> constantly in scope, while
  39 at the same time avoiding leaks due to circular dependencies. This is however
  40 no longer needed after introduction of a proper mutual-assured-destruction
  41 contract between a C<Schema> instance and its C<ResultSource> registrants.
  42
  43 =head1 METHODS
  44
  45 =head2 new
  46
  47 =cut
  48
  49 sub new {
  50   my ($class, $args) = @_;
  51   my $self = bless $args, ref $class || $class;
  52
  53   unless( ($self->{schema} || $self->{_detached_source}) && $self->{source_moniker} ) {
  54     my $err = 'Expecting a schema instance and a source moniker';
  55     $self->{schema}
  56       ? $self->{schema}->throw_exception($err)
  57       : DBIx::Class::Exception->throw($err)
  58   }
  59
  60   $self;
  61 }
  62
  63 =head2 resolve
  64
  65 Resolve the moniker into the actual ResultSource object
  66
  67 =cut
  68
  69 sub resolve {
  70   return $_[0]->{schema}->source($_[0]->source_moniker) if $_[0]->{schema};
  71
  72   $_[0]->_detached_source || DBIx::Class::Exception->throw( sprintf (
  73     # vague error message as this is never supposed to happen
  74     "Unable to resolve moniker '%s' - please contact the dev team at %s",
  75     $_[0]->source_moniker,
  76     'http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT',
  77   ), 'full_stacktrace');
  78 }
  79
  80 =head2 STORABLE_freeze
  81
  82 Freezes a handle.
  83
  84 =cut
  85
  86 sub STORABLE_freeze {
  87   my ($self, $cloning) = @_;
  88
  89   my $to_serialize = { %$self };
  90
  91   delete $to_serialize->{schema};
  92   delete $to_serialize->{_detached_source};
  93   $to_serialize->{_frozen_from_class} = $self->{schema}
  94     ? $self->{schema}->class($self->source_moniker)
  95     : $self->{_detached_source}->result_class
  96   ;
  97
  98   nfreeze($to_serialize);
  99 }
 100
 101 =head2 STORABLE_thaw
 102
 103 Thaws frozen handle. Resets the internal schema reference to the package
 104 variable C<$thaw_schema>. The recommended way of setting this is to use
 105 C<< $schema->thaw($ice) >> which handles this for you.
 106
 107 =cut
 108
 109 sub STORABLE_thaw {
 110   my ($self, $cloning, $ice) = @_;
 111   %$self = %{ thaw($ice) };
 112
 113   my $from_class = delete $self->{_frozen_from_class};
 114
 115   if( $thaw_schema ) {
 116     $self->schema( $thaw_schema );
 117   }
 118   elsif( my $rs = $from_class->result_source_instance ) {
 119     # in the off-chance we are using CDBI-compat and have leaked $schema already
 120     if( my $s = try { $rs->schema } ) {
 121       $self->schema( $s );
 122     }
 123     else {
 124       $rs->source_name( $self->source_moniker );
 125       $rs->{_detached_thaw} = 1;
 126       $self->_detached_source( $rs );
 127     }
 128   }
 129   else {
 130     DBIx::Class::Exception->throw(
 131       "Thaw failed - original result class '$from_class' does not exist on this system"
 132     );
 133   }
 134 }
 135
 136 =head1 AUTHOR
 137
 138 Ash Berlin C<< <ash@cpan.org> >>
 139
 140 =cut
 141
 142 1;