File Coverage

blib/lib/CGI/Session/Driver/file.pm

Criterion	Covered	Total	%
statement	53	75	70.6
branch	10	32	31.2
condition	2	9	22.2
subroutine	11	12	91.6
pod	5	5	100.0
total	81	133	60.9

package CGI::Session::Driver::file;

# $Id: file.pm 216 2005-09-01 10:52:26Z sherzodr $

use strict;

use Carp;
use File::Spec;
use Fcntl qw( :DEFAULT :flock :mode );
use CGI::Session::Driver;
use vars qw( $FileName);

@CGI::Session::Driver::file::ISA        = ( "CGI::Session::Driver" );
$CGI::Session::Driver::file::VERSION    = "3.4";
$FileName                               = "cgisess_%s";

sub init {
    my $self = shift;
    $self->{Directory} ||= File::Spec->tmpdir();

    if (defined $CGI::Session::File::FileName) {
        $FileName = $CGI::Session::File::FileName;
    }

    unless ( -d $self->{Directory} ) {
        require File::Path;
        unless ( File::Path::mkpath($self->{Directory}) ) {
            return $self->set_error( "init(): couldn't create directory path: $!" );
        }
    }
}

sub retrieve {
    my $self = shift;
    my ($sid) = @_;

    my $directory   = $self->{Directory};
    my $file        = sprintf( $FileName, $sid );
    my $path        = File::Spec->catfile($directory, $file);

    return 0 unless -e $path;

    unless ( sysopen(FH, $path, O_RDONLY) ) {
        return $self->set_error( "retrieve(): couldn't open '$path': $!" );
    }
    my $rv = "";
    while (  ) {
        $rv .= $_;
    }
    close(FH);
    return $rv;
}



sub store {
    my $self = shift;
    my ($sid, $datastr) = @_;

    my $directory = $self->{Directory};
    my $file      = sprintf( $FileName, $sid );
    my $path      = File::Spec->catfile($directory, $file);
    sysopen(FH, $path, O_WRONLY|O_CREAT) or return $self->set_error( "store(): couldn't open '$path': $!" );
    flock(FH, LOCK_EX)      or return $self->set_error( "store(): couldn't lock '$path': $!" );
    truncate(FH, 0)         or return $self->set_error( "store(): couldn't truncate '$path': $!" );
    print FH $datastr;
    close(FH)               or return $self->set_error( "store(): couldn't close '$path': $!" );
    return 1;
}


sub remove {
    my $self = shift;
    my ($sid) = @_;

    my $directory = $self->{Directory};
    my $file      = sprintf( $FileName, $sid );
    my $path      = File::Spec->catfile($directory, $file);
    unlink($path) or return $self->set_error( "remove(): couldn't unlink '$path': $!" );
    return 1;
}


sub traverse {
    my $self = shift;
    my ($coderef) = @_;

    unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) {
        croak "traverse(): usage error";
    }

    opendir( DIRHANDLE, $self->{Directory} )
        or return $self->set_error( "traverse(): couldn't open $self->{Directory}, " . $! );

    my $filename_pattern = $FileName;
    $filename_pattern =~ s/\./\\./g;
    $filename_pattern =~ s/\%s/(\.\+)/g;
    while ( my $filename = readdir(DIRHANDLE) ) {
        next if $filename =~ m/^\.\.?$/;
        my $full_path = File::Spec->catfile($self->{Directory}, $filename);
        my $mode = (stat($full_path))[2]
            or return $self->set_error( "traverse(): stat failed for $full_path: " . $! );
        next if S_ISDIR($mode);
        if ( $filename =~ /^$filename_pattern$/ ) {
            $coderef->($1);
        }
    }
    closedir( DIRHANDLE );
    return 1;
}

sub DESTROY {
    my $self = shift;
}

1;

__END__;