View | Details | Raw Unified | Return to bug 17427
Collapse All | Expand All

(-)a/lib/Data/Session.pm (+2672 lines)
Line 0 Link Here
1
package Data::Session;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Class::Load ':all'; # For try_load_class() and is_class_loaded().
9
10
use File::Spec;  # For catdir.
11
use File::Slurper 'read_dir';
12
13
use Hash::FieldHash ':all';
14
15
use Try::Tiny;
16
17
fieldhash my %my_drivers       => 'my_drivers';
18
fieldhash my %my_id_generators => 'my_id_generators';
19
fieldhash my %my_serializers   => 'my_serializers';
20
21
our $errstr  = '';
22
our $VERSION = '1.18';
23
24
# -----------------------------------------------
25
26
sub atime
27
{
28
	my($self, $atime) = @_;
29
	my($data) = $self -> session;
30
31
	# This is really only for use by load_session().
32
33
	if (defined $atime)
34
	{
35
		$$data{_SESSION_ATIME} = $atime;
36
37
		$self -> session($data);
38
		$self -> modified(1);
39
	}
40
41
	return $$data{_SESSION_ATIME};
42
43
} # End of atime.
44
45
# -----------------------------------------------
46
47
sub check_expiry
48
{
49
	my($self) = @_;
50
51
	if ($self -> etime && ( ($self -> atime + $self -> etime) < time) )
52
	{
53
		($self -> verbose) && $self -> log('Expiring id: ' . $self -> id);
54
55
		$self -> delete;
56
		$self -> expired(1);
57
	}
58
59
} # End of check_expiry.
60
61
# -----------------------------------------------
62
63
sub clear
64
{
65
	my($self, $name) = @_;
66
	my($data) = $self -> session;
67
68
	if (! $name)
69
	{
70
		$name = [$self -> param];
71
	}
72
	elsif (ref($name) ne 'ARRAY')
73
	{
74
		$name = [$name];
75
	}
76
	else
77
	{
78
		$name = [grep{! /^_/} @$name];
79
	}
80
81
	for my $key (@$name)
82
	{
83
		delete $$data{$key};
84
		delete $$data{_SESSION_PTIME}{$key};
85
86
		$self -> modified(1);
87
	}
88
89
	$self -> session($data);
90
91
	return 1;
92
93
} # End of clear.
94
95
# -----------------------------------------------
96
97
sub cookie
98
{
99
	my($self)   = shift;
100
	my($q)      = $self -> query;
101
	my(@param)  = ('-name' => $self -> name, '-value' => $self -> id, @_);
102
	my($cookie) = '';
103
104
	if (! $q -> can('cookie') )
105
	{
106
	}
107
	elsif ($self -> expired)
108
	{
109
		$cookie = $q -> cookie(@param, -expires => '-1d');
110
	}
111
	elsif (my($t) = $self -> expire)
112
	{
113
		$cookie = $q -> cookie(@param, -expires => "+${t}s");
114
	}
115
	else
116
	{
117
		$cookie = $q -> cookie(@param);
118
	}
119
120
	return $cookie;
121
122
} # End of cookie.
123
124
# -----------------------------------------------
125
126
sub ctime
127
{
128
	my($self) = @_;
129
	my($data) = $self -> session;
130
131
	return $$data{_SESSION_CTIME};
132
133
} # End of ctime.
134
135
# -----------------------------------------------
136
137
sub delete
138
{
139
	my($self)   = @_;
140
	my($result) = $self -> driver_class -> remove($self -> id);
141
142
	$self -> clear;
143
	$self -> deleted(1);
144
145
	return $result;
146
147
} # End of delete.
148
149
# -----------------------------------------------
150
151
sub DESTROY
152
{
153
	my($self) = @_;
154
155
	$self -> flush;
156
157
} # End of DESTROY.
158
159
# -----------------------------------------------
160
161
sub dump
162
{
163
	my($self, $heading) = @_;
164
	my($data) = $self -> session;
165
166
	($heading) && $self -> log($heading);
167
168
	for my $key (sort keys %$data)
169
	{
170
		if (ref($$data{$key}) eq 'HASH')
171
		{
172
			$self -> log("$key: " . join(', ', map{"$_: $$data{$key}{$_}"} sort keys %{$$data{$key} }) );
173
		}
174
		else
175
		{
176
			$self -> log("$key: $$data{$key}");
177
		}
178
	}
179
180
} # End of dump.
181
182
# -----------------------------------------------
183
184
sub etime
185
{
186
	my($self) = @_;
187
	my($data) = $self -> session;
188
189
	return $$data{_SESSION_ETIME};
190
191
} # End of etime.
192
193
# -----------------------------------------------
194
195
sub expire
196
{
197
	my($self, @arg) = @_;
198
199
	if (! @arg)
200
	{
201
		return $self -> etime;
202
	}
203
204
	if ($#arg == 0)
205
	{
206
		# Set the expiry time of the session.
207
208
		my($data) = $self -> session;
209
		my($time) = $self -> validate_time($arg[0]);
210
211
		if ($$data{_SESSION_ETIME} != $time)
212
		{
213
			$$data{_SESSION_ETIME} = $time;
214
215
			$self -> session($data);
216
			$self -> modified(1);
217
		}
218
	}
219
	else
220
	{
221
		# Set the expiry times of session parameters.
222
223
		my($data)     = $self -> session;
224
		my($modified) = 0;
225
		my(%arg)      = @arg;
226
227
		my($time);
228
229
		# Warning: The next line ignores 'each %{@arg}'.
230
231
		while (my($key, $value) = each %arg)
232
		{
233
			$time = $self -> validate_time($value);
234
235
			($time == 0) && next;
236
237
			if (! $$data{_SESSION_PTIME}{$key} || ($$data{_SESSION_PTIME}{$key} ne $time) )
238
			{
239
				$$data{_SESSION_PTIME}{$key} = $time;
240
241
				$modified = 1;
242
			}
243
		}
244
245
		if ($modified)
246
		{
247
			$self -> session($data);
248
			$self -> modified(1);
249
		}
250
	}
251
252
	return 1;
253
254
} # End of expire.
255
256
# -----------------------------------------------
257
258
sub flush
259
{
260
	my($self) = @_;
261
262
	if ($self -> modified && ! $self -> deleted)
263
	{
264
		$self -> driver_class -> store
265
		(
266
			$self -> id,
267
			$self -> serializer_class -> freeze($self -> session),
268
			$self -> etime
269
		);
270
	}
271
272
	($self -> verbose > 1) && $self -> dump('Flushing. New: ' . $self -> is_new . '. Modified: ' . $self -> modified . '. Deleted: ' . $self -> deleted);
273
274
	return 1;
275
276
} # End of flush.
277
278
# -----------------------------------------------
279
280
sub get_my_drivers
281
{
282
	my($self)	= @_;
283
	my($path)	= $self -> _get_pm_path('Driver');
284
285
	# Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why?
286
287
	my(@driver) = sort map{s/.pm//; $_} read_dir($path);
288
289
	($#driver < 0) && die __PACKAGE__ . '. No drivers available';
290
291
	($self -> verbose > 1) && $self -> log('Drivers: ' . join(', ', @driver) );
292
293
	$self -> my_drivers(\@driver);
294
295
} # End of get_my_drivers.
296
297
# -----------------------------------------------
298
299
sub get_my_id_generators
300
{
301
	my($self)	= @_;
302
	my($path)	= $self -> _get_pm_path('ID');
303
304
	# Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why?
305
306
	my(@id_generator) = sort map{s/.pm//; $_} read_dir($path);
307
308
	($#id_generator < 0) && die __PACKAGE__ . '. No id generators available';
309
310
	($self -> verbose > 1) && $self -> log('Id generators: ' . join(', ', @id_generator) );
311
312
	$self -> my_id_generators(\@id_generator);
313
314
} # End of get_my_id_generators.
315
316
# -----------------------------------------------
317
318
sub get_my_serializers
319
{
320
	my($self)	= @_;
321
	my($path)	= $self -> _get_pm_path('Serialize');
322
323
	# Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why?
324
325
	my(@serializer) = sort map{s/.pm//; $_} read_dir($path);
326
327
	($#serializer < 0) && die __PACKAGE__ . '. No serializers available';
328
329
	($self -> verbose > 1) && $self -> log('Serializers: ' . join(', ', @serializer) );
330
331
	$self -> my_serializers(\@serializer);
332
333
} # End of get_my_serializers.
334
335
# -----------------------------------------------
336
337
sub _get_pm_path
338
{
339
	my($self, $subdir)	= @_;
340
	my($path)			= $INC{'Data/Session.pm'};
341
	$path				=~ s/\.pm$//;
342
343
	return File::Spec -> catdir($path, $subdir);
344
}
345
346
# -----------------------------------------------
347
348
sub http_header
349
{
350
	my($self)   = shift;
351
	my($cookie) = $self -> cookie;
352
353
	my($header);
354
355
	if ($cookie)
356
	{
357
		$header = $self -> query -> header(-cookie => $cookie, @_);
358
	}
359
	else
360
	{
361
		$header = $self -> query -> header(@_);
362
	}
363
364
	return $header;
365
366
} # End of http_header.
367
368
# -----------------------------------------------
369
370
sub load_driver
371
{
372
	my($self, $arg) = @_;
373
	my($class)      = join('::', __PACKAGE__, 'Driver', $self -> driver_option);
374
375
	try_load_class($class);
376
377
	die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) );
378
379
	($self -> verbose > 1) && $self -> log("Loaded driver_option: $class");
380
381
	$self -> driver_class($class -> new(%$arg) );
382
383
	($self -> verbose > 1) && $self -> log("Initialized driver_class: $class");
384
385
} # End of load_driver.
386
387
# -----------------------------------------------
388
389
sub load_id_generator
390
{
391
	my($self, $arg)  = @_;
392
	my($class)       = join('::', __PACKAGE__, 'ID', $self -> id_option);
393
394
	try_load_class($class);
395
396
	die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) );
397
398
	($self -> verbose > 1) && $self -> log("Loaded id_option: $class");
399
400
	$self -> id_class($class -> new(%$arg) );
401
402
	($self -> verbose > 1) && $self -> log("Initialized id_class: $class");
403
404
} # End of load_id_generator.
405
406
# -----------------------------------------------
407
408
sub load_param
409
{
410
	my($self, $q, $name) = @_;
411
412
	if (! defined $q)
413
	{
414
		$q = $self -> load_query_class;
415
	}
416
417
	my($data) = $self -> session;
418
419
	if (! $name)
420
	{
421
		$name = [sort keys %$data];
422
	}
423
	elsif (ref($name) ne 'ARRAY')
424
	{
425
		$name = [$name];
426
	}
427
428
	for my $key (grep{! /^_/} @$name)
429
	{
430
		$q -> param($key => $$data{$key});
431
	}
432
433
	return $q;
434
435
} # End of load_param.
436
437
# -----------------------------------------------
438
439
sub load_query_class
440
{
441
	my($self) = @_;
442
443
	if (! $self -> query)
444
	{
445
		my($class) = $self -> query_class;
446
447
		try_load_class($class);
448
449
		die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) );
450
451
		($self -> verbose > 1) && $self -> log('Loaded query_class: ' . $class);
452
453
		$self -> query($class -> new);
454
455
		($self -> verbose > 1) && $self -> log('Called query_class -> new: ' . $class);
456
	}
457
458
	return $self -> query;
459
460
} # End of load_query_class.
461
462
# -----------------------------------------------
463
464
sub load_serializer
465
{
466
	my($self, $arg) = @_;
467
	my($class)      = join('::', __PACKAGE__, 'Serialize', $self -> serializer_option);
468
469
	try_load_class($class);
470
471
	die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) );
472
473
	($self -> verbose > 1) && $self -> log("Loaded serializer_option: $class");
474
475
	$self -> serializer_class($class -> new(%$arg) );
476
477
	($self -> verbose > 1) && $self -> log("Initialized serializer_class: $class");
478
479
} # End of load_serializer.
480
481
# -----------------------------------------------
482
483
sub load_session
484
{
485
	my($self) = @_;
486
	my($id)   = $self -> user_id;
487
488
	($self -> verbose > 1) && $self -> log("Loading session for id: $id");
489
490
	if ($id)
491
	{
492
		my($raw_data) = $self -> driver_class -> retrieve($id);
493
494
		($self -> verbose > 1) && $self -> log("Tried to retrieve session for id: $id. Length of raw data: @{[length($raw_data)]}");
495
496
		if (! $raw_data)
497
		{
498
			$self -> new_session($id);
499
		}
500
		else
501
		{
502
			# Retrieved an old session, so flag it as accessed, and not-new.
503
504
			my($data) = $self -> serializer_class -> thaw($raw_data);
505
506
			if ($self -> verbose > 1)
507
			{
508
				for my $key (sort keys %{$$data{_SESSION_PTIME} })
509
				{
510
					$self -> log("Recovered session parameter expiry time: $key: $$data{_SESSION_PTIME}{$key}");
511
				}
512
			}
513
514
			$self -> id($id);
515
			$self -> is_new(0);
516
			$self -> session($data);
517
518
			($self -> verbose > 1) && $self -> dump('Loaded');
519
520
			# Check for session expiry.
521
522
			$self -> check_expiry;
523
524
			($self -> verbose > 1) && $self -> dump('Loaded and checked expiry');
525
526
			# Check for session parameter expiry.
527
			# Stockpile keys to be cleared. We can't call $self -> clear($key) inside the loop,
528
			# because it updates $$data{_SESSION_PTIME}, which in turns confuses 'each'.
529
530
			my(@stack);
531
532
			while (my($key, $time) = each %{$$data{_SESSION_PTIME} })
533
			{
534
				if ($time && ( ($self -> atime + $time) < time) )
535
				{
536
					push @stack, $key;
537
				}
538
			}
539
540
			$self -> clear($_) for @stack;
541
542
			# We can't do this above, just after my($data)..., since it's used just above, as $self -> atime().
543
544
			$self -> atime(time);
545
546
			($self -> verbose > 1) && $self -> dump('Loaded and checked parameter expiry');
547
		}
548
	}
549
	else
550
	{
551
		$self -> new_session(0);
552
	}
553
554
	($self -> verbose > 1) && $self -> log("Loaded session for id: " . $self -> id);
555
556
	return 1;
557
558
} # End of load_session.
559
560
# -----------------------------------------------
561
562
sub new
563
{
564
	my($class, %arg)  = @_;
565
	$arg{debug}       ||= 0; # new(...).
566
	$arg{deleted}     = 0;   # Internal.
567
	$arg{expired}     = 0;   # Internal.
568
	$arg{id}          ||= 0; # new(...).
569
	$arg{modified}    = 0;   # Internal.
570
	$arg{name}        ||= 'CGISESSID'; # new(...).
571
	$arg{query}       ||= ''; # new(...).
572
	$arg{query_class} ||= 'CGI'; # new(...).
573
	$arg{session}     = {};  # Internal.
574
	$arg{type}        ||= ''; # new(...).
575
	$arg{verbose}     ||= 0; # new(...).
576
577
	my($self);
578
579
	try
580
	{
581
		$self  = from_hash(bless({}, $class), \%arg);
582
583
		$self -> get_my_drivers;
584
		$self -> get_my_id_generators;
585
		$self -> get_my_serializers;
586
		$self -> parse_options;
587
		$self -> validate_options;
588
		$self -> load_driver(\%arg);
589
		$self -> load_id_generator(\%arg);
590
		$self -> load_serializer(\%arg);
591
		$self -> load_session; # Calls user_id() which calls load_query_class() if necessary.
592
	}
593
	catch
594
	{
595
		$errstr = $_;
596
		$self   = undef;
597
	};
598
599
	return $self;
600
601
} # End of new.
602
603
# -----------------------------------------------
604
605
sub new_session
606
{
607
	my($self, $id) = @_;
608
	$id            = $id ? $id : $self -> id_class -> generate;
609
	my($time)      = time;
610
611
	$self -> session
612
	({
613
		_SESSION_ATIME => $time, # Access time.
614
		_SESSION_CTIME => $time, # Create time.
615
		_SESSION_ETIME => 0,     # Session expiry time.
616
		_SESSION_ID    => $id,   # Session id.
617
		_SESSION_PTIME => {},    # Parameter expiry times.
618
	});
619
620
	$self -> id($id);
621
	$self -> is_new(1);
622
623
} # End of new_session.
624
625
# -----------------------------------------------
626
627
sub param
628
{
629
	my($self, @arg) = @_;
630
	my($data) = $self -> session;
631
632
	if ($#arg < 0)
633
	{
634
		return grep{! /^_/} sort keys %$data;
635
	}
636
	elsif ($#arg == 0)
637
	{
638
		# If only 1 name is supplied, return the session's data for that name.
639
640
		return $$data{$arg[0]};
641
	}
642
643
	# Otherwise, loop over all the supplied data.
644
645
	my(%arg) = @arg;
646
647
	for my $key (keys %arg)
648
	{
649
		next if ($key =~ /^_/);
650
651
		# Don't update a value if it's the same as the original value.
652
		# That way we don't update the last-access-time.
653
		# We're effectively testing $x == $y, but we're not testing to ensure:
654
		# o undef == undef
655
		# o 0 == 0
656
		# o '' == ''
657
		# So changing undef to 0 or visa versa, etc, will all be ignored.
658
659
		(! $$data{$key} && ! $arg{$key}) && next;
660
661
		if ( (! $$data{$key} && $arg{$key}) || ($$data{$key} && ! $arg{$key}) || ($$data{$key} ne $arg{$key}) )
662
		{
663
			$$data{$key} = $arg{$key};
664
665
			$self -> modified(1);
666
		}
667
	}
668
669
	$self -> session($data);
670
671
	return 1;
672
673
} # End of param.
674
675
# -----------------------------------------------
676
# Format expected: new(type => 'driver:File;id:MD5;serialize:DataDumper').
677
678
sub parse_options
679
{
680
	my($self)    = @_;
681
	my($options) = $self -> type || '';
682
683
	($self -> verbose > 1) && $self -> log("Parsing type '$options'");
684
685
	$options     =~ tr/ //d;
686
	my(%options) = map{split(/:/, $_)} split(/;/, lc $options); # lc!
687
	my(%default) =
688
	(
689
		driver    => 'File',
690
		id        => 'MD5',
691
		serialize => 'DataDumper',
692
	);
693
694
	for my $key (keys %options)
695
	{
696
		(! $default{$key}) && die __PACKAGE__ . ". Error in type: Unexpected component '$key'";
697
	}
698
699
	my(%driver)       = map{(lc $_ => $_)} @{$self -> my_drivers};
700
	my(%id_generator) = map{(lc $_ => $_)} @{$self -> my_id_generators};
701
	my(%serializer)   = map{(lc $_ => $_)} @{$self -> my_serializers};
702
703
	# The sort is just to make the warnings ($required) appear in alphabetical order.
704
705
	for my $required (sort keys %default)
706
	{
707
		# Set default if user does not supply the key:value pair.
708
709
		if (! exists $options{$required})
710
		{
711
			$options{$required} = $default{$required};
712
713
			($self -> verbose) && $self -> log("Warning for type: Defaulting '$required' to '$default{$required}'");
714
		}
715
716
		# Ensure the value is set.
717
718
		(! $options{$required}) && die __PACKAGE__ . ". Error in type: Missing value for option '$required'";
719
720
		# Ensure the case of the value is correct.
721
722
		if ($required eq 'driver')
723
		{
724
			if ($driver{lc $options{$required} })
725
			{
726
				$options{$required} = $driver{lc $options{$required} };
727
			}
728
			else
729
			{
730
				die __PACKAGE__ . ". Unknown driver '$options{$required}'";
731
			}
732
		}
733
		elsif ($required eq 'id')
734
		{
735
			if ($id_generator{lc $options{$required} })
736
			{
737
				$options{$required} = $id_generator{lc $options{$required} };
738
			}
739
			else
740
			{
741
				die __PACKAGE__ . ". Unknown id generator '$options{$required}'";
742
			}
743
		}
744
		elsif ($required eq 'serialize')
745
		{
746
			if ($serializer{lc $options{$required} })
747
			{
748
				$options{$required} = $serializer{lc $options{$required} };
749
			}
750
			else
751
			{
752
				die __PACKAGE__ . ". Unknown serialize '$options{$required}'";
753
			}
754
		}
755
	}
756
757
	$self -> driver_option($options{driver});
758
	$self -> id_option($options{id});
759
	$self -> serializer_option($options{serialize});
760
	$self -> type(join(';', map{"$_:$options{$_}"} sort keys %default));
761
762
	if ($self -> verbose > 1)
763
	{
764
		$self -> log('type:              ' . $self -> type);
765
		$self -> log('driver_option:     ' . $self -> driver_option);
766
		$self -> log('id_option:         ' . $self -> id_option);
767
		$self -> log('serializer_option: ' . $self -> serializer_option);
768
	}
769
770
} # End of parse_options.
771
772
# -----------------------------------------------
773
# Warning: Returns a hashref.
774
775
sub ptime
776
{
777
	my($self) = @_;
778
	my($data) = $self -> session;
779
780
	return $$data{_SESSION_PTIME};
781
782
} # End of ptime.
783
784
# -----------------------------------------------
785
786
sub save_param
787
{
788
	my($self, $q, $name) = @_;
789
790
	if (! defined $q)
791
	{
792
		$q = $self -> load_query_class;
793
	}
794
795
	my($data) = $self -> session;
796
797
	if (! $name)
798
	{
799
		$name = [$q -> param];
800
	}
801
	elsif (ref($name) ne 'ARRAY')
802
	{
803
		$name = [grep{! /^_/} $name];
804
	}
805
	else
806
	{
807
		$name = [grep{! /^_/} @$name];
808
	}
809
810
	for my $key (@$name)
811
	{
812
		$$data{$key} = $q -> param($key);
813
814
		$self -> modified(1);
815
	}
816
817
	$self -> session($data);
818
819
	return 1;
820
821
} # End of save_param.
822
823
# -----------------------------------------------
824
825
sub traverse
826
{
827
	my($self, $sub) = @_;
828
829
	return $self -> driver_class -> traverse($sub);
830
831
} # End of traverse.
832
833
# -----------------------------------------------
834
835
sub user_id
836
{
837
	my($self) = @_;
838
839
	# Sources of id:
840
	# o User supplied one in $session -> new(id => $id).
841
	# o User didn't, so we try $self -> query -> cookie and/or $self -> query -> param.
842
843
	my($id) = $self -> id;
844
845
	if (! $id)
846
	{
847
		$self -> load_query_class;
848
849
		my($name) = $self -> name;
850
		my($q)    = $self -> query;
851
852
		if ($q -> can('cookie') )
853
		{
854
			$id = $q -> cookie($name) || $q -> param($name);
855
856
			($self -> verbose > 1) && $self -> log('query can cookie(). id from cookie or param: ' . ($id || '') );
857
		}
858
		else
859
		{
860
			$id = $q -> param($name);
861
862
			($self -> verbose > 1) && $self -> log("query can't cookie(). id from param: " . ($id || '') );
863
		}
864
865
		if (! $id)
866
		{
867
			$id = 0;
868
		}
869
	}
870
871
	return $id;
872
873
} # End of user_id.
874
875
# -----------------------------------------------
876
877
sub validate_options
878
{
879
	my($self) = @_;
880
881
	if ( ($self -> id_option eq 'Static') && ! $self -> id)
882
	{
883
		die __PACKAGE__ . '. When using id:Static, you must provide a (true) id to new(id => ...)';
884
	}
885
886
} # End of validate_options.
887
888
# -----------------------------------------------
889
890
sub validate_time
891
{
892
	my($self, $time) = @_;
893
894
	(! $time) && return 0;
895
896
	$time = "${time}s" if ($time =~ /\d$/);
897
898
	($time !~ /^([-+]?\d+)([smhdwMy])$/) && die __PACKAGE__ . ". Can't parse time: $time";
899
900
	my(%scale) =
901
	(
902
		s =>        1,
903
		m =>       60,
904
		h =>     3600,
905
		d =>    86400,
906
		w =>   604800,
907
		M =>  2592000,
908
		y => 31536000,
909
	);
910
911
	return $scale{$2} * $1;
912
913
} # End of validate_time.
914
915
# -----------------------------------------------
916
917
1;
918
919
=pod
920
921
=head1 NAME
922
923
Data::Session - Persistent session data management
924
925
=head1 Synopsis
926
927
1: A self-contained CGI script (scripts/cgi.demo.cgi):
928
929
	#!/usr/bin/perl
930
931
	use CGI;
932
933
	use Data::Session;
934
935
	use File::Spec;
936
937
	# ----------------------------------------------
938
939
	sub generate_html
940
	{
941
		my($name, $id, $count) = @_;
942
		$id        ||= '';
943
		my($title) = "CGI demo for Data::Session";
944
		return     <<EOS;
945
	<html>
946
	<head><title>$title</title></head>
947
	<body>
948
		Number of times this script has been run: $count.<br/>
949
		Current value of $name: $id.<br/>
950
		<form id='sample' method='post' name='sample'>
951
		<button id='submit'>Click to submit</button>
952
		<input type='hidden' name='$name' id='$name' value='$id' />
953
		</form>
954
	</body>
955
	</html>
956
	EOS
957
958
	} # End of generate_html.
959
960
	# ----------------------------------------------
961
962
	my($q)        = CGI -> new;
963
	my($name)     = 'sid'; # CGI form field name.
964
	my($sid)      = $q -> param($name);
965
	my($dir_name) = '/tmp';
966
	my($type)     = 'driver:File;id:MD5;serialize:JSON';
967
	my($session)  = Data::Session -> new
968
	(
969
		directory => $dir_name,
970
		name      => $name,
971
		query     => $q,
972
		type      => $type,
973
	);
974
	my($id) = $session -> id;
975
976
	# First entry ever?
977
978
	my($count);
979
980
	if ($sid) # Not $id, which always has a value...
981
	{
982
		# No. The CGI form field called sid has a (true) value.
983
		# So, this is the code for the second and subsequent entries.
984
		# Count the # of times this CGI script has been run.
985
986
		$count = $session -> param('count') + 1;
987
	}
988
	else
989
	{
990
		# Yes. There is no CGI form field called sid (with a true value).
991
		# So, this is the code for the first entry ever.
992
		# Count the # of times this CGI script has been run.
993
994
		$count = 0;
995
	}
996
997
	$session -> param(count => $count);
998
999
	print $q -> header, generate_html($name, $id, $count);
1000
1001
	# Calling flush() is good practice, rather than hoping 'things just work'.
1002
	# In a persistent environment, this call is mandatory...
1003
	# But you knew that, because you'd read the docs, right?
1004
1005
	$session -> flush;
1006
1007
2: A basic session. See scripts/sqlite.pl:
1008
1009
	# The EXLOCK is for BSD-based systems.
1010
	my($directory)   = File::Temp::newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1);
1011
	my($data_source) = 'dbi:SQLite:dbname=' . File::Spec -> catdir($directory, 'sessions.sqlite');
1012
	my($type)        = 'driver:SQLite;id:SHA1;serialize:DataDumper'; # Case-sensitive.
1013
	my($session)     = Data::Session -> new
1014
	(
1015
		data_source => $data_source,
1016
		type        => $type,
1017
	) || die $Data::Session::errstr;
1018
1019
3: Using BerkeleyDB as a cache manager. See scripts/berkeleydb.pl:
1020
1021
	# The EXLOCK is for BSD-based systems.
1022
	my($file_name) = File::Temp -> new(EXLOCK => 0, SUFFIX => '.bdb');
1023
	my($env)       = BerkeleyDB::Env -> new
1024
	(
1025
		Home => File::Spec -> tmpdir,
1026
		Flags => DB_CREATE | DB_INIT_CDB | DB_INIT_MPOOL,
1027
	);
1028
	if (! $env)
1029
	{
1030
		print "BerkeleyDB is not responding. \n";
1031
		exit;
1032
	}
1033
	my($bdb) = BerkeleyDB::Hash -> new(Env => $env, Filename => $file_name, Flags => DB_CREATE);
1034
	if (! $bdb)
1035
	{
1036
		print "BerkeleyDB is not responding. \n";
1037
		exit;
1038
	}
1039
	my($type)    = 'driver:BerkeleyDB;id:SHA1;serialize:DataDumper'; # Case-sensitive.
1040
	my($session) = Data::Session -> new
1041
	(
1042
		cache => $bdb,
1043
		type  => $type,
1044
	) || die $Data::Session::errstr;
1045
1046
4: Using memcached as a cache manager. See scripts/memcached.pl:
1047
1048
	my($memd) = Cache::Memcached -> new
1049
	({
1050
		namespace => 'data.session.id',
1051
		servers   => ['127.0.0.1:11211'],
1052
	});
1053
	my($test) = $memd -> set(time => time);
1054
	if (! $test || ($test != 1) )
1055
	{
1056
		print "memcached is not responding. \n";
1057
		exit;
1058
	}
1059
	$memd -> delete('time');
1060
	my($type)    = 'driver:Memcached;id:SHA1;serialize:DataDumper'; # Case-sensitive.
1061
	my($session) = Data::Session -> new
1062
	(
1063
		cache => $memd,
1064
		type  => $type,
1065
	) || die $Data::Session::errstr;
1066
1067
5: Using a file to hold the ids. See scripts/file.autoincrement.pl:
1068
1069
	# The EXLOCK is for BSD-based systems.
1070
	my($directory) = File::Temp::newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1);
