File Coverage

blib/lib/NBU/Retention.pm
Criterion Covered Total %
statement 22 56 39.2
branch 0 8 0.0
condition n/a
subroutine 6 13 46.1
pod 0 7 0.0
total 28 84 33.3


line stmt bran cond sub pod time code
1             #
2             # Copyright (c) 2002 Paul Winkeler. All Rights Reserved.
3             # This program is free software; you may redistribute it and/or modify it under
4             # the same terms as Perl itself.
5             #
6             package NBU::Retention;
7              
8 1     1   6 use strict;
  1         2  
  1         43  
9 1     1   5 use Carp;
  1         3  
  1         91  
10              
11             BEGIN {
12 1     1   22 use Exporter ();
  1         2  
  1         19  
13 1     1   4 use AutoLoader qw(AUTOLOAD);
  1         1  
  1         7  
14 1     1   41 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
  1         2  
  1         195  
15 1     1   2 $VERSION = do { my @r=(q$Revision: 1.7 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
  1         5  
  1         7  
16 1         17 @ISA = qw();
17 1         2 @EXPORT = qw();
18 1         1 @EXPORT_OK = qw();
19 1         414 %EXPORT_TAGS = qw();
20             }
21              
22             my $retained;
23             my %retentionLevels;
24              
25             sub new {
26 0     0 0   my $proto = shift;
27 0           my $retention = {
28             };
29              
30 0           bless $retention, $proto;
31              
32 0 0         if (@_) {
33 0           my $level = $retention->{LEVEL} = shift;
34 0           $retention->{PERIOD} = shift;
35 0           $retention->{DESCRIPTION} = shift;
36              
37 0           $retentionLevels{$level} = $retention;
38             }
39 0           return $retention;
40             }
41              
42             sub populate {
43 0     0 0   my $proto = shift;
44              
45 0           my @masters = NBU->masters; my $master = $masters[0];
  0            
46              
47 0 0         die "Could not open retention pipe\n"
48             unless my $pipe = NBU->cmd("bpretlevel -M ".$master->name." -l |");
49 0           while (<$pipe>) {
50 0           chop; s/[\s]*$//;
  0            
51 0           my ($level, $period, $description) = split(/[\s]+/, $_, 3);
52 0           $proto->new($level, $period, $description);
53 0           chop;
54             }
55 0           close($pipe);
56 0           $retained = 1;
57             }
58              
59             sub byLevel {
60 0     0 0   my $proto = shift;
61 0           my $level = shift;
62              
63 0 0         $proto->populate if (!$retained);
64 0           return $retentionLevels{$level};
65             }
66              
67             sub period {
68 0     0 0   my $self = shift;
69              
70 0           return $self->{PERIOD};
71             }
72              
73             sub level {
74 0     0 0   my $self = shift;
75              
76 0           return $self->{LEVEL};
77             }
78              
79             sub description {
80 0     0 0   my $self = shift;
81              
82 0           return $self->{DESCRIPTION};
83             }
84              
85             sub list {
86 0     0 0   my $proto = shift;
87              
88 0 0         $proto->populate if (!$retained);
89 0           return (values %retentionLevels);
90             }
91              
92             1;
93              
94             __END__