File Coverage

blib/lib/Cache/FileCache.pm
Criterion Covered Total %
statement 68 83 81.9
branch 4 8 50.0
condition 2 3 66.6
subroutine 23 29 79.3
pod 4 10 40.0
total 101 133 75.9


line stmt bran cond sub pod time code
1             ######################################################################
2             # $Id: FileCache.pm,v 1.31 2002/04/07 17:04:46 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              
12             package Cache::FileCache;
13              
14              
15 2     2   669 use strict;
  2         2  
  2         67  
16 2     2   10 use vars qw( @ISA );
  2         3  
  2         75  
17 2     2   1127 use Cache::BaseCache;
  2         5  
  2         106  
18 2     2   13 use Cache::Cache;
  2         5  
  2         77  
19 2     2   11 use Cache::CacheUtils qw ( Assert_Defined Build_Path Static_Params );
  2         4  
  2         294  
20 2     2   1291 use Cache::FileBackend;
  2         8  
  2         85  
21 2     2   20 use Cache::Object;
  2         4  
  2         50  
22 2     2   11 use Error;
  2         6  
  2         17  
23 2     2   2097 use File::Spec::Functions;
  2         1829  
  2         2211  
24              
25              
26             @ISA = qw ( Cache::BaseCache );
27              
28              
29             # by default, the cache nests all entries on the filesystem three
30             # directories deep
31              
32             my $DEFAULT_CACHE_DEPTH = 3;
33              
34              
35             # by default, the root of the cache is located in 'FileCache'. On a
36             # UNIX system, this will appear in "/tmp/FileCache/"
37              
38             my $DEFAULT_CACHE_ROOT = "FileCache";
39              
40              
41             # by default, the directories in the cache on the filesystem should
42             # be globally writable to allow for multiple users. While this is a
43             # potential security concern, the actual cache entries are written
44             # with the user's umask, thus reducing the risk of cache poisoning
45              
46             my $DEFAULT_DIRECTORY_UMASK = 000;
47              
48              
49             sub Clear
50             {
51 16     16 1 71 my ( $p_optional_cache_root ) = Static_Params( @_ );
52              
53 16         58 foreach my $namespace ( _Namespaces( $p_optional_cache_root ) )
54             {
55 20         68 _Get_Cache( $namespace, $p_optional_cache_root )->clear( );
56             }
57             }
58              
59              
60             sub Purge
61             {
62 4     4 1 30 my ( $p_optional_cache_root ) = Static_Params( @_ );
63              
64 4         23 foreach my $namespace ( _Namespaces( $p_optional_cache_root ) )
65             {
66 4         21 _Get_Cache( $namespace, $p_optional_cache_root )->purge( );
67             }
68             }
69              
70              
71             sub Size
72             {
73 14     14 1 54 my ( $p_optional_cache_root ) = Static_Params( @_ );
74              
75 14         27 my $size = 0;
76              
77 14         41 foreach my $namespace ( _Namespaces( $p_optional_cache_root ) )
78             {
79 6         25 $size += _Get_Cache( $namespace, $p_optional_cache_root )->size( );
80             }
81              
82 14         154 return $size;
83             }
84              
85              
86             sub new
87             {
88 33     33 1 841 my ( $self ) = _new( @_ );
89              
90 33         146 $self->_complete_initialization( );
91              
92 33         654 return $self;
93             }
94              
95              
96             sub _Get_Backend
97             {
98 34     34   96 my ( $p_optional_cache_root ) = Static_Params( @_ );
99              
100 34         355 return new Cache::FileBackend( _Build_Cache_Root( $p_optional_cache_root ) );
101              
102             }
103              
104              
105             # return the OS default temp directory
106              
107             sub _Get_Temp_Directory
108             {
109 70 50   70   1958 my $tmpdir = File::Spec->tmpdir( ) or
110             throw Error::Simple( "No tmpdir on this system. Upgrade File::Spec?" );
111              
112 70         302 return $tmpdir;
113             }
114              
115              
116             sub _Build_Cache_Root
117             {
118 34     34   98 my ( $p_optional_cache_root ) = Static_Params( @_ );
119              
120 34 50       108 if ( defined $p_optional_cache_root )
121             {
122 0         0 return $p_optional_cache_root;
123             }
124             else
125             {
126 34         83 return Build_Path( _Get_Temp_Directory( ), $DEFAULT_CACHE_ROOT );
127             }
128             }
129              
130              
131             sub _Namespaces
132             {
133 34     34   197 my ( $p_optional_cache_root ) = Static_Params( @_ );
134              
135 34         237 return _Get_Backend( $p_optional_cache_root )->get_namespaces( );
136             }
137              
138              
139             sub _Get_Cache
140             {
141 30     30   107 my ( $p_namespace, $p_optional_cache_root ) = Static_Params( @_ );
142              
143 30         105 Assert_Defined( $p_namespace );
144              
145 30 50       77 if ( defined $p_optional_cache_root )
146             {
147 0         0 return new Cache::FileCache( { 'namespace' => $p_namespace,
148             'cache_root' => $p_optional_cache_root } );
149             }
150             else
151             {
152 30         317 return new Cache::FileCache( { 'namespace' => $p_namespace } );
153             }
154             }
155              
156              
157             sub _new
158             {
159 36     36   79 my ( $proto, $p_options_hash_ref ) = @_;
160 36   66     185 my $class = ref( $proto ) || $proto;
161              
162 36         228 my $self = $class->SUPER::_new( $p_options_hash_ref );
163 36         124 $self->_initialize_file_backend( );
164 36         129 return $self;
165             }
166              
167              
168             sub _initialize_file_backend
169             {
170 36     36   56 my ( $self ) = @_;
171              
172 36         206 $self->_set_backend( new Cache::FileBackend( $self->_get_initial_root( ),
173             $self->_get_initial_depth( ),
174             $self->_get_initial_umask( ) ));
175             }
176              
177              
178             sub _get_initial_root
179             {
180 36     36   48 my ( $self ) = @_;
181              
182 36 50       108 if ( defined $self->_read_option( 'cache_root' ) )
183             {
184 0         0 return $self->_read_option( 'cache_root' );
185             }
186             else
187             {
188 36         75 return Build_Path( _Get_Temp_Directory( ), $DEFAULT_CACHE_ROOT );
189             }
190             }
191              
192              
193             sub _get_initial_depth
194             {
195 36     36   58 my ( $self ) = @_;
196              
197 36         122 return $self->_read_option( 'cache_depth', $DEFAULT_CACHE_DEPTH );
198             }
199              
200              
201             sub _get_initial_umask
202             {
203 36     36   64 my ( $self ) = @_;
204              
205 36         105 return $self->_read_option( 'directory_umask', $DEFAULT_DIRECTORY_UMASK );
206             }
207              
208              
209             sub get_cache_depth
210             {
211 0     0 0   my ( $self ) = @_;
212              
213 0           return $self->_get_backend( )->get_depth( );
214             }
215              
216              
217             sub set_cache_depth
218             {
219 0     0 0   my ( $self, $p_cache_depth ) = @_;
220              
221 0           $self->_get_backend( )->set_depth( $p_cache_depth );
222             }
223              
224              
225             sub get_cache_root
226             {
227 0     0 0   my ( $self ) = @_;
228              
229 0           return $self->_get_backend( )->get_root( );
230             }
231              
232              
233             sub set_cache_root
234             {
235 0     0 0   my ( $self, $p_cache_root ) = @_;
236              
237 0           $self->_get_backend( )->set_root( $p_cache_root );
238             }
239              
240              
241             sub get_directory_umask
242             {
243 0     0 0   my ( $self ) = @_;
244              
245 0           return $self->_get_backend( )->get_directory_umask( );
246             }
247              
248              
249             sub set_directory_umask
250             {
251 0     0 0   my ( $self, $p_directory_umask ) = @_;
252              
253 0           $self->_get_backend( )->set_directory_umask( $p_directory_umask );
254             }
255              
256              
257             1;
258              
259              
260             __END__