File Coverage

blib/lib/BackupPC/Backups/Info.pm
Criterion Covered Total %
statement 11 154 7.1
branch 0 54 0.0
condition 0 6 0.0
subroutine 4 13 30.7
pod 9 9 100.0
total 24 236 10.1


line stmt bran cond sub pod time code
1             package BackupPC::Backups::Info;
2              
3 1     1   64707 use 5.006;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         22  
5 1     1   5 use warnings;
  1         2  
  1         43  
6 1     1   6 use base 'Error::Helper';
  1         2  
  1         485  
7              
8             =head1 NAME
9              
10             BackupPC::Backups::Info - Restrieves info on BackupPC backups.
11              
12             =head1 VERSION
13              
14             Version 0.1.1
15              
16             =cut
17              
18             our $VERSION = '0.1.1';
19              
20              
21             =head1 SYNOPSIS
22              
23             Quick summary of what the module does.
24              
25             Perhaps a little code snippet.
26              
27             use BackupPC::Backups::Info;
28              
29             my $bpcinfo = BackupPC::Backups::Info->new();
30             ...
31              
32             =head1 METHODS
33              
34             =head2 new
35              
36             Initiates the object.
37              
38             One variable is taken and that is the back to the BackupPC pool.
39             By default this is '/var/db/BackupPC' if not specified.
40              
41             my $bpcinfo=BackupPC::Backups::Info->new;
42             if ( $bpcinfo->error ){
43             warn("init failed.... the pool directy does not exist or is not accessible");
44             }
45              
46             =cut
47              
48             sub new{
49 0     0 1   my $dir=$_[1];
50              
51 0 0         if ( !defined( $dir ) ){
52 0           $dir='/var/db/BackupPC';
53             }
54              
55 0           my $self = {
56             perror=>undef,
57             error=>undef,
58             errorString=>"",
59             errorExtra=>{
60             flags=>{
61             1=>'badBackupPCdir',
62             2=>'noPCdir',
63             3=>'opendir',
64             4=>'noMachineName',
65             5=>'slashmachine',
66             6=>'noMachine',
67             7=>'open',
68             }
69             },
70             dir=>$dir,
71             pcdir=>$dir.'/pc',
72             last=>{},
73             parsed=>{},
74             maxAge=>172800, #two days in seconds
75             };
76 0           bless $self;
77              
78             #makes sure that the directory exists.
79 0 0         if ( ! -d $dir ){
80 0           $self->{perror}=1;
81 0           $self->{error}=1;
82 0           $self->{errorString}='"'.$dir.'" is not a directory or does not exist';
83 0           $self->warn;
84 0           return $self;
85             }
86              
87             #makes sure that the directory exists.
88 0 0         if ( ! -d $dir.'/pc' ){
89 0           $self->{perror}=1;
90 0           $self->{error}=2;
91 0           $self->{errorString}='"'.$dir.'/pc" is not a directory or does not exist';
92 0           $self->warn;
93 0           return $self;
94             }
95            
96 0           return $self;
97             }
98              
99             =head2 get_dir
100              
101             This returns the top dir for BackupPC.
102              
103             There is no need for error checking as long as it did not error upon init.
104              
105             my $dir=$bpcinfo->get_dir;
106              
107             =cut
108              
109             sub get_dir{
110 0     0 1   my $self=$_[0];
111            
112 0 0         if( ! $self->errorblank ){
113 0           return undef;
114             }
115              
116 0           return $self->{dir};
117             }
118              
119             =head2 get_last
120              
121             Gets the last line parsed for a for the file.
122              
123             If the machine has not been parsed yet, it will be and the last
124             entry returned.
125              
126             Two options are taken.
127              
128             The first is the machine in question.
129              
130             The second is perl boolean if it should reread the file even if it already has a last.
131              
132             The BACKUP HASH for information on the returned hash reference.
133              
134             my $lastRef=$bpcinfo->get_last($machine)
135             if ( $bpcinfo->error ){
136             warn('something happened'.$self->errorstring);
137             }
138              
139             =cut
140              
141             sub get_last{
142 0     0 1   my $self=$_[0];
143 0           my $machine=$_[1];
144 0           my $force=$_[2];
145              
146 0 0         if( ! $self->errorblank ){
147 0           return undef;
148             }
149              
150 0 0         if ( !defined( $machine ) ){
151 0           $self->{error}=4;
152 0           $self->{errorString}='Need to specify a machine name to fetch the raw file for.';
153 0           $self->warn;
154 0           return undef;
155             }
156              
157 0 0         if ( $machine =~ /\// ){
158 0           $self->{error}=5;
159 0           $self->{errorString}='The machine name may not contain a /';
160 0           $self->warn;
161 0           return undef;
162             }
163            
164 0 0 0       if (
165             (!defined( $self->{last}{ $machine } )) ||
166             $force
167             ){
168 0           $self->get_parsed( $machine );
169 0 0         if ( $self->error ){
170 0           return undef;
171             }
172             }
173              
174 0           return $self->{last}{$machine};
175             }
176              
177             =head2 get_pc_dir
178              
179             This returns the directory which will contain the directories for the hosts setup in BackupPC.
180              
181             There is no need for error checking as long as it did not error upon init.
182              
183             my $dir=$bpcinfo->get_dir;
184             if ( $bpcinfo->error ){
185             warn('something happened'.$self->errorstring);
186             }
187              
188             =cut
189              
190             sub get_pc_dir{
191 0     0 1   my $self=$_[0];
192            
193 0 0         if( ! $self->errorblank ){
194 0           return undef;
195             }
196              
197 0           return $self->{pcdir};
198             }
199              
200             =head2 get_parsed
201              
202             This parses the raw backups file and then returns a array of hashes.
203             For a explanation of the hashes, please see BACKUP HASH.
204              
205             One archment is taken and that is the machine name.
206              
207             my @parsed=$bpcinfo->get_parsed($machine);
208             if ( $bpcinfo->error ){
209             warn('something happened: '.$self->errorstring);
210             }
211              
212             =cut
213              
214             sub get_parsed{
215 0     0 1   my $self=$_[0];
216 0           my $machine=$_[1];
217            
218 0 0         if( ! $self->errorblank ){
219 0           return undef;
220             }
221              
222 0 0         if ( !defined( $machine ) ){
223 0           $self->{error}=4;
224 0           $self->{errorString}='Need to specify a machine name to fetch the raw file for.';
225 0           $self->warn;
226 0           return undef;
227             }
228              
229 0 0         if ( $machine =~ /\// ){
230 0           $self->{error}=5;
231 0           $self->{errorString}='The machine name may not contain a /';
232 0           $self->warn;
233 0           return undef;
234             }
235              
236             #gets the raw file
237 0           my $raw=$self->get_raw($machine);
238 0 0         if ($self->error){
239 0           return undef;
240             }
241              
242             #break it at the lines
243 0           my @lines=split(/\n/, $raw);
244              
245             #will store what we return
246 0           my @parsed;
247              
248 0           my $int=0;
249 0           while( defined( $lines[$int] ) ){
250 0           my %backup;
251             ( $backup{num}, $backup{type}, $backup{startTime}, $backup{endTime},
252             $backup{nFiles}, $backup{size}, $backup{nFilesExist}, $backup{sizeExist},
253             $backup{nFilesNew}, $backup{sizeNew}, $backup{xferErrs}, $backup{xferBadFile},
254             $backup{xferBadShare}, $backup{tarErrs}, $backup{compress},
255             $backup{sizeExistComp}, $backup{sizeNewComp}, $backup{noFill},
256 0           $backup{fillFromNum}, $backup{mangle}, $backup{xferMethod}, $backup{level} )=split(/\t/, $lines[$int]);
257              
258 0 0         if ( $backup{compress} eq ''){
259 0           $backup{compress}=0;
260             }
261            
262 0           push( @parsed, \%backup );
263            
264 0           $int++;
265             }
266              
267             #save info on the last
268 0           my %last=%{$parsed[$#parsed]};
  0            
269 0           $self->{last}{$machine}=\%last;
270              
271             #save the parsed
272 0           $self->{parsed}{$machine}=\@parsed;
273            
274 0           return @parsed;
275             }
276              
277             =head2 get_raw
278              
279             This retrieves the law data from a backups file for a machine.
280              
281             The section on backups file in
282             L
283             is suggested reading if you plan on actually using this.
284              
285             my $raw=$bpcinfo->get_raw('foo');
286             if ($bpcinfo->error){
287             warn('something errored');
288             }
289              
290             =cut
291              
292             sub get_raw{
293 0     0 1   my $self=$_[0];
294 0           my $machine=$_[1];
295            
296 0 0         if( ! $self->errorblank ){
297 0           return undef;
298             }
299              
300 0 0         if ( !defined( $machine ) ){
301 0           $self->{error}=4;
302 0           $self->{errorString}='Need to specify a machine name to fetch the raw file for.';
303 0           $self->warn;
304 0           return undef;
305             }
306              
307 0 0         if ( $machine =~ /\// ){
308 0           $self->{error}=5;
309 0           $self->{errorString}='The machine name may not contain a /';
310 0           $self->warn;
311 0           return undef;
312             }
313              
314 0           my $pcdir=$self->get_pc_dir;
315 0           my $machineDir=$pcdir.'/'.$machine;
316            
317 0 0         if (! -d $machineDir ){
318 0           $self->{error}=6;
319 0           $self->{eerorString}='"'.$machineDir.'" does not eixst';
320 0           $self->warn;
321 0           return undef;
322             }
323              
324 0           my $backupsFile=$machineDir.'/backups';
325              
326 0           my $fh;
327 0 0         if (! open( $fh, '<', $backupsFile ) ){
328 0           $self->{error}=7;
329 0           $self->{errorString}='failed to open "'.$backupsFile.'"';
330 0           $self->warn;
331             };
332              
333 0           my $data='';
334 0           while ( my $line=$fh->getline ){
335 0           $data=$data.$line;
336             }
337            
338 0           return $data;
339             }
340              
341             =head2 list_machines
342              
343             This returns an array of machines backed up.
344              
345             my @machines=$bpcinfo->list_machines;
346             if ( $bpcinfo->error ){
347             warn('something happened: '.$self->errorstring);
348             }
349              
350             =cut
351              
352             sub list_machines{
353 0     0 1   my $self=$_[0];
354            
355 0 0         if( ! $self->errorblank ){
356 0           return undef;
357             }
358              
359 0           my $pcdir=$self->get_pc_dir;
360            
361 0           my $dh;
362 0 0         if ( ! opendir( $dh, $pcdir ) ){
363 0           $self->{error}=3;
364 0           $self->{errorString}='Can not opendir "'.$pcdir.'"';
365 0           $self->warn;
366             }
367 0           my @machines;
368 0           while (readdir($dh) ){
369 0           my $entry=$_;
370 0 0 0       if ( ( -d $pcdir.'/'.$entry ) &&
371             ( $entry !~ /^\./ )
372             ){
373 0           push( @machines, $entry );
374             }
375             }
376 0           closedir( $dh );
377              
378 0           return @machines;
379             }
380              
381             =head2 list_parsed
382              
383             This returns a array the machines that have currently been parsed.
384              
385             As long as no permanent errors are set, this will not error.
386              
387             my @parsed=$bpcinfo->list_parsed;
388              
389             =cut
390              
391             sub list_parsed{
392 0     0 1   my $self=$_[0];
393            
394 0 0         if( ! $self->errorblank ){
395 0           return undef;
396             }
397              
398 0           return keys(%{$self->{parsed}});
  0            
399             }
400              
401             =head2 read_in_all
402              
403             This reads in the backups files for each machine.
404              
405             Currently this just attempts to read in all via get_parsed
406             and ignores any errors, just proceeding to the next one.
407              
408             As long as list_machines does not error, this will not error.
409              
410             $bpcinfo->read_in_all
411             if ( $bpcinfo->error ){
412             warn('something happened: '.$self->errorstring);
413             }
414              
415             =cut
416              
417             sub read_in_all{
418 0     0 1   my $self=$_[0];
419            
420 0 0         if( ! $self->errorblank ){
421 0           return undef;
422             }
423              
424 0           my @machines=$self->list_machines;
425 0 0         if ( $self->error ){
426 0           return undef;
427             }
428              
429 0           my $pcdir=$self->get_pc_dir;
430            
431 0           my $int=0;
432 0           while( defined( $machines[$int] ) ){
433 0 0         if ( -f $pcdir.'/'.$machines[$int].'/backups' ){
434 0           $self->get_parsed( $machines[$int] );
435             }
436            
437 0           $int++;
438             }
439              
440 0           return 1;
441             }
442              
443             =head1 BACKUP HASH
444              
445             Based on __TOPDIR__/pc/$host/backup from
446             L.
447              
448             =head2 num
449              
450             The backup number for the current hash.
451              
452             =head2 type
453              
454             Either 'incr' or 'full'.
455              
456             =head2 startTime
457              
458             The unix start time of the backup.
459              
460             =head2 endTime
461              
462             The unix end time of the backup.
463              
464             =head2 nFiles
465              
466             Number of files backed up.
467              
468             =head2 size
469              
470             Total file size backed up.
471              
472             =head2 nFilesExist
473              
474             Number of files already in the pool.
475              
476             =head2 sizeExist
477              
478             Total size of files that were already in the pool.
479              
480             =head2 nFilesNew
481              
482             Number of new files not already in the pool.
483              
484             =head2 sizeNew
485              
486             Total size of files not in the pool.
487              
488             =head2 xferErrs
489              
490             Number of warnings/errors from the backup method.
491              
492             =head2 xferBadFile
493              
494             Number of errors from the backup method in regards to bad files.
495              
496             =head2 xferBadShare
497              
498             Number of errors from smbclient that were bad share errors.
499              
500             =head2 tarErrs
501              
502             Number of errors from BackupPC_tarExtract.
503              
504             =head2 compress
505              
506             The compression level used on this backup. Zero means no compression.
507              
508             Please note that while BackupPC may leave this field blank if none is used, this module
509             will check for a blank value and set it to zero.
510              
511             =head2 sizeExistComp
512              
513             Total compressed size of files that already existed in the pool.
514              
515             =head2 sizeNewComp
516              
517             Total compressed size of new files in the pool.
518              
519             =head2 noFill
520              
521             et if this backup has not been filled in with the most recent previous filled or full backup.
522             See $Conf{IncrFill} in the BackupPC docs.
523              
524             =head2 fillFromNum
525              
526             If filled, this is the backup it was filled from.
527              
528             =head2 mangle
529              
530             Set if this backup has mangled file names and attributes. Always true for backups in v1.4.0
531             and above. False for all backups prior to v1.4.0.
532              
533             =head2 xferMethod
534              
535             The value of $Conf{XferMethod} when this dump was done.
536              
537             =head2 level
538              
539             =head1 ERROR FLAGS
540              
541             =head2 1/backBackupPCdig
542              
543             /var/db/BackupPC or whatever was specified does not exist or is not a directory.
544              
545             =head2 2/noPCdir
546              
547             /var/db/BackupPC/pc does not exist or is not a directory.
548              
549             =head2 3/opendir
550              
551             Opendir failed. Most likely this script needs to be running as the same user as BackupPC.
552              
553             =head2 4/noMachineName
554              
555             Specify the machine name to operate on.
556              
557             =head2 5/slashmachine
558              
559             The machine name has a slash in it.
560              
561             =head2 6/noMachine
562              
563             The machine does not exist.
564              
565             =head2 7/open
566              
567             Open on a file failed. Please make sure the script is running as the same user as BackupPC.
568              
569             =head1 AUTHOR
570              
571             Zane C. Bowers-Hadley, C<< >>
572              
573             =head1 BUGS
574              
575             Please report any bugs or feature requests to C, or through
576             the web interface at L. I will be notified, and then you'll
577             automatically be notified of progress on your bug as I make changes.
578              
579              
580              
581              
582             =head1 SUPPORT
583              
584             You can find documentation for this module with the perldoc command.
585              
586             perldoc BackupPC::Backups::Info
587              
588              
589             You can also look for information at:
590              
591             =over 4
592              
593             =item * RT: CPAN's request tracker (report bugs here)
594              
595             L
596              
597             =item * AnnoCPAN: Annotated CPAN documentation
598              
599             L
600              
601             =item * CPAN Ratings
602              
603             L
604              
605             =item * Search CPAN
606              
607             L
608              
609             =back
610              
611              
612             =head1 ACKNOWLEDGEMENTS
613              
614              
615             =head1 LICENSE AND COPYRIGHT
616              
617             Copyright 2017 Zane C. Bowers-Hadley.
618              
619             This program is free software; you can redistribute it and/or modify it
620             under the terms of the the Artistic License (2.0). You may obtain a
621             copy of the full license at:
622              
623             L
624              
625             Any use, modification, and distribution of the Standard or Modified
626             Versions is governed by this Artistic License. By using, modifying or
627             distributing the Package, you accept this license. Do not use, modify,
628             or distribute the Package, if you do not accept this license.
629              
630             If your Modified Version has been derived from a Modified Version made
631             by someone other than you, you are nevertheless required to ensure that
632             your Modified Version complies with the requirements of this license.
633              
634             This license does not grant you the right to use any trademark, service
635             mark, tradename, or logo of the Copyright Holder.
636              
637             This license includes the non-exclusive, worldwide, free-of-charge
638             patent license to make, have made, use, offer to sell, sell, import and
639             otherwise transfer the Package with respect to any patent claims
640             licensable by the Copyright Holder that are necessarily infringed by the
641             Package. If you institute patent litigation (including a cross-claim or
642             counterclaim) against any party alleging that the Package constitutes
643             direct or contributory patent infringement, then this Artistic License
644             to you shall terminate on the date that such litigation is filed.
645              
646             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
647             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
648             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
649             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
650             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
651             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
652             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
653             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
654              
655              
656             =cut
657              
658             1; # End of BackupPC::Backups::Info