File Coverage

blib/lib/Catalyst/Plugin/Session/Store/DBIC/Delegate.pm

Criterion	Covered	Total	%
statement	15	53	28.3
branch	0	14	0.0
condition	0	3	0.0
subroutine	5	12	41.6
pod	4	4	100.0
total	24	86	27.9

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>[e-mail]<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;