1071
	my($file_name) = 'autoinc.session.dat';
1072
	my($id_file)   = File::Spec -> catfile($directory, $file_name);
1073
	my($type)      = 'driver:File;id:AutoIncrement;serialize:DataDumper'; # Case-sensitive.
1074
	my($session)   = Data::Session -> new
1075
	(
1076
		id_base     => 99,
1077
		id_file     => $id_file,
1078
		id_step     => 2,
1079
		type        => $type,
1080
	) || die $Data::Session::errstr;
1081
1082
6: Using a file to hold the ids. See scripts/file.sha1.pl (non-CGI context):
1083
1084
	my($directory) = '/tmp';
1085
	my($file_name) = 'session.%s.dat';
1086
	my($type)      = 'driver:File;id:SHA1;serialize:DataDumper'; # Case-sensitive.
1087
1088
	# Create the session:
1089
	my($session)   = Data::Session -> new
1090
	(
1091
		directory => $directory,
1092
		file_name => $file_name,
1093
		type      => $type,
1094
	) || die $Data::Session::errstr;
1095
1096
	# Time passes...
1097
1098
	# Retrieve the session:
1099
	my($id)      = $session -> id;
1100
	my($session) = Data::Session -> new
1101
	(
1102
		directory => $directory,
1103
		file_name => $file_name,
1104
		id        => $id, # <== Look! You must supply the id for retrieval.
1105
		type      => $type,
1106
	) || die $Data::Session::errstr;
1107
1108
7: As a variation on the above, see scripts/cgi.sha1.pl (CGI context but command line program):
1109
1110
	# As above (scripts/file.sha1.pl), for creating the session. Then...
1111
1112
	# Retrieve the session:
1113
	my($q)       = CGI -> new; # CGI form data provides the id.
1114
	my($session) = Data::Session -> new
1115
	(
1116
		directory => $directory,
1117
		file_name => $file_name,
1118
		query     => $q, # <== Look! You must supply the id for retrieval.
1119
		type      => $type,
1120
	) || die $Data::Session::errstr;
1121
1122
Also, much can be gleaned from t/basic.t and t/Test.pm. See L</Test Code>.
1123
1124
=head1 Description
1125
1126
L<Data::Session> is typically used by a CGI script to preserve state data between runs of the
1127
script. This gives the end user the illusion that the script never exits.
1128
1129
It can also be used to communicate between 2 scripts, as long as they agree beforehand what session
1130
id to use.
1131
1132
See L<Data::Session::CGISession> for an extended discussion of the design changes between
1133
L<Data::Session> and L<CGI::Session>.
1134
1135
L<Data::Session> stores user data internally in a hashref, and the module reserves key names
1136
starting with '_'.
1137
1138
The current list of reserved keys is documented under L</flush()>.
1139
1140
Of course, the module also has a whole set of methods to help manage state.
1141
1142
=head1 Methods
1143
1144
=head2 new()
1145
1146
Calling new() returns a object of type L<Data::Session>, or - if new() fails - it returns undef.
1147
For details see L</Trouble with Errors>.
1148
1149
new() takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
1150
might be mandatory.
1151
1152
The keys are listed here in alphabetical order.
1153
1154
They are lower-case because they are (also) method names, meaning they can be called to set or get
1155
the value at any time.
1156
1157
But a warning: In some cases, setting them after this module has used the previous value, will have
1158
no effect. All such cases should be documented.
1159
1160
Beginners understandably confused by the quantity of options should consult the L</Synopsis> for
1161
example code.
1162
1163
The questions of combinations of options, and which option has priority over other options,
1164
are addressed in the section, L</Combinations of Options>.
1165
1166
=over 4
1167
1168
=item o cache => $cache
1169
1170
Specifies an object of type L<BerkeleyDB> or L<Cache::Memcached> to use for storage.
1171
1172
Only needed if you use 'type' like 'driver:BerkeleyDB ...' or 'driver:Memcached ...'.
1173
1174
See L<Data::Session::Driver::BerkeleyDB> and L<Data::Session::Driver::Memcached>.
1175
1176
Default: '' (the empty string).
1177
1178
=item o data_col_name => $string
1179
1180
Specifies the name of the column holding the session data, in the session table.
1181
1182
This key is optional.
1183
1184
Default: 'a_session'.
1185
1186
=item o data_source => $string
1187
1188
Specifies a value to use as the 1st parameter in the call to L<DBI>'s connect() method.
1189
1190
A typical value would be 'dbi:Pg:dbname=project'.
1191
1192
This key is optional. It is only used if you do not supply a value for the 'dbh' key.
1193
1194
Default: '' (the empty string).
1195
1196
=item o data_source_attrs => $hashref
1197
1198
Specify a hashref of options to use as the last parameter in the call to L<DBI>'s connect() method.
1199
1200
This key is optional. It is only used if you do not supply a value for the 'dbh' key.
1201
1202
Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}.
1203
1204
=item o dbh => $dbh
1205
1206
Specifies a database handle to use to access the session table.
1207
1208
This key is optional.
1209
1210
However, if not specified, you must specify a value for 'data_source', and perhaps also 'username'
1211
and 'password', so that this module can create a database handle.
1212
1213
If this module does create a database handle, it will also destroy it, whereas if you supply a database
1214
handle, you are responsible for destroying it.
1215
1216
=item o debug => $Boolean
1217
1218
Specifies that debugging should be turned on (1) or off (0) in L<Data::Session::File::Driver> and
1219
L<Data::Session::ID::AutoIncrement>.
1220
1221
When debug is 1, $! is included in error messages, but because this reveals directory names, it is
1222
0 by default.
1223
1224
This key is optional.
1225
1226
Default: 0.
1227
1228
=item o directory => $string
1229
1230
Specifies the directory in which session files are stored, when each session is stored in a separate
1231
file (by using 'driver:File ...' as the first component of the 'type').
1232
1233
This key is optional.
1234
1235
Default: Your temp directory as determined by L<File::Spec>.
1236
1237
See L</Specifying Session Options> for details.
1238
1239
=item o file_name => $string_containing_%s
1240
1241
Specifies the syntax for the names of session files, when each session is stored in a separate file
1242
(by using 'driver:File ...' as the first component of the 'type').
1243
1244
This key is optional.
1245
1246
Default: 'cgisess_%s', where the %s is replaced at run-time by the session id.
1247
1248
The directory in which these files are stored is specified by the 'directory' option above.
1249
1250
See L</Specifying Session Options> for details.
1251
1252
=item o host => $string
1253
1254
Specifies a host, typically for use with a data_source referring to MySQL.
1255
1256
This key is optional.
1257
1258
Default: '' (the empty string).
1259
1260
=item o id => $string
1261
1262
Specifies an id to retrieve from storage.
1263
1264
This key is optional.
1265
1266
Default: 0.
1267
1268
Note: If you do not provide an id here, the module calls L</user_id()> to determine whether or not
1269
an id is available from a cookie or a form field.
1270
1271
This complex topic is discussed in the section L<Specifying an Id>.
1272
1273
=item o id_col_name => $string
1274
1275
Specifies the name of the column holding the session id, in the session table.
1276
1277
This key is optional.
1278
1279
Default: 'id'.
1280
1281
=item o id_base => $integer
1282
1283
Specifies the base from which to start ids when using the '... id:AutoIncrement ...' component in
1284
the 'type'.
1285
1286
Note: The first id returned by L<Data::Session::ID::AutoIncrement> will be id_base + id_step.
1287
So, if id_base is 1000 and id_step is 10, then the lowest id will be 1010.
1288
1289
This key is optional.
1290
1291
Default: 0.
1292
1293
=item o id_file => $file_path_and_name
1294
1295
Specifies the file path and name in which to store the last used id, as calculated from C<id_base +
1296
id_step>, when using the '... id:AutoIncrement ...' component in the 'type'.
1297
1298
This value must contain a path because the 'directory' option above is only used for session files
1299
(when using L<Data::Session::Driver::File>).
1300
1301
This key is optional.
1302
1303
Default: File::Spec -> catdir(File::Spec -> tmpdir, 'data.session.id').
1304
1305
=item o id_step => $integer
1306
1307
Specifies the step size between ids when using the '... id:AutoIncrement ...' component of the
1308
'type'.
1309
1310
This key is optional.
1311
1312
Default: 1.
1313
1314
=item o name => $string
1315
1316
Specifies the name of the cookie or form field which holds the session id.
1317
1318
This key is optional.
1319
1320
Default: 'CGISESSID'.
1321
1322
Usage of 'name' is discussed in the sections L</Specifying an Id> and L</user_id()>.
1323
1324
=item o no_flock => $boolean
1325
1326
Specifies (no_flock => 1) to not use flock() to obtain a lock on a session file before processing
1327
it, or (no_flock => 0) to use flock().
1328
1329
This key is optional.
1330
1331
Default: 0.
1332
1333
This value is used in these cases:
1334
1335
=over 4
1336
1337
=item o type => 'driver:File ...'
1338
1339
=item o type => '... id:AutoIncrement ...'
1340
1341
=back
1342
1343
=item o no_follow => $boolean
1344
1345
Influences the mode to use when calling sysopen() on session files.
1346
1347
'Influences' means the value is bit-wise ored with O_RDWR for reading and with O_WRONLY for writing.
1348
1349
This key is optional.
1350
1351
Default: eval { O_NOFOLLOW } || 0.
1352
1353
This value is used in this case:
1354
1355
=over 4
1356
1357
=item o type => 'driver:File ...'
1358
1359
=back
1360
1361
=item o password => $string
1362
1363
Specifies a value to use as the 3rd parameter in the call to L<DBI>'s connect() method.
1364
1365
This key is optional. It is only used if you do not supply a value for the 'dbh' key.
1366
1367
Default: '' (the empty string).
1368
1369
=item o pg_bytea => $boolean
1370
1371
Specifies that you're using a Postgres-specific column type of 'bytea' to hold the session data,
1372
in the session table.
1373
1374
This key is optional, but see the section, L</Combinations of Options> for how it interacts with
1375
the pg_text key.
1376
1377
Default: 0.
1378
1379
Warning: Columns of type bytea can hold null characters (\x00), whereas columns of type text cannot.
1380
1381
=item o pg_text => $boolean
1382
1383
Specifies that you're using a Postgres-specific column type of 'text' to hold the session data, in
1384
the session table.
1385
1386
This key is optional, but see the section, L</Combinations of Options> for how it interacts with the
1387
pg_bytea key.
1388
1389
Default: 0.
1390
1391
Warning: Columns of type bytea can hold null characters (\x00), whereas columns of type text cannot.
1392
1393
=item o port => $string
1394
1395
Specifies a port, typically for use with a data_source referring to MySQL.
1396
1397
This key is optional.
1398
1399
Default: '' (the empty string).
1400
1401
=item o query => $q
1402
1403
Specifies the query object.
1404
1405
If not specified, the next option - 'query_class' - will be used to create a query object.
1406
1407
Either way, the object will be accessible via the $session -> query() method.
1408
1409
This key is optional.
1410
1411
Default: '' (the empty string).
1412
1413
=item o query_class => $class_name
1414
1415
Specifies the class of query object to create if a value is not provided for the 'query' option.
1416
1417
This key is optional.
1418
1419
Default: 'CGI'.
1420
1421
=item o socket => $string
1422
1423
Specifies a socket, typically for use with a data_source referring to MySQL.
1424
1425
The reason this key is called socket and not mysql_socket is in case other drivers permit a socket
1426
option.
1427
1428
This key is optional.
1429
1430
Default: '' (the empty string).
1431
1432
=item o table_name => $string
1433
1434
Specifies the name of the table holding the session data.
1435
1436
This key is optional.
1437
1438
Default: 'sessions'.
1439
1440
=item o type => $string
1441
1442
Specifies the type of L<Data::Session> object you wish to create.
1443
1444
This key is optional.
1445
1446
Default: 'driver:File;id:MD5;serialize:DataDumper'.
1447
1448
This complex topic is discussed in the section L</Specifying Session Options>.
1449
1450
=item o umask => $octal_number
1451
1452
Specifies the mode to use when calling sysopen() on session files.
1453
1454
This value is used in these cases:
1455
1456
=over 4
1457
1458
=item o type => 'driver:File ...'
1459
1460
=item o type => '... id:AutoIncrement ...'
1461
1462
=back
1463
1464
Default: 0660 (octal).
1465
1466
=item o username => $string
1467
1468
Specifies a value to use as the 2nd parameter in the call to L<DBI>'s connect() method.
1469
1470
This key is optional. It is only used if you do not supply a value for the 'dbh' key.
1471
1472
Default: '' (the empty string).
1473
1474
=item o verbose => $integer
1475
1476
Print to STDERR more or less information.
1477
1478
Typical values are 0, 1 and 2.
1479
1480
This key is optional.
1481
1482
Default: 0, meaings nothing is printed.
1483
1484
See L</dump([$heading])> for what happens when verbose is 2.
1485
1486
=back
1487
1488
=head3 Specifying Session Options
1489
1490
See also L</Case-sensitive Options>.
1491
1492
The default 'type' string is 'driver:File;id:MD5;serialize:DataDumper'. It consists of 3 optional
1493
components separated by semi-colons.
1494
1495
Each of those 3 components consists of 2 fields (a key and a value) separated by a colon.
1496
1497
The keys:
1498
1499
=over 4
1500
1501
=item o driver
1502
1503
This specifies what type of persistent storage you wish to use for session data.
1504
1505
Values for 'driver':
1506
1507
=over 4
1508
1509
=item o BerkeleyDB
1510
1511
Use L<BerkeleyDB> for storage. In this case, you must pass an object of type L<BerkeleyDB>
1512
to new() as the value of the 'cache' option.
1513
1514
See L<Data::Session::Driver::BerkeleyDB>.
1515
1516
=item o File
1517
1518
The default, 'File', says sessions are each stored in a separate file.
1519
1520
The directory for these files is specified with the 'directory' option to new().
1521
1522
If a directory is not specified in that way, L<File::Spec> is used to find your temp directory.
1523
1524
The names of the session files are generated from the 'file_name' option to new().
1525
1526
The default file name (pattern) is 'cgisess_%s', where the %s is replaced by the session id.
1527
1528
See L<Data::Session::Driver::File>.
1529
1530
=item o Memcached
1531
1532
Use C<memcached> for storage. In this case, you must pass an object of type L<Cache::Memcached> to
1533
new() as the value of the 'cache' option.
1534
1535
See L<Data::Session::Driver::Memcached>.
1536
1537
=item o mysql
1538
1539
This says each session is stored in a separate row of a database table using the L<DBD::mysql>
1540
database server.
1541
1542
These rows have a unique primary id equal to the session id.
1543
1544
See L<Data::Session::Driver::mysql>.
1545
1546
=item o ODBC
1547
1548
This says each session is stored in a separate row of a database table using the L<DBD::ODBC>
1549
database connector.
1550
1551
These rows have a unique primary id equal to the session id.
1552
1553
See L<Data::Session::Driver::ODBC>.
1554
1555
=item o Oracle
1556
1557
This says each session is stored in a separate row of a database table using the L<DBD::Oracle>
1558
database server.
1559
1560
These rows have a unique primary id equal to the session id.
1561
1562
See L<Data::Session::Driver::Oracle>.
1563
1564
=item o Pg
1565
1566
This says each session is stored in a separate row of a database table using the L<DBD::Pg> database
1567
server.
1568
1569
These rows have a unique primary id equal to the session id.
1570
1571
See L<Data::Session::Driver::Pg>.
1572
1573
=item o SQLite
1574
1575
This says each session is stored in a separate row of a database table using the SQLite database
1576
server.
1577
1578
These rows have a unique primary id equal to the session id.
1579
1580
The advantage of SQLite is that a client I<and server> are shipped with all recent versions of Perl.
1581
1582
See L<Data::Session::Driver::SQLite>.
1583
1584
=back
1585
1586
=item o id
1587
1588
This specifies what type of id generator you wish to use.
1589
1590
Values for 'id':
1591
1592
=over 4
1593
1594
=item o AutoIncrement
1595
1596
This says ids are generated starting from a value specified with the 'id_base' option to new(),
1597
and the last-used id is stored in the file name given by the 'id_file' option to new().
1598
1599
This file name must include a path, since the 'directory' option to new() is I<not> used here.
1600
1601
When a new id is required, the value in the file is incremented by the value of the 'id_step' option
1602
to new(), with the new value both written back to the file and returned as the new session id.
1603
1604
The default value of id_base is 0, and the default value of id_step is 1. Together, the first id
1605
available as a session id is id_base + id_step = 1.
1606
1607
The sequence starts when the module cannot find the given file, or when its contents are not
1608
numeric.
1609
1610
See L<Data::Session::ID::AutoIncrement>.
1611
1612
=item o MD5
1613
1614
The default, 'MD5', says ids are to be generated by L<Digest::MD5>.
1615
1616
See L<Data::Session::ID::MD5>.
1617
1618
=item o SHA1
1619
1620
This says ids are to be generated by L<Digest::SHA>, using a digest algorithm of 1.
1621
1622
See L<Data::Session::ID::SHA1>.
1623
1624
=item o SHA256
1625
1626
This says ids are to be generated by L<Digest::SHA>, using a digest algorithm of 256.
1627
1628
See L<Data::Session::ID::SHA256>.
1629
1630
=item o SHA512
1631
1632
This says ids are to be generated by L<Digest::SHA>, using a digest algorithm of 512.
1633
1634
See L<Data::Session::ID::SHA512>.
1635
1636
=item o Static
1637
1638
This says that the id passed in to new(), as the value of the 'id' option, will be used as the
1639
session id for every session.
1640
1641
Of course, this id must have a true value. L<Data::Session> dies on all values Perl regards as
1642
false.
1643
1644
See L<Data::Session::ID::Static>.
1645
1646
=item o UUID16
1647
1648
This says ids are to be generated by L<Data::UUID>, to generate a 16 byte long binary UUID.
1649
1650
See L<Data::Session::ID::UUID16>.
1651
1652
=item o UUID34
1653
1654
This says ids are to be generated by L<Data::UUID>, to generate a 34 byte long string UUID.
1655
1656
See L<Data::Session::ID::UUID34>.
1657
1658
=item o UUID36
1659
1660
This says ids are to be generated by L<Data::UUID>, to generate a 36 byte long string UUID.
1661
1662
See L<Data::Session::ID::UUID36>.
1663
1664
=item o UUID64
1665
1666
This says ids are to be generated by L<Data::UUID>, to generate a 24 (sic) byte long, base-64
1667
encoded, UUID.
1668
1669
See L<Data::Session::ID::UUID64>.
1670
1671
=back
1672
1673
See scripts/digest.pl which prints the length of each type of digest.
1674
1675
=item o serialize
1676
1677
The specifies what type of mechanism you wish to use to convert the in-memory session data into a
1678
form appropriate for your chosen storage type.
1679
1680
Values for 'serialize':
1681
1682
=over 4
1683
1684
=item o DataDumper
1685
1686
Use L<Data::Dumper> to freeze/thaw sessions.
1687
1688
See L<Data::Session::Serialize::DataDumper>.
1689
1690
=item o FreezeThaw
1691
1692
Use L<FreezeThaw> to freeze/thaw sessions.
1693
1694
See L<Data::Session::Serialize::FreezeThaw>.
1695
1696
=item o JSON
1697
1698
Use L<JSON> to freeze/thaw sessions.
1699
1700
See L<Data::Session::Serialize::JSON>.
1701
1702
=item o Storable
1703
1704
Use L<Storable> to freeze/thaw sessions.
1705
1706
See L<Data::Session::Serialize::Storable>.
1707
1708
Warning: Storable should be avoided until this problem is fixed:
1709
L<http://rt.cpan.org/Public/Bug/Display.html?id=36087>.
1710
1711
=item o YAML
1712
1713
Use L<YAML::Tiny> to freeze/thaw sessions.
1714
1715
See L<Data::Session::Serialize::YAML>.
1716
1717
=back
1718
1719
=back
1720
1721
=head3 Case-sensitive Options
1722
1723
Just to emphasize: The names of drivers, etc follow the DBD::* (or similar) style of
1724
case-sensitivity.
1725
1726
The following classes for drivers, id generators and serializers, are shipped with this package.
1727
1728
Drivers:
1729
1730
=over 4
1731
1732
=item o L<Data::Session::Driver::BerkeleyDB>
1733
1734
This name comes from L<BerkeleyDB>.
1735
1736
And yes, the module uses L<BerkeleyDB> and not L<DB_File>.
1737
1738
=item o L<Data::Session::Driver::File>
1739
1740
=item o L<Data::Session::Driver::Memcached>
1741
1742
This name comes from L<Cache::Memcached> even though the external program you run is called
1743
memcached.
1744
1745
=item o L<Data::Session::Driver::mysql>
1746
1747
=item o L<Data::Session::Driver::ODBC>
1748
1749
=item o L<Data::Session::Driver::Oracle>
1750
1751
=item o L<Data::Session::Driver::Pg>
1752
1753
=item o L<Data::Session::Driver::SQLite>
1754
1755
=back
1756
1757
ID generators:
1758
1759
=over 4
1760
1761
=item o L<Data::Session::ID::AutoIncrement>
1762
1763
=item o L<Data::Session::ID::MD5>
1764
1765
=item o L<Data::Session::ID::SHA1>
1766
1767
=item o L<Data::Session::ID::SHA256>
1768
1769
=item o L<Data::Session::ID::SHA512>
1770
1771
=item o L<Data::Session::ID::Static>
1772
1773
=item o L<Data::Session::ID::UUID16>
1774
1775
=item o L<Data::Session::ID::UUID34>
1776
1777
=item o L<Data::Session::ID::UUID36>
1778
1779
=item o L<Data::Session::ID::UUID64>
1780
1781
=back
1782
1783
Serializers:
1784
1785
=over 4
1786
1787
=item o L<Data::Session::Serialize::DataDumper>
1788
1789
=item o L<Data::Session::Serialize::FreezeThaw>
1790
1791
=item o L<Data::Session::Serialize::JSON>
1792
1793
=item o L<Data::Session::Serialize::Storable>
1794
1795
Warning: Storable should be avoided until this problem is fixed:
1796
L<http://rt.cpan.org/Public/Bug/Display.html?id=36087>
1797
1798
=item o L<Data::Session::Serialize::YAML>
1799
1800
=back
1801
1802
=head3 Specifying an Id
1803
1804
L</user_id()> is called to determine if an id is available from a cookie or a form field.
1805
1806
There are several cases to consider:
1807
1808
=over 4
1809
1810
=item o You specify an id which exists in storage
1811
1812
You can check this with the call $session -> is_new, which will return 0.
1813
1814
$session -> id will return the old id.
1815
1816
=item o You do not specify an id
1817
1818
The module generates a new session and a new id.
1819
1820
You can check this with the call $session -> is_new, which will return 1.
1821
1822
$session -> id will return the new id.
1823
1824
=item o You specify an id which does not exist in storage
1825
1826
You can check this with the call $session -> is_new, which will return 1.
1827
1828
$session -> id will return the old id.
1829
1830
=back
1831
1832
So, how to tell the difference between the last 2 cases? Like this:
1833
1834
	if ($session -> id == $session -> user_id)
1835
	{
1836
		# New session using user-supplied id.
1837
	}
1838
	else
1839
	{
1840
		# New session with new id.
1841
	}
