File Coverage

blib/lib/Cache/CacheUtils.pm
Criterion Covered Total %
statement 27 38 71.0
branch 4 12 33.3
condition 1 3 33.3
subroutine 10 13 76.9
pod 0 6 0.0
total 42 72 58.3


line stmt bran cond sub pod time code
1             ######################################################################
2             # $Id: CacheUtils.pm,v 1.39 2003/04/15 14:46:19 dclinton Exp $
3             # Copyright (C) 2001-2003 DeWitt Clinton All Rights Reserved
4             #
5             # Software distributed under the License is distributed on an "AS
6             # IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or
7             # implied. See the License for the specific language governing
8             # rights and limitations under the License.
9             ######################################################################
10              
11             package Cache::CacheUtils;
12              
13 2     2   12 use strict;
  2         6  
  2         84  
14 2     2   26 use vars qw( @ISA @EXPORT_OK );
  2         4  
  2         102  
15 2     2   20 use Cache::Cache;
  2         3  
  2         74  
16 2     2   11 use Error;
  2         3  
  2         15  
17 2     2   99 use Exporter;
  2         4  
  2         74  
18 2     2   13 use File::Spec;
  2         3  
  2         58  
19 2     2   2967 use Storable qw( nfreeze thaw dclone );
  2         9078  
  2         1196  
20              
21             @ISA = qw( Exporter );
22              
23             @EXPORT_OK = qw( Assert_Defined
24             Build_Path
25             Clone_Data
26             Freeze_Data
27             Static_Params
28             Thaw_Data );
29              
30             # throw an Exception if the Assertion fails
31              
32             sub Assert_Defined
33             {
34 650 50   650 0 2785 if ( not defined $_[0] )
35             {
36 0         0 my ( $package, $filename, $line ) = caller( );
37 0         0 throw Error::Simple( "Assert_Defined failed: $package line $line\n" );
38             }
39             }
40              
41              
42             # Take a list of directory components and create a valid path
43              
44             sub Build_Path
45             {
46 0     0 0 0 my ( @p_elements ) = @_;
47              
48             # TODO: add this to Untaint_Path or something
49             # ( $p_unique_key !~ m|[0-9][a-f][A-F]| ) or
50             # throw Error::Simple( "key '$p_unique_key' contains illegal characters'" );
51              
52 0 0       0 if ( grep ( /\.\./, @p_elements ) )
53             {
54 0         0 throw Error::Simple( "Illegal path characters '..'" );
55             }
56              
57 0         0 return File::Spec->catfile( @p_elements );
58             }
59              
60              
61             # use Storable to clone an object
62              
63             sub Clone_Data
64             {
65 212     212 0 350 my ( $p_object ) = @_;
66              
67 212 100       13946 return defined $p_object ? dclone( $p_object ) : undef;
68             }
69              
70              
71             # use Storable to freeze an object
72              
73             sub Freeze_Data
74             {
75 0     0 0 0 my ( $p_object ) = @_;
76              
77 0 0       0 return defined $p_object ? nfreeze( $p_object ) : undef;
78             }
79              
80              
81             # Take a parameter list and automatically shift it such that if
82             # the method was called as a static method, then $self will be
83             # undefined. This allows the use to write
84             #
85             # sub Static_Method
86             # {
87             # my ( $parameter ) = Static_Params( @_ );
88             # }
89             #
90             # and not worry about whether it is called as:
91             #
92             # Class->Static_Method( $param );
93             #
94             # or
95             #
96             # Class::Static_Method( $param );
97              
98              
99             sub Static_Params
100             {
101 10     10 0 33 my $type = ref $_[0];
102              
103 10 50 33     47 if ( $type and ( $type !~ /^(SCALAR|ARRAY|HASH|CODE|REF|GLOB|LVALUE)$/ ) )
104             {
105 0         0 shift( @_ );
106             }
107              
108 10         41 return @_;
109             }
110              
111              
112             # use Storable to thaw an object
113              
114             sub Thaw_Data
115             {
116 0     0 0   my ( $p_frozen_object ) = @_;
117              
118 0 0         return defined $p_frozen_object ? thaw( $p_frozen_object ) : undef;
119             }
120              
121              
122             1;
123              
124              
125             __END__