File Coverage

blib/lib/CGI/Session/ID/incr.pm
Criterion Covered Total %
statement 28 28 100.0
branch 6 12 50.0
condition 4 7 57.1
subroutine 6 6 100.0
pod 0 1 0.0
total 44 54 81.4


line stmt bran cond sub pod time code
1             package CGI::Session::ID::incr;
2              
3             # $Id$
4              
5 2     2   11 use strict;
  2         5  
  2         70  
6 2     2   22 use File::Spec;
  2         4  
  2         49  
7 2     2   11 use Carp "croak";
  2         2  
  2         111  
8 2     2   13 use Fcntl qw( :DEFAULT :flock );
  2         5  
  2         1303  
9 2     2   17 use CGI::Session::ErrorHandler;
  2         3  
  2         711  
10              
11             $CGI::Session::ID::incr::VERSION = '4.43';
12             @CGI::Session::ID::incr::ISA = qw( CGI::Session::ErrorHandler );
13              
14              
15             sub generate_id {
16 2     2 0 6 my ($self, $args) = @_;
17              
18 2 50       12 my $IDFile = $args->{IDFile} or croak "Don't know where to store the id";
19 2   50     14 my $IDIncr = $args->{IDIncr} || 1;
20 2   50     13 my $IDInit = $args->{IDInit} || 0;
21              
22 2 50       224 sysopen(FH, $IDFile, O_RDWR|O_CREAT, 0666) or return $self->set_error("Couldn't open IDFile=>$IDFile: $!");
23 2 50       26 flock(FH, LOCK_EX) or return $self->set_error("Couldn't lock IDFile=>$IDFile: $!");
24 2   66     56 my $ID = <FH> || $IDInit;
25 2 50       20 seek(FH, 0, 0) or return $self->set_error("Couldn't seek IDFile=>$IDFile: $!");
26 2 50       149 truncate(FH, 0) or return $self->set_error("Couldn't truncate IDFile=>$IDFile: $!");
27 2         7 $ID += $IDIncr;
28 2         13 print FH $ID;
29 2 50       109 close(FH) or return $self->set_error("Couldn't close IDFile=>$IDFile: $!");
30 2         10 return $ID;
31             }
32              
33              
34             1;
35              
36             __END__;
37              
38             =pod
39              
40             =head1 NAME
41              
42             CGI::Session::ID::incr - CGI::Session ID driver
43              
44             =head1 SYNOPSIS
45              
46             use CGI::Session;
47             $session = CGI::Session->new("id:Incr", undef, {
48             Directory => '/tmp',
49             IDFile => '/tmp/cgisession.id',
50             IDInit => 1000,
51             IDIncr => 2 });
52              
53             =head1 DESCRIPTION
54              
55             CGI::Session::ID::incr is to generate auto incrementing Session IDs. Compare it with L<CGI::Session::ID::md5|CGI::Session::ID::md5>, where session ids are truly random 32 character long strings. CGI::Session::ID::incr expects the following arguments passed to CGI::Session->new() as the third argument.
56              
57             =over 4
58              
59             =item IDFile
60              
61             Location where auto incremented IDs are stored. This attribute is required.
62              
63             =item IDInit
64              
65             Initial value of the ID if it's the first ID to be generated. For example, if you want the ID numbers to start with 1000 as opposed to 0, that's where you should set your value. Default is C<0>.
66              
67             =item IDIncr
68              
69             How many digits each number should increment by. For example, if you want the first generated id to start with 1000, and each subsequent id to increment by 10, set I<IDIncr> to 10 and I<IDInit> to 1000. Default is C<1>.
70              
71             =back
72              
73             =head1 LICENSING
74              
75             For support and licensing information see L<CGI::Session|CGI::Session>
76              
77             =cut