1842
1843
=head3 Combinations of Options
1844
1845
See also L</Specifying Session Options>, for options-related combinations.
1846
1847
=over 4
1848
1849
=item o dbh
1850
1851
If you don't specify a value for the 'dbh' key, this module must create a database handle in those
1852
cases when you specify a database driver of some sort in the value for 'type'.
1853
1854
To create that handle, we needs a value for 'data_source', and that in turn may require values for
1855
'username' and 'password'.
1856
1857
When using SQLite, just specify a value for 'data_source'. The default values for 'username' and
1858
'password' - empty strings - will work.
1859
1860
=item o file_name and id_file
1861
1862
When using new(type => 'driver:File;id:AutoIncrement;...'), then file_name is ignored and id_file is
1863
used.
1864
1865
If id_file is not supplied, it defaults to File::Spec -> catdir(File::Spec -> tmpdir,
1866
'data.session.id').
1867
1868
When using new(type => 'driver:File;id:<Not AutoIncrement>;...'), then id_file is ignored and
1869
file_name is used.
1870
1871
If file_name is not supplied, it defaults to 'cgisess_%s'. Note the mandatory %s.
1872
1873
=item o pg_bytea and pg_text
1874
1875
If you set 'pg_bytea' to 1, then 'pg_text' will be set to 0.
1876
1877
If you set 'pg_text' to 1, then 'pg_bytea' will be set to 0.
1878
1879
If you set them both to 0 (i.e. the default), then 'pg_bytea' will be set to 1.
1880
1881
If you set them both to 1, 'pg_bytea' will be left as 1 and 'pg_text' will be set to 0.
1882
1883
This choice was made because you really should be using a column type of 'bytea' for a_session
1884
in the sessions table, since the type 'text' does not handle null (\x00) characters.
1885
1886
=back
1887
1888
=head2 atime([$atime])
1889
1890
The [] indicates an optional parameter.
1891
1892
Returns the last access time of the session.
1893
1894
By default, the value comes from calling Perl's time() function, or you may pass in a time,
1895
which is then used to set the last access time of the session.
1896
1897
This latter alternative is used by L</load_session()>.
1898
1899
See also L</ctime()>, L</etime()> and L</ptime()>.
1900
1901
=head2 check_expiry()
1902
1903
Checks that there is an expiry time set for the session, and, if (atime + etime) < time():
1904
1905
=over 4
1906
1907
=item o Deletes the session
1908
1909
See L</delete()> for precisely what this means.
1910
1911
=item o Sets the expired flag
1912
1913
See L</expired()>.
1914
1915
=back
1916
1917
This is used when the session is loaded, when you call L</http_header([@arg])>, and by
1918
scripts/expire.pl.
1919
1920
=head2 clear([$name])
1921
1922
The [] indicates an optional parameter.
1923
1924
Returns 1.
1925
1926
Specifies that you wish to delete parameters stored in the session, i.e. stored by previous calls to
1927
param().
1928
1929
$name is a parameter name or an arrayref of parameter names.
1930
1931
If $name is not specified, it is set to the list of all unreserved keys (parameter names) in the
1932
session.
1933
1934
See L</param([@arg])> for details.
1935
1936
=head2 cookie([@arg])
1937
1938
The [] indicates an optional parameter.
1939
1940
Returns a cookie, or '' (the empty string) if the query object does not have a cookie() method.
1941
1942
Use the @arg parameter to pass any extra parameters to the query object's cookie() method.
1943
1944
Warning: Parameters which are handled by L<Data::Session>, and hence should I<not> be passed in,
1945
are:
1946
1947
=over 4
1948
1949
=item o -expires
1950
1951
=item o -name
1952
1953
=item o -value
1954
1955
=back
1956
1957
See L</http_header([@arg])> and scripts/cookie.pl.
1958
1959
=head2 ctime()
1960
1961
Returns the creation time of the session.
1962
1963
The value comes from calling Perl's time() function when the session was created.
1964
1965
This is not the creation time of the session I<object>, except for new sessions.
1966
1967
See also L</atime()>, L</etime()> and L</ptime()>.
1968
1969
=head2 delete()
1970
1971
Returns the result of calling the driver's remove() method.
1972
1973
Specifies that you want to delete the session. Here's what it does:
1974
1975
=over 4
1976
1977
=item o Immediately deletes the session from storage
1978
1979
=item o Calls clear()
1980
1981
This deletes all non-reserved parameters from the session object, and marks it as modified.
1982
1983
=item o Marks the session object as deleted
1984
1985
=back
1986
1987
The latter step means that when (or if) the session object goes out of scope, it will not be flushed
1988
to storage.
1989
1990
Likewise, if you call flush(), the call will be ignored.
1991
1992
Nevertheless, the session object is still fully functional - it just can't be saved or retrieved.
1993
1994
See also L</deleted()> and L</expire([@arg])>.
1995
1996
=head2 deleted()
1997
1998
Returns a Boolean (0/1) indicating whether or not the session has been deleted.
1999
2000
See also L</delete()> and L</expire([@arg])>.
2001
2002
=head2 dump([$heading])
2003
2004
The [] indicates an optional parameter.
2005
2006
Dumps the session's contents to STDERR, with a prefix of '# '.
2007
2008
The $heading, if any, is written first, on a line by itself, with the same prefix.
2009
2010
This is especially useful for testing, since it fits in with the L<Test::More> method diag().
2011
2012
When verbose is 2, dump is called at these times:
2013
2014
=over 4
2015
2016
=item o When a session is flushed
2017
2018
=item o As soon as a session is loaded
2019
2020
=item o As soon as expiry is checked on a just-loaded session
2021
2022
=item o As soon as parameter expiry is checked on a just-loaded session
2023
2024
=back
2025
2026
=head2 etime()
2027
2028
Returns the expiry time of the session.
2029
2030
This is the same as calling $session -> expiry(). In fact, this just calls $session -> etime.
2031
2032
See also L</atime()>, L</ctime()> and L</ptime()>.
2033
2034
=head2 expire([@arg])
2035
2036
The [] indicates an optional parameter.
2037
2038
Specifies that you wish to set or retrieve the session's expiry time, or set the expiry times of
2039
session parameters.
2040
2041
Integer time values ($time below) are assumed to be seconds. The value may be positive or 0 or
2042
negative.
2043
2044
These expiry times are relative to the session's last access time, not the session's creation time.
2045
2046
In all cases, a time of 0 disables expiry.
2047
2048
This affects users of L<Cache::Memcached>. See below and L<Data::Session::Driver::Memcached>.
2049
2050
When a session expires, it is deleted from storage. See L</delete()> for details.
2051
2052
The test for whether or not a session has expired only takes place when a session is loaded from
2053
storage.
2054
2055
When a session parameter expires, it is deleted from the session object. See L</clear([$name])>
2056
for details.
2057
2058
The test for whether or not a session parameter has expired only takes place when a session is
2059
loaded from storage.
2060
2061
=over 4
2062
2063
=item o $session -> expire()
2064
2065
Use $session -> expire() to return the session's expiry time. This just calls $session -> etime.
2066
2067
The default expiry time is 0, meaning the session will never expire. Likewise, by default, session
2068
parameters never expire.
2069
2070
=item o $session -> expire($time)
2071
2072
Use $session -> expire($time) to set the session's expiry time.
2073
2074
Use these suffixes to change the interpretation of the integer you specify:
2075
2076
	+-----------+---------------+
2077
	|   Suffix  |   Meaning     |
2078
	+-----------+---------------+
2079
	|     s     |   Second      |
2080
	|     m     |   Minute      |
2081
	|     h     |   Hour        |
2082
	|     d     |   Day         |
2083
	|     w     |   Week        |
2084
	|     M     |   Month       |
2085
	|     y     |   Year        |
2086
	+-----------+---------------+
