1 package Yaala::Data::Persistent;
6 =head1 Yaala::Data::Persistent
8 Saves datastructures to disk and retrieves them again. This allows data
9 to exist for longer than just one run.
13 use Yaala::Config qw#get_config get_checksum#;
15 @Yaala::Data::Persistent::EXPORT_OK = qw#init#;
16 @Yaala::Data::Persistent::ISA = ('Exporter');
18 our $HAVE_STORABLE = 0;
19 our $WANT_PERSISTENCY = 1;
20 our $DATA_STRUCTURE = {};
21 our $FILENAME = 'persistency.data';
23 my $VERSION = '$Id: Persistent.pm,v 1.5 2004/11/07 11:15:28 octo Exp $';
24 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
26 eval "use Storable qw#store retrieve#;";
30 print STDERR ' - Storable is installed' if ($::DEBUG);
34 print STDERR ' - Storable is NOT installed' if ($::DEBUG);
37 =head1 Configuration options
39 =head2 use_persistency
41 If set to false persistency will not be used, even if the required
42 module ``Storable'' is installed.
44 If unset it defaults to automatic detection of the ``Storable'' module
45 and uses persistency if possible.
49 if (get_config ('use_persistency'))
51 my $want = lc (get_config ('use_persistency'));
52 if ($want eq 'no' or $want eq 'false' or $want eq 'off')
54 $WANT_PERSISTENCY = 0;
56 elsif ($want eq 'yes' or $want eq 'true' or $want eq 'on')
60 print STDERR $/, __FILE__, ": You've set ``use_persistency'' to ``$want''.",
61 $/, __FILE__, " For this to work you need to have the perl module ``Storable'' installed.",
62 $/, __FILE__, ' Please go to your nearest CPAN-mirror and install it first.',
63 $/, __FILE__, ' This config-option will be ignored.';
66 elsif ($want eq 'auto' or $want eq 'automatic')
68 # do nothing.. Already been done.
72 print STDERR $/, __FILE__, ": You've set ``use_persistency'' to ``$want''.",
73 $/, __FILE__, ' This value is not understood and is being ignored.';
77 =head2 persistency_file
79 Sets the file to store persistency data in. Defaults to
84 if (get_config ('persistency_file'))
86 $FILENAME = get_config ('persistency_file');
89 if ($HAVE_STORABLE and $WANT_PERSISTENCY and -e $FILENAME)
91 $DATA_STRUCTURE = retrieve ($FILENAME);
93 my $checksum = get_checksum ();
94 print STDERR $/, __FILE__, ": Config-checksum is ``$checksum''" if ($::DEBUG & 0x200);
96 if (!defined ($DATA_STRUCTURE))
98 print STDERR $/, __FILE__, ": Persistent data could not be loaded.",
99 $/, __FILE__, "``$FILENAME'' will be overwritten when the program exits.";
100 $DATA_STRUCTURE = {'*CHECKSUM*' => $checksum};
104 if (!defined ($DATA_STRUCTURE->{'*CHECKSUM*'})
105 or ($DATA_STRUCTURE->{'*CHECKSUM*'} ne $checksum))
107 print STDERR $/, __FILE__, ": Persistent data could be read, but checksums didn't match.",
108 $/, __FILE__, ": The data will not be used and the file overwritten." if ($::DEBUG);
112 if (!defined ($DATA_STRUCTURE->{'*CHECKSUM*'}))
114 print STDERR $/, __FILE__, ": \$DATA_STRUCTURE->{'*CHECKSUM*'} isn't defined.";
118 my $tmp = $DATA_STRUCTURE->{'*CHECKSUM*'};
119 print STDERR $/, __FILE__, ": ``$tmp'' ne ``$checksum''";
123 $DATA_STRUCTURE = {'*CHECKSUM*' => $checksum};
127 elsif ($HAVE_STORABLE and $WANT_PERSISTENCY and !-e $FILENAME)
129 my $checksum = get_checksum ();
130 print STDERR $/, __FILE__, ": Config-checksum is ``$checksum''" if ($::DEBUG & 0x200);
132 $DATA_STRUCTURE = {'*CHECKSUM*' => $checksum};
139 if (!$HAVE_STORABLE) { return (undef); }
145 $DATA_STRUCTURE->{$pkg}{$name} = $ptr;
150 if (!$HAVE_STORABLE) { return (undef); }
156 if (defined ($DATA_STRUCTURE->{$pkg}{$name}))
158 $ptr = $DATA_STRUCTURE->{$pkg}{$name};
164 =head1 Exported routines
166 =head2 init ($name, $type)
168 Initializes a variable in the persistency-namespace which is daved
169 automatically upon termination.
171 The type is needed for proper initialisazion when the persistency-file
172 could not be read. Valid veriable types are ``scalar'', ``hash'' and
175 The name must be uniqe for each package so the module can identify which
176 variable is requested,
187 if (defined ($DATA_STRUCTURE->{$pkg}{$name}))
189 $ptr = $DATA_STRUCTURE->{$pkg}{$name};
193 if ($type eq 'scalar')
198 elsif ($type eq 'hash')
203 elsif ($type eq 'array')
213 $DATA_STRUCTURE->{$pkg}{$name} = $ptr;
221 if ($HAVE_STORABLE and $WANT_PERSISTENCY)
223 print STDERR $/, __FILE__, ": Writing persistent data to ``$FILENAME''" if ($::DEBUG);
224 store ($DATA_STRUCTURE, $FILENAME);