Сделал такой модуль:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
use utf8;
use strict;
use warnings;
use boolean;
use JSON;
my $json = JSON->new->allow_nonref->allow_blessed->convert_blessed->relaxed;
my $done;
package Store;
our $debug;
our $scope;
our $data = {};
#tie %$data, 'Tie::IxHash';
sub _log($;$)
{
return undef unless ($Store::debug||0);
my $msg = shift;
my $var = shift;
my $tag = "[$$ Store]: ";
print $tag, $msg, "\n";
use Data::Dumper;
$Data::Dumper::Useperl = 1;
$Data::Dumper::Indent = 0;
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Purity = 1;
$Data::Dumper::Pair = ':';
$var = Dumper($var) if (defined($var) && ref($var));
print ' ' x (length($tag)-2), ': ', $var, "\n" if (defined($var));
}
sub _scope(;$)
{
my $file = (shift||$0);
$file = substr($file, rindex($file,'/')+1) unless (rindex($file,'/')<0);
$file = substr($file, 0, index($file,'.pl')) unless (rindex($file,'.pl')<0);
return $file;
}
sub _get()
{
my $file = '/tmp/store_'.&_scope($scope).'.json';
&_log('Read data: '.$file);
my $size = -s $file;
unless ($size)
{
$done = 1;
&_log('Read done , empty data');
return;
}
open(JSON, "<", $file);
read(JSON, my $buff, $size);
close(JSON);
$buff = $json->decode($buff);
$data->{$_} = ($buff->{$_}) foreach (keys %$buff);
$done = 1;
&_log('Read done', $data);
}
sub _set()
{
return unless ($done);
my $file = '/tmp/store_'.&_scope($scope).'.json';
&_log('Store data: '.$file);
open(JSON, ">:utf8", $file);
print JSON $json->encode($data);
close(JSON);
}
INIT { &_get(); }
END { &_set(); }
sub new
{
my $this = shift;
my $scope = shift;
my $class = ref($this)||$this;
$Store::scope = &_scope($scope) if (defined $scope);
&_log('New instance');
my $self = {};
bless $self, $class;
return $self;
}
sub DESTROY
{
my $self = shift;
&_log('Close instance');
}
sub data
{
my $self; $self = shift if (ref($_[0] eq __PACKAGE__));
while (my $arg = shift)
{
last unless ($arg);
unless (ref $arg)
{
my $val = shift;
$Store::data->{$arg} = $val;
next;
}
if (ref($arg) eq 'HASH')
{
while (my ($k,$v) = each(%$arg))
{
$Store::data->{$k} = $v;
}
next;
}
}
return $Store::data;
}
$done = 1;
1;
Получилось немного не так, как я хотел, но вроде бы все работает.
Но проблема с режимом отладки — на стадии CHECK (в которой вызывается процедура _get) переменные не инициализированы и поэтому отладочный вывод отсутствует.
Не посоветуете, как такие ситуации правильно разрешаются?
Может быть можно как-то передать список при подключении модуля — use Store qw(debug) ?
