File Coverage

blib/lib/App/MBUtiny/Storage/Local.pm
Criterion Covered Total %
statement 47 157 29.9
branch 1 48 2.0
condition 0 26 0.0
subroutine 13 19 68.4
pod 7 7 100.0
total 68 257 26.4


line stmt bran cond sub pod time code
1             package App::MBUtiny::Storage::Local; # $Id: Local.pm 121 2019-07-01 19:51:50Z abalama $
2 2     2   17 use strict;
  2         11  
  2         59  
3 2     2   9 use utf8;
  2         4  
  2         9  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             App::MBUtiny::Storage::Local - App::MBUtiny::Storage subclass for local storage support
10              
11             =head1 VIRSION
12              
13             Version 1.00
14              
15             =head1 SYNOPSIS
16              
17            
18            
19             #FixUP on
20             Localdir /path/to/foo/storage
21             Localdir /path/to/bar/storage
22             Comment Local storage said blah-blah-blah # Optional for collector
23            
24              
25             # . . .
26              
27            
28              
29             =head1 DESCRIPTION
30              
31             App::MBUtiny::Storage subclass for local storage support
32              
33             =head2 del
34              
35             Removes the specified file.
36             This is backend method of L
37              
38             =head2 get
39              
40             Gets the backup file from storage and saves it to specified path.
41             This is backend method of L
42              
43             =head2 init
44              
45             The method performs initialization of storage.
46             This is backend method of L
47              
48             =head2 list
49              
50             Gets backup file list on storage.
51             This is backend method of L
52              
53             =head2 local_storages
54              
55             my @list = $storage->local_storages;
56              
57             Returns list of local storage nodes
58              
59             =head2 put
60              
61             Sends backup file to storage.
62             This is backend method of L
63              
64             =head2 test
65              
66             Storage testing.
67             This is backend method of L
68              
69             =head1 HISTORY
70              
71             See C file
72              
73             =head1 TO DO
74              
75             See C file
76              
77             =head1 BUGS
78              
79             * none noted
80              
81             =head1 SEE ALSO
82              
83             L
84              
85             =head1 AUTHOR
86              
87             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
88              
89             =head1 COPYRIGHT
90              
91             Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved
92              
93             =head1 LICENSE
94              
95             This program is free software; you can redistribute it and/or
96             modify it under the same terms as Perl itself.
97              
98             See C file and L
99              
100             =cut
101              
102 2     2   79 use vars qw/ $VERSION /;
  2         3  
  2         103  
103             $VERSION = '1.00';
104              
105 2     2   1346 use Storable qw/dclone/;
  2         6685  
  2         135  
106 2     2   16 use File::Spec;
  2         5  
  2         60  
107 2     2   1052 use File::Copy qw/copy/;
  2         4900  
  2         126  
108 2     2   15 use List::Util qw/uniq/;
  2         5  
  2         125  
109              
110 2     2   969 use App::MBUtiny::Util qw/ filesize node2anode /;
  2         6  
  2         185  
111              
112 2     2   650 use CTK::Util qw/ preparedir getlist /;
  2         162400  
  2         194  
113 2     2   15 use CTK::ConfGenUtil;
  2         4  
  2         135  
114 2     2   12 use CTK::TFVals qw/ :ALL /;
  2         5  
  2         483  
115              
116             use constant {
117 2         2924 STORAGE_SIGN => 'Local',
118 2     2   15 };
  2         3  
