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