File Coverage

lib/Class/Rebirth.pm
Criterion Covered Total %
statement 55 61 90.1
branch 9 16 56.2
condition n/a
subroutine 11 11 100.0
pod 1 1 100.0
total 76 89 85.3


line stmt bran cond sub pod time code
1              
2             package Class::Rebirth; ## Brings a deserialized class back to life
3             $Class::Rebirth::VERSION = '1.000';
4              
5 4     4   2128 use strict;
  4         5  
  4         125  
6 4     4   16 use warnings;
  4         4  
  4         122  
7 4     4   21 use Carp;
  4         5  
  4         279  
8              
9 4     4   16 use Scalar::Util;
  4         4  
  4         179  
10              
11 4     4   13 use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION);
  4         4  
  4         262  
12 4     4   14 use Exporter;
  4         5  
  4         116  
13              
14 4     4   668 use Data::Dumper;
  4         5334  
  4         203  
15              
16 4     4   2323 use List::MoreUtils qw(uniq);
  4         33665  
  4         24  
17              
18             @ISA = qw(Exporter);
19              
20             %EXPORT_TAGS = ( all => [qw(
21             rebirth
22             )] );
23              
24             Exporter::export_ok_tags('all');
25              
26              
27             # When a class is deserialized from saved dump it still holds the information,
28             # but the methods are not accessable anymore.
29             #
30             # So far a run with eval would do the rebirth, but that does only work if
31             # needed classes are required/ used. Here the Class::Rebirth also cares about requiring
32             # the needed classes nested in the potential object.
33             #
34             # A death class I call zombie (has nothing todo with processes), as they look like
35             # normal classes but have no living methods.
36             #
37             #
38             #
39             # SYNOPSIS
40             # ========
41             #
42             # use Class::Rebirth 'rebirth';
43             # my $object = rebirth( $zombie );
44             #
45             #
46             # or
47             #
48             # use Class::Rebirth;
49             # my $object = Class::Rebirth::rebirth( $zombie );
50             #
51             #
52             # It is also able to use a data dump instead of an object.
53             #
54             # my $object = Class::Rebirth::rebirth( $dump );
55             #
56             #
57             #
58             # AUTHOR
59             # ======
60             # Andreas Hernitscheck ahernit(AT)cpan.org
61              
62              
63             # @brief Takes a death object and and creates a living object of it.
64             # Such a zombie class looks like a normal class when you dump it.
65             # But it is not alive, means methods won't work. An Effect which
66             # happens by deserializing classes from a store (dumped data).
67             sub rebirth { # $object ($zombie)
68 1 50   1 1 4 my $zombie = shift or croak "requires zombie";
69 1         1 my $obj;
70              
71             # if zombie is dump string, build an object first
72 1 50       6 if ($zombie =~ /^\$/){
73 0         0 $zombie = _createObjectByDump( $zombie );
74             }
75              
76              
77 1         3 my @pkgs = _getUsedPackagesOfObject($zombie);
78              
79 1         2 foreach my $p (@pkgs){
80 3         101 eval("require $p;");
81 3 50       815 if ($@){die $@};
  0         0  
82             }
83              
84             ## rerun an eval to realy bring it back to life
85 1         3 my $target;
86 1         44 my $ser = Data::Dumper->Dump([$zombie],['$target']);
87 1         157 eval $ser;
88 1 50       5 if ($@){die $@};
  0         0  
89              
90              
91 1         3 return $target;
92             }
93              
94              
95             # Can use a data dump'ed string which
96             # starts with a variable assignment like $VAR1=
97             # @return object
98             sub _createObjectByDump{
99 2     2   1790 my $dump = shift;
100 2         3 my $target;
101              
102              
103             # relace var with own var
104 2         11 $dump =~ s/^(\$[a-z0-9]+)/\$target/i;
105              
106 2         136 eval $dump;
107              
108 2 50       13 if ($@){die $@};
  0         0  
109              
110 2         4 return $target;
111             }
112              
113              
114              
115             # Does a deep search in object for
116             # used package names.
117             # @return list of packages
118             sub _getUsedPackagesOfObject{
119 6     6   1687 my $obj = shift;
120 6         6 my @list;
121              
122              
123 6 50       32 if (Scalar::Util::blessed $obj){
124 6         10 push @list, ref($obj);
125             }
126              
127              
128 6         14 foreach my $k (keys %$obj){
129 8         11 my $value = $obj->{$k};
130              
131             # walk down any hash to find more blessed objects
132 8 50       16 if (ref $obj->{$k} eq 'HASH'){
133              
134 0         0 my @sublist = _getUsedPackagesOfObject( $value );
135              
136 0         0 push @list, @sublist;
137             }
138              
139             # is blessed object
140 8 100       24 if (Scalar::Util::blessed $value){
141 4         6 push @list, ref($obj);
142              
143 4         12 my @sublist = _getUsedPackagesOfObject( $value );
144 4         11 push @list, @sublist;
145             }
146             }
147              
148             # make unique strings
149 6         36 @list = uniq @list;
150              
151 6         20 return @list;
152             }
153              
154              
155              
156              
157              
158              
159             1;
160              
161              
162              
163              
164             #################### pod generated by Pod::Autopod - keep this line to make pod updates possible ####################
165              
166             =head1 NAME
167              
168             Class::Rebirth.pm - Class::Rebirth.pm
169              
170              
171             =head1 SYNOPSIS
172              
173              
174             use Class::Rebirth 'rebirth';
175             my $object = rebirth( $zombie );
176              
177              
178             or
179              
180             use Class::Rebirth;
181             my $object = Class::Rebirth::rebirth( $zombie );
182              
183              
184             It is also able to use a data dump instead of an object.
185              
186             my $object = Class::Rebirth::rebirth( $dump );
187              
188              
189              
190              
191              
192             =head1 DESCRIPTION
193              
194             When a class is deserialized from saved dump it still holds the information,
195             but the methods are not accessable anymore.
196              
197             So far a run with eval would do the rebirth, but that does only work if
198             needed classes are required/ used. Here the Class::Rebirth also cares about requiring
199             the needed classes nested in the potential object.
200              
201             A death class I call zombie (has nothing todo with processes), as they look like
202             normal classes but have no living methods.
203              
204              
205              
206              
207              
208             =head1 REQUIRES
209              
210             L
211              
212             L
213              
214             L
215              
216             L
217              
218             L
219              
220              
221             =head1 METHODS
222              
223             =head2 rebirth
224              
225             my $object = rebirth($zombie);
226              
227             Takes a death object and and creates a living object of it.
228             Such a zombie class looks like a normal class when you dump it.
229             But it is not alive, means methods won't work. An effect which
230             happens by deserializing classes from a store (dumped data).
231              
232              
233              
234             =head1 AUTHOR
235              
236             Andreas Hernitscheck ahernit(AT)cpan.org
237              
238              
239             =cut
240