119              
120             sub init {
121 1     1 1 39 my $self = shift;
122 1         4 $self->maybe::next::method();
123 1         5 $self->storage_status(STORAGE_SIGN, -1);
124              
125 1         3 my $uselocal = 0;
126 1         5 my $local_nodes = dclone(node2anode(node($self->{host}, 'local')));
127 1         4 $self->{local_nodes} = $local_nodes;
128 1         2 my %local_dirs;
129 1         3 foreach my $local_node (@$local_nodes) {
130 0   0     0 my $localdirs = array($local_node, 'localdir') || [];
131 0         0 foreach my $dir (@$localdirs) {
132 0 0 0     0 if ((-e $dir) && (-d $dir or -l $dir)) {
      0        
133 0         0 $local_dirs{$dir} = 1;
134             } else {
135 0 0       0 if (preparedir($dir)) {
136 0         0 $local_dirs{$dir} = 1;
137             }
138             }
139 0 0       0 $uselocal++ if $local_dirs{$dir};
140             }
141             }
142 1         6 $self->{local_dirs} = [(keys(%local_dirs))];
143              
144 1 50       4 $self->storage_status(STORAGE_SIGN, $uselocal) if $uselocal;
145             #print explain($self->{local_dirs}), "\n";
146              
147 1         3 return $self;
148             }
149             sub local_storages {
150 0     0 1   my $self = shift;
151 0   0       my $storages = $self->{local_nodes} || [];
152 0           return @$storages;
153             }
154             sub test {
155 0     0 1   my $self = shift;
156 0           my %params = @_; $self->maybe::next::method(%params);
  0            
157 0           my $sign = STORAGE_SIGN;
158 0 0         return -1 if $self->storage_status($sign) <= 0; # SKIP
159 0           my $dirs = $self->{local_dirs};
160 0           my @test = ();
161 0           foreach my $dir (@$dirs) {
162 0 0         if (-e $dir) {
163 0           push @test, [1, $dir];
164             } else {
165 0           $self->storage_status($sign, 0);
166 0           push @test, [0, $dir, "Directory \"$dir\" not found"];
167             }
168             }
169 0           $self->{test}->{$sign} = [@test];
170 0           return 1;
171             }
172             sub put {
173 0     0 1   my $self = shift;
174 0           my %params = @_; $self->maybe::next::method(%params);
  0            
175 0 0         return $self->storage_status(STORAGE_SIGN, -1) if $self->storage_status(STORAGE_SIGN) <= 0; # SKIP and set SKIP
176 0           my $status = 1;
177 0           my $name = $params{name};
178 0           my $file = $params{file};
179              
180 0           my $local_nodes = $self->{local_nodes};
181 0           foreach my $local_node (@$local_nodes) {
182 0           my $ostat = 1;
183 0   0       my $localdirs = array($local_node, 'localdir') || [];
184 0           my @dirs = ();
185 0           foreach my $dir (@$localdirs) {
186 0           my $dst = File::Spec->catfile($dir, $name);
187 0 0         if (copy($file, $dst)) {
188 0   0       $params{size} ||= 0;
189 0   0       my $size = filesize($file) // 0;
190 0 0         if ($size == $params{size}) {
191 0           push @dirs, $dir;
192             } else {
193 0           $self->error(sprintf("Copy \"%s\" to \"%s\" failed: size is different", $name, $dir, $!));
194 0           $ostat = 0;
195 0           $status = 0;
196             }
197             } else {
198 0           $self->error(sprintf("Copy \"%s\" to \"%s\" failed: %s", $name, $dir, $!));
199 0           $ostat = 0;
200 0           $status = 0;
201             };
202             }
203 0 0         my $storages_comment = @dirs ? join("; ", @dirs) : "No real local storages";
204 0           my $comment = join("\n", grep {$_} ($storages_comment, value($local_node, 'comment')));
  0            
205 0 0         $self->fixup("put", $ostat, $comment) if value($local_node, 'fixup'); # Fixup!
206             }
207 0 0         $self->storage_status(STORAGE_SIGN, 0) unless $status;
208             }
209             sub get {
210 0     0 1   my $self = shift;
211 0           my %params = @_;
212 0 0         if ($self->storage_status(STORAGE_SIGN) <= 0) { # SKIP and set SKIP
213 0           $self->maybe::next::method(%params);
214 0           return $self->storage_status(STORAGE_SIGN, -1);
215             }
216 0           my $name = $params{name}; # archive name
217 0           my $file = $params{file}; # destination archive file path
218              
219 0           foreach my $local_node ($self->local_storages) {
220 0   0       my $localdirs = array($local_node, 'localdir') || [];
221 0           foreach my $dir (@$localdirs) {
222 0           my $src = File::Spec->catfile($dir, $name);
223 0   0       my $src_size = filesize($src) // 0;
224 0 0         if (copy($src, $file)) {
225 0   0       my $dst_size = filesize($file) // 0;
226 0 0         if ($src_size == $dst_size) {
227 0 0         unless ($self->validate($file)) { # FAIL validation!
228 0           $self->error(sprintf("Local storage dir %s failed: file %s is not valid!", $dir, $file));
229 0           next;
230             }
231 0           return $self->storage_status(STORAGE_SIGN, 1); # Done!
232             } else {
233 0           $self->error(sprintf("Copy \"%s\" to \"%s\" failed: size is different", $src, $file, $!));
234             }
235             } else {
236 0           $self->error(sprintf("Copy \"%s\" to \"%s\" failed: %s", $src, $file, $!));
237             };
238             }
239             }
240 0           $self->storage_status(STORAGE_SIGN, 0);
241 0           $self->maybe::next::method(%params);
242             }
243             sub del {
244 0     0 1   my $self = shift;
245 0           my $name = shift;
246 0           $self->maybe::next::method($name);
247 0 0         return $self->storage_status(STORAGE_SIGN, -1) if $self->storage_status(STORAGE_SIGN) <= 0; # SKIP and set SKIP
248 0           my $status = 1;
249 0           my $local_nodes = $self->{local_nodes};
250 0           foreach my $local_node (@$local_nodes) {
251 0   0       my $localdirs = array($local_node, 'localdir') || [];
252 0           my @dirs = ();
253 0           foreach my $dir (@$localdirs) {
254 0           my $file = File::Spec->catfile($dir, $name);
255 0 0         next unless -e $file;
256 0 0         if (unlink($file)) {
257 0 0         if (-e $file) {
258 0           $self->error(sprintf("Unlink \"%s\" failed", $file));
259 0           $status = 0;
260             }
261             } else {
262 0           $self->error(sprintf("Unlink \"%s\" failed: %s", $file, $!));
263 0           $status = 0;
264             }
265             }
266 0 0         $self->fixup("del", $name) if value($local_node, 'fixup'); # Fixup!
267             }
268 0 0         $self->storage_status(STORAGE_SIGN, 0) unless $status;
269             }
270             sub list {
271 0     0 1   my $self = shift;
272 0           my %params = @_; $self->maybe::next::method(%params);
  0            
273 0 0         return $self->storage_status(STORAGE_SIGN, -1) if $self->storage_status(STORAGE_SIGN) <= 0; # SKIP and set SKIP
274 0           my $sign = STORAGE_SIGN;
275 0           my $dirs = $self->{local_dirs};
276 0           my @list = ();
277 0           foreach my $dir (@$dirs) {
278 0 0         if (-e $dir) {
279 0   0       my $l = getlist($dir) || [];
280 0           push @list, @$l;
281             }
282             }
283 0           $self->{list}->{$sign} = [uniq(@list)];
284 0           return 1;
285             }
286              
287             1;
288              
289             __END__