File Coverage

blib/lib/Data/Package/File.pm
Criterion Covered Total %
statement 41 57 71.9
branch 4 14 28.5
condition 2 3 66.6
subroutine 14 17 82.3
pod 2 3 66.6
total 63 94 67.0


line stmt bran cond sub pod time code
1             package Data::Package::File;
2              
3             =pod
4              
5             =head1 NAME
6              
7             Data::Package::File - Data::Package base class for data stored in a local file
8              
9             =head1 DESCRIPTION
10              
11             The B base class provides a series of additional
12             methods that ease the development of L classes that source
13             their data from files on the local filesystem.
14              
15             =head1 METHODS
16              
17             B extends the interface of L with a few
18             additional methods.
19              
20             =cut
21              
22 1     1   37419 use 5.005;
  1         5  
  1         132  
23 1     1   7 use strict;
  1         3  
  1         35  
24 1     1   7633 use Data::Package ();
  1         2  
  1         24  
25 1     1   6 use File::Spec ();
  1         2  
  1         15  
26 1     1   1077 use IO::File ();
  1         14237  
  1         34  
27 1     1   9 use Params::Util qw{ _STRING };
  1         2  
  1         53  
28 1     1   7 use Class::Inspector ();
  1         2  
  1         19  
29 1     1   2562 use File::ShareDir ();
  1         2829  
  1         28  
30              
31 1     1   6 use vars qw{$VERSION @ISA};
  1         3  
  1         67  
32             BEGIN {
33 1     1   3 $VERSION = '1.05';
34 1         558 @ISA = 'Data::Package';
35             }
36              
37              
38              
39              
40              
41             #####################################################################
42             # Data::File::Package Methods
43              
44             # Apply checks to the class
45             sub import {
46 0     0   0 my $class = shift;
47              
48             # The method should give us a file name as a string
49 0         0 my $file = $class->file;
50 0 0       0 unless ( defined _STRING($file) ) {
51 0         0 die "The ->file method for data package $class did not return a string";
52             }
53              
54             # Check that the file is absolute, exists and is readable
55 0 0       0 unless ( File::Spec->file_name_is_absolute($file) ) {
56 0         0 die "The data file path for $class is not an absolute path ($file)";
57             }
58 0 0       0 unless ( -f $file ) {
59 0         0 die "The data file for $class does not exist ($file)";
60             }
61 0 0       0 unless ( -r $file ) {
62 0         0 die "The data file for $class does not have read permissions ($file)";
63             }
64              
65 0         0 return 1;
66             }
67              
68             =pod
69              
70             =head1 file
71              
72             my $to_load = My::Data:Class->file;
73              
74             The C method can be defined by a L subclass,
75             and should return an absolute path for a file reable by the current user,
76             in the form of a simple scalar string.
77              
78             At load-time, this value will be checked for correctness, and if the value
79             returned is invalid, loading of the file will fail.
80              
81             =cut
82              
83             sub file {
84 6   66 6 0 3279 my $class = ref($_[0]) || $_[0];
85              
86             # Support the dist_file method
87 6         24 my @dist_file = $class->dist_file;
88 6 100       33 if ( @dist_file ) {
89 3         19 return File::Spec->rel2abs(
90             File::ShareDir::dist_file( @dist_file )
91             )
92             }
93              
94             # Support the module_file method
95 3         35 my @module_file = $class->module_file;
96 3 50       25 if ( @module_file ) {
97 3 50       9 if ( @module_file == 1 ) {
98 0         0 unshift @module_file, $class;
99             }
100 3         14 return File::Spec->rel2abs(
101             File::ShareDir::module_file( @module_file )
102             )
103             }
104              
105 0         0 return undef;
106             }
107              
108             =pod
109              
110             =head2 dist_file
111              
112             package My::Dist::DataSubclass;
113            
114             sub dist_file {
115             return ( 'My-Dist', 'data.txt' );
116             }
117              
118             The C method is one of two that provide integration with
119             L. Instead of defining a C method, you can
120             instead define C.
121              
122             If C exists, and any values are returned, those values
123             will be passed through to the C function,
124             with the resulting value converted to an absolute path (if needed)
125             and used to provide the appropriate object to the caller.
126              
127             Should return a list with two values, the name of the distribution
128             the package is in, and the file path within the package's F
129             directory.
130              
131             =cut
132              
133             sub dist_file {
134 3     3 1 7 return ();
135             }
136              
137              
138             =pod
139              
140             =head2 module_file
141              
142             package My::DataClass;
143            
144             # Get a file from this module
145             sub module_file {
146             return 'data.txt';
147             }
148            
149             # Get a file for another (loaded) module
150             sub module_file {
151             return ( 'My::RelatedClass', 'data.txt' );
152             }
153              
154             The C method is one of two that provide integration with
155             L. Instead of defining a C method, you can
156             instead define C.
157              
158             If C exists, and any values are returned, those values
159             will be passed through to the C function,
160             with the resulting value converted to an absolute path (if needed)
161             and used to provide the appropriate object to the caller.
162              
163             Should return a list with two values, the module to get the shared files
164             for, and the the file path within the module's F directory.
165              
166             If C returns a single value, the name of the class will
167             be automatically prepended as the module name.
168              
169             =cut
170              
171             sub module_file {
172 0     0 1 0 return ();
173             }
174              
175              
176              
177              
178              
179             #####################################################################
180             # Add support for IO::File, Path::Class and URI
181              
182             sub __as_IO_File {
183 3     3   230 IO::File->new( $_[0]->file );
184             }
185              
186             sub __as_Path_Class_File {
187 0     0   0 require Path::Class;
188 0         0 Path::Class::file( $_[0]->file );
189             }
190              
191             sub __as_URI_file {
192 3     3   118 require URI::file;
193 3         11 URI::file->new( $_[0]->file );
194             }
195              
196             1;
197              
198             =pod
199              
200             =head1 SUPPORT
201              
202             Bugs should always be submitted via the CPAN bug tracker.
203              
204             L
205              
206             For other issues, contact the maintainer
207              
208             =head1 AUTHOR
209              
210             Adam Kennedy Eadamk@cpan.orgE
211              
212             =head1 COPYRIGHT
213              
214             Copyright 2007 Adam Kennedy.
215              
216             This program is free software; you can redistribute
217             it and/or modify it under the same terms as Perl itself.
218              
219             The full text of the license can be found in the
220             LICENSE file included with this module.
221              
222             =cut