File Coverage

blib/lib/Data/Session/ID/AutoIncrement.pm
Criterion Covered Total %
statement 37 40 92.5
branch 8 26 30.7
condition 1 3 33.3
subroutine 8 9 88.8
pod 1 3 33.3
total 55 81 67.9


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