File Coverage

blib/lib/CGI/Session/ID/incr.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	6	12	50.0
condition	3	7	42.8
subroutine	6	6	100.0
pod	0	1	0.0
total	43	54	79.6

package CGI::Session::ID::incr;

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

use strict;
use File::Spec;
use Carp "croak";
use Fcntl qw( :DEFAULT :flock );
use CGI::Session::ErrorHandler;

$CGI::Session::ID::incr::VERSION = '1.5';
@CGI::Session::ID::incr::ISA     = qw( CGI::Session::ErrorHandler );


sub generate_id {
    my ($self, $args) = @_;

    my $IDFile = $args->{IDFile} or croak "Don't know where to store the id";
    my $IDIncr = $args->{IDIncr} || 1;
    my $IDInit = $args->{IDInit} || 0;

    sysopen(FH, $IDFile, O_RDWR|O_CREAT, 0666) or return $self->set_error("Couldn't open IDFile=>$IDFile: $!");
    flock(FH, LOCK_EX) or return $self->set_error("Couldn't lock IDFile=>$IDFile: $!");
    my $ID =  || $IDInit;
    seek(FH, 0, 0) or return $self->set_error("Couldn't seek IDFile=>$IDFile: $!");
    truncate(FH, 0) or return $self->set_error("Couldn't truncate IDFile=>$IDFile: $!");
    $ID += $IDIncr;
    print FH $ID;
    close(FH) or return $self->set_error("Couldn't close IDFile=>$IDFile: $!");
    return $ID;
}


1;

__END__;