File Coverage

blib/lib/Attribute/Persistent.pm
Criterion Covered Total %
statement 11 13 84.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 16 18 88.8


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.