2087
2088
Hence $session -> expire('2h') means expire the session in 2 hours.
2089
2090
expire($time) calls validate_time($time) to perform the conversion from '2h' to seconds,
2091
so L</validate_time($time)> is available to you too.
2092
2093
If setting a time like this, expire($time) returns 1.
2094
2095
Note: The time set here is passed as the 3rd parameter to the storage driver's store() method (for
2096
all types of storage), and from there as the 3rd parameter to the set() method of
2097
L<Cache::Memcached>. Of course, this doesn't happen immediately - it only happens when the session
2098
is saved.
2099
2100
=item o $session -> expire($key_1 => $time_1[, $key_2 => $time_2...])
2101
2102
Use $session -> expire($key_1 => $time_1[, $key_2 => $time_2...]) to set the expiry times of
2103
session parameters.
2104
2105
=back
2106
2107
Special cases:
2108
2109
=over 4
2110
2111
=item o To expire the session immediately, call delete()
2112
2113
=item o To expire a session parameter immediately, call clear($key)
2114
2115
=back
2116
2117
See also L</atime()>, L</ctime()>, L</etime()>, L</delete()> and
2118
L</deleted()>.
2119
2120
=head2 expired()
2121
2122
Returns a Boolean (0/1) indicating whether or not the session has expired.
2123
2124
See L</delete()>.
2125
2126
=head2 flush()
2127
2128
Returns 1.
2129
2130
Specifies that you want the session object immediately written to storage.
2131
2132
If you have previously called delete(), the call to flush() is ignored.
2133
2134
If the object has not been modified, the call to flush() is ignored.
2135
2136
Warning: With persistent environments, you object may never go out of scope that way you think it
2137
does.See L</Trouble with Exiting> for details.
2138
2139
These reserved session parameters are included in what's written to storage:
2140
2141
=over 4
2142
2143
=item o _SESSION_ATIME
2144
2145
The session's last access time.
2146
2147
=item o _SESSION_CTIME
2148
2149
The session's creation time.
2150
2151
=item o _SESSION_ETIME
2152
2153
The session's expiry time.
2154
2155
A time of 0 means there is no expiry time.
2156
2157
This affect users of L<Cache::Memcached>. See L</expire([@arg])> and
2158
L<Data::Session::Driver::Memcached>.
2159
2160
=item o _SESSION_ID
2161
2162
The session's id.
2163
2164
=item o _SESSION_PTIME
2165
2166
A hashref of session parameter expiry times.
2167
2168
=back
2169
2170
=head2 http_header([@arg])
2171
2172
The [] indicate an optional parameter.
2173
2174
Returns a HTTP header. This means it does I<not> print the header. You have to do that, when
2175
appropriate.
2176
2177
Unlike L<CGI::Session>, L<Data::Session> does I<not> force the document type to be 'text/html'.
2178
2179
You must pass in a document type to http_header(), as
2180
C<< $session -> http_header('-type' => 'text/html') >>, or use the query object's default.
2181
2182
Both L<CGI> and L<CGI::Simple> default to 'text/html'.
2183
2184
L<Data::Session> handles the case where the query object does not have a cookie() method, by calling
2185
$session -> cookie() to generate either a cookie, or '' (the empty string).
2186
2187
The @arg parameter, if any, is passed to the query object's header() method, after the cookie
2188
parameter, if any.
2189
2190
=head2 id()
2191
2192
Returns the id of the session.
2193
2194
=head2 is_new()
2195
2196
Returns a Boolean (0/1).
2197
2198
Specifies you want to know if the session object was created from scratch (1) or was retrieved
2199
from storage (0).
2200
2201
=head2 load_param([$q][, $name])
2202
2203
The [] indicate optional parameters.
2204
2205
Returns $q.
2206
2207
Loads (copies) all non-reserved parameters from the session object into the query object.
2208
2209
L</save_param([$q][, $name])> performs the opposite operation.
2210
2211
$q is a query object, and $name is a parameter name or an arrayref of names.
2212
2213
If the query object is not specified, generates one by calling $session -> load_query_class,
2214
and stores it in the internal 'query' attribute.
2215
2216
If you don't provide $q, use undef, don't just omit the parameter.
2217
2218
If $name is specified, only the session parameters named in the arrayref are processed.
2219
2220
If $name is not specified, copies all parameters belonging to the query object.
2221
2222
=head2 load_query_class()
2223
2224
Returns the query object.
2225
2226
This calls $session -> query_class -> new if the session object's query object is not defined.
2227
2228
=head2 load_session()
2229
2230
Returns a session.
2231
2232
Note: This method does not take any parameters, and hence does not function in the same way as
2233
load(...) in L<CGI::Session>.
2234
2235
Algorithm:
2236
2237
=over 4
2238
2239
=item o If user_id() returns a session id, try to load that session
2240
2241
If that succeeds, return the session.
2242
2243
If it fails, generate a new session, and return it.
2244
2245
You can call is_new() to tell the difference between these 2 cases.
2246
2247
=item o If user_id() returns 0, generate a new session, and return it
2248
2249
=back
2250
2251
=head2 modified()
2252
2253
Returns a Boolean (0/1) indicating whether or not the session's parameters have been modified.
2254
2255
However, changing a value from one form of not-defined, e.g. undef, to another form of not-defined,
2256
e.g. 0, is ignored, meaning the modified flag is not set. In such cases, you could set the flag
2257
yourself.
2258
2259
Note: Loading a session from storage changes the session's last access time, which means the session
2260
has been modified.
2261
2262
If you wish to stop the session being written to storage, without deleting it, you can reset the
2263
modified flag with $session -> modified(0).
2264
2265
=head2 param([@arg])
2266
2267
The [] indicates an optional parameter.
2268
2269
Specifies that you wish to retrieve data stored in the session, or you wish to store data in the
2270
session.
2271
2272
Data is stored in the session object as in a hash, via a set of $key => $value relationships.
2273
2274
Use $session -> param($key_1 => $value_1[, $key_2 => $value_2...]) to store data in the session.
2275
2276
If storing data, param() returns 1.
2277
2278
The values stored in the session may be undef.
2279
2280
Note: If the value being stored is the same as the pre-existing value, the value in the session is
2281
not updated, which means the last access time does not change.
2282
2283
Use $session -> param() to return a sorted list of all keys.
2284
2285
That call returns a list of the keys you have previously stored in the session.
2286
2287
Use $session -> param('key') to return the value associated with the given key.
2288
2289
See also L</clear([$name])>.
2290
2291
=head2 ptime()
2292
2293
Returns the hashref of session parameter expiry times.
2294
2295
Keys are parameter names and values are expiry times in seconds.
2296
2297
These expiry times are set by calling L</expire([@arg])>.
2298
2299
See also L</atime()>, L</ctime()> and L</etime()>.
2300
2301
=head2 save_param([$q][, $name])
2302
2303
The [] indicate optional parameters.
2304
2305
Returns 1.
2306
2307
Loads (copies) all non-reserved parameters from the query object into the session object.
2308
2309
L</load_param([$q][, $name])> performs the opposite operation.
2310
2311
$q is a query object, and $name is a parameter name or an arrayref of names.
2312
2313
If the query object is not specified, generates one by calling $session -> load_query_class,
2314
and stores it in the internal 'query' attribute. This means you can retrieve it with
2315
$session -> query.
2316
2317
If you don't provide $q, use undef, don't just omit the parameter.
2318
2319
If $name is specified, only the session parameters named in the arrayref are processed.
2320
2321
If $name is not specified, copies all parameters.
2322
2323
=head2 traverse($sub)
2324
2325
Returns 1.
2326
2327
Specifies that you want the $sub called for each session id found in storage, with one (1) id as
2328
the only parameter in each call.
2329
2330
Note: traverse($sub) does not load the sessions, and hence has no effect on the session's last
2331
access time.
2332
2333
See scripts/expire.pl.
2334
2335
=head2 user_id()
2336
2337
Returns either a session id, or 0.
2338
2339
Algorithm:
2340
2341
=over 4
2342
2343
=item o If $session -> id() returns a true value, return that
2344
2345
E.g. The user supplied one in $session -> new(id => $id).
2346
2347
Return this id.
2348
2349
=item o Try to recover an id from the cookie object or the query object.
2350
2351
If the query object supports the cookie method, call
2352
$self -> query -> cookie and (if that doesn't find an id), $self -> query -> param.
2353
2354
If the query object does not support the cookie method, just call $self -> query -> param.
2355
2356
Return any id found, or 0.
2357
2358
Note: The name of the cookie, and the name of the CGI form field, is passed to new() by the 'name'
2359
option.
2360
2361
=back
2362
2363
=head2 validate_options()
2364
2365
Cross-check a few things.
2366
2367
E.g. When using type => '... id:Static ...', you must supply a (true) id to new(id => ...').
2368
2369
=head2 validate_time($time)
2370
2371
Dies for an invalid time string, or returns the number of seconds corresponding to $time,
2372
which may be positive or negative.
2373
2374
See L</expire([@arg])> for details on the time string format.
2375
2376
=head1 Test Code
2377
2378
t/basic.ini and t/bulk.ini contain DSNs for BerkeleyDB, File, Memcache, MySQL, Pg and SQLite.
2379
Actually, they're the same file, just with different DSNs activated.
2380
2381
So, you can use t/basic.t to run minimal tests (with only File and SQLite activated) like this:
2382
2383
	perl -Ilib t/basic.t
2384
2385
or you can edit t/bulk.ini as desired, and pass it in like this:
2386
2387
	perl -Ilib t/basic.t t/bulk.ini
2388
2389
Simple instructions for installing L<BerkeleyDB> (Oracle and Perl) are in
2390
L<Data::Session::Driver::Berkeley>.
2391
2392
Simple instructions for installing L<Cache::Memcached> and memcached are in
2393
L<Data::Session::Driver::Memcached>.
2394
2395
=head1 FAQ
2396
2397
=head2 Guidelines re Sources of Confusion
2398
2399
This section discusses various issues which confront beginners:
2400
2401
=over 4
2402
2403
=item o 1: Both Data::Session and L<CGI::Snapp> have a I<param()> method
2404
2405
Let's say your L<CGI> script sub-classes L<CGI::Application> or it's successor L<CGI::Snapp>.
2406
2407
Then inside your sub-class's methods, this works:
2408
2409
	$self -> param(a_key => 'a_value');
2410
2411
	Time passes...
2412
2413
	my($value) = $self -> param('a_key');
2414
2415
because those 2 modules each implement a method called I<param()>. Basically, you're storing a value
2416
(via 'param') inside $self.
2417
2418
But when you store an object of type Data::Session using I<param()>, it looks like this:
2419
2420
	$self -> param(session => Data::Session -> new(...) );
2421
2422
Now, Data::Session itself I<also> implements a method called I<param()>. So, to store something in
2423
the session (but not in $self), you must do:
2424
2425
	$self -> param('session') -> param(a_key => 'a_value');
2426
2427
	Time passes...
2428
2429
	my($value) = $self -> param('session') -> param('a_key');
2430
2431
It should be obvious that confusion can arise here because the 2 objects represented by $self and
2432
$self -> param('session') both have I<param()> methods.
2433
2434
=item o 2: How exactly should a L<CGI> script save a session?
2435
2436
The first example in the Synopsis shows a very simple L<CGI> script doing the right thing by
2437
calling I<flush()> just before it exits.
2438
2439
Alternately, if you sub-class L<CGI::Snapp>, the call to I<flush()> is best placed in your
2440
I<teardown()> method, which is where you override L<CGI::Snapp/teardown()>. The point here is that
2441
your I<teardown()> is called automatically at the end of each run mode.
2442
2443
This important matter is also discussed in L</General Questions> below.
2444
2445
=item o 3: Storing array and hashes
2446
2447
Put simply: Don't do that!
2448
2449
This will fail:
2450
2451
	$self -> param('session') -> param(my_hash => %my_hash);
2452
2453
	Time passes...
2454
2455
	my(%my_hash) = $self -> param('session') -> param('my_hash');
2456
2457
Likewise for an array instead of a hash.
2458
2459
But why? Because the part 'param(my_hash => %my_hash)' is basically assigning a list (%my_hash) to
2460
a scalar (my_hash). Hence, only 1 element of the list (the 'first' key in some unknown order) will
2461
be assigned.
2462
2463
So, when you try to restore the hash with 'my(%my_hash) ...', all you'll get back is a scalar, which
2464
will generate the classic error message 'Odd number of elements in hash assignment...'.
2465
2466
The solution is to use arrayrefs and hashrefs:
2467
2468
	$self -> param('session') -> param(my_hash => {%my_hash});
2469
2470
	Time passes...
2471
2472
	my(%my_hash) = %{$self -> param('session') -> param('my_hash')};
2473
2474
Likewise for an array:
2475
2476
	$self -> param('session') -> param(my_ara => [@my_ara]);
2477
2478
	Time passes...
2479
2480
	my(@my_ara) = @{$self -> param('session') -> param('my_ara')};
2481
2482
=back
2483
2484
=head2 General Questions
2485
2486
=over 4
2487
2488
=item o My sessions are not getting written to disk!
2489
2490
This is because you haven't stored anything in them. You're probably thinking sessions are saved
2491
just because they exist.
2492
2493
Actually, sessions are only saved if they have at least 1 parameter set. The session id and
2494
access/etc times are not enough to trigger saving.
2495
2496
Just do something like $session -> param(ok => 1); if you want a session saved just to indicate it
2497
exists. Code like this sets the modified flag on the session, so that flush() actually does the
2498
save.
2499
2500
Also, see L</Trouble with Exiting>, below, to understand why flush() must be called explicitly in
2501
persistent environments.
2502
2503
=item o Why don't the test scripts use L<Test::Database>?
2504
2505
I decided to circumvent it by using L<DBIx::Admin::DSNManager> and adopting the wonders of nested
2506
testing. But, since V 1.11, I've replaced that module with L<Config::Tiny>, to reduce dependencies,
2507
and hence to make it easier to get L<Data::Session> into Debian.
2508
2509
See t/basic.t, and in particular this line: subtest $driver => sub.
2510
2511
=item o Why didn't you use OSSP::uuid as did L<CGI::Session::ID::uuid>?
2512
2513
Because when I tried to build that module (under Debian), ./configure died, saying I had set 2
2514
incompatible options, even though I hadn't set either of them.
2515
2516
=item o What happens when 2 processes write sessions with the same id?
2517
2518
The last-to-write wins, by overwriting what the first wrote.
2519
2520
=item o Params::Validate be adopted to validate parameters?
2521
2522
Not yet.
2523
2524
=back
2525
2526
=head1 Troubleshooting
2527
2528
=head2 Trouble with Errors
2529
2530
When object construction fails, new() sets $Data::Session::errstr and returns undef.
2531
This means you can use this idiom:
2532
2533
	my($session) = Data::Session -> new(...) || process_error($Data::Session::errstr);
2534
2535
However, when methods detect errors they die, so after successful object construction, you can do:
2536
2537
	use Try::Tiny;
2538
2539
	try
2540
	{
2541
		$session -> some_method_which_may_die;
2542
	}
2543
	catch
2544
	{
2545
		process_error($_); # Because $_ holds the error message.
2546
	};
2547
2548
=head2 Trouble with Exiting
2549
2550
If the session object's clean-up code is called, in DESTROY(), the session data is automatically
2551
flushed to storage (except when it's been deleted, or has not been modified).
2552
2553
However, as explained below, there can be problems with your code (i.e. not with L<Data::Session>)
2554
such that this clean-up code is not called, or, if called, it cannot perform as expected.
2555
2556
The general guideline, then, is that you should explicitly call C<flush()> on the session object
2557
before your program exits.
2558
2559
Common traps for beginners:
2560
2561
=over 4
2562
2563
=item o Creating 2 CGI-like objects
2564
2565
If your code creates an object of type L<CGI> or similar, but you don't pass that object into
2566
L<Data::Session> via the 'query' parameter to new(), this module will create one for you,
2567
which can be very confusing.
2568
2569
The solution is to always create such a object yourself, and to always pass that into
2570
L<Data::Session>.
2571
2572
In the case that the user of a CGI script runs your code for the first time, there will be no
2573
session id, either from a cookie or from a form field.
2574
2575
In such a case, L<Data::Session> will do what you expect, which is to generate a session id.
2576
2577
=item o Letting your database handle go out of scope too early
2578
2579
When your script is exiting, and you're trying to save session data to storage via a database
2580
handle, the save will fail if the handle goes out of scope before the session data is flushed to
2581
storage.
2582
2583
So, don't do that.
2584
2585
=item o Assuming your session object goes out of scope when it doesn't
2586
2587
In persistent environments such as L<Plack>, FastCGI and mod_perl, your code exits as expected, but
2588
the session object does not go out of scope in the normal way.
2589
2590
In cases like this, it is mandatory for you to call flush() on the session object before your
2591
code exits, since persistent environments operate in such a way that the session object's clean-up
2592
code does not get called. This means that flush() is not called automatically by DESTROY() as you
2593
would expect, because DESTROY() is not being called.
2594
2595
=item o Creating circular references anywhere in your code
2596
2597
In these cases, Perl's clean-up code may not run to completion, which means the session object may
2598
not have its clean-up code called at all. As above, flush() may not get called.
2599
2600
If you must create circular references, it's vital you debug the exit logic using a module such as
2601
L<Devel::Cycle> before assuming the fault is with L<Data::Session>.
2602
2603
=item o Using signal handlers
2604
2605
Write your code defensively, if you wish to call the session object's flush() method when a signal
2606
might affect program exit logic.
2607
2608
=back
2609
2610
=head2 Trouble with IDs
2611
2612
The module uses code like if (! $self -> id), which means ids must be (Perl) true values, so undef,
2613
0 and '' will not work.
2614
2615
=head2 Trouble with UUID16
2616
2617
While testing with UUID16 as the id generator, I got this message:
2618
... invalid byte sequence for encoding "UTF8" ...
2619
2620
That's because when I create a database (in Postgres) I use "create database d_name owner d_owner
2621
encoding 'UTF8';" and UUID16 simply produces a 16 byte binary value, which is not guaranteed to be
2622
or contain a valid UTF8 character.
2623
2624
This also means you should never try to use 'driver:File;id:UUID16 ...', since the ids generated by
2625
this module would rarely if ever be valid as a part of a file name.
2626
2627
=head2 Trouble with UUID64
2628
2629
While testing with UUID64 as the id generator, I got this message:
2630
...  Session ids cannot contain \ or / ...
2631
2632
That's because I was using a File driver, and UUID's encoded in base 64 can contain /.
2633
2634
So, don't do that.
2635
2636
=head1 Version Numbers
2637
2638
Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions.
2639
2640
=head1 Repository
2641
2642
L<https://github.com/ronsavage/Data-Session.git>
2643
2644
=head1 Support
2645
2646
LBugs should be reported via the CPAN bug tracker at
2647
2648
L<https://github.com/ronsavage/Data-Session/issues>
2649
2650
=head1 Thanks
2651
2652
Many thanks are due to all the people who contributed to both L<Apache::Session> and
2653
L<CGI::Session>.
2654
2655
Likewise, many thanks to the implementors of nesting testing. See L<Test::Simple>.
2656
2657
=head1 Author
2658
2659
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
2660
2661
Home page: L<http://savage.net.au/index.html>.
2662
2663
=head1 Copyright
2664
2665
Australian copyright (c) 2010, Ron Savage.
2666
2667
	All Programs of mine are 'OSI Certified Open Source Software';
2668
	you can redistribute them and/or modify them under the terms of
2669
	The Artistic License, a copy of which is available at:
2670
	http://www.opensource.org/licenses/index.html
2671
2672
=cut
(-)a/lib/Data/Session/Base.pm (+114 lines)
Line 0 Link Here
1
package Data::Session::Base;
2
3
no autovivification;
4
use strict;
5
use warnings;
6
7
use Hash::FieldHash ':all';
8
9
fieldhash my %cache             => 'cache';
10
fieldhash my %data_col_name     => 'data_col_name';
11
fieldhash my %data_source       => 'data_source';
12
fieldhash my %data_source_attr  => 'data_source_attr';
13
fieldhash my %dbh               => 'dbh';
14
fieldhash my %debug             => 'debug';
15
fieldhash my %deleted           => 'deleted';
16
fieldhash my %directory         => 'directory';
17
fieldhash my %driver_cless      => 'driver_class';
18
fieldhash my %driver_option     => 'driver_option';
19
fieldhash my %expired           => 'expired';
20
fieldhash my %file_name         => 'file_name';
21
fieldhash my %host              => 'host';
22
fieldhash my %id                => 'id';
23
fieldhash my %id_base           => 'id_base';
24
fieldhash my %id_col_name       => 'id_col_name';
25
fieldhash my %id_file           => 'id_file';
26
fieldhash my %id_class          => 'id_class';
27
fieldhash my %id_option         => 'id_option';
28
fieldhash my %id_step           => 'id_step';
29
fieldhash my %is_new            => 'is_new';
30
fieldhash my %modified          => 'modified';
31
fieldhash my %name              => 'name';
32
fieldhash my %no_flock          => 'no_flock';
33
fieldhash my %no_follow         => 'no_follow';
34
fieldhash my %password          => 'password';
35
fieldhash my %pg_bytea          => 'pg_bytea';
36
fieldhash my %pg_text           => 'pg_text';
37
fieldhash my %port              => 'port';
38
fieldhash my %query             => 'query';
39
fieldhash my %query_class       => 'query_class';
40
fieldhash my %serializer_class  => 'serializer_class';
41
fieldhash my %serializer_option => 'serializer_option';
42
fieldhash my %session           => 'session';
43
fieldhash my %socket            => 'socket';
44
fieldhash my %table_name        => 'table_name';
45
fieldhash my %type              => 'type';
46
fieldhash my %umask             => 'umask';
47
fieldhash my %username          => 'username';
48
fieldhash my %verbose           => 'verbose';
49
50
our $errstr  = '';
51
our $VERSION = '1.18';
52
53
# -----------------------------------------------
54
55
sub log
56
{
57
	my($self, $s) = @_;
58
	$s ||= '';
59
60
	print STDERR "# $s\n";
61
62
} # End of log.
63
64
# -----------------------------------------------
65
66
1;
67
68
=pod
69
70
=head1 NAME
71
72
L<Data::Session::Base> - A persistent session manager
73
74
=head1 Synopsis
75
76
See L<Data::Session> for details.
77
78
=head1 Description
79
80
Provide a set of methods for all derived classes, including log().
81
82
=head1 Method: new()
83
84
This class is never used on its own.
85
86
=head1 Method: log($s)
87
88
Print the string to STDERR.
89
90
If $s is empty, use '' (the empty string), to avoid a warning message.
91
92
Lastly, the string is output preceeded by a '#', so it does not interfere with test output.
93
That is, log($s) emulates diag $s.
94
95
=head1 Support
96
97
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
98
99
=head1 Author
100
101
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
102
103
Home page: L<http://savage.net.au/index.html>.
104
105
=head1 Copyright
106
107
Australian copyright (c) 2010, Ron Savage.
108
109
	All Programs of mine are 'OSI Certified Open Source Software';
110
	you can redistribute them and/or modify them under the terms of
111
	The Artistic License, a copy of which is available at:
112
	http://www.opensource.org/licenses/index.html
113
114
=cut
(-)a/lib/Data/Session/CGISession.pm (+440 lines)
Line 0 Link Here
1
package Data::Session::CGISession;
2
3
our $VERSION = '1.18';
4
5
# -----------------------------------------------
6
7
1;
8
9
=pod
10
11
=head1 NAME
12
13
L<Data::Session> - A persistent session manager
14
15
=head1 The Design of Data::Session, contrasted with CGI::Session
16
17
For background, read the docs (including the Changes files) and bug reports for both
18
L<Apache::Session> and L<CGI::Session>.
19
20
The interface to L<Data::Session> is not quite compatible with that of L<CGI::Session>, hence the
21
new namespace.
22
23
The purpose of L<Data::Session> is to be a brand-new alternative to both L<Apache::Session> and
24
L<CGI::Session>.
25
26
=head1 Aliases for Method Names
27
28
Aliases for method names are not supported.
29
30
In L<CGI::Session>, methods etime() and expires() were aliased to expire(). This is not supported
31
in L<Data::Session>.
32
33
L<Data::Session> does have an etime() method, L<Data::Session/Method: etime()>, which is different.
34
35
In L<CGI::Session>, method header() was aliased to http_header(). Only the latter method is
36
supported in L<Data::Session>. See L</Method: cookie()> and L</Method: http_header([@arg])>.
37
38
In L<CGI::Session>, id generators had a method generate_id() aliased to generate(). This is not
39
supported in L<Data::Session>.
40
41
In L<CGI::Session>, method param_dataref() was aliased to dataref(). Neither of these methods is
42
supported in L<Data::Session>. If you want to access the session data, use
43
my($hashref) = $session -> session.
44
45
=head1 Backwards-compatibility
46
47
This topic is sometimes used as a form of coercion, which is unacceptable, and sometimes leads to
48
a crippled design.
49
50
So, by design, L<Data::Session> is not I<exactly> backwards-compatible with L<CGI::Session>, but
51
does retain it's major features:
52
53
=over 4
54
55
=item o Specify the basic operating parameters with new(type => $string)
56
57
This determines the type of session object you wish to create.
58
59
Default: 'driver:File;id:MD5;serialize:DataDumper'.
60
61
And specifically, the format of that case-sensitive string is as expected. See
62
L<Data::Session/Specifying Session Options> for details.
63
64
=item o Retrieve the session id with the id() method
65
66
=item o Set and get parameters with the param() method
67
68
=item o Ensure session data is saved to disk with the flush() method
69
70
Call this just before your program exits.
71
72
In particular, as with L<CGI::Session>, persistent environments stop your program exiting in the way
73
you are used to. This matter is discussed in L<Data::Session/Trouble with Exiting>.
74
75
=back
76
77
=head1 CGI::Session::ExpireSessions is obsolete
78
79
Instead, consider using scripts/expire.pl, which ships with L<Data::Session>.
80
81
=head1 Code refs as database handles
82
83
Being able to supply a code ref as the value of the 'dbh' parameter to new() is supported.
84
85
This mechanism is used to delay creation of a database handle until it is actually needed,
86
which means if it is not needed it is not created.
87
88
=head1 Class 'v' Object
89
90
Calling methods on the class is not supported. You must always create an object.
91
92
The reason for this is to ensure every method call, without exception, has access to the per-object
93
data supplied by you, or by default, in the call to new().
94
95
=head1 The type of the Data::Session object
96
97
Controlling the capabilities of the L<Data::Session> object is determined by the 'type' parameter
98
passed in to new, as Data::Session -> new(type => $string).
99
100
A sample string looks like 'driver:BerkeleyDB;id:SHA1;serialize:DataDumper'.
101
102
Abbreviation of component key names ('driver', 'id', 'serialize') is not supported.
103
104
Such abbreviations were previously handled by L<Text::Abbrev>. Now, these must be named in full.
105
106
The decision to force corresponding class names to lower case is not supported.
107
108
Nevertheless, lower-cased input will be accepted. Such input is converted to the case you expect.
109
110
This affects the names of various sub-classes. See L</ID Generators>, L</Serialization Drivers> and
111
L</Storage Drivers>.
112
113
For example, driver:pg is now driver:Pg, which actually means L<Data::Session::Driver::Pg>, based on
114
the class name L<DBD::Pg>.
115
116
=head1 Exceptions
117
118
Exceptions are caught with L<Try::Tiny>. Errors cause L<Data::Session> to die.
119
120
The only exception to this is the call to new(), which can return undef. In that case, check
121
$Data::Session::errstr.
122
123
=head1 Global Variables
124
125
Global variables are not supported. This includes:
126
127
=over 4
128
129
=item o $CGI::Session::Driver::DBI::TABLE_NAME
130
131
=item o $CGI::Session::Driver::DBI::*::TABLE_NAME
132
133
=item o $CGI::Session::Driver::file::FileName
134
135
=item o $CGI::Session::IP_MATCH
136
137
=item o $CGI::Session::NAME
138
139
=back
140
141
=head1 ID Generators
142
143
Id generator classes have been renamed:
144
145
=over 4
146
147
=item o CGI::Session::ID::incr becomes L<Data::Session::ID::AutoIncrement>
148
149
=item o CGI::Session::ID::md5 becomes L<Data::Session::ID::MD5>
150
151
=item o CGI::Session::ID::sha becomes L<Data::Session::ID::SHA1>
152
153
=item o CGI::Session::ID::sha256 becomes L<Data::Session::ID::SHA256>
154
155
=item o CGI::Session::ID::sha512 becomes L<Data::Session::ID::SHA512>
156
157
=item o CGI::Session::ID::static becomes L<Data::Session::ID::Static>
158
159
=item o CGI::Session::ID::uuid becomes L<Data::Session::ID::UUID16> or UUID34 or UUID36 or UUD64
160
161
=back
162
163
=head1 JSON
164
165
L<Data::Session::Serialize::JSON> uses L<JSON>, not L<JSON::Syck>.
166
167
=head2 Managing Object Attributes
168
169
The light-weight L<Hash::FieldHash> is used to manage object attributes.
170
171
So, neither L<Mouse> nor L<Moose>, nor any other such class helper, is used.
172
173
=head1 Method: cookie()
174
175
Forcing the query object to have a cookie method is not supported. You may now use a query class
176
which does not provide a cookie method.
177
178
The logic of checking the cookie (if any) first (i.e. before checking for a form field of the same
179
name) is supported.
180
181
See L</Method: http_header([@arg])>.
182
183
=head1 Method: http_header([@arg])
184
185
The [] indicate an optional parameter.
186
187
Returns a HTTP header. This means it does not print the header. You have to do that, when
188
appropriate.
189
190
Forcing the document type to be 'text/html' when calling http_header() is not supported. You must
191
pass in a document type to http_header(), as $session -> http_header('-type' => 'text/html'), or
192
use the query object's default. Both L<CGI> and L<CGI::Simple> default to 'text/html'.
193
194
L<Data::Session> handles the case where the query object does not have a cookie() method.
195
196
The @arg parameter, if any, is passed to the query object's header() method, after the cookie
197
parameter, if any.
198
199
=head1 Method: load()
200
201
The new load() takes no parameters.
202
203
=head1 Method: new()
204
205
Excess versions of new() are not supported.
206
207
The new new() takes a hash of parameters.
208
209
This hash will include all options previously passed in in different parameters to new(), including
210
$dsn, $query, $sid, \%dsn_args and \%session_params.
211
212
=head1 Name Changes
213
214
Class name changes are discussed in L</ID Generators>, L</Serialization Drivers> and
215
L</Storage Drivers>.
216
217
As discussed in L<Data::Session/Method: new()>, these name changes are both the result of cleaning
218
up all the options to new(), and because the option names are now also method names.
219
220
=over 4
221
222
=item o DataColName becomes data_col_name
223
224
This is used in the call to new().
225
226
=item o DataSource becomes data_source
227
228
This is used in the call to new().
229
230
=item o generate_id becomes generate
231
232
This is used in various id generator classes, some of which provided generate as an alias.
233
234
=item o Handle becomes dbh
235
236
This is used in the call to new().
237
238
=item o IdColName becomes id_col_name
239
240
This is used in the call to new().
241
242
=item o IDFile becomes id_file
243
244
This is used in the call to new(), and in the '... id:AutoIncrement ...' id generator.
245
246
=item o IDIncr becomes id_step
247
248
This is used in the call to new(), and in the '... id:AutoIncrement ...' id generator.
249
250
=item o IDInit becomes id_base
251
252
This is used in the call to new(), and in the '... id:AutoIncrement ...' id generator.
253
254
=back
255
256
=head1 param()
257
258
Excess versions of param() will not be supported.
259
260
Use param($key => $value) to set and param($key) to get.
261
262
param() may be passed a hash, to set several key/value pairs in 1 call.
263
264
=head1 POD
265
266
All POD has been re-written.
267
268
=head1 Race Conditions
269
270
The race handling code in L<CGI::Session::Driver::postgresql> has been incorporated into other
271
L<Data::Session::Driver::*> drivers.
272
273
=head1 Serialization Drivers
274
275
Serializing classes have been renamed:
276
277
=over 4
278
279
=item o CGI::Session::Serialize::default becomes L<Data::Session::Serialize::DataDumper>
280
281
=item o CGI::Session::Serialize::freezethaw becomes L<Data::Session::Serialize::FreezeThaw>
282
283
=item o CGI::Session::Serialize::json becomes L<Data::Session::Serialize::JSON>
284
285
The latter will use L<JSON>. In the past L<JSON::Syck> was used.
286
287
=item o CGI::Session::Serialize::storable becomes L<Data::Session::Serialize::Storable>
288
289
=item o CGI::Session::Serialize::yaml becomes L<Data::Session::Serialize::YAML>
290
291
The latter uses L<YAML::Tiny>. In the past either L<YAML::Syck> or L<YAML> was used.
292
293
=back
294
295
=head1 Session ids will be mandatory
296
297
The ability to create a Perl object without a session id is not supported.
298
299
Every time a object of type L<Data::Session> is created, it must have an id.
300
301
This id is either supplied by the caller, taken from the query object, or one is generated.
302
303
See L<Data::Session/Specifying an Id> for details.
304
305
=head1 Session modification
306
307
L<CGI::Session> tracks calls to param() to set a flag if the object is modified, so as to avoid
308
writing the session to disk if nothing has been modified.
309
310
This includes checking if setting a param's value to the value it already has.
311
312
The behaviour is supported.
313
314
=head1 Session Parameters
315
316
L<CGI::Session> had these internal object attributes (parameters) not available to the user:
317
318
=over 4
319
320
=item o _DATA
321
322
Hashref: Keys: _SESSION_ATIME, _SESSION_CTIME, _SESSION_ID and _SESSION_REMOTE_ADDR.
323
324
=item o _DSN
325
326
Hashref.
327
328
=item o _OBJECTS
329
330
Hashref.
331
332
=item o _DRIVER_ARGS
333
334
Hashref.
335
336
=item o _CLAIMED_ID
337
338
Scalar.
339
340
=item o _STATUS
341
342
Scalar (bitmap).
343
344
=item o _QUERY
345
346
Scalar.
347
348
=back
349
350
L<Data::Session> has these internal object attributes (parameters):
351
352
=over 4
353
354
=item o _SESSION_ATIME
355
356
Scalar: Last access time.
357
358
=item o _SESSION_CTIME
359
360
Scalar: Creation time.
361
362
=item o _SESSION_ETIME
363
364
Scalar: Expiry time.
365
366
=item o _SESSION_ID
367
368
Scalar: The id.
369
370
=item o _SESSION_PTIME
371
372
Hashref: Expiry times of parameters.
373
374
=back
375
376
L<Data::Session> stores user data internally in a hashref, and the module reserves keys starting
377
with '_'.
378
379
Of course, it has a whole set of methods to manage state.
380
381
=head1 Session States
382
383
L<CGI::Session> objects can be one of 6 states. Every attempt has been made to simplify this design.
384
385
=head1 Storage Drivers
386
387
Classes related to DBI/DBD will use DBD::* style names, to help beginners.
388
389
Hence (with special cases):
390
391
=over 4
392
393
=item o CGI::Session::Driver::db_file becomes L<Data::Session::Driver::BerkeleyDB>
394
395
The latter no longer uses DB_File.
396
397
=item o CGI::Session::Driver::file becomes L<Data::Session::Driver::File>
398
399
=item o CGI::Session::Driver::memcached becomes L<Data::Session::Driver::Memcached>
400
401
=item o CGI::Session::Driver::mysql becomes L<Data::Session::Driver::mysql>
402
403
=item o CGI::Session::Driver::odbc becomes L<Data::Session::Driver::ODBC>
404
405
=item o CGI::Session::Driver::oracle becomes L<Data::Session::Driver::Oracle>
406
407
=item o CGI::Session::Driver::postgresql becomes L<Data::Session::Driver::Pg>
408
409
=item o CGI::Session::Driver::sqlite becomes L<Data::Session::Driver::SQLite>
410
411
=back
412
413
=head1 Tests
414
415
All tests have been re-written.
416
417
=head1 The Version of Perl
418
419
Perl 5 code will be used.
420
421
=head1 YAML
422
423
L<Data::Session::Serialize::YAML> uses L<YAML::Tiny>, not L<YAML::Syck> or L<YAML>.
424
425
=head1 Author
426
427
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
428
429
Home page: L<http://savage.net.au/index.html>.
430
431
=head1 Copyright
432
433
Australian copyright (c) 2010, Ron Savage.
434
435
	All Programs of mine are 'OSI Certified Open Source Software';
436
	you can redistribute them and/or modify them under the terms of
437
	The Artistic License, a copy of which is available at:
438
	http://www.opensource.org/licenses/index.html
439
440
=cut
(-)a/lib/Data/Session/Driver.pm (+224 lines)
Line 0 Link Here
1
package Data::Session::Driver;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use DBI;
9
10
use Hash::FieldHash ':all';
11
12
fieldhash my %created_dbh => 'created_dbh';
13
14
our $errstr  = '';
15
our $VERSION = '1.18';
16
17
# -----------------------------------------------
18
19
sub DESTROY
20
{
21
	my($self) = @_;
22
23
	(! $self -> dbh) && return;
24
25
	(! $self -> dbh -> ping) && die __PACKAGE__ . '. Database handle fails to ping';
26
27
	(! ${$self -> dbh}{AutoCommit}) && $self -> dbh -> commit;
28
29
	if ($self -> created_dbh)
30
	{
31
		$self -> dbh -> disconnect;
32
		$self -> created_dbh(0);
33
	}
34
35
	$self -> dbh('');
36
37
} # End of DESTROY.
38
39
# -----------------------------------------------
40
41
sub get_dbh
42
{
43
	my($self, $arg) = @_;
44
45
	if ($self -> dbh)
46
	{
47
		(ref $self -> dbh eq 'CODE') && $self -> dbh($self -> dbh -> () );
48
	}
49
	else
50
	{
51
		$self -> dbh
52
		(
53
			DBI -> connect
54
			(
55
				$self -> data_source,
56
				$self -> username,
57
				$self -> password,
58
				$self -> data_source_attr,
59
			) || die __PACKAGE__ . ". Can't connect to database with dsn '" . $self -> data_source . "'"
60
		);
61
		$self -> created_dbh(1);
62
	}
63
64
} # End of get_dbh.
65
66
# -----------------------------------------------
67
68
sub init
69
{
70
	my($class, $arg)        = @_;
71
	$$arg{created_dbh}      = 0;
72
	$$arg{data_col_name}    ||= 'a_session';
73
	$$arg{data_source}      ||= '';
74
	$$arg{data_source_attr} ||= {AutoCommit => 1, PrintError => 0, RaiseError => 1};
75
	$$arg{dbh}              ||= '';
76
	$$arg{host}             ||= '';
77
	$$arg{id}               ||= 0;
78
	$$arg{id_col_name}      ||= 'id';
79
	$$arg{password}         ||= '';
80
	$$arg{port}             ||= '';
81
	$$arg{socket}           ||= '';
82
	$$arg{table_name}       ||= 'sessions';
83
	$$arg{username}         ||= '';
84
	$$arg{verbose}          ||= 0;
85
86
} # End of init.
87
88
# -----------------------------------------------
89
90
sub remove
91
{
92
	my($self, $id)          = @_;
93
	my($dbh)                = $self -> dbh;
94
	local $$dbh{RaiseError} = 1;
95
	my($id_col_name)        = $self -> id_col_name;
96
	my($table_name)         = $self -> table_name;
97
	my($sql)                = "delete from $table_name where $id_col_name = ?";
98
99
	$dbh -> do($sql, {}, $id) || die __PACKAGE__ . ". Can't delete $id_col_name '$id' from table '$table_name'";
100
101
	return 1;
102
103
} # End of remove.
104
105
# -----------------------------------------------
106
107
sub retrieve
108
{
109
	my($self, $id)          = @_;
110
	my($data_col_name)      = $self -> data_col_name;
111
	my($dbh)                = $self -> dbh;
112
	local $$dbh{RaiseError} = 1;
113
	my($id_col_name)        = $self -> id_col_name;
114
	my($table_name)         = $self -> table_name;
115
	my($sql)                = "select $data_col_name from $table_name where $id_col_name = ?";
116
	my($message)            = __PACKAGE__ . "Can't %s in retrieve(). SQL: $sql";
117
	my($sth)                = $dbh -> prepare_cached($sql, {}, 3) || die sprintf($message, 'prepare_cached');
118
119
	$sth -> execute($id) || die sprintf($message, 'execute');
120
121
	my($row) = $sth -> fetch;
122
123
	$sth -> finish;
124
125
	# Return '' for failure.
126
127
	return $row ? $$row[0] : '';
128
129
} # End of retrieve.
130
131
# -----------------------------------------------
132
133
sub traverse
134
{
135
	my($self, $sub) = @_;
136
137
	if (! $sub || ref($sub) ne 'CODE')
138
	{
139
		die __PACKAGE__ . '. traverse() called without subref';
140
	}
141
142
	my($dbh)                = $self -> dbh;
143
	local $$dbh{RaiseError} = 1;
144
	my($id_col_name)        = $self -> id_col_name;
145
	my($table_name)         = $self -> table_name;
146
	my($sql)                = "select $id_col_name from $table_name";
147
	my($message)            = __PACKAGE__ . "Can't %s in traverse(). SQL: $sql";
148
	my($id)                 = $dbh -> selectall_arrayref($sql, {}) || die sprintf($message, 'selectall_arrayref');
149
150
	for my $i (0 .. $#$id)
151
	{
152
		$sub -> ($$id[$i][0]);
153
	}
154
155
	return 1;
156
157
} # End of traverse.
158
159
# -----------------------------------------------
160
161
1;
162
163
=pod
164
165
=head1 NAME
166
167
L<Data::Session::Driver> - A persistent session manager
168
169
=head1 Synopsis
170
171
See L<Data::Session> for details.
172
173
=head1 Description
174
175
L<Data::Session::Driver> is the parent of all L<Data::Session::Driver::*> modules.
176
177
=head1 Case-sensitive Options
178
179
See L<Data::Session/Case-sensitive Options> for important information.
180
181
=head1 Method: new()
182
183
Creates a new object of type L<Data::Session::Driver>.
184
185
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
186
might be mandatory.
187
188
=head1 Method: remove($id)
189
190
Deletes from storage the session identified by $id, or dies if it can't.
191
192
Returns 1.
193
194
=head1 Method: retrieve($id)
195
196
Retrieve from storage the session identified by $id, or dies if it can't.
197
198
Returns the session.
199
200
This is a frozen session. This value must be thawed by calling the appropriate serialization
201
driver's thaw() method.
202
203
L<Data::Session> calls the right thaw() automatically.
204
205
=head1 Support
206
207
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
208
209
=head1 Author
210
211
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
212
213
Home page: L<http://savage.net.au/index.html>.
214
215
=head1 Copyright
216
217
Australian copyright (c) 2010, Ron Savage.
218
219
	All Programs of mine are 'OSI Certified Open Source Software';
220
	you can redistribute them and/or modify them under the terms of
221
	The Artistic License, a copy of which is available at:
222
	http://www.opensource.org/licenses/index.html
223
224
=cut
(-)a/lib/Data/Session/Driver/BerkeleyDB.pm (+260 lines)
Line 0 Link Here
1
package Data::Session::Driver::BerkeleyDB;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use BerkeleyDB;
9
10
use Hash::FieldHash ':all';
11
12
use Try::Tiny;
13
14
our $VERSION = '1.18';
15
16
# -----------------------------------------------
17
18
sub init
19
{
20
	my($self, $arg) = @_;
21
	$$arg{cache}    ||= '';
22
	$$arg{verbose}  ||= 0;
23
24
} # End of init.
25
26
# -----------------------------------------------
27
28
sub new
29
{
30
	my($class, %arg) = @_;
31
32
	$class -> init(\%arg);
33
34
	(! $arg{cache}) && die __PACKAGE__ . '. No cache supplied to new(...)';
35
36
	return from_hash(bless({}, $class), \%arg);
37
38
} # End of new.
39
40
# -----------------------------------------------
41
42
sub remove
43
{
44
	my($self, $id) = @_;
45
	my($lock)      = $self -> cache -> cds_lock;
46
	my($status)    = $self -> cache -> db_del($id);
47
48
	$lock -> cds_unlock;
49
50
	# Return '' for failure.
51
52
	return $status ? '' : 1;
53
54
} # End of remove.
55
56
# -----------------------------------------------
57
58
sub retrieve
59
{
60
	my($self, $id) = @_;
61
	my($lock)      = $self -> cache -> cds_lock;
62
	my($data)      = '';
63
	my($status)    = $self -> cache -> db_get($id => $data);
64
65
	$lock -> cds_unlock;
66
67
	# Return '' for failure.
68
69
	return $status ? '' : $data;
70
71
} # End of retrieve.
72
73
# -----------------------------------------------
74
75
sub store
76
{
77
	my($self, $id, $data) = @_;
78
	my($lock)   = $self -> cache -> cds_lock;
79
	my($status) = $self -> cache -> db_put($id => $data);
80
81
	$lock -> cds_unlock;
82
83
	return $status ? '' : 1;
84
85
} # End of store.
86
87
# -----------------------------------------------
88
89
sub traverse
90
{
91
	my($self, $sub) = @_;
92
	my($id, $data)  = ('', '');
93
	my($cursor)     = $self -> cache -> db_cursor;
94
95
	while ($cursor -> c_get($id, $data, DB_NEXT) == 0)
96
	{
97
		$sub -> ($id);
98
	}
99
100
	undef $cursor;
101
102
	return 1;
103
104
} # End of traverse.
105
106
# -----------------------------------------------
107
108
1;
109
110
=pod
111
112
=head1 NAME
113
114
L<Data::Session::Driver::BerkeleyDB> - A persistent session manager
115
116
=head1 Synopsis
117
118
See L<Data::Session> for details.
119
120
=head1 Description
121
122
L<Data::Session::Driver::BerkeleyDB> allows L<Data::Session> to manipulate sessions via
123
L<BerkeleyDB>.
124
125
To use this module do both of these:
126
127
=over 4
128
129
=item o Specify a driver of type BerkeleyDB, as
130
Data::Session -> new(type => 'driver:BerkeleyDB ...')
131
132
=item o Specify a cache object of type L<BerkeleyDB> as Data::Session -> new(cache => $object)
133
134
Also, $object must have been created with a Env parameter of type L<BerkeleyDB::Env>. See below.
135
136
=back
137
138
See scripts/berkeleydb.pl.
139
140
=head1 Case-sensitive Options
141
142
See L<Data::Session/Case-sensitive Options> for important information.
143
144
=head1 Method: new()
145
146
Creates a new object of type L<Data::Session::Driver::BerkeleyDB>.
147
148
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
149
might be mandatory.
150
151
The keys are listed here in alphabetical order.
152
153
They are lower-case because they are (also) method names, meaning they can be called to set or get
154
the value at any time.
155
156
=over 4
157
158
=item o cache => $object
159
160
Specifies the object of type L<BerkeleyDB> to use for session storage.
161
162
This key is normally passed in as Data::Session -> new(cache => $object).
163
164
Warning: This cache object must have been set up both as an object of type L<BerkeleyDB>, and with
165
that object having an Env parameter of type L<Berkeley::Env>, because this module -
166
L<Data::Session::Driver::BerkeleyDB> - uses the L<BerkeleyDB> method cds_lock().
167
168
This key is mandatory.
169
170
=item o verbose => $integer
171
172
Print to STDERR more or less information.
173
174
Typical values are 0, 1 and 2.
175
176
This key is normally passed in as Data::Session -> new(verbose => $integer).
177
178
This key is optional.
179
180
=back
181
182
=head1 Method: remove($id)
183
184
Deletes from storage the session identified by $id.
185
186
Returns the result of calling the L<BerkeleyDB> method delete($id).
187
188
This result is a Boolean value indicating 1 => success or 0 => failure.
189
190
=head1 Method: retrieve($id)
191
192
Retrieve from storage the session identified by $id.
193
194
Returns the result of calling the L<BerkeleyDB> method get($id).
195
196
This result is a frozen session. This value must be thawed by calling the appropriate serialization
197
driver's thaw() method.
198
199
L<Data::Session> calls the right thaw() automatically.
200
201
=head1 Method: store($id => $data)
202
203
Writes to storage the session identified by $id, together with its data $data.
204
205
Returns the result of calling the L<BerkeleyDB> method set($id => $data).
206
207
This result is a Boolean value indicating 1 => success or 0 => failure.
208
209
=head1 Method: traverse()
210
211
Retrieves all ids via a cursor, and for each id calls the supplied subroutine with the id as the
212
only parameter.
213
214
The database is not locked during this process.
215
216
Returns 1.
217
218
=head1 Installing BerkeleyDB
219
220
	Get Oracle's BerkeleyDB from
221
	http://www.oracle.com/technetwork/database/berkeleydb/overview/index.html
222
	I used V 5.1.19
223
	tar xvzf db-5.1.19.tar.gz
224
	cd db-5.1.19/build_unix
225
	../dist/configure
226
	make
227
	sudo make install
228
	It installs into /usr/local/BerkeleyDB.5.1
229
230
	Get Perl's BerkeleyDB from http://search.cpan.org
231
	I used V 0.43
232
	tar xvzf BerkeleyDB-0.43.tar.gz
233
	cd BerkeleyDB-0.43
234
	Edit 2 lines in config.in:
235
	INCLUDE = /usr/local/BerkeleyDB.5.1/include
236
	LIB     = /usr/local/BerkeleyDB.5.1/lib
237
	perl Makefile.PL
238
	make && make test
239
	sudo make install
240
241
=head1 Support
242
243
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
244
245
=head1 Author
246
247
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
248
249
Home page: L<http://savage.net.au/index.html>.
250
251
=head1 Copyright
252
253
Australian copyright (c) 2010, Ron Savage.
254
255
	All Programs of mine are 'OSI Certified Open Source Software';
256
	you can redistribute them and/or modify them under the terms of
257
	The Artistic License, a copy of which is available at:
258
	http://www.opensource.org/licenses/index.html
259
260
=cut
(-)a/lib/Data/Session/Driver/File.pm (+379 lines)
Line 0 Link Here
1
package Data::Session::Driver::File;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Fcntl qw/:DEFAULT :flock :mode/;
9
10
use File::Path;
11
use File::Spec;
12
13
use Hash::FieldHash ':all';
14
15
use Try::Tiny;
16
17
our $VERSION = '1.18';
18
19
# -----------------------------------------------
20
21
sub get_file_path
22
{
23
	my($self, $sid) = @_;
24
	(my $id = $sid) =~ s|\\|/|g;
25
26
	($id =~ m|/|) && die __PACKAGE__ . ". Session ids cannot contain \\ or /: '$sid'";
27
28
    return File::Spec -> catfile($self -> directory, sprintf($self -> file_name, $sid) );
29
30
} # End of get_file_path.
31
32
# -----------------------------------------------
33
34
sub init
35
{
36
	my($self, $arg)  = @_;
37
	$$arg{debug}     ||= 0;
38
	$$arg{directory} ||= File::Spec -> tmpdir;
39
	$$arg{file_name} ||= 'cgisess_%s';
40
	$$arg{id}        ||= 0;
41
	$$arg{no_flock}  ||= 0;
42
	$$arg{no_follow} ||= eval { O_NOFOLLOW } || 0;
43
	$$arg{umask}     ||= 0660;
44
	$$arg{verbose}   ||= 0;
45
46
} # End of init.
47
48
# -----------------------------------------------
49
50
sub new
51
{
52
	my($class, %arg) = @_;
53
54
	$class -> init(\%arg);
55
56
	my($self) = from_hash(bless({}, $class), \%arg);
57
58
	($self -> file_name !~ /%s/) && die __PACKAGE__ . ". file_name must contain %s";
59
60
	if (! -d $self -> directory)
61
	{
62
		if (! File::Path::mkpath($self -> directory) )
63
		{
64
			die __PACKAGE__ . ". Can't create directory '" . $self -> directory . "'";
65
		}
66
	}
67
68
	return $self;
69
70
} # End of new.
71
72
# -----------------------------------------------
73
74
sub remove
75
{
76
	my($self, $id) = @_;
77
	my($file_path) = $self -> get_file_path($id);
78
79
	unlink $file_path || die __PACKAGE__ . ". Can't unlink file '$file_path'. " . ($self -> debug ? $! : '');
80
81
	return 1;
82
83
} # End of remove.
84
85
# -----------------------------------------------
86
87
sub retrieve
88
{
89
	my($self, $id) = @_;
90
	my($file_path) = $self -> get_file_path($id);
91
	my($message)   = __PACKAGE__ . ". Can't %s file '$file_path'. %s";
92
93
	(! -e $file_path) && return '';
94
95
	# Remove symlinks if possible.
96
97
	if (-l $file_path)
98
	{
99
		unlink($file_path) || die sprintf($message, 'unlink', $self -> debug ? $! : '');
100
	}
101
102
	my($mode) = (O_RDWR | $self -> no_follow);
103
104
	my($fh);
105
106
	sysopen($fh, $file_path, $mode, $self -> umask) || die sprintf($message, 'open', $self -> debug ? $! : '');
107
108
	# Sanity check.
109
110
	(-l $file_path) && die sprintf($message, "open it. It's a link, not a", '');
111
112
	if (! $self -> no_flock)
113
	{
114
		flock($fh, LOCK_EX) || die sprintf($message, 'lock', $self -> debug ? $! : '');
115
	}
116
117
	my($data) = '';
118
119
	while (<$fh>)
120
	{
121
		$data .= $_;
122
	}
123
124
	close($fh) || die sprintf($message, 'close', $self -> debug ? $! : '');
125
126
	return $data;
127
128
} # End of retrieve.
129
130
# -----------------------------------------------
131
132
sub store
133
{
134
	my($self, $id, $data) = @_;
135
	my($file_path) = $self -> get_file_path($id);
136
	my($message)   = __PACKAGE__ . ". Can't %s file '$file_path'. %s";
137
138
	# Remove symlinks if possible.
139
140
	if (-l $file_path)
141
	{
142
		unlink($file_path) || die sprintf($message, 'unlink', $self -> debug ? $! : '');
143
	}
144
145
	my($mode) = -e $file_path ? (O_WRONLY | $self -> no_follow) : (O_RDWR | O_CREAT | O_EXCL);
146
147
	my($fh);
148
149
	sysopen($fh, $file_path, $mode, $self -> umask) || die sprintf($message, 'open', $self -> debug ? $! : '');
150
151
	# Sanity check.
152
153
	(-l $file_path) && die sprintf($message, "create it. It's a link, not a", '');
154
155
	if (! $self -> no_flock)
156
	{
157
		flock($fh, LOCK_EX) || die sprintf($message, 'lock', $self -> debug ? $! : '');
158
	}
159
160
	seek($fh, 0, 0)  || die sprintf($message, 'seek', $self -> debug ? $! : '');
161
	truncate($fh, 0) || die sprintf($message, 'truncate', $self -> debug ? $! : '');
162
	print $fh $data;
163
	close($fh) || die sprintf($message, 'close', $self -> debug ? $! : '');
164
165
	return 1;
166
167
} # End of store.
168
169
# -----------------------------------------------
170
171
sub traverse
172
{
173
	my($self, $sub) = @_;
174
175
	if (! $sub || ref($sub) ne 'CODE')
176
	{
177
		die __PACKAGE__ . '. traverse() called without subref';
178
	}
179
180
	my($pattern) = $self -> file_name;
181
	$pattern     =~ s/\./\\./g; # Or /\Q.../.
182
	$pattern     =~ s/%s/(\.\+)/;
183
	my($message) = __PACKAGE__ . ". Can't %s dir '" . $self -> directory . "' in traverse. %s";
184
185
	opendir(INX, $self -> directory) || die sprintf($message, 'open', $self -> debug ? $! : '');
186
187
	my($entry);
188
189
	# I do not use readdir(INX) || die .. here because I could not get it to work,
190
	# even with: while ($entry = (readdir(INX) || die sprintf($message, 'read', $!) ) ).
191
	# Every attempt triggered the call to die.
192
193
	while ($entry = readdir(INX) )
194
	{
195
		next if ($entry =~ /^\.\.?/ || -d $entry);
196
197
		($entry =~ /$pattern/) && $sub -> ($1);
198
	}
199
200
	closedir(INX) || die sprintf($message, 'close', $self -> debug ? $! : '');
201
202
	return 1;
203
204
} # End of traverse.
205
206
# -----------------------------------------------
207
208
1;
209
210
=pod
211
212
=head1 NAME
213
214
L<Data::Session::Driver::File> - A persistent session manager
215
216
=head1 Synopsis
217
218
See L<Data::Session> for details.
219
220
=head1 Description
221
222
L<Data::Session::Driver::File> allows L<Data::Session> to manipulate sessions via files.
223
224
To use this module do this:
225
226
=over 4
227
228
=item o Specify a driver of type File, as Data::Session -> new(type => 'driver:File ...')
229
230
=back
231
232
=head1 Case-sensitive Options
233
234
See L<Data::Session/Case-sensitive Options> for important information.
235
236
=head1 Method: new()
237
238
Creates a new object of type L<Data::Session::Driver::File>.
239
240
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
241
might be mandatory.
242
243
The keys are listed here in alphabetical order.
244
245
They are lower-case because they are (also) method names, meaning they can be called to set or get
246
the value at any time.
247
248
=over 4
249
250
=item o debug => $Boolean
251
252
Specifies that debugging should be turned on (1) or off (0) in L<Data::Session::File::Driver> and
253
L<Data::Session::ID::AutoIncrement>.
254
255
When debug is 1, $! is included in error messages, but because this reveals directory names, it is 0
256
by default.
257
258
This key is optional.
259
260
Default: 0.
261
262
=item o directory => $string
263
264
Specifies the path to the directory which will contain the session files.
265
266
This key is normally passed in as Data::Session -> new(directory => $string).
267
268
Default: File::Spec -> tmpdir.
269
270
This key is optional.
271
272
=item o file_name => $string_containing_%s
273
274
Specifies the pattern to use for session file names. It must contain 1 '%s', which will be replaced
275
by the session id before the pattern is used as a file name.
276
277
This key is normally passed in as Data::Session -> new(file_name => $string_containing_%s).
278
279
Default: 'cgisess_%s'.
280
281
This key is optional.
282
283
=item o no_flock => $boolean
284
285
Specifies (no_flock => 1) to not use flock() to obtain a lock on a session file before processing
286
it, or (no_flock => 0) to use flock().
287
288
This key is normally passed in as Data::Session -> new(no_flock => $boolean).
289
290
Default: 0.
291
292
This key is optional.
293
294
=item o no_follow => $value
295
296
Influences the mode to use when calling sysopen() on session files.
297
298
'Influences' means the value is bit-wise ored with O_RDWR for reading and with O_WRONLY for writing.
299
300
This key is normally passed in as Data::Session -> new(no_follow => $boolean).
301
302
Default: eval{O_NOFOLLOW} || 0.
303
304
This key is optional.
305
306
=item o umask => $octal_value
307
308
Specifies the mode to use when calling sysopen() on session files.
309
310
This key is normally passed in as Data::Session -> new(umask => $octal_value).
311
312
Default: 0660.
313
314
This key is optional.
315
316
=item o verbose => $integer
317
318
Print to STDERR more or less information.
319
320
Typical values are 0, 1 and 2.
321
322
This key is normally passed in as Data::Session -> new(verbose => $integer).
323
324
This key is optional.
325
326
=back
327
328
=head1 Method: remove($id)
329
330
Deletes from storage the session identified by $id.
331
332
Returns 1 if it succeeds, and dies if it can't.
333
334
=head1 Method: retrieve($id)
335
336
Retrieves from storage the session identified by $id, or dies if it can't.
337
338
Returns the result of reading the session from the file identified by $id.
339
340
This result is a frozen session. This value must be thawed by calling the appropriate serialization
341
driver's thaw() method.
342
343
L<Data::Session> calls the right thaw() automatically.
344
345
=head1 Method: store($id => $data)
346
347
Writes to storage the session identified by $id, together with its data $data.
348
349
Storage is a file identified by $id.
350
351
Returns 1 if it succeeds, and dies if it can't.
352
353
=head1 Method: traverse($sub)
354
355
Retrieves all ids via their file names, and for each id calls the supplied subroutine with the id as
356
the only parameter.
357
358
Returns 1.
359
360
=head1 Support
361
362
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
363
364
=head1 Author
365
366
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
367
368
Home page: L<http://savage.net.au/index.html>.
369
370
=head1 Copyright
371
372
Australian copyright (c) 2010, Ron Savage.
373
374
	All Programs of mine are 'OSI Certified Open Source Software';
375
	you can redistribute them and/or modify them under the terms of
376
	The Artistic License, a copy of which is available at:
377
	http://www.opensource.org/licenses/index.html
378
379
=cut
(-)a/lib/Data/Session/Driver/Memcached.pm (+227 lines)
Line 0 Link Here
1
package Data::Session::Driver::Memcached;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
use Try::Tiny;
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub init
17
{
18
	my($self, $arg) = @_;
19
	$$arg{cache}    ||= '';
20
	$$arg{verbose}  ||= 0;
21
22
} # End of init.
23
24
# -----------------------------------------------
25
26
sub new
27
{
28
	my($class, %arg) = @_;
29
30
	$class -> init(\%arg);
31
32
	(! $arg{cache}) && die __PACKAGE__ . '. No cache supplied to new(...)';
33
34
	return from_hash(bless({}, $class), \%arg);
35
36
} # End of new.
37
38
# -----------------------------------------------
39
40
sub remove
41
{
42
	my($self, $id) = @_;
43
44
	return $self -> cache -> delete($id);
45
46
} # End of remove.
47
48
# -----------------------------------------------
49
50
sub retrieve
51
{
52
	my($self, $id) = @_;
53
54
	# Return undef for failure.
55
56
	return $self -> cache -> get($id);
57
58
} # End of retrieve.
59
60
# -----------------------------------------------
61
62
sub store
63
{
64
	my($self, $id, $data, $time) = @_;
65
66
	return $self -> cache -> set($id, $data, $time);
67
68
} # End of store.
69
70
# -----------------------------------------------
71
72
sub traverse
73
{
74
	my($self, $sub) = @_;
75
76
	return 1;
77
78
} # End of traverse.
79
80
# -----------------------------------------------
81
82
1;
83
84
=pod
85
86
=head1 NAME
87
88
L<Data::Session::Driver::Memcached> - A persistent session manager
89
90
=head1 Synopsis
91
92
See L<Data::Session> for details.
93
94
=head1 Description
95
96
L<Data::Session::Driver::Memcached> allows L<Data::Session> to manipulate sessions
97
L<Cache::Memcached>.
98
99
To use this module do both of these:
100
101
=over 4
102
103
=item o Specify a driver of type Memcached, as Data::Session -> new(type => 'driver:Memcached ...')
104
105
=item o Specify a cache object of type L<Cache::Memcached> as Data::Session -> new(cache => $object)
106
107
=back
108
109
See scripts/memcached.pl.
110
111
=head1 Case-sensitive Options
112
113
See L<Data::Session/Case-sensitive Options> for important information.
114
115
=head1 Method: new()
116
117
Creates a new object of type L<Data::Session::Driver::Memcached>.
118
119
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
120
might be mandatory.
121
122
The keys are listed here in alphabetical order.
123
124
They are lower-case because they are (also) method names, meaning they can be called to set or get
125
the value at any time.
126
127
=over 4
128
129
=item o cache => $object
130
131
Specifies the object of type L<Cache::Memcached> to use for session storage.
132
133
This key is normally passed in as Data::Session -> new(cache => $object).
134
135
This key is mandatory.
136
137
=item o verbose => $integer
138
139
Print to STDERR more or less information.
140
141
Typical values are 0, 1 and 2.
142
143
This key is normally passed in as Data::Session -> new(verbose => $integer).
144
145
This key is optional.
146
147
=back
148
149
=head1 Method: remove($id)
150
151
Deletes from storage the session identified by $id.
152
153
Returns the result of calling the L<Cache::Memcached> method delete($id).
154
155
This result is a Boolean value indicating 1 => success or 0 => failure.
156
157
=head1 Method: retrieve($id)
158
159
Retrieve from storage the session identified by $id.
160
161
Returns the result of calling the L<Cache::Memcached> method get($id).
162
163
This result is a frozen session. This value must be thawed by calling the appropriate serialization
164
driver's thaw() method.
165
166
L<Data::Session> calls the right thaw() automatically.
167
168
=head1 Method: store($id, $data, $time)
169
170
Writes to storage the session identified by $id, together with its data $data. The expiry time of
171
the object is passed into the set() method of L<Cache::Memcached>, too.
172
173
Returns the result of calling the L<Cache::Memcached> method set($id, $data, $time).
174
175
This result is a Boolean value indicating 1 => success or 0 => failure.
176
177
Note: $time is 0 for sessions which don't expire. If you wish to pass undef or 'never', as per the
178
L<Cache::Memcached> documentation, you will have to subclass L<Cache::Memcached> and override the
179
set() method to change 0 to 'never'.
180
181
=head1 Method: traverse()
182
183
There is no mechanism (apart from memcached's debug code) to get a list of all keys in a cache
184
managed by memcached, so there is no way to traverse them via this module.
185
186
Returns 1.
187
188
=head1 Installing memcached
189
190
	Get libevent from http://www.monkey.org/~provos/libevent/
191
	I used V 2.0.8-rc
192
	./configure
193
	make && make verify
194
	sudo make install
195
	It installs into /usr/local/lib, so tell memcached where to look:
196
	LD_LIBRARY_PATH=/usr/local/lib
197
	export LD_LIBRARY_PATH
198
199
	Get memcached from http://memcached.org/
200
	I used V 1.4.5
201
	./configure --with-libevent=/usr/local/lib
202
	make && make test
203
	sudo make install
204
205
	Running memcached:
206
	memcached -m 5 &
207
208
=head1 Support
209
210
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
211
212
=head1 Author
213
214
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
215
216
Home page: L<http://savage.net.au/index.html>.
217
218
=head1 Copyright
219
220
Australian copyright (c) 2010, Ron Savage.
221
222
	All Programs of mine are 'OSI Certified Open Source Software';
223
	you can redistribute them and/or modify them under the terms of
224
	The Artistic License, a copy of which is available at:
225
	http://www.opensource.org/licenses/index.html
226
227
=cut
(-)a/lib/Data/Session/Driver/ODBC.pm (+269 lines)
Line 0 Link Here
1
package Data::Session::Driver::ODBC;
2
3
use parent 'Data::Session::Driver';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
use Try::Tiny;
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub new
17
{
18
	my($class, %arg) = @_;
19
20
	$class -> init(\%arg);
21
22
	my($self) = from_hash(bless({}, $class), \%arg);
23
24
	$self -> get_dbh(\%arg);
25
26
	return $self;
27
28
} # End of new.
29
30
# -----------------------------------------------
31
32
sub store
33
{
34
	my($self, $id, $data)   = @_;
35
	my($data_col_name)      = $self -> data_col_name;
36
	my($dbh)                = $self -> dbh;
37
	local $$dbh{RaiseError} = 1;
38
	my($id_col_name)        = $self -> id_col_name;
39
	my($table_name)         = $self -> table_name;
40
	my($sql)                = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " .
41
								"on duplicate key update $data_col_name = ?";
42
43
	$dbh -> do($sql, {}, $data, $id, $data) || die __PACKAGE__ . ". $DBI::errstr";
44
45
	return 1;
46
47
} # End of store.
48
49
# -----------------------------------------------
50
51
1;
52
53
=pod
54
55
=head1 NAME
56
57
L<Data::Session::Driver::ODBC> - A persistent session manager
58
59
=head1 Synopsis
60
61
See L<Data::Session> for details.
62
63
=head1 Description
64
65
L<Data::Session::Driver::ODBC> allows L<Data::Session> to store sessions via L<DBD::ODBC>.
66
67
To use this module do both of these:
68
69
=over 4
70
71
=item o Specify a driver of type ODBC, as Data::Session -> new(type => 'driver:ODBC ...')
72
73
=item o Specify a database handle as Data::Session -> new(dbh => $dbh), or a data source as
74
Data::Session -> new(data_source => $string)
75
76
=back
77
78
=head1 Case-sensitive Options
79
80
See L<Data::Session/Case-sensitive Options> for important information.
81
82
=head1 Method: new()
83
84
Creates a new object of type L<Data::Session::Driver::ODBC>.
85
86
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
87
might be mandatory.
88
89
The keys are listed here in alphabetical order.
90
91
They are lower-case because they are (also) method names, meaning they can be called to set or get
92
the value at any time.
93
94
=over 4
95
96
=item o data_col_name => $string
97
98
Specifes the name of the column in the sessions table which holds the session data.
99
100
This key is normally passed in as Data::Session -> new(data_col_name => $string).
101
102
Default: 'a_session'.
103
104
This key is optional.
105
106
=item o data_source => $string
107
108
Specifies the data source (as used by
109
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
110
111
This key is normally passed in as Data::Session -> new(data_source => $string).
112
113
Default: ''.
114
115
This key is optional, as long as a value is supplied for 'dbh'.
116
117
=item o data_source_attr => $string
118
119
Specifies the attributes (as used by
120
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
121
122
This key is normally passed in as Data::Session -> new(data_source_attr => $string).
123
124
Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}.
125
126
This key is optional.
127
128
=item o dbh => $dbh
129
130
Specifies the database handle to use to access the sessions table.
131
132
This key is normally passed in as Data::Session -> new(dbh => $dbh).
133
134
If not specified, this module will use the values of these keys to obtain a database handle:
135
136
=over 4
137
138
=item o data_source
139
140
=item o data_source_attr
141
142
=item o username
143
144
=item o password
145
146
=back
147
148
Default: ''.
149
150
This key is optional.
151
152
=item o host => $string
153
154
Not used.
155
156
=item o id_col_name => $string
157
158
Specifes the name of the column in the sessions table which holds the session id.
159
160
This key is normally passed in as Data::Session -> new(id_col_name => $string).
161
162
Default: 'id'.
163
164
This key is optional.
165
166
=item o password => $string
167
168
Specifies the password (as used by
169
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
170
171
This key is normally passed in as Data::Session -> new(password => $string).
172
173
Default: ''.
174
175
This key is optional.
176
177
=item o port => $string
178
179
Not used.
180
181
=item o socket => $string
182
183
Not used.
184
185
=item o table_name => $string
186
187
Specifes the name of the sessions table.
188
189
This key is normally passed in as Data::Session -> new(table_name => $string).
190
191
Default: 'sessions'.
192
193
This key is optional.
194
195
=item o username => $string
196
197
Specifies the username (as used by
198
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
199
200
This key is normally passed in as Data::Session -> new(username => $string).
201
202
Default: ''.
203
204
This key is optional.
205
206
=item o verbose => $integer
207
208
Print to STDERR more or less information.
209
210
Typical values are 0, 1 and 2.
211
212
This key is normally passed in as Data::Session -> new(verbose => $integer).
213
214
This key is optional.
215
216
=back
217
218
=head1 Method: remove($id)
219
220
Deletes from storage the session identified by $id, or dies if it can't.
221
222
Returns 1.
223
224
=head1 Method: retrieve($id)
225
226
Retrieve from storage the session identified by $id, or dies if it can't.
227
228
Returns the session.
229
230
This is a frozen session. This value must be thawed by calling the appropriate serialization
231
driver's thaw() method.
232
233
L<Data::Session> calls the right thaw() automatically.
234
235
=head1 Method: store($id => $data)
236
237
Writes to storage the session identified by $id, together with its data $data, or dies if it can't.
238
239
Returns 1.
240
241
=head1 Method: traverse()
242
243
Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the
244
id as the only parameter.
245
246
$dbh -> selectall_arrayref is used, and the table is not locked.
247
248
Returns 1.
249
250
=head1 Support
251
252
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
253
254
=head1 Author
255
256
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
257
258
Home page: L<http://savage.net.au/index.html>.
259
260
=head1 Copyright
261
262
Australian copyright (c) 2010, Ron Savage.
263
264
	All Programs of mine are 'OSI Certified Open Source Software';
265
	you can redistribute them and/or modify them under the terms of
266
	The Artistic License, a copy of which is available at:
267
	http://www.opensource.org/licenses/index.html
268
269
=cut
(-)a/lib/Data/Session/Driver/Oracle.pm (+269 lines)
Line 0 Link Here
1
package Data::Session::Driver::Oracle;
2
3
use parent 'Data::Session::Driver';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
use Try::Tiny;
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub new
17
{
18
	my($class, %arg) = @_;
19
20
	$class -> init(\%arg);
21
22
	my($self) = from_hash(bless({}, $class), \%arg);
23
24
	$self -> get_dbh(\%arg);
25
26
	return $self;
27
28
} # End of new.
29
30
# -----------------------------------------------
31
32
sub store
33
{
34
	my($self, $id, $data)   = @_;
35
	my($data_col_name)      = $self -> data_col_name;
36
	my($dbh)                = $self -> dbh;
37
	local $$dbh{RaiseError} = 1;
38
	my($id_col_name)        = $self -> id_col_name;
39
	my($table_name)         = $self -> table_name;
40
	my($sql)                = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " .
41
								"on duplicate key update $data_col_name = ?";
42
43
	$dbh -> do($sql, {}, $data, $id, $data) || die __PACKAGE__ . ". $DBI::errstr";
44
45
	return 1;
46
47
} # End of store.
48
49
# -----------------------------------------------
50
51
1;
52
53
=pod
54
55
=head1 NAME
56
57
L<Data::Session::Driver::Oracle> - A persistent session manager
58
59
=head1 Synopsis
60
61
See L<Data::Session> for details.
62
63
=head1 Description
64
65
L<Data::Session::Driver::Oracle> allows L<Data::Session> to store sessions via L<DBD::Oracle>.
66
67
To use this module do both of these:
68
69
=over 4
70
71
=item o Specify a driver of type Oracle, as Data::Session -> new(type => 'driver:Oracle ...')
72
73
=item o Specify a database handle as Data::Session -> new(dbh => $dbh) or a data source as
74
Data::Session -> new(data_source => $string)
75
76
=back
77
78
=head1 Case-sensitive Options
79
80
See L<Data::Session/Case-sensitive Options> for important information.
81
82
=head1 Method: new()
83
84
Creates a new object of type L<Data::Session::Driver::Oracle>.
85
86
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
87
might be mandatory.
88
89
The keys are listed here in alphabetical order.
90
91
They are lower-case because they are (also) method names, meaning they can be called to set or get
92
the value at any time.
93
94
=over 4
95
96
=item o data_col_name => $string
97
98
Specifes the name of the column in the sessions table which holds the session data.
99
100
This key is normally passed in as Data::Session -> new(data_col_name => $string).
101
102
Default: 'a_session'.
103
104
This key is optional.
105
106
=item o data_source => $string
107
108
Specifies the data source (as used by DBI -> connect($data_source, $username, $password, $attr) ) to
109
obtain a database handle.
110
111
This key is normally passed in as Data::Session -> new(data_source => $string).
112
113
Default: ''.
114
115
This key is optional, as long as a value is supplied for 'dbh'.
116
117
=item o data_source_attr => $string
118
119
Specifies the attributes (as used by
120
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
121
122
This key is normally passed in as Data::Session -> new(data_source_attr => $string).
123
124
Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}.
125
126
This key is optional.
127
128
=item o dbh => $dbh
129
130
Specifies the database handle to use to access the sessions table.
131
132
This key is normally passed in as Data::Session -> new(dbh => $dbh).
133
134
If not specified, this module will use the values of these keys to obtain a database handle:
135
136
=over 4
137
138
=item o data_source
139
140
=item o data_source_attr
141
142
=item o username
143
144
=item o password
145
146
=back
147
148
Default: ''.
149
150
This key is optional.
151
152
=item o host => $string
153
154
Not used.
155
156
=item o id_col_name => $string
157
158
Specifes the name of the column in the sessions table which holds the session id.
159
160
This key is normally passed in as Data::Session -> new(id_col_name => $string).
161
162
Default: 'id'.
163
164
This key is optional.
165
166
=item o password => $string
167
168
Specifies the password (as used by
169
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
170
171
This key is normally passed in as Data::Session -> new(password => $string).
172
173
Default: ''.
174
175
This key is optional.
176
177
=item o port => $string
178
179
Not used.
180
181
=item o socket => $string
182
183
Not used.
184
185
=item o table_name => $string
186
187
Specifes the name of the sessions table.
188
189
This key is normally passed in as Data::Session -> new(table_name => $string).
190
191
Default: 'sessions'.
192
193
This key is optional.
194
195
=item o username => $string
196
197
Specifies the username (as used by
198
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
199
200
This key is normally passed in as Data::Session -> new(username => $string).
201
202
Default: ''.
203
204
This key is optional.
205
206
=item o verbose => $integer
207
208
Print to STDERR more or less information.
209
210
Typical values are 0, 1 and 2.
211
212
This key is normally passed in as Data::Session -> new(verbose => $integer).
213
214
This key is optional.
215
216
=back
217
218
=head1 Method: remove($id)
219
220
Deletes from storage the session identified by $id, or dies if it can't.
221
222
Returns 1.
223
224
=head1 Method: retrieve($id)
225
226
Retrieve from storage the session identified by $id, or dies if it can't.
227
228
Returns the session.
229
230
This is a frozen session. This value must be thawed by calling the appropriate serialization
231
driver's thaw() method.
232
233
L<Data::Session> calls the right thaw() automatically.
234
235
=head1 Method: store($id => $data)
236
237
Writes to storage the session identified by $id, together with its data $data, or dies if it can't.
238
239
Returns 1.
240
241
=head1 Method: traverse()
242
243
Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id
244
as the only parameter.
245
246
$dbh -> selectall_arrayref is used, and the table is not locked.
247
248
Returns 1.
249
250
=head1 Support
251
252
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
253
254
=head1 Author
255
256
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
257
258
Home page: L<http://savage.net.au/index.html>.
259
260
=head1 Copyright
261
262
Australian copyright (c) 2010, Ron Savage.
263
264
	All Programs of mine are 'OSI Certified Open Source Software';
265
	you can redistribute them and/or modify them under the terms of
266
	The Artistic License, a copy of which is available at:
267
	http://www.opensource.org/licenses/index.html
268
269
=cut
(-)a/lib/Data/Session/Driver/Pg.pm (+363 lines)
Line 0 Link Here
1
package Data::Session::Driver::Pg;
2
3
use parent 'Data::Session::Driver';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use DBD::Pg qw(PG_BYTEA PG_TEXT);
9
10
use Hash::FieldHash ':all';
11
12
use Try::Tiny;
13
14
our $VERSION = '1.18';
15
16
# -----------------------------------------------
17
18
sub init
19
{
20
	my($self, $arg) = @_;
21
22
	$self -> SUPER::init($arg);
23
24
	$$arg{pg_bytea} ||= 0;
25
	$$arg{pg_text}  ||= 0;
26
27
	if ($$arg{pg_bytea} == 0 && $$arg{pg_text} == 0)
28
	{
29
		$$arg{pg_bytea} = 1;
30
	}
31
	elsif ($$arg{pg_bytea} == 1 && $$arg{pg_text} == 1)
32
	{
33
		$$arg{pg_text} = 0;
34
	}
35
36
} # End of init.
37
38
# -----------------------------------------------
39
40
sub new
41
{
42
	my($class, %arg) = @_;
43
44
	$class -> init(\%arg);
45
46
	my($self) = from_hash(bless({}, $class), \%arg);
47
48
	$self -> get_dbh(\%arg);
49
50
	return $self;
51
52
} # End of new.
53
54
# -----------------------------------------------
55
56
sub store
57
{
58
	my($self, $id, $data)   = @_;
59
	my($data_col_name)      = $self -> data_col_name;
60
	my($dbh)                = $self -> dbh;
61
	local $$dbh{RaiseError} = 1;
62
	my($id_col_name)        = $self -> id_col_name;
63
	my($table_name)         = $self -> table_name;
64
65
	# There is a race condition were two clients could run this code concurrently,
66
	# and both end up trying to insert. That's why we check for "duplicate" below
67
68
	try
69
	{
70
		my($sql) = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " .
71
						"where not exists (select 1 from $table_name where $id_col_name = ? limit 1)";
72
		my($sth) = $dbh -> prepare($sql);
73
74
		$sth -> bind_param(1, $data, {pg_type => $self -> pg_bytea ? PG_BYTEA : PG_TEXT});
75
		$sth -> bind_param(2, $id);
76
		$sth -> bind_param(3, $id);
77
78
		my($rv);
79
80
		try
81
		{
82
			$rv = $sth -> execute;
83
84
			($rv eq '0E0') && $self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data);
85
		}
86
		catch
87
		{
88
			if ($_ =~ /duplicate/)
89
			{
90
				$self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data);
91
			}
92
			else
93
			{
94
				die __PACKAGE__ . ". $_";
95
			}
96
		};
97
98
		$sth -> finish;
99
	}
100
	catch
101
	{
102
		die __PACKAGE__ . ". $_";
103
	};
104
105
	return 1;
106
107
} # End of store.
108
109
# -----------------------------------------------
110
111
sub update
112
{
113
	my($self, $dbh, $table_name, $id_col_name, $data_col_name, $id, $data) = @_;
114
	my($sql) = "update $table_name set $data_col_name = ? where $id_col_name = ?";
115
	my($sth) = $dbh -> prepare($sql);
116
117
	$sth -> bind_param(1, $data, {pg_type => $self -> pg_bytea ? PG_BYTEA : PG_TEXT});
118
	$sth -> bind_param(2, $id);
119
120
	$sth -> execute;
121
	$sth -> finish;
122
123
	return 1;
124
125
} # End of update.
126
127
# -----------------------------------------------
128
129
1;
130
131
=pod
132
133
=head1 NAME
134
135
L<Data::Session::Driver::Pg> - A persistent session manager
136
137
=head1 Synopsis
138
139
See L<Data::Session> for details.
140
141
=head1 Description
142
143
L<Data::Session::Driver::Pg> allows L<Data::Session> to manipulate sessions via L<DBD::Pg>.
144
145
To use this module do both of these:
146
147
=over 4
148
149
=item o Specify a driver of type Pg, as Data::Session -> new(type => 'driver:Pg ...')
150
151
=item o Specify a database handle as Data::Session -> new(dbh => $dbh) or a data source as
152
Data::Session -> new(data_source => $string)
153
154
=back
155
156
=head1 Case-sensitive Options
157
158
See L<Data::Session/Case-sensitive Options> for important information.
159
160
=head1 Method: new()
161
162
Creates a new object of type L<Data::Session::Driver::Pg>.
163
164
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
165
might be mandatory.
166
167
The keys are listed here in alphabetical order.
168
169
They are lower-case because they are (also) method names, meaning they can be called to set or get
170
the value at any time.
171
172
=over 4
173
174
=item o data_col_name => $string
175
176
Specifes the name of the column in the sessions table which holds the session data.
177
178
This key is normally passed in as Data::Session -> new(data_col_name => $string).
179
180
Default: 'a_session'.
181
182
This key is optional.
183
184
=item o data_source => $string
185
186
Specifies the data source (as used by
187
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
188
189
This key is normally passed in as Data::Session -> new(data_source => $string).
190
191
Default: ''.
192
193
This key is optional, as long as a value is supplied for 'dbh'.
194
195
=item o data_source_attr => $hashref
196
197
Specifies the attributes (as used by
198
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
199
200
This key is normally passed in as Data::Session -> new(data_source_attr => $hashref).
201
202
Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}.
203
204
This key is optional.
205
206
=item o dbh => $dbh
207
208
Specifies the database handle to use to access the sessions table.
209
210
This key is normally passed in as Data::Session -> new(dbh => $dbh).
211
212
If not specified, this module will use the values of these keys to obtain a database handle:
213
214
=over 4
215
216
=item o data_source
217
218
=item o data_source_attr
219
220
=item o username
221
222
=item o password
223
224
=back
225
226
Default: ''.
227
228
This key is optional.
229
230
=item o host => $string
231
232
Not used.
233
234
=item o id_col_name => $string
235
236
Specifes the name of the column in the sessions table which holds the session id.
237
238
This key is normally passed in as Data::Session -> new(id_col_name => $string).
239
240
Default: 'id'.
241
242
This key is optional.
243
244
=item o password => $string
245
246
Specifies the password (as used by
247
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
248
249
This key is normally passed in as Data::Session -> new(password => $string).
250
251
Default: ''.
252
253
This key is optional.
254
255
=item o pg_bytea => $boolean
256
257
Specifies (if pg_bytea => 1) that the a_session column in the sessions table is of type bytea.
258
259
This key is normally passed in as Data::Session -> new(pg_bytea => $boolean).
260
261
If both 'pg_bytea' and 'pg_text' are set to 1, 'pg_text' is forced to be 0.
262
263
If both 'pg_bytea' and 'pg_text' are set to 0, 'pg_bytea' is forced to be 1.
264
265
=item o pg_text => $boolean
266
267
Specifies (if pg_text => 1) that the a_session column in the sessions table is of type text.
268
269
This key is normally passed in as Data::Session -> new(pg_text => $boolean).
270
271
=item o port => $string
272
273
Not used.
274
275
=item o socket => $string
276
277
Not used.
278
279
=item o table_name => $string
280
281
Specifes the name of the sessions table.
282
283
This key is normally passed in as Data::Session -> new(table_name => $string).
284
285
Default: 'sessions'.
286
287
This key is optional.
288
289
=item o username => $string
290
291
Specifies the username (as used by
292
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
293
294
This key is normally passed in as Data::Session -> new(username => $string).
295
296
Default: ''.
297
298
This key is optional.
299
300
=item o verbose => $integer
301
302
Print to STDERR more or less information.
303
304
This key is normally passed in as Data::Session -> new(verbose => $integer).
305
306
Typical values are 0, 1 and 2.
307
308
This key is optional.
309
310
=back
311
312
=head1 Method: remove($id)
313
314
Deletes from storage the session identified by $id, or dies if it can't.
315
316
Returns 1.
317
318
=head1 Method: retrieve($id)
319
320
Retrieve from storage the session identified by $id, or dies if it can't.
321
322
Returns the session.
323
324
This is a frozen session. This value must be thawed by calling the appropriate serialization
325
driver's thaw() method.
326
327
L<Data::Session> calls the right thaw() automatically.
328
329
=head1 Method: store($id => $data)
330
331
Writes to storage the session identified by $id, together with its data $data, or dies if it can't.
332
333
$dbh -> selectall_arrayref is used, and the table is not locked.
334
335
Returns 1.
336
337
=head1 Method: traverse()
338
339
Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id
340
as the only parameter.
341
342
Returns 1.
343
344
=head1 Support
345
346
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
347
348
=head1 Author
349
350
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
351
352
Home page: L<http://savage.net.au/index.html>.
353
354
=head1 Copyright
355
356
Australian copyright (c) 2010, Ron Savage.
357
358
	All Programs of mine are 'OSI Certified Open Source Software';
359
	you can redistribute them and/or modify them under the terms of
360
	The Artistic License, a copy of which is available at:
361
	http://www.opensource.org/licenses/index.html
362
363
=cut
(-)a/lib/Data/Session/Driver/SQLite.pm (+330 lines)
Line 0 Link Here
1
package Data::Session::Driver::SQLite;
2
3
use parent 'Data::Session::Driver';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use DBI qw(SQL_BLOB);
9
10
use Hash::FieldHash ':all';
11
12
use Try::Tiny;
13
14
our $VERSION = '1.18';
15
16
# -----------------------------------------------
17
18
sub new
19
{
20
	my($class, %arg) = @_;
21
22
	$class -> init(\%arg);
23
24
	my($self) = from_hash(bless({}, $class), \%arg);
25
26
	$self -> get_dbh(\%arg);
27
28
	my($dbh)                          = $self -> dbh;
29
	$$dbh{sqlite_handle_binary_nulls} = 1;
30
31
	$self -> dbh($dbh);
32
33
	return $self;
34
35
} # End of new.
36
37
# -----------------------------------------------
38
39
sub store
40
{
41
	my($self, $id, $data)   = @_;
42
	my($data_col_name)      = $self -> data_col_name;
43
	my($dbh)                = $self -> dbh;
44
	local $$dbh{RaiseError} = 1;
45
	my($id_col_name)        = $self -> id_col_name;
46
	my($table_name)         = $self -> table_name;
47
48
	# There is a race condition were two clients could run this code concurrently,
49
	# and both end up trying to insert. That's why we check for "duplicate" below
50
51
	try
52
	{
53
		my($sql) = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " .
54
						"where not exists (select 1 from $table_name where $id_col_name = ? limit 1)";
55
		my($sth) = $dbh -> prepare($sql);
56
57
		$sth -> bind_param(1, $data, SQL_BLOB);
58
		$sth -> bind_param(2, $id);
59
		$sth -> bind_param(3, $id);
60
61
		my($rv);
62
63
		try
64
		{
65
			$rv = $sth -> execute;
66
67
			($rv eq '0E0') && $self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data);
68
		}
69
		catch
70
		{
71
			if ($_ =~ /Error: .+ is not unique/)
72
			{
73
				$self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data);
74
			}
75
			else
76
			{
77
				die __PACKAGE__ . ". $_";
78
			}
79
		};
80
81
		$sth -> finish;
82
	}
83
	catch
84
	{
85
		die __PACKAGE__ . ". $_";
86
	};
87
88
	return 1;
89
90
} # End of store.
91
92
# -----------------------------------------------
93
94
sub update
95
{
96
	my($self, $dbh, $table_name, $id_col_name, $data_col_name, $id, $data) = @_;
97
	my($sql) = "update $table_name set $data_col_name = ? where $id_col_name = ?";
98
	my($sth) = $dbh -> prepare($sql);
99
100
	$sth -> bind_param(1, $data, SQL_BLOB);
101
	$sth -> bind_param(2, $id);
102
103
	$sth -> execute;
104
	$sth -> finish;
105
106
} # End of update.
107
108
# -----------------------------------------------
109
110
1;
111
112
=pod
113
114
=head1 NAME
115
116
L<Data::Session::Driver::SQLite> - A persistent session manager
117
118
=head1 Synopsis
119
120
See L<Data::Session> for details.
121
122
=head1 Description
123
124
L<Data::Session::Driver::SQLite> allows L<Data::Session> to manipulate sessions via L<DBD::SQLite>.
125
126
To use this module do both of these:
127
128
=over 4
129
130
=item o Specify a driver of type SQLite, as Data::Session -> new(type => 'driver:SQLite ...')
131
132
=item o Specify a database handle as Data::Session -> new(dbh => $dbh) or a data source as
133
Data::Session -> new(data_source => $string)
134
135
=back
136
137
See scripts/sqlite.pl.
138
139
=head1 Case-sensitive Options
140
141
See L<Data::Session/Case-sensitive Options> for important information.
142
143
=head1 Method: new()
144
145
Creates a new object of type L<Data::Session::Driver::SQLite>.
146
147
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
148
might be mandatory.
149
150
The keys are listed here in alphabetical order.
151
152
They are lower-case because they are (also) method names, meaning they can be called to set or get
153
the value at any time.
154
155
=over 4
156
157
=item o data_col_name => $string
158
159
Specifes the name of the column in the sessions table which holds the session data.
160
161
This key is normally passed in as Data::Session -> new(data_col_name => $string).
162
163
Default: 'a_session'.
164
165
This key is optional.
166
167
=item o data_source => $string
168
169
Specifies the data source (as used by
170
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
171
172
This key is normally passed in as Data::Session -> new(data_source => $string).
173
174
Default: ''.
175
176
This key is optional, as long as a value is supplied for 'dbh'.
177
178
=item o data_source_attr => $string
179
180
Specifies the attributes (as used by
181
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
182
183
This key is normally passed in as Data::Session -> new(data_source_attr => $string).
184
185
Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}.
186
187
This key is optional.
188
189
=item o dbh => $dbh
190
191
Specifies the database handle to use to access the sessions table.
192
193
This key is normally passed in as Data::Session -> new(dbh => $dbh).
194
195
If not specified, this module will use the values of these keys to obtain a database handle:
196
197
=over 4
198
199
=item o data_source
200
201
=item o data_source_attr
202
203
=item o username
204
205
=item o password
206
207
=back
208
209
Default: ''.
210
211
This key is optional.
212
213
=item o host => $string
214
215
Not used.
216
217
=item o id_col_name => $string
218
219
Specifes the name of the column in the sessions table which holds the session id.
220
221
This key is normally passed in as Data::Session -> new(id_col_name => $string).
222
223
Default: 'id'.
224
225
This key is optional.
226
227
=item o password => $string
228
229
Specifies the password (as used by
230
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
231
232
This key is normally passed in as Data::Session -> new(password => $string).
233
234
Default: ''.
235
236
This key is optional.
237
238
=item o port => $string
239
240
Not used.
241
242
=item o socket => $string
243
244
Not used.
245
246
=item o table_name => $string
247
248
Specifes the name of the sessions table.
249
250
This key is normally passed in as Data::Session -> new(table_name => $string).
251
252
Default: 'sessions'.
253
254
This key is optional.
255
256
=item o username => $string
257
258
Specifies the username (as used by
259
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
260
261
This key is normally passed in as Data::Session -> new(username => $string).
262
263
Default: ''.
264
265
This key is optional.
266
267
=item o verbose => $integer
268
269
Print to STDERR more or less information.
270
271
Typical values are 0, 1 and 2.
272
273
This key is normally passed in as Data::Session -> new(verbose => $integer).
274
275
This key is optional.
276
277
=back
278
279
=head1 Method: remove($id)
280
281
Deletes from storage the session identified by $id, or dies if it can't.
282
283
Returns 1.
284
285
=head1 Method: retrieve($id)
286
287
Retrieve from storage the session identified by $id, or dies if it can't.
288
289
Returns the session.
290
291
This is a frozen session. This value must be thawed by calling the appropriate serialization
292
driver's thaw() method.
293
294
L<Data::Session> calls the right thaw() automatically.
295
296
=head1 Method: store($id => $data)
297
298
Writes to storage the session identified by $id, together with its data $data, or dies if it can't.
299
300
Returns 1.
301
302
=head1 Method: traverse()
303
304
Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id
305
as the only parameter.
306
307
$dbh -> selectall_arrayref is used, and the table is not locked.
308
309
Returns 1.
310
311
=head1 Support
312
313
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
314
315
=head1 Author
316
317
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
318
319
Home page: L<http://savage.net.au/index.html>.
320
321
=head1 Copyright
322
323
Australian copyright (c) 2010, Ron Savage.
324
325
	All Programs of mine are 'OSI Certified Open Source Software';
326
	you can redistribute them and/or modify them under the terms of
327
	The Artistic License, a copy of which is available at:
328
	http://www.opensource.org/licenses/index.html
329
330
=cut
(-)a/lib/Data/Session/Driver/mysql.pm (+296 lines)
Line 0 Link Here
1
package Data::Session::Driver::mysql;
2
3
use parent 'Data::Session::Driver';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub new
15
{
16
	my($class, %arg) = @_;
17
18
	$class -> init(\%arg);
19
20
	my($self) = from_hash(bless({}, $class), \%arg);
21
	my($dsn)  = $self -> data_source;
22
	my(%attr) =
23
	(
24
		host   => 'host',
25
		port   => 'port',
26
		socket => 'mysql_socket',
27
	);
28
29
	for my $key (sort keys %attr)
30
	{
31
		if ($arg{$key})
32
		{
33
			$dsn .= ";$attr{$key}=$arg{$key}";
34
		}
35
	}
36
37
	$self -> data_source($dsn);
38
	$self -> get_dbh(\%arg);
39
40
	return $self;
41
42
} # End of new.
43
44
# -----------------------------------------------
45
46
sub store
47
{
48
	my($self, $id, $data)   = @_;
49
	my($data_col_name)      = $self -> data_col_name;
50
	my($dbh)                = $self -> dbh;
51
	local $$dbh{RaiseError} = 1;
52
	my($id_col_name)        = $self -> id_col_name;
53
	my($table_name)         = $self -> table_name;
54
	my($sql)                = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " .
55
								"on duplicate key update $data_col_name = ?";
56
57
	$dbh -> do($sql, {}, $data, $id, $data) || die __PACKAGE__ . ". $DBI::errstr";
58
59
	return 1;
60
61
} # End of store.
62
63
# -----------------------------------------------
64
65
1;
66
67
=pod
68
69
=head1 NAME
70
71
L<Data::Session::Driver::mysql> - A persistent session manager
72
73
=head1 Synopsis
74
75
See L<Data::Session> for details.
76
77
=head1 Description
78
79
L<Data::Session::Driver::mysql> allows L<Data::Session> to manipulate sessions via L<DBD::mysql>.
80
81
To use this module do both of these :
82
83
=over 4
84
85
=item o Specify a driver of type mysql, as Data::Session -> new(type => 'driver:mysql ...')
86
87
=item o Specify a database handle as Data::Session -> new(dbh => $dbh), or a data source as
88
Data::Session -> new(data_source => $string)
89
90
=back
91
92
=head1 Case-sensitive Options
93
94
See L<Data::Session/Case-sensitive Options> for important information.
95
96
=head1 Method: new()
97
98
Creates a new object of type L<Data::Session::Driver::mysql>.
99
100
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
101
might be mandatory.
102
103
The keys are listed here in alphabetical order.
104
105
They are lower-case because they are (also) method names, meaning they can be called to set or get
106
the value at any time.
107
108
=over 4
109
110
=item o data_col_name => $string
111
112
Specifes the name of the column in the sessions table which holds the session data.
113
114
This key is normally passed in as Data::Session -> new(data_col_name => $string).
115
116
Default: 'a_session'.
117
118
This key is optional.
119
120
=item o data_source => $string
121
122
Specifies the data source (as used by DBI -> connect($data_source, $username, $password,
123
$data_source_attr) ) to obtain a database handle.
124
125
This key is normally passed in as Data::Session -> new(data_source => $string).
126
127
Default: ''.
128
129
This key is optional, as long as a value is supplied for 'dbh'.
130
131
=item o data_source_attr => $hashref
132
133
Specifies the attributes (as used by DBI -> connect($data_source, $username, $password, $attr) ) to
134
obtain a database handle.
135
136
This key is normally passed in as Data::Session -> new(data_source_attr => $hashref).
137
138
Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}.
139
140
This key is optional.
141
142
=item o dbh => $dbh
143
144
Specifies the database handle to use to access the sessions table.
145
146
This key is normally passed in as Data::Session -> new(dbh => $dbh).
147
148
If not specified, this module will use the values of these keys to obtain a database handle:
149
150
=over 4
151
152
=item o data_source
153
154
=item o data_source_attr
155
156
=item o username
157
158
=item o password
159
160
=back
161
162
Default: ''.
163
164
This key is optional.
165
166
=item o host => $string
167
168
Specifies the host name to attach to the data_source.
169
170
So Data::Session -> new(data_source => 'dbi:mysql:database=test', host => '192.168.100.1') generates
171
the call $dbh = DBI -> connect('dbi:mysql:database=test;host=192.168.100.1', ...).
172
173
=item o id_col_name => $string
174
175
Specifes the name of the column in the sessions table which holds the session id.
176
177
This key is normally passed in as Data::Session -> new(id_col_name => $string).
178
179
Default: 'id'.
180
181
This key is optional.
182
183
=item o password => $string
184
185
Specifies the password (as used by DBI -> connect($data_source, $username, $password,
186
$data_source_attr) ) to obtain a database handle.
187
188
This key is normally passed in as Data::Session -> new(password => $string).
189
190
Default: ''.
191
192
This key is optional.
193
194
=item o port => $string
195
196
Specifies the port number to attach to the data_source.
197
198
So Data::Session -> new(data_source => 'dbi:mysql:database=test', port => '5000') generates
199
the call $dbh = DBI -> connect('dbi:mysql:database=test;port=5000', ...).
200
201
=item o socket => $string
202
203
Specifies the socket to attach to the data_source.
204
205
So Data::Session -> new(data_source => 'dbi:mysql:database=test', socket => '/dev/mysql.sock')
206
generates the call
207
$dbh = DBI -> connect('dbi:mysql:database=test;mysql_socket=/dev/mysql.sock', ...).
208
209
The reason this key is called socket and not mysql_socket is in case other drivers permit a socket
210
option.
211
212
=item o table_name => $string
213
214
Specifes the name of the sessions table.
215
216
This key is normally passed in as Data::Session -> new(table_name => $string).
217
218
Default: 'sessions'.
219
220
This key is optional.
221
222
=item o username => $string
223
224
Specifies the username (as used by
225
DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle.
226
227
This key is normally passed in as Data::Session -> new(username => $string).
228
229
Default: ''.
230
231
This key is optional.
232
233
=item o verbose => $integer
234
235
Print to STDERR more or less information.
236
237
This key is normally passed in as Data::Session -> new(verbose => $integer).
238
239
Typical values are 0, 1 and 2.
240
241
This key is optional.
242
243
=back
244
245
=head1 Method: remove($id)
246
247
Deletes from storage the session identified by $id, or dies if it can't.
248
249
Returns 1.
250
251
=head1 Method: retrieve($id)
252
253
Retrieve from storage the session identified by $id, or dies if it can't.
254
255
Returns the session.
256
257
This is a frozen session. This value must be thawed by calling the appropriate serialization
258
driver's thaw() method.
259
260
L<Data::Session> calls the right thaw() automatically.
261
262
=head1 Method: store($id => $data)
263
264
Writes to storage the session identified by $id, together with its data $data, or dies if it can't.
265
266
Returns 1.
267
268
=head1 Method: traverse()
269
270
Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id
271
as the only parameter.
272
273
$dbh -> selectall_arrayref is used, and the table is not locked.
274
275
Returns 1.
276
277
=head1 Support
278
279
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
280
281
=head1 Author
282
283
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
284
285
Home page: L<http://savage.net.au/index.html>.
286
287
=head1 Copyright
288
289
Australian copyright (c) 2010, Ron Savage.
290
291
	All Programs of mine are 'OSI Certified Open Source Software';
292
	you can redistribute them and/or modify them under the terms of
293
	The Artistic License, a copy of which is available at:
294
	http://www.opensource.org/licenses/index.html
295
296
=cut
(-)a/lib/Data/Session/ID.pm (+75 lines)
Line 0 Link Here
1
package Data::Session::ID;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use File::Spec;
9
10
use Hash::FieldHash ':all';
11
12
fieldhash my %id_length => 'id_length';
13
14
our $errstr  = '';
15
our $VERSION = '1.18';
16
17
# -----------------------------------------------
18
19
sub init
20
{
21
	my($class, $arg)  = @_;
22
	$$arg{debug}      ||= 0;
23
	$$arg{id}         ||= 0;
24
	$$arg{id_base}    ||= 0; # For AutoIncrement (AI).
25
	$$arg{id_file}    ||= File::Spec -> catdir(File::Spec -> tmpdir, 'data.session.id'); # For AI.
26
	$$arg{id_length}  = 0;   # For UUID.
27
	$$arg{id_step}    ||= 1; # For AI.
28
	$$arg{no_flock}   ||= 0;
29
	$$arg{umask}      ||= 0660;
30
	$$arg{verbose}    ||= 0;
31
32
} # End of init.
33
34
# -----------------------------------------------
35
36
1;
37
38
=pod
39
40
=head1 NAME
41
42
L<Data::Session::ID> - A persistent session manager
43
44
=head1 Synopsis
45
46
See L<Data::Session> for details.
47
48
=head1 Description
49
50
L<Data::Session::ID> is the parent of all L<Data::Session::ID::*> modules.
51
52
=head1 Case-sensitive Options
53
54
See L<Data::Session/Case-sensitive Options> for important information.
55
56
=head1 Support
57
58
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
59
60
=head1 Author
61
62
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
63
64
Home page: L<http://savage.net.au/index.html>.
65
66
=head1 Copyright
67
68
Australian copyright (c) 2010, Ron Savage.
69
70
	All Programs of mine are 'OSI Certified Open Source Software';
71
	you can redistribute them and/or modify them under the terms of
72
	The Artistic License, a copy of which is available at:
73
	http://www.opensource.org/licenses/index.html
74
75
=cut
(-)a/lib/Data/Session/ID/AutoIncrement.pm (+221 lines)
Line 0 Link Here
1
package Data::Session::ID::AutoIncrement;
2
3
use parent 'Data::Session::ID';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Fcntl qw/:DEFAULT :flock/;
9
10
use Hash::FieldHash ':all';
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub generate
17
{
18
	my($self)    = @_;
19
	my($id_file) = $self -> id_file;
20
21
	(! $id_file) && die __PACKAGE__ . '. id_file not specifed in new(...)';
22
23
	my($message) = __PACKAGE__ . ". Can't %s id_file '$id_file'. %s";
24
25
	my($fh);
26
27
	sysopen($fh, $id_file, O_RDWR | O_CREAT, $self -> umask) || die sprintf($message, 'open', $self -> debug ? $! : '');
28
29
	if (! $self -> no_flock)
30
	{
31
		flock($fh, LOCK_EX) || die sprintf($message, 'lock', $self -> debug ? $! : '');
32
	}
33
34
	my($id) = <$fh>;
35
36
	if (! $id || ($id !~ /^\d+$/) )
37
	{
38
		$id = $self -> id_base;
39
	}
40
41
	$id += $self -> id_step;
42
43
	seek($fh, 0, 0)  || die sprintf($message, 'seek', $self -> debug ? $! : '');
44
	truncate($fh, 0) || die sprintf($message, 'truncate', $self -> debug ? $! : '');
45
	print $fh $id;
46
	close $fh || die sprintf($message, 'close', $self -> debug ? $! : '');
47
48
	return $id;
49
50
} # End of generate.
51
52
# -----------------------------------------------
53
54
sub id_length
55
{
56
	my($self) = @_;
57
58
	return 32;
59
60
} # End of id_length.
61
62
# -----------------------------------------------
63
64
sub new
65
{
66
	my($class, %arg) = @_;
67
68
	$class -> init(\%arg);
69
70
	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<Data::Session::ID::AutoIncrement> - A persistent session manager
83
84
=head1 Synopsis
85
86
See L<Data::Session> for details.
87
88
=head1 Description
89
90
L<Data::Session::ID::AutoIncrement> allows L<Data::Session> 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<Data::Session/Case-sensitive Options> for important information.
104
105
=head1 Method: new()
106
107
Creates a new object of type L<Data::Session::ID::AutoIncrement>.
108
109
C<new()> 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<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
205
206
=head1 Author
207
208
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
209
210
Home page: L<http://savage.net.au/index.html>.
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
(-)a/lib/Data/Session/ID/MD5.pm (+137 lines)
Line 0 Link Here
1
package Data::Session::ID::MD5;
2
3
use parent 'Data::Session::ID';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Digest::MD5;
9
10
use Hash::FieldHash ':all';
11
12
our $errstr  = '';
13
our $VERSION = '1.18';
14
15
# -----------------------------------------------
16
17
sub generate
18
{
19
	my($self) = @_;
20
21
	return Digest::MD5 -> new -> add($$, time, rand(time) ) -> hexdigest;
22
23
} # End of generate.
24
25
# -----------------------------------------------
26
27
sub id_length
28
{
29
	my($self) = @_;
30
31
	return 32;
32
33
} # End of id_length.
34
35
# -----------------------------------------------
36
37
sub new
38
{
39
	my($class, %arg) = @_;
40
	$arg{verbose}    ||= 0;
41
42
	return from_hash(bless({}, $class), \%arg);
43
44
} # End of new.
45
46
# -----------------------------------------------
47
48
1;
49
50
=pod
51
52
=head1 NAME
53
54
L<Data::Session::ID::MD5> - A persistent session manager
55
56
=head1 Synopsis
57
58
See L<Data::Session> for details.
59
60
=head1 Description
61
62
L<Data::Session::ID::MD5> allows L<Data::Session> to generate session ids using L<Digest::MD5>.
63
64
To use this module do this:
65
66
=over 4
67
68
=item o Specify an id generator of type MD5, as Data::Session -> new(type => '... id:MD5 ...')
69
70
=back
71
72
=head1 Case-sensitive Options
73
74
See L<Data::Session/Case-sensitive Options> for important information.
75
76
=head1 Method: new()
77
78
Creates a new object of type L<Data::Session::ID::MD5>.
79
80
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
81
might be mandatory.
82
83
The keys are listed here in alphabetical order.
84
85
They are lower-case because they are (also) method names, meaning they can be called to set or get
86
the value at any time.
87
88
=over 4
89
90
=item o verbose => $integer
91
92
Print to STDERR more or less information.
93
94
Typical values are 0, 1 and 2.
95
96
This key is normally passed in as Data::Session -> new(verbose => $integer).
97
98
This key is optional.
99
100
=back
101
102
=head1 Method: generate()
103
104
Generates the next session id, or dies if it can't.
105
106
The algorithm is Digest::MD5 -> new -> add($$, time, rand(time) ) -> hexdigest.
107
108
Returns the new id.
109
110
=head1 Method: id_length()
111
112
Returns 32 because that's the number of hex digits in a MD5 digest.
113
114
This can be used to generate the SQL to create the sessions table.
115
116
See scripts/digest.pl.
117
118
=head1 Support
119
120
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
121
122
=head1 Author
123
124
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
125
126
Home page: L<http://savage.net.au/index.html>.
127
128
=head1 Copyright
129
130
Australian copyright (c) 2010, Ron Savage.
131
132
	All Programs of mine are 'OSI Certified Open Source Software';
133
	you can redistribute them and/or modify them under the terms of
134
	The Artistic License, a copy of which is available at:
135
	http://www.opensource.org/licenses/index.html
136
137
=cut
(-)a/lib/Data/Session/ID/SHA1.pm (+130 lines)
Line 0 Link Here
1
package Data::Session::ID::SHA1;
2
3
use parent 'Data::Session::SHA';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub generate
15
{
16
	my($self) = @_;
17
18
	return $self -> SUPER::generate(1);
19
20
} # End of generate.
21
22
# -----------------------------------------------
23
24
sub id_length
25
{
26
	my($self) = @_;
27
28
	return 40;
29
30
} # End of id_length.
31
32
# -----------------------------------------------
33
34
sub new
35
{
36
	my($class, %arg) = @_;
37
	$arg{verbose}    ||= 0;
38
39
	return from_hash(bless({}, $class), \%arg);
40
41
} # End of new.
42
43
# -----------------------------------------------
44
45
1;
46
47
=pod
48
49
=head1 NAME
50
51
L<Data::Session::ID::SHA1> - A persistent session manager
52
53
=head1 Synopsis
54
55
See L<Data::Session> for details.
56
57
=head1 Description
58
59
L<Data::Session::ID::SHA1> allows L<Data::Session> to generate session ids using L<Digest::SHA>.
60
61
To use this module do this:
62
63
=over 4
64
65
=item o Specify an id generator of type SHA1, as Data::Session -> new(type => '... id:SHA1 ...')
66
67
=back
68
69
=head1 Case-sensitive Options
70
71
See L<Data::Session/Case-sensitive Options> for important information.
72
73
=head1 Method: new()
74
75
Creates a new object of type L<Data::Session::ID::SHA1>.
76
77
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
78
might be mandatory.
79
80
The keys are listed here in alphabetical order.
81
82
They are lower-case because they are (also) method names, meaning they can be called to set or get
83
the value at any time.
84
85
=over 4
86
87
=item o verbose => $integer
88
89
Print to STDERR more or less information.
90
91
Typical values are 0, 1 and 2.
92
93
This key is normally passed in as Data::Session -> new(verbose => $integer).
94
95
This key is optional.
96
97
=back
98
99
=head1 Method: generate()
100
101
Generates the next session id, or dies if it can't.
102
103
The algorithm is Digest::SHA -> new(1) -> add($$, time, rand(time) ) -> hexdigest.
104
105
Returns the new id.
106
107
=head1 Method: id_length()
108
109
Returns 40 because that's the number of hex digits in an SHA1 digest.
110
111
=head1 Support
112
113
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
114
115
=head1 Author
116
117
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
118
119
Home page: L<http://savage.net.au/index.html>.
120
121
=head1 Copyright
122
123
Australian copyright (c) 2010, Ron Savage.
124
125
	All Programs of mine are 'OSI Certified Open Source Software';
126
	you can redistribute them and/or modify them under the terms of
127
	The Artistic License, a copy of which is available at:
128
	http://www.opensource.org/licenses/index.html
129
130
=cut
(-)a/lib/Data/Session/ID/SHA256.pm (+132 lines)
Line 0 Link Here
1
package Data::Session::ID::SHA256;
2
3
use parent 'Data::Session::SHA';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub generate
15
{
16
	my($self) = @_;
17
18
	return $self -> SUPER::generate(256);
19
20
} # End of generate.
21
22
# -----------------------------------------------
23
24
sub id_length
25
{
26
	my($self) = @_;
27
28
	return 64;
29
30
} # End of id_length.
31
32
# -----------------------------------------------
33
34
sub new
35
{
36
	my($class, %arg) = @_;
37
	$arg{verbose}    ||= 0;
38
39
	return from_hash(bless({}, $class), \%arg);
40
41
} # End of new.
42
43
# -----------------------------------------------
44
45
1;
46
47
=pod
48
49
=head1 NAME
50
51
L<Data::Session::ID::SHA256> - A persistent session manager
52
53
=head1 Synopsis
54
55
See L<Data::Session> for details.
56
57
=head1 Description
58
59
L<Data::Session::ID::SHA256> allows L<Data::Session> to generate session ids using L<Digest::SHA>.
60
61
To use this module do this:
62
63
=over 4
64
65
=item o Specify an id generator of type SHA256, as Data::Session -> new(type => '... id:SHA256 ...')
66
67
=back
68
69
=head1 Case-sensitive Options
70
71
See L<Data::Session/Case-sensitive Options> for important information.
72
73
=head1 Method: new()
74
75
Creates a new object of type L<Data::Session::ID::SHA256>.
76
77
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
78
might be mandatory.
79
80
The keys are listed here in alphabetical order.
81
82
They are lower-case because they are (also) method names, meaning they can be called to set or get
83
the value at any time.
84
85
=over 4
86
87
=item o verbose => $integer
88
89
Print to STDERR more or less information.
90
91
Typical values are 0, 1 and 2.
92
93
This key is normally passed in as Data::Session -> new(verbose => $integer).
94
95
This key is optional.
96
97
=back
98
99
=head1 Method: generate()
100
101
Generates the next session id, or dies if it can't.
102
103
The algorithm is Digest::SHA -> new(256) -> add($$, time, rand(time) ) -> hexdigest.
104
105
Returns the new id.
106
107
=head1 Method: id_length()
108
109
Returns 64 because that's the number of hex digits in an SHA256 digest.
110
111
This can be used to generate the SQL to create the sessions table.
112
113
=head1 Support
114
115
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
116
117
=head1 Author
118
119
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
120
121
Home page: L<http://savage.net.au/index.html>.
122
123
=head1 Copyright
124
125
Australian copyright (c) 2010, Ron Savage.
126
127
	All Programs of mine are 'OSI Certified Open Source Software';
128
	you can redistribute them and/or modify them under the terms of
129
	The Artistic License, a copy of which is available at:
130
	http://www.opensource.org/licenses/index.html
131
132
=cut
(-)a/lib/Data/Session/ID/SHA512.pm (+132 lines)
Line 0 Link Here
1
package Data::Session::ID::SHA512;
2
3
use parent 'Data::Session::SHA';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub generate
15
{
16
	my($self) = @_;
17
18
	return $self -> SUPER::generate(512);
19
20
} # End of generate.
21
22
# -----------------------------------------------
23
24
sub id_length
25
{
26
	my($self) = @_;
27
28
	return 128;
29
30
} # End of id_length.
31
32
# -----------------------------------------------
33
34
sub new
35
{
36
	my($class, %arg) = @_;
37
	$arg{verbose}    ||= 0;
38
39
	return from_hash(bless({}, $class), \%arg);
40
41
} # End of new.
42
43
# -----------------------------------------------
44
45
1;
46
47
=pod
48
49
=head1 NAME
50
51
L<Data::Session::ID::SHA512> - A persistent session manager
52
53
=head1 Synopsis
54
55
See L<Data::Session> for details.
56
57
=head1 Description
58
59
L<Data::Session::ID::SHA512> allows L<Data::Session> to generate session ids using L<Digest::SHA>.
60
61
To use this module do this:
62
63
=over 4
64
65
=item o Specify an id generator of type SHA512, as Data::Session -> new(type => '... id:SHA512 ...')
66
67
=back
68
69
=head1 Case-sensitive Options
70
71
See L<Data::Session/Case-sensitive Options> for important information.
72
73
=head1 Method: new()
74
75
Creates a new object of type L<Data::Session::ID::SHA512>.
76
77
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
78
might be mandatory.
79
80
The keys are listed here in alphabetical order.
81
82
They are lower-case because they are (also) method names, meaning they can be called to set or get
83
the value at any time.
84
85
=over 4
86
87
=item o verbose => $integer
88
89
Print to STDERR more or less information.
90
91
Typical values are 0, 1 and 2.
92
93
This key is normally passed in as Data::Session -> new(verbose => $integer).
94
95
This key is optional.
96
97
=back
98
99
=head1 Method: generate()
100
101
Generates the next session id, or dies if it can't.
102
103
The algorithm is Digest::SHA -> new(512) -> add($$, time, rand(time) ) -> hexdigest.
104
105
Returns the new id.
106
107
=head1 Method: id_length()
108
109
Returns 128 because that's the number of hex digits in an SHA512 digest.
110
111
This can be used to generate the SQL to create the sessions table.
112
113
=head1 Support
114
115
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
116
117
=head1 Author
118
119
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
120
121
Home page: L<http://savage.net.au/index.html>.
122
123
=head1 Copyright
124
125
Australian copyright (c) 2010, Ron Savage.
126
127
	All Programs of mine are 'OSI Certified Open Source Software';
128
	you can redistribute them and/or modify them under the terms of
129
	The Artistic License, a copy of which is available at:
130
	http://www.opensource.org/licenses/index.html
131
132
=cut
(-)a/lib/Data/Session/ID/Static.pm (+145 lines)
Line 0 Link Here
1
package Data::Session::ID::Static;
2
3
use parent 'Data::Session::ID';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Hash::FieldHash ':all';
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub generate
15
{
16
	my($self) = @_;
17
	my($id)   = $self -> id;
18
19
	(! $id) && die __PACKAGE__ . '. Static id (supplied to new) is not a true value';
20
21
	return $id;
22
23
} # End of generate.
24
25
# -----------------------------------------------
26
27
sub id_length
28
{
29
	my($self) = @_;
30
31
	return 32;
32
33
} # End of id_length.
34
35
# -----------------------------------------------
36
37
sub new
38
{
39
	my($class, %arg) = @_;
40
41
	$class -> init(\%arg);
42
43
	return from_hash(bless({}, $class), \%arg);
44
45
} # End of new.
46
47
# -----------------------------------------------
48
49
1;
50
51
=pod
52
53
=head1 NAME
54
55
L<Data::Session::ID::Static> - A persistent session manager
56
57
=head1 Synopsis
58
59
See L<Data::Session> for details.
60
61
=head1 Description
62
63
L<Data::Session::ID::Static> allows L<Data::Session> to generate a static (constant) session id.
64
65
To use this module do this:
66
67
=over 4
68
69
=item o Specify an id generator of type Static, as Data::Session -> new(type => '... id:Static ...')
70
71
=back
72
73
=head1 Case-sensitive Options
74
75
See L<Data::Session/Case-sensitive Options> for important information.
76
77
=head1 Method: new()
78
79
Creates a new object of type L<Data::Session::ID::Static>.
80
81
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
82
might be mandatory.
83
84
The keys are listed here in alphabetical order.
85
86
They are lower-case because they are (also) method names, meaning they can be called to set or get
87
the value at any time.
88
89
=over 4
90
91
=item o id => $string
92
93
Specifies the static (constant) id to 'generate'.
94
95
This key is normally passed in as Data::Session -> new(id => $string).
96
97
Default: 0.
98
99
This key is mandatory, and can't be 0.
100
101
=item o verbose => $integer
102
103
Print to STDERR more or less information.
104
105
Typical values are 0, 1 and 2.
106
107
This key is normally passed in as Data::Session -> new(verbose => $integer).
108
109
This key is optional.
110
111
=back
112
113
=head1 Method: generate()
114
115
Generates the next session id (which is always what was passed in to new(id => ...) ), or dies if it
116
can't.
117
118
Returns the new id.
119
120
=head1 Method: id_length()
121
122
Returns 32 because that's the classic value of the size of the id field in the sessions table.
123
124
This can be used to generate the SQL to create the sessions table.
125
126
=head1 Support
127
128
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
129
130
=head1 Author
131
132
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
133
134
Home page: L<http://savage.net.au/index.html>.
135
136
=head1 Copyright
137
138
Australian copyright (c) 2010, Ron Savage.
139
140
	All Programs of mine are 'OSI Certified Open Source Software';
141
	you can redistribute them and/or modify them under the terms of
142
	The Artistic License, a copy of which is available at:
143
	http://www.opensource.org/licenses/index.html
144
145
=cut
(-)a/lib/Data/Session/ID/UUID16.pm (+156 lines)
Line 0 Link Here
1
package Data::Session::ID::UUID16;
2
3
use parent 'Data::Session::ID';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Data::UUID;
9
10
use Hash::FieldHash ':all';
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub generate
17
{
18
	my($self) = @_;
19
20
	return Data::UUID -> new -> create_bin;
21
22
} # End of generate.
23
24
# -----------------------------------------------
25
26
sub id_length
27
{
28
	my($self) = @_;
29
30
	return 16;
31
32
} # End of id_length.
33
34
# -----------------------------------------------
35
36
sub init
37
{
38
	my($self, $arg)  = @_;
39
	$$arg{id_length} = 16; # Bytes.
40
	$$arg{verbose}   ||= 0;
41
42
} # End of init.
43
44
# -----------------------------------------------
45
46
sub new
47
{
48
	my($class, %arg) = @_;
49
50
	$class -> init(\%arg);
51
52
	return from_hash(bless({}, $class), \%arg);
53
54
} # End of new.
55
56
# -----------------------------------------------
57
58
1;
59
60
=pod
61
62
=head1 NAME
63
64
L<Data::Session::ID::UUID16> - A persistent session manager
65
66
=head1 Synopsis
67
68
See L<Data::Session> for details.
69
70
=head1 Case-sensitive Options
71
72
See L<Data::Session/Case-sensitive Options> for important information.
73
74
To use this module do this:
75
76
=over 4
77
78
=item o Specify an id generator of type UUID16, as Data::Session -> new(type => '... id:UUID16 ...')
79
80
=back
81
82
=head1 Description
83
84
L<Data::Session::ID::UUID16> allows L<Data::Session> to generate session ids using L<Data::UUID>.
85
86
=head1 Method: new()
87
88
Creates a new object of type L<Data::Session::ID::UUID16>.
89
90
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
91
might be mandatory.
92
93
The keys are listed here in alphabetical order.
94
95
They are lower-case because they are (also) method names, meaning they can be called to set or get
96
the value at any time.
97
98
=over 4
99
100
=item o verbose => $integer
101
102
Print to STDERR more or less information.
103
104
Typical values are 0, 1 and 2.
105
106
This key is normally passed in as Data::Session -> new(verbose => $integer).
107
108
This key is optional.
109
110
=back
111
112
=head1 Method: generate()
113
114
Generates the next session id, or dies if it can't.
115
116
The algorithm is Data::UUID -> new -> create_bin.
117
118
Returns the new id.
119
120
Note: A UUID16 hex string is not necessarily a valid UTF8 string, so you can't use UUID16
121
to generate ids which are to be stored in a Postgres table if the database was created like this (in
122
psql):
123
124
	create database a_db owner an_owner encoding 'UTF8';
125
126
Warning: This also means you should never try to use 'driver:File;id:UUID16;...', since the ids
127
generated by this module would rarely if ever be valid as a part of a file name.
128
129
=head1 Method: id_length()
130
131
Returns 16 because that's the number of bytes in a UUID16 digest.
132
133
This can be used to generate the SQL to create the sessions table.
134
135
See scripts/digest.pl.
136
137
=head1 Support
138
139
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
140
141
=head1 Author
142
143
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
144
145
Home page: L<http://savage.net.au/index.html>.
146
147
=head1 Copyright
148
149
Australian copyright (c) 2010, Ron Savage.
150
151
	All Programs of mine are 'OSI Certified Open Source Software';
152
	you can redistribute them and/or modify them under the terms of
153
	The Artistic License, a copy of which is available at:
154
	http://www.opensource.org/licenses/index.html
155
156
=cut
(-)a/lib/Data/Session/ID/UUID34.pm (+149 lines)
Line 0 Link Here
1
package Data::Session::ID::UUID34;
2
3
use parent 'Data::Session::ID';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Data::UUID;
9
10
use Hash::FieldHash ':all';
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub generate
17
{
18
	my($self) = @_;
19
20
	return Data::UUID -> new -> create_hex;
21
22
} # End of generate.
23
24
# -----------------------------------------------
25
26
sub id_length
27
{
28
	my($self) = @_;
29
30
	return 34;
31
32
} # End of id_length.
33
34
# -----------------------------------------------
35
36
sub init
37
{
38
	my($self, $arg)  = @_;
39
	$$arg{id_length} = 34; # Bytes.
40
	$$arg{verbose}   ||= 0;
41
42
} # End of init.
43
44
# -----------------------------------------------
45
46
sub new
47
{
48
	my($class, %arg) = @_;
49
50
	$class -> init(\%arg);
51
52
	return from_hash(bless({}, $class), \%arg);
53
54
} # End of new.
55
56
# -----------------------------------------------
57
58
1;
59
60
=pod
61
62
=head1 NAME
63
64
L<Data::Session::ID::UUID34> - A persistent session manager
65
66
=head1 Synopsis
67
68
See L<Data::Session> for details.
69
70
=head1 Description
71
72
L<Data::Session::ID::UUID34> allows L<Data::Session> to generate session ids using L<Data::UUID>.
73
74
To use this module do this:
75
76
=over 4
77
78
=item o Specify an id generator of type UUID34, as Data::Session -> new(type => '... id:UUID34 ...')
79
80
=back
81
82
=head1 Case-sensitive Options
83
84
See L<Data::Session/Case-sensitive Options> for important information.
85
86
=head1 Method: new()
87
88
Creates a new object of type L<Data::Session::ID::UUID34>.
89
90
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
91
might be mandatory.
92
93
The keys are listed here in alphabetical order.
94
95
They are lower-case because they are (also) method names, meaning they can be called to set or get
96
the value at any time.
97
98
=over 4
99
100
=item o verbose => $integer
101
102
Print to STDERR more or less information.
103
104
Typical values are 0, 1 and 2.
105
106
This key is normally passed in as Data::Session -> new(verbose => $integer).
107
108
This key is optional.
109
110
=back
111
112
=head1 Method: generate()
113
114
Generates the next session id, or dies if it can't.
115
116
The algorithm is Data::UUID -> new -> create_hex.
117
118
Returns the new id.
119
120
Note: L<Data::UUID> returns '0x' as the prefix of the 34-byte hex digest. You have been warned.
121
122
=head1 Method: id_length()
123
124
Returns 34 because that's the number of bytes in a UUID34 digest.
125
126
This can be used to generate the SQL to create the sessions table.
127
128
See scripts/digest.pl.
129
130
=head1 Support
131
132
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
133
134
=head1 Author
135
136
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
137
138
Home page: L<http://savage.net.au/index.html>.
139
140
=head1 Copyright
141
142
Australian copyright (c) 2010, Ron Savage.
143
144
	All Programs of mine are 'OSI Certified Open Source Software';
145
	you can redistribute them and/or modify them under the terms of
146
	The Artistic License, a copy of which is available at:
147
	http://www.opensource.org/licenses/index.html
148
149
=cut
(-)a/lib/Data/Session/ID/UUID36.pm (+147 lines)
Line 0 Link Here
1
package Data::Session::ID::UUID36;
2
3
use parent 'Data::Session::ID';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Data::UUID;
9
10
use Hash::FieldHash ':all';
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub generate
17
{
18
	my($self) = @_;
19
20
	return Data::UUID -> new -> create_str;
21
22
} # End of generate.
23
24
# -----------------------------------------------
25
26
sub id_length
27
{
28
	my($self) = @_;
29
30
	return 36;
31
32
} # End of id_length.
33
34
# -----------------------------------------------
35
36
sub init
37
{
38
	my($self, $arg)  = @_;
39
	$$arg{id_length} = 36; # Bytes.
40
	$$arg{verbose}   ||= 0;
41
42
} # End of init.
43
44
# -----------------------------------------------
45
46
sub new
47
{
48
	my($class, %arg) = @_;
49
50
	$class -> init(\%arg);
51
52
	return from_hash(bless({}, $class), \%arg);
53
54
} # End of new.
55
56
# -----------------------------------------------
57
58
1;
59
60
=pod
61
62
=head1 NAME
63
64
L<Data::Session::ID::UUID36> - A persistent session manager
65
66
=head1 Synopsis
67
68
See L<Data::Session> for details.
69
70
=head1 Description
71
72
L<Data::Session::ID::UUID36> allows L<Data::Session> to generate session ids using L<Data::UUID>.
73
74
To use this module do this:
75
76
=over 4
77
78
=item o Specify an id generator of type UUID36, as Data::Session -> new(type => '... id:UUID36 ...')
79
80
=back
81
82
=head1 Case-sensitive Options
83
84
See L<Data::Session/Case-sensitive Options> for important information.
85
86
=head1 Method: new()
87
88
Creates a new object of type L<Data::Session::ID::UUID36>.
89
90
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
91
might be mandatory.
92
93
The keys are listed here in alphabetical order.
94
95
They are lower-case because they are (also) method names, meaning they can be called to set or get
96
the value at any time.
97
98
=over 4
99
100
=item o verbose => $integer
101
102
Print to STDERR more or less information.
103
104
Typical values are 0, 1 and 2.
105
106
This key is normally passed in as Data::Session -> new(verbose => $integer).
107
108
This key is optional.
109
110
=back
111
112
=head1 Method: generate()
113
114
Generates the next session id, or dies if it can't.
115
116
The algorithm is Data::UUID -> new -> create_str.
117
118
Returns the new id.
119
120
=head1 Method: id_length()
121
122
Returns 36 because that's the number of bytes in a UUID36 digest.
123
124
This can be used to generate the SQL to create the sessions table.
125
126
See scripts/digest.pl.
127
128
=head1 Support
129
130
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
131
132
=head1 Author
133
134
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
135
136
Home page: L<http://savage.net.au/index.html>.
137
138
=head1 Copyright
139
140
Australian copyright (c) 2010, Ron Savage.
141
142
	All Programs of mine are 'OSI Certified Open Source Software';
143
	you can redistribute them and/or modify them under the terms of
144
	The Artistic License, a copy of which is available at:
145
	http://www.opensource.org/licenses/index.html
146
147
=cut
(-)a/lib/Data/Session/ID/UUID64.pm (+154 lines)
Line 0 Link Here
1
package Data::Session::ID::UUID64;
2
3
use parent 'Data::Session::ID';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Data::UUID;
9
10
use Hash::FieldHash ':all';
11
12
our $VERSION = '1.18';
13
14
# -----------------------------------------------
15
16
sub generate
17
{
18
	my($self) = @_;
19
20
	return Data::UUID -> new -> create_b64;
21
22
} # End of generate.
23
24
# -----------------------------------------------
25
26
sub id_length
27
{
28
	my($self) = @_;
29
30
	return 24; # sic.
31
32
} # End of id_length.
33
34
# -----------------------------------------------
35
36
sub init
37
{
38
	my($self, $arg)  = @_;
39
	$$arg{id_length} = 24; # Bytes.
40
	$$arg{verbose}   ||= 0;
41
42
} # End of init.
43
44
# -----------------------------------------------
45
46
sub new
47
{
48
	my($class, %arg) = @_;
49
50
	$class -> init(\%arg);
51
52
	return from_hash(bless({}, $class), \%arg);
53
54
} # End of new.
55
56
# -----------------------------------------------
57
58
1;
59
60
=pod
61
62
=head1 NAME
63
64
L<Data::Session::ID::UUID64> - A persistent session manager
65
66
=head1 Synopsis
67
68
See L<Data::Session> for details.
69
70
=head1 Description
71
72
L<Data::Session::ID::UUID64> allows L<Data::Session> to generate session ids using L<Data::UUID>.
73
74
To use this module do this:
75
76
=over 4
77
78
=item o Specify an id generator of type UUID64, as Data::Session -> new(type => '... id:UUID64 ...')
79
80
=back
81
82
Note: The uuid will be 24 (sic) bytes because that's the number of bytes in a UUID64 digest.
83
84
See scripts/digest.pl.
85
86
=head1 Case-sensitive Options
87
88
See L<Data::Session/Case-sensitive Options> for important information.
89
90
=head1 Method: new()
91
92
Creates a new object of type L<Data::Session::ID::UUID64>.
93
94
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
95
might be mandatory.
96
97
The keys are listed here in alphabetical order.
98
99
They are lower-case because they are (also) method names, meaning they can be called to set or get
100
the value at any time.
101
102
=over 4
103
104
=item o verbose => $integer
105
106
Print to STDERR more or less information.
107
108
Typical values are 0, 1 and 2.
109
110
This key is normally passed in as Data::Session -> new(verbose => $integer).
111
112
This key is optional.
113
114
=back
115
116
=head1 Method: generate()
117
118
Generates the next session id, or dies if it can't.
119
120
The algorithm is Data::UUID -> new -> create_b64.
121
122
Returns the new id.
123
124
Warning: You should never try to use 'driver:File;id:UUID64;...', since the ids generated by
125
this module sometimes contain '/', which the code forbids to be part of a file name.
126
127
=head1 Method: id_length()
128
129
Returns 24 (sic) because that's the number of bytes in a UUID64 digest.
130
131
This can be used to generate the SQL to create the sessions table.
132
133
See scripts/digest.pl.
134
135
=head1 Support
136
137
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
138
139
=head1 Author
140
141
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
142
143
Home page: L<http://savage.net.au/index.html>.
144
145
=head1 Copyright
146
147
Australian copyright (c) 2010, Ron Savage.
148
149
	All Programs of mine are 'OSI Certified Open Source Software';
150
	you can redistribute them and/or modify them under the terms of
151
	The Artistic License, a copy of which is available at:
152
	http://www.opensource.org/licenses/index.html
153
154
=cut
(-)a/lib/Data/Session/SHA.pm (+77 lines)
Line 0 Link Here
1
package Data::Session::SHA;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Digest::SHA;
9
10
use Hash::FieldHash ':all';
11
12
our $errstr  = '';
13
our $VERSION = '1.18';
14
15
# -----------------------------------------------
16
17
sub generate
18
{
19
	my($self, $bits) = @_;
20
21
	return Digest::SHA -> new($bits) -> add($$, time, rand(time) ) -> hexdigest;
22
23
} # End of generate.
24
25
# -----------------------------------------------
26
27
sub new
28
{
29
	my($class, %arg) = @_;
30
	$arg{verbose}    ||= 0;
31
32
	return from_hash(bless({}, $class), \%arg);
33
34
} # End of new.
35
36
# -----------------------------------------------
37
38
1;
39
40
=pod
41
42
=head1 NAME
43
44
L<Data::Session::SHA> - A persistent session manager
45
46
=head1 Synopsis
47
48
See L<Data::Session> for details.
49
50
=head1 Description
51
52
L<Data::Session::SHA> is the parent of all L<Data::Session::SHA::*> modules.
53
54
=head1 Case-sensitive Options
55
56
See L<Data::Session/Case-sensitive Options> for important information.
57
58
=head1 Support
59
60
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
61
62
=head1 Author
63
64
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
65
66
Home page: L<http://savage.net.au/index.html>.
67
68
=head1 Copyright
69
70
Australian copyright (c) 2010, Ron Savage.
71
72
	All Programs of mine are 'OSI Certified Open Source Software';
73
	you can redistribute them and/or modify them under the terms of
74
	The Artistic License, a copy of which is available at:
75
	http://www.opensource.org/licenses/index.html
76
77
=cut
(-)a/lib/Data/Session/Serialize/DataDumper.pm (+265 lines)
Line 0 Link Here
1
package Data::Session::Serialize::DataDumper;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Data::Dumper;
9
10
use Safe;
11
12
use Scalar::Util qw(blessed reftype refaddr);
13
14
use vars qw( %overloaded );
15
16
require overload;
17
18
our $VERSION = '1.18';
19
20
# -----------------------------------------------
21
22
sub freeze
23
{
24
	my($self, $data) = @_;
25
	my($d) = Data::Dumper -> new([$data], ["D"]);
26
27
	$d -> Deepcopy(0);
28
	$d -> Indent(0);
29
	$d -> Purity(1);
30
	$d -> Quotekeys(1);
31
	$d -> Terse(0);
32
	$d -> Useqq(0);
33
34
	return $d ->Dump;
35
36
} # End of freeze.
37
38
# -----------------------------------------------
39
40
sub new
41
{
42
	my($class) = @_;
43
44
	return bless({}, $class);
45
46
} # End of new.
47
48
# -----------------------------------------------
49
# We need to do this because the values we get back from the safe compartment
50
# will have packages defined from the safe compartment's *main instead of
51
# the one we use.
52
53
sub _scan
54
{
55
	# $_ gets aliased to each value from @_ which are aliases of the values in
56
	# the current data structure.
57
58
	for (@_)
59
	{
60
		if (blessed $_)
61
		{
62
			if (overload::Overloaded($_) )
63
			{
64
				my($address) = refaddr $_;
65
66
				# If we already rebuilt and reblessed this item, use the cached
67
				# copy so our ds is consistent with the one we serialized.
68
69
				if (exists $overloaded{$address})
70
				{
71
					$_ = $overloaded{$address};
72
				}
73
				else
74
				{
75
					my($reftype) = reftype $_;
76
77
					if ($reftype eq "HASH")
78
					{
79
						$_ = $overloaded{$address} = bless { %$_ }, ref $_;
80
					}
81
					elsif ($reftype eq "ARRAY")
82
					{
83
						$_ = $overloaded{$address} = bless [ @$_ ], ref $_;
84
					}
85
					elsif ($reftype eq "SCALAR" || $reftype eq "REF")
86
					{
87
						$_ = $overloaded{$address} = bless \do{my $o = $$_}, ref $_;
88
					}
89
					else
90
					{
91
						die __PACKAGE__ . ". Do not know how to reconstitute blessed object of base type $reftype";
92
					}
93
				}
94
			}
95
			else
96
			{
97
				bless $_, ref $_;
98
			}
99
		}
100
	}
101
102
	return @_;
103
104
} # End of _scan.
105
106
# -----------------------------------------------
107
108
sub thaw
109
{
110
	my($self, $data) = @_;
111
112
	# To make -T happy.
113
114
	my($safe_string) = $data =~ m/^(.*)$/s;
115
	my($rv)          = Safe -> new -> reval($safe_string);
116
117
	if ($@)
118
	{
119
		die __PACKAGE__ . ". Couldn't thaw. $@";
120
	}
121
122
	_walk($rv);
123
124
	return $rv;
125
126
} # End of thaw.
127
128
# -----------------------------------------------
129
130
sub _walk
131
{
132
	my(@filter) = _scan(shift);
133
134
	local %overloaded;
135
136
	my(%seen);
137
138
	# We allow the value assigned to a key to be undef.
139
	# Hence the defined() test is not in the while().
140
141
	while (@filter)
142
	{
143
		defined(my $x = shift @filter) or next;
144
145
		$seen{refaddr $x || ''}++ and next;
146
147
		# The original syntax my($r) = reftype($x) or next led to if ($r...)
148
		# issuing an uninit warning when $r was undef.
149
150
		my($r) = reftype($x) || next;
151
152
		if ($r eq "HASH")
153
		{
154
			# We use this form to make certain we have aliases
155
			# to the values in %$x and not copies.
156
157
			push @filter, _scan(@{$x}{keys %$x});
158
		}
159
		elsif ($r eq "ARRAY")
160
		{
161
			push @filter, _scan(@$x);
162
		}
163
		elsif ($r eq "SCALAR" || $r eq "REF")
164
		{
165
			push @filter, _scan($$x);
166
		}
167
	}
168
169
} # End of _walk.
170
171
# -----------------------------------------------
172
173
1;
174
175
=pod
176
177
=head1 NAME
178
179
L<Data::Session::Serialize::DataDumper> - A persistent session manager
180
181
=head1 Synopsis
182
183
See L<Data::Session> for details.
184
185
=head1 Description
186
187
L<Data::Session::Serialize::DataDumper> allows L<Data::Session> to manipulate sessions with
188
L<Data::Dumper>.
189
190
To use this module do this:
191
192
=over 4
193
194
=item o Specify a driver of type DataDumper as
195
Data::Session -> new(type=> '... serialize:DataDumper')
196
197
=back
198
199
The Data::Dumper options used are:
200
201
	$d -> Deepcopy(0);
202
	$d -> Indent(0);
203
	$d -> Purity(1);
204
	$d -> Quotekeys(1);
205
	$d -> Terse(0);
206
	$d -> Useqq(0);
207
208
=head1 Case-sensitive Options
209
210
See L<Data::Session/Case-sensitive Options> for important information.
211
212
=head1 Method: new()
213
214
Creates a new object of type L<Data::Session::Serialize::DataDumper>.
215
216
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
217
might be mandatory.
218
219
The keys are listed here in alphabetical order.
220
221
They are lower-case because they are (also) method names, meaning they can be called to set or get
222
the value at any time.
223
224
=over 4
225
226
=item o verbose => $integer
227
228
Print to STDERR more or less information.
229
230
Typical values are 0, 1 and 2.
231
232
This key is normally passed in as Data::Session -> new(verbose => $integer).
233
234
This key is optional.
235
236
=back
237
238
=head1 Method: freeze($data)
239
240
Returns $data frozen by L<Data::Dumper>.
241
242
=head1 Method: thaw($data)
243
244
Returns $data thawed by L<Data::Dumper>.
245
246
=head1 Support
247
248
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
249
250
=head1 Author
251
252
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
253
254
Home page: L<http://savage.net.au/index.html>.
255
256
=head1 Copyright
257
258
Australian copyright (c) 2010, Ron Savage.
259
260
	All Programs of mine are 'OSI Certified Open Source Software';
261
	you can redistribute them and/or modify them under the terms of
262
	The Artistic License, a copy of which is available at:
263
	http://www.opensource.org/licenses/index.html
264
265
=cut
(-)a/lib/Data/Session/Serialize/FreezeThaw.pm (+127 lines)
Line 0 Link Here
1
package Data::Session::Serialize::FreezeThaw;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use FreezeThaw;
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub freeze
15
{
16
	my($self, $data) = @_;
17
18
	return FreezeThaw::freeze($data);
19
20
} # End of freeze.
21
22
# -----------------------------------------------
23
24
sub new
25
{
26
	my($class) = @_;
27
28
	return bless({}, $class);
29
30
} # End of new.
31
32
# -----------------------------------------------
33
34
sub thaw
35
{
36
	my($self, $data) = @_;
37
38
	return (FreezeThaw::thaw($data) )[0];
39
40
} # End of thaw.
41
42
# -----------------------------------------------
43
44
1;
45
46
=pod
47
48
=head1 NAME
49
50
L<Data::Session::Serialize::FreezeThaw> - A persistent session manager
51
52
=head1 Synopsis
53
54
See L<Data::Session> for details.
55
56
=head1 Description
57
58
L<Data::Session::Serialize::FreezeThaw> allows L<Data::Session> to manipulate sessions with
59
L<FreezeThaw>.
60
61
To use this module do this:
62
63
=over 4
64
65
=item o Specify a driver of type FreezeThaw as
66
Data::Session -> new(type => '... serialize:FreezeThaw')
67
68
=back
69
70
=head1 Case-sensitive Options
71
72
See L<Data::Session/Case-sensitive Options> for important information.
73
74
=head1 Method: new()
75
76
Creates a new object of type L<Data::Session::Serialize::FreezeThaw>.
77
78
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
79
might be mandatory.
80
81
The keys are listed here in alphabetical order.
82
83
They are lower-case because they are (also) method names, meaning they can be called to set or get
84
the value at any time.
85
86
=over 4
87
88
=item o verbose => $integer
89
90
Print to STDERR more or less information.
91
92
Typical values are 0, 1 and 2.
93
94
This key is normally passed in as Data::Session -> new(verbose => $integer).
95
96
This key is optional.
97
98
=back
99
100
=head1 Method: freeze($data)
101
102
Returns $data frozen by L<FreezeThaw>.
103
104
=head1 Method: thaw($data)
105
106
Returns $data thawed by L<FreezeThaw>.
107
108
=head1 Support
109
110
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
111
112
=head1 Author
113
114
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
115
116
Home page: L<http://savage.net.au/index.html>.
117
118
=head1 Copyright
119
120
Australian copyright (c) 2010, Ron Savage.
121
122
	All Programs of mine are 'OSI Certified Open Source Software';
123
	you can redistribute them and/or modify them under the terms of
124
	The Artistic License, a copy of which is available at:
125
	http://www.opensource.org/licenses/index.html
126
127
=cut
(-)a/lib/Data/Session/Serialize/JSON.pm (+125 lines)
Line 0 Link Here
1
package Data::Session::Serialize::JSON;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use JSON;
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub freeze
15
{
16
	my($self, $data) = @_;
17
18
	return JSON -> new -> encode($data);
19
20
} # End of freeze.
21
22
# -----------------------------------------------
23
24
sub new
25
{
26
	my($class) = @_;
27
28
	return bless({}, $class);
29
30
} # End of new.
31
32
# -----------------------------------------------
33
34
sub thaw
35
{
36
	my($self, $data) = @_;
37
38
	return JSON -> new -> decode($data);
39
40
} # End of thaw.
41
42
# -----------------------------------------------
43
44
1;
45
46
=pod
47
48
=head1 NAME
49
50
L<Data::Session::Serialize::JSON> - A persistent session manager
51
52
=head1 Synopsis
53
54
See L<Data::Session> for details.
55
56
=head1 Description
57
58
L<Data::Session::Serialize::JSON> allows L<Data::Session> to manipulate sessions with L<JSON>.
59
60
To use this module do this:
61
62
=over 4
63
64
=item o Specify a driver of type JSON as Data::Session -> new(type => '... serialize:JSON')
65
66
=back
67
68
=head1 Case-sensitive Options
69
70
See L<Data::Session/Case-sensitive Options> for important information.
71
72
=head1 Method: new()
73
74
Creates a new object of type L<Data::Session::Serialize::JSON>.
75
76
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
77
might be mandatory.
78
79
The keys are listed here in alphabetical order.
80
81
They are lower-case because they are (also) method names, meaning they can be called to set or get
82
the value at any time.
83
84
=over 4
85
86
=item o verbose => $integer
87
88
Print to STDERR more or less information.
89
90
Typical values are 0, 1 and 2.
91
92
This key is normally passed in as Data::Session -> new(verbose => $integer).
93
94
This key is optional.
95
96
=back
97
98
=head1 Method: freeze($data)
99
100
Returns $data frozen by L<JSON>.
101
102
=head1 Method: thaw($data)
103
104
Returns $data thawed by L<JSON>.
105
106
=head1 Support
107
108
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
109
110
=head1 Author
111
112
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
113
114
Home page: L<http://savage.net.au/index.html>.
115
116
=head1 Copyright
117
118
Australian copyright (c) 2010, Ron Savage.
119
120
	All Programs of mine are 'OSI Certified Open Source Software';
121
	you can redistribute them and/or modify them under the terms of
122
	The Artistic License, a copy of which is available at:
123
	http://www.opensource.org/licenses/index.html
124
125
=cut
(-)a/lib/Data/Session/Serialize/Storable.pm (+129 lines)
Line 0 Link Here
1
package Data::Session::Serialize::Storable;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use Storable;
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub freeze
15
{
16
	my($self, $data) = @_;
17
18
	return Storable::freeze($data);
19
20
} # End of freeze.
21
22
# -----------------------------------------------
23
24
sub new
25
{
26
	my($class) = @_;
27
28
	return bless({}, $class);
29
30
} # End of new.
31
32
# -----------------------------------------------
33
34
sub thaw
35
{
36
	my($self, $data) = @_;
37
38
	return Storable::thaw($data);
39
40
} # End of thaw.
41
42
# -----------------------------------------------
43
44
1;
45
46
=pod
47
48
=head1 NAME
49
50
L<Data::Session::Serialize::Storable> - A persistent session manager
51
52
=head1 Synopsis
53
54
See L<Data::Session> for details.
55
56
Warning: Storable should be avoided until this problem is fixed:
57
L<http://rt.cpan.org/Public/Bug/Display.html?id=36087>
58
59
=head1 Description
60
61
L<Data::Session::Serialize::Storable> allows L<Data::Session> to manipulate sessions with
62
L<Storable>.
63
64
To use this module do this:
65
66
=over 4
67
68
=item o Specify a driver of type Storable as Data::Session -> new(type => '... serialize:Storable')
69
70
=back
71
72
=head1 Case-sensitive Options
73
74
See L<Data::Session/Case-sensitive Options> for important information.
75
76
=head1 Method: new()
77
78
Creates a new object of type L<Data::Session::Serialize::Storable>.
79
80
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
81
might be mandatory.
82
83
The keys are listed here in alphabetical order.
84
85
They are lower-case because they are (also) method names, meaning they can be called to set or get
86
the value at any time.
87
88
=over 4
89
90
=item o verbose => $integer
91
92
Print to STDERR more or less information.
93
94
Typical values are 0, 1 and 2.
95
96
This key is normally passed in as Data::Session -> new(verbose => $integer).
97
98
This key is optional.
99
100
=back
101
102
=head1 Method: freeze($data)
103
104
Returns $data frozen by L<Storable>.
105
106
=head1 Method: thaw($data)
107
108
Returns $data thawed by L<Storable>.
109
110
=head1 Support
111
112
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
113
114
=head1 Author
115
116
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
117
118
Home page: L<http://savage.net.au/index.html>.
119
120
=head1 Copyright
121
122
Australian copyright (c) 2010, Ron Savage.
123
124
	All Programs of mine are 'OSI Certified Open Source Software';
125
	you can redistribute them and/or modify them under the terms of
126
	The Artistic License, a copy of which is available at:
127
	http://www.opensource.org/licenses/index.html
128
129
=cut
(-)a/lib/Data/Session/Serialize/YAML.pm (-1 / +125 lines)
Line 0 Link Here
0
- 
1
package Data::Session::Serialize::YAML;
2
3
use parent 'Data::Session::Base';
4
no autovivification;
5
use strict;
6
use warnings;
7
8
use YAML::Tiny ();
9
10
our $VERSION = '1.18';
11
12
# -----------------------------------------------
13
14
sub freeze
15
{
16
	my($self, $data) = @_;
17
18
	return YAML::Tiny::freeze($data);
19
20
} # End of freeze.
21
22
# -----------------------------------------------
23
24
sub new
25
{
26
	my($class) = @_;
27
28
	return bless({}, $class);
29
30
} # End of new.
31
32
# -----------------------------------------------
33
34
sub thaw
35
{
36
	my($self, $data) = @_;
37
38
	return YAML::Tiny::thaw($data);
39
40
} # End of thaw.
41
42
# -----------------------------------------------
43
44
1;
45
46
=pod
47
48
=head1 NAME
49
50
L<Data::Session::Serialize::YAML> - A persistent session manager
51
52
=head1 Synopsis
53
54
See L<Data::Session> for details.
55
56
=head1 Description
57
58
L<Data::Session::Serialize::YAML> allows L<Data::Session> to manipulate sessions with L<YAML::Tiny>.
59
60
To use this module do this:
61
62
=over 4
63
64
=item o Specify a driver of type YAML as Data::Session -> new(type => '... serialize:YAML')
65
66
=back
67
68
=head1 Case-sensitive Options
69
70
See L<Data::Session/Case-sensitive Options> for important information.
71
72
=head1 Method: new()
73
74
Creates a new object of type L<Data::Session::Serialize::YAML>.
75
76
C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations
77
might be mandatory.
78
79
The keys are listed here in alphabetical order.
80
81
They are lower-case because they are (also) method names, meaning they can be called to set or get
82
the value at any time.
83
84
=over 4
85
86
=item o verbose => $integer
87
88
Print to STDERR more or less information.
89
90
Typical values are 0, 1 and 2.
91
92
This key is normally passed in as Data::Session -> new(verbose => $integer).
93
94
This key is optional.
95
96
=back
97
98
=head1 Method: freeze($data)
99
100
Returns $data frozen by L<YAML::Tiny>.
101
102
=head1 Method: thaw($data)
103
104
Returns $data thawed by L<YAML::Tiny>.
105
106
=head1 Support
107
108
Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>.
109
110
=head1 Author
111
112
L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010.
113
114
Home page: L<http://savage.net.au/index.html>.
115
116
=head1 Copyright
117
118
Australian copyright (c) 2010, Ron Savage.
119
120
	All Programs of mine are 'OSI Certified Open Source Software';
121
	you can redistribute them and/or modify them under the terms of
122
	The Artistic License, a copy of which is available at:
123
	http://www.opensource.org/licenses/index.html
124
125
=cut

Return to bug 17427