view release on metacpan or  search on metacpan

lib/HTTP/Session/Store/DBI.pm  view on Meta::CPAN

);
has 'sid_col' => (
    is  => 'ro',
    isa => 'Str',
    required => 1,
    default  => 'sid',
);
has 'data_col' => (
    is  => 'ro',
    isa => 'Str',
    required => 1,
    default  => 'data',
);
has 'expires_col' => (
    is  => 'ro',
    isa => 'Str',
    required => 1,
    default  => 'expires',
);
has 'clean_thres' => (
    is  => 'ro',
    isa => 'Num',
    required => 1,
    default  => '0.001'
);

sub select {
    my ( $self, $session_id ) = @_;
    
    my $dbh = $self->dbh;
    my $sid_table = $self->sid_table;
    my $sid_col   = $self->sid_col;
    my $data_col  = $self->data_col;
    my $expires_col  = $self->expires_col;
    my $sql = qq~SELECT $data_col, $expires_col FROM $sid_table WHERE $sid_col = ?~;
    my $sth = $dbh->prepare( $sql ); 
    $sth->execute( $session_id );
    my ($data, $expires) = $sth->fetchrow_array;
    
    return unless ($data);
    return unless ( $expires > time() );
    
    return thaw( decode_base64($data) );
}

sub insert {
    my ($self, $session_id, $data) = @_;
    
    $data = encode_base64( nfreeze($data) );
    
    my $dbh = $self->dbh;
    my $sid_table = $self->sid_table;
    my $sid_col   = $self->sid_col;
    my $data_col  = $self->data_col;
    my $expires_col  = $self->expires_col;
    my $sql =qq~INSERT INTO $sid_table ($sid_col, $data_col, $expires_col) VALUES (?, ?, ?)~;
    my $sth = $dbh->prepare($sql);
    $sth->execute( $session_id, $data, time() + $self->expires );
}

sub update {
    my ($self, $session_id, $data) = @_;
    
    $data = encode_base64( nfreeze($data) );
    
    my $dbh = $self->dbh;
    my $sid_table = $self->sid_table;
    my $sid_col   = $self->sid_col;
    my $data_col  = $self->data_col;
    my $expires_col  = $self->expires_col;
    my $sql =qq~UPDATE $sid_table SET $data_col = ?, $expires_col = ? WHERE $sid_col = ?~;
    my $sth = $dbh->prepare($sql);
    $sth->execute( $data, time() + $self->expires, $session_id );
}

sub delete {
    my ($self, $session_id) = @_;
    
    my $dbh = $self->dbh;
    my $sid_table = $self->sid_table;
    my $sid_col   = $self->sid_col;
    my $data_col  = $self->data_col;
    my $expires_col  = $self->expires_col;
    my $sql =qq~DELETE FROM $sid_table WHERE $sid_col = ?~;
    my $sth = $dbh->prepare($sql);
    $sth->execute( $session_id );
    
    if ( rand() < $self->clean_thres ) {
        my $time_now = time();
        $dbh->do(qq~DELETE FROM $sid_table WHERE expires < $time_now~);
    }
}


no Moose;
no Moose::Util::TypeConstraints;

__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 NAME

HTTP::Session::Store::DBI - store session data in DBI for L<HTTP::Session>

=head1 SYNOPSIS

    use HTTP::Session;
    
    my $session = HTTP::Session->new(
        store   => HTTP::Session::Store::DBI->new( {
            dbh => ["dbi:SQLite:dbname=xxx", '', '', {RaiseError => 1}]
        } ),
        state => ...,
        request => ...,
    );

=head1 DESCRIPTION

store session data in DBI. read L<HTTP::Session> for usage.