File Coverage

blib/lib/Package/Checkpoint.pm
Criterion Covered Total %
statement 46 46 100.0
branch 4 4 100.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 61 61 100.0


line stmt bran cond sub pod time code
1             package Package::Checkpoint;
2              
3 2     2   233430 use strict;
  2         9  
  2         59  
4 2     2   10 use warnings;
  2         4  
  2         48  
5 2     2   33 use 5.020;
  2         9  
6 2     2   13 use experimental qw( postderef signatures );
  2         3  
  2         12  
7 2     2   1675 use Package::Stash;
  2         16910  
  2         77  
8 2     2   1390 use Storable qw( dclone );
  2         6722  
  2         136  
9 2     2   1089 use Ref::Util qw( is_ref );
  2         3393  
  2         1299  
10              
11             # ABSTRACT: Checkpoint the scalar, array and hash values in a package for later restoration
12             our $VERSION = '0.01'; # VERSION
13              
14              
15 2         7 sub new ($class, $name)
16 2     2 1 12828 {
  2         5  
  2         5  
17 2         7 my %self = ( name => $name );
18              
19 2         40 my $stash = $self{stash} = Package::Stash->new($name);
20              
21 2         39 foreach my $var ($stash->list_all_symbols('SCALAR'))
22             {
23 4         34 my $value = $stash->get_symbol("\$$var")->$*;
24 4 100       173 $self{scalar}->{$var} = is_ref($value) ? dclone($value) : $value;
25             }
26              
27 2         18 foreach my $var ($stash->list_all_symbols('ARRAY'))
28             {
29 2         37 $self{array}->{$var} = dclone $stash->get_symbol("\@$var");
30             }
31              
32 2         14 foreach my $var ($stash->list_all_symbols('HASH'))
33             {
34 2         85 $self{hash}->{$var} = dclone $stash->get_symbol("\%$var");
35             }
36              
37 2         17 bless \%self, $class;
38             }
39              
40              
41             sub restore ($self)
42 2     2 1 614 {
  2         5  
  2         5  
43 2         8 my $stash = $self->{stash};
44              
45 2         10 foreach my $var (keys $self->{scalar}->%*)
46             {
47 4         11 my $value = $self->{scalar}->{$var};
48 4 100       118 $stash->get_symbol("\$$var")->$* = is_ref $value ? dclone($value) : $value;
49             }
50              
51 2         14 foreach my $var (keys $self->{array}->%*)
52             {
53 2         37 $stash->get_symbol("\@$var")->@* = dclone($self->{array}->{$var})->@*;
54             }
55              
56 2         9 foreach my $var (keys $self->{hash}->%*)
57             {
58 2         39 $stash->get_symbol("\%$var")->%* = dclone($self->{hash}->{$var})->%*;
59             }
60              
61 2         15 return $self;
62             }
63              
64             1;
65              
66             __END__