This file is indexed.

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