/usr/share/perl5/Catalyst/Plugin/Session/Store/DBIC/Delegate.pm is in libcatalyst-plugin-session-store-dbic-perl 0.14-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 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | package Catalyst::Plugin::Session::Store::DBIC::Delegate;
use strict;
use warnings;
use base qw/Class::Accessor::Fast/;
use Carp qw/carp/;
use Scalar::Util qw/blessed/;
__PACKAGE__->mk_accessors(qw/model id_field data_field _session_row _flash_row/);
=head1 NAME
Catalyst::Plugin::Session::Store::DBIC::Delegate - Delegates between the session and flash rows
=head1 DESCRIPTION
This class delegates between two rows in your sessions table for a
given session (session and flash). This is done for compatibility
with L<Catalyst::Plugin::Session::Store::DBI>.
=head1 METHODS
=head2 session
Return the session row for this delegate.
=cut
sub session {
my ($self, $key) = @_;
my $row = $self->_session_row;
unless ($row) {
$row = $self->_load_row($key);
$self->_session_row($row);
}
return $row;
}
=head2 flash
Return the flash row for this delegate.
=cut
sub flash {
my ($self, $key) = @_;
my $row = $self->_flash_row;
unless ($row) {
$row = $self->_load_row($key);
$self->_flash_row($row);
}
return $row;
}
=head2 _load_row
Load the specified session or flash row from the database. This is a
wrapper around L<DBIx::Class::ResultSet/find_or_create> to add support
for transactions.
=cut
sub _load_row {
my ($self, $key) = @_;
my $load_sub = sub {
return $self->model->find_or_create({ $self->id_field => $key })
};
my $row;
if (blessed $self->model and $self->model->can('result_source')) {
$row = $self->model->result_source->schema->txn_do($load_sub);
}
else {
# Fallback for DBIx::Class::DB
$row = $load_sub->();
}
return $row;
}
=head2 expires
Return the expires row for this delegate. As with
L<Catalyst::Plugin::Session::Store::DBI>, this maps to the L</session>
row.
=cut
sub expires {
my ($self, $key) = @_;
$key =~ s/^expires/session/;
$self->session($key);
}
=head2 flush
Update the session and flash data in the backend store.
=cut
sub flush {
my ($self) = @_;
for (qw/_session_row _flash_row/) {
my $row = $self->$_;
next unless $row;
# Check the size if available to avoid silent trucation on e.g. MySQL
my $data_field = $self->data_field;
if (my $size = $row->result_source->column_info($data_field)->{size}) {
my $total_size = length($row->$data_field);
carp "This session requires $total_size bytes of storage, but your database column '$data_field' can only store $size bytes. Storing this session may not be reliable; increase the size of your data field"
if $total_size > $size;
}
$row->update if $row->in_storage;
}
$self->_clear_instance_data;
}
=head2 _clear_instance_data
Remove any references held by the delegate.
=cut
sub _clear_instance_data {
my ($self) = @_;
$self->id_field(undef);
$self->model(undef);
$self->_session_row(undef);
$self->_flash_row(undef);
}
=head1 AUTHOR
Daniel Westermann-Clark E<lt>danieltwc@cpan.orgE<gt>
=head1 COPYRIGHT
Copyright 2006-2008 Daniel Westermann-Clark, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;
|