line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Attribute::Persistent; |
2
|
2
|
|
|
2
|
|
1104
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
280
|
|
3
|
|
|
|
|
|
|
our $VERSION = "1.1"; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
my $key; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
require Digest::MD5; |
8
|
|
|
|
|
|
|
local *IN; |
9
|
|
|
|
|
|
|
if (-e $0 and open IN, $0) { |
10
|
|
|
|
|
|
|
local $/; |
11
|
|
|
|
|
|
|
my $x = ; |
12
|
|
|
|
|
|
|
$key = Digest::MD5::md5_hex($x); |
13
|
|
|
|
|
|
|
close IN; |
14
|
|
|
|
|
|
|
} else { |
15
|
|
|
|
|
|
|
$key = "Persistent$0"; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
1; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
package UNIVERSAL; |
21
|
2
|
|
|
2
|
|
2230
|
use Attribute::Handlers::Prospective; |
|
2
|
|
|
|
|
660657
|
|
|
2
|
|
|
|
|
18
|
|
22
|
2
|
|
|
2
|
|
915583
|
use File::Spec::Functions (':ALL'); |
|
2
|
|
|
|
|
176790
|
|
|
2
|
|
|
|
|
512
|
|
23
|
2
|
|
|
2
|
|
76
|
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } |
24
|
2
|
|
|
2
|
|
1889
|
use AnyDBM_File; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use MLDBM qw(AnyDBM_File); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
no strict; # Attributes do evil things |
28
|
|
|
|
|
|
|
sub persistent :ATTR(RAWDATA) { |
29
|
|
|
|
|
|
|
my $name = *{$_[1]}{NAME}; |
30
|
|
|
|
|
|
|
$name =~ /LEXICAL\((.*)\)/ or do { |
31
|
|
|
|
|
|
|
require Carp; |
32
|
|
|
|
|
|
|
croak("Can only define :persistent on lexicals"); |
33
|
|
|
|
|
|
|
}; |
34
|
|
|
|
|
|
|
my $origname = $1; |
35
|
|
|
|
|
|
|
$name = $origname; |
36
|
|
|
|
|
|
|
my $type; |
37
|
|
|
|
|
|
|
$name =~ s/^\$/S-/ |
38
|
|
|
|
|
|
|
and do { require Carp; croak ("Can't persist scalars yet"); }; |
39
|
|
|
|
|
|
|
$name =~ s/^\%/H-/ and $type = '%'; |
40
|
|
|
|
|
|
|
$name =~ s/^\@/A-/ and $type = '@'; |
41
|
|
|
|
|
|
|
# But ... |
42
|
|
|
|
|
|
|
if ($_[4] ne "undef") { $name = $_[4]; } |
43
|
|
|
|
|
|
|
$name =~ s/\W+/-/g; |
44
|
|
|
|
|
|
|
my $filename = catdir(tmpdir(),"$key-$_[0]-$name"); |
45
|
|
|
|
|
|
|
tie (($type eq "%" ? %{$_[2]} : @{$_[2]}), "MLDBM", $filename) |
46
|
|
|
|
|
|
|
or do {require Carp; croak("Couldn't tie $origname to $filename - $!")}; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
1; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head1 NAME |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Attribute::Persistent - Really lazy persistence |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 SYNOPSIS |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
use Attribute::Persistent; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
my %hash :persistent; |
60
|
|
|
|
|
|
|
$hash{counter}++; # Value retained between calls to the program. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my %hash2 :persistent(SessionTable); # Explicitly provide a filename. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head1 DESCRIPTION |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
This module provides a way of abstracting away persistence of array and |
67
|
|
|
|
|
|
|
hash variables. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
It's useful for quick hacks when you don't care about pulling in the |
70
|
|
|
|
|
|
|
right DBM library and calling C and so on. Its job is to reduce |
71
|
|
|
|
|
|
|
fuss for the lazy programmer at the cost of flexibility. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
It uses C, so you can use complex data structures in your arrays |
74
|
|
|
|
|
|
|
and hashes. It uses C, so if you really care about which |
75
|
|
|
|
|
|
|
DBM you get, you can modify C in a C block |
76
|
|
|
|
|
|
|
B loading this module. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
It works out which DBMs belong to it by taking an md5 sum of the source |
79
|
|
|
|
|
|
|
code. This means that if you change your code, you lose your data. |
80
|
|
|
|
|
|
|
If you like to keep your data while messing about with your code, you |
81
|
|
|
|
|
|
|
need to explicitly give C a key, like this: |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
BEGIN { $Attribute::Persistent::KEY = "MyProgram"; } |
84
|
|
|
|
|
|
|
use Attribute::Persistent; # Order is important. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
This uniquely identifies your program, meaning that the module doesn't |
87
|
|
|
|
|
|
|
have to grub around with C<$0> and md5 sums. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
But hell, it's not supposed to be this complex. Just use the module and |
90
|
|
|
|
|
|
|
slap C<:persistent> onto your lexicals where appropriate, and it just |
91
|
|
|
|
|
|
|
works. That's all most people need to care about. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head1 AUTHOR |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Originally by Simon Cozens, C |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Maintained by Scott Penrose, C |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 LICENSE |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Artistic and GPL. |