File Coverage

blib/lib/Data/Session/ID/AutoIncrement.pm
Criterion Covered Total %
statement 38 40 95.0
branch 9 26 34.6
condition 2 3 66.6
subroutine 8 9 88.8
pod 1 3 33.3
total 58 81 71.6


line stmt bran cond sub pod time code
1             package Data::Session::ID::AutoIncrement;
2              
3 1     1   451 use parent 'Data::Session::ID';
  1         2  
  1         4  
4 1     1   54 no autovivification;
  1         3  
  1         5  
5 1     1   51 use strict;
  1         1  
  1         16  
6 1     1   4 use warnings;
  1         1  
  1         22  
7              
8 1     1   4 use Fcntl qw/:DEFAULT :flock/;
  1         1  
  1         266  
9              
10 1     1   6 use Hash::FieldHash ':all';
  1         2  
  1         425  
11              
12             our $VERSION = '1.17';
13              
14             # -----------------------------------------------
15              
16             sub generate
17             {
18 15     15 0 24 my($self) = @_;
19 15         49 my($id_file) = $self -> id_file;
20              
21 15 50       31 (! $id_file) && die __PACKAGE__ . '. id_file not specifed in new(...)';
22              
23 15         37 my($message) = __PACKAGE__ . ". Can't %s id_file '$id_file'. %s";
24              
25 15         21 my($fh);
26              
27 15 0       498 sysopen($fh, $id_file, O_RDWR | O_CREAT, $self -> umask) || die sprintf($message, 'open', $self -> debug ? $! : '');
    50          
28              
29 15 50       77 if (! $self -> no_flock)
30             {
31 15 0       91 flock($fh, LOCK_EX) || die sprintf($message, 'lock', $self -> debug ? $! : '');
    50          
32             }
33              
34 15         163 my($id) = <$fh>;
35              
36 15 100 66     109 if (! $id || ($id !~ /^\d+$/) )
37             {
38 1         7 $id = $self -> id_base;
39             }
40              
41 15         52 $id += $self -> id_step;
42              
43 15 0       50 seek($fh, 0, 0) || die sprintf($message, 'seek', $self -> debug ? $! : '');
    50          
44 15 0       472 truncate($fh, 0) || die sprintf($message, 'truncate', $self -> debug ? $! : '');
    50          
45 15         48 print $fh $id;
46 15 0       748 close $fh || die sprintf($message, 'close', $self -> debug ? $! : '');
    50          
47              
48 15         112 return $id;
49              
50             } # End of generate.
51              
52             # -----------------------------------------------
53              
54             sub id_length
55             {
56 0     0 0 0 my($self) = @_;
57              
58 0         0 return 32;
59              
60             } # End of id_length.
61              
62             # -----------------------------------------------
63              
64             sub new
65             {
66 30     30 1 194 my($class, %arg) = @_;
67              
68 30         119 $class -> init(\%arg);
69              
70 30         1543 return from_hash(bless({}, $class), \%arg);
71              
72             } # End of new.
73              
74             # -----------------------------------------------
75              
76             1;
77              
78             =pod
79              
80             =head1 NAME
81              
82             L - A persistent session manager
83              
84             =head1 Synopsis
85              
86             See L for details.
87              
88             =head1 Description
89              
90             L allows L to generate session ids.
91              
92             To use this module do this:
93              
94             =over 4
95              
96             =item o Specify an id generator of type AutoIncrement, as
97             Data::Session -> new(type => '... id:AutoIncrement ...')
98              
99             =back
100              
101             =head1 Case-sensitive Options
102              
103             See L for important information.
104              
105             =head1 Method: new()
106              
107             Creates a new object of type L.
108              
109             C takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
110             might be mandatory.
111              
112             The keys are listed here in alphabetical order.
113              
114             They are lower-case because they are (also) method names, meaning they can be called to set or get
115             the value at any time.
116              
117             =over 4
118              
119             =item o id_base => $integer
120              
121             Specifies the base value for the auto-incrementing sessions ids.
122              
123             This key is normally passed in as Data::Session -> new(id_base => $integer).
124              
125             Note: The first id returned by generate() is id_base + id_step.
126              
127             Default: 0.
128              
129             This key is optional.
130              
131             =item o id_file => $file_name
132              
133             Specifies the file name in which to save the 'current' id.
134              
135             This key is normally passed in as Data::Session -> new(id_file => $file_name).
136              
137             Note: The next id returned by generate() is 'current' id + id_step.
138              
139             Default: File::Spec -> catdir(File::Spec -> tmpdir, 'data.session.id').
140              
141             The reason Data::Session -> new(directory => ...) is not used as the default directory is because
142             this latter option is for where the session files are stored if the driver is File and the id
143             generator is not AutoIncrement.
144              
145             This key is optional.
146              
147             =item o id_step => $integer
148              
149             Specifies the amount to be added to the previous id to get the next id.
150              
151             This key is normally passed in as Data::Session -> new(id_step => $integer).
152              
153             Default: 1.
154              
155             This key is optional.
156              
157             =item o no_flock => $boolean
158              
159             Specifies (no_flock => 1) to not use flock() to obtain a lock on $file_name (which holds the
160             'current' id) before processing it, or (no_flock => 0) to use flock().
161              
162             This key is normally passed in as Data::Session -> new(no_flock => $boolean).
163              
164             Default: 0.
165              
166             This key is optional.
167              
168             =item o umask => $octal_value
169              
170             Specifies the mode to use when calling sysopen() on $file_name.
171              
172             This key is normally passed in as Data::Session -> new(umask => $octal_value).
173              
174             Default: 0660.
175              
176             This key is optional.
177              
178             =item o verbose => $integer
179              
180             Print to STDERR more or less information.
181              
182             Typical values are 0, 1 and 2.
183              
184             This key is normally passed in as Data::Session -> new(verbose => $integer).
185              
186             This key is optional.
187              
188             =back
189              
190             =head1 Method: generate()
191              
192             Generates the next session id, or dies if it can't.
193              
194             Returns the new id.
195              
196             =head1 Method: id_length()
197              
198             Returns 32 because that's the classic value of the size of the id field in the sessions table.
199              
200             This can be used to generate the SQL to create the sessions table.
201              
202             =head1 Support
203              
204             Log a bug on RT: L.
205              
206             =head1 Author
207              
208             L was written by Ron Savage Iron@savage.net.auE> in 2010.
209              
210             Home page: L.
211              
212             =head1 Copyright
213              
214             Australian copyright (c) 2010, Ron Savage.
215              
216             All Programs of mine are 'OSI Certified Open Source Software';
217             you can redistribute them and/or modify them under the terms of
218             The Artistic License, a copy of which is available at:
219             http://www.opensource.org/licenses/index.html
220              
221             =cut