File Coverage

blib/lib/Connector/Builtin/File/Path.pm
Criterion Covered Total %
statement 84 94 89.3
branch 28 44 63.6
condition 6 9 66.6
subroutine 13 14 92.8
pod 4 4 100.0
total 135 165 81.8


line stmt bran cond sub pod time code
1             # Connector::Builtin::File::Path
2             #
3             # Proxy class for accessing files
4             #
5             # Written by Oliver Welter for the OpenXPKI project 2012
6             #
7             package Connector::Builtin::File::Path;
8              
9 2     2   111351 use strict;
  2         17  
  2         72  
10 2     2   11 use warnings;
  2         4  
  2         56  
11 2     2   13 use English;
  2         5  
  2         16  
12 2     2   909 use File::Spec;
  2         5  
  2         75  
13 2     2   715 use Data::Dumper;
  2         7419  
  2         136  
14 2     2   1085 use Template;
  2         42230  
  2         74  
15              
16 2     2   598 use Moose;
  2         478052  
  2         17  
17             extends 'Connector::Builtin';
18              
19             with 'Connector::Role::LocalPath';
20              
21             has content => (
22             is => 'rw',
23             isa => 'Str',
24             );
25              
26             has ifexists => (
27             is => 'rw',
28             isa => 'Str',
29             default => 'replace'
30             );
31              
32             has user => (
33             is => 'rw',
34             isa => 'Str',
35             default => ''
36             );
37              
38             has group => (
39             is => 'rw',
40             isa => 'Str',
41             default => ''
42             );
43              
44             has mode => (
45             is => 'rw',
46             isa => 'Str',
47             default => ''
48             );
49              
50             sub _build_config {
51 0     0   0 my $self = shift;
52              
53 0 0       0 if (! -d $self->{LOCATION}) {
54 0         0 confess("Cannot open directory " . $self->{LOCATION} );
55             }
56              
57 0         0 return 1;
58             }
59              
60             # return the content of the file
61             sub get {
62              
63 6     6 1 1351 my $self = shift;
64 6         13 my $path = shift;
65              
66 6         17 my $filename = $self->_sanitize_path( $path );
67              
68 6 50       138 if (! -r $filename) {
69 0         0 return $self->_node_not_exists( $path );
70             }
71              
72 6         14 my $content = do {
73 6         33 local $INPUT_RECORD_SEPARATOR;
74 6         232 open my $fh, '<', $filename;
75 6         273 <$fh>;
76             };
77 6         52 return $content;
78             }
79              
80             sub get_meta {
81 2     2 1 6 my $self = shift;
82              
83             # If we have no path, we tell the caller that we are a connector
84 2         8 my @path = $self->_build_path_with_prefix( shift );
85 2 100       8 if (scalar @path == 0) {
86 1         10 return { TYPE => "connector" };
87             }
88              
89 1         8 return {TYPE => "scalar" };
90             }
91              
92              
93             sub exists {
94              
95 4     4 1 8 my $self = shift;
96              
97             # No path = connector root which always exists
98 4         14 my @path = $self->_build_path_with_prefix( shift );
99 4 100       18 if (scalar @path == 0) {
100 1         5 return 1;
101             }
102              
103 3         12 my $filename = $self->_sanitize_path( \@path );
104              
105 3         89 return -r $filename;
106             }
107              
108              
109             # return the content of the file
110             sub set {
111              
112 12     12 1 45 my $self = shift;
113 12         20 my $file = shift;
114 12         23 my $data = shift;
115              
116 12         43 my $filename = $self->_sanitize_path( $file, $data );
117              
118 12         28 my $content;
119 12 100       395 if ($self->content()) {
120 10         224 $self->log()->debug('Process template for content ' . $self->content());
121 10         97 my $template = Template->new({});
122              
123 10 100       4405 $data = { DATA => $data } if (ref $data eq '');
124              
125 10 50       388 $template->process( \$self->content(), $data, \$content) || die "Error processing content template.";
126             } else {
127 2 50       13 if (ref $data ne '') {
128 0         0 die "You need to define a content template if data is not a scalar";
129             }
130 2         4 $content = $data;
131             }
132              
133 12         19040 my $mode = $self->ifexists();
134 12 100 66     99 if ($mode eq 'fail' && -f $filename) {
135 1         16 die "File $filename exists";
136             }
137              
138 11 100 66     52 if ($mode eq 'silent' && -f $filename) {
139 1         10 return;
140             }
141              
142 10         16 my $uid = -1;
143 10         16 my $gid;
144 10 50       315 if (my $user = $self->user()) {
145 0 0       0 $uid = getpwnam($user) or die "$user not known";
146 0         0 $gid = -1;
147             }
148              
149 10 50       302 if (my $group = $self->group()) {
150 0 0       0 $gid = getgrnam($group) or die "$group not known";
151             }
152              
153 10 100 66     65 if ($mode eq 'append' && -f $filename) {
154 1 50       40 open (FILE, ">>",$filename) || die "Unable to open file for appending";
155             } else {
156 9 100       952 open (FILE, ">", $filename) || die "Unable to open file for writing";
157             }
158              
159 8         101 print FILE $content;
160 8         668 close FILE;
161              
162 8 100       353 if (my $filemode = $self->mode()) {
163 2 100       13 if ($filemode =~ m{\A[0-7]{4}\z}) {
164 1 50       36 chmod (oct($filemode), $filename) || die "Unable to change mode to $filemode";
165             } else {
166 1         13 die "Given mode string '$filemode' is not valid";
167             }
168             }
169              
170 7 50       24 if ($gid) {
171 0 0       0 chown ($uid, $gid, $filename) || die "Unable to chown $filename to $uid/$gid";
172             }
173              
174             #FIXME - some error handling might not hurt
175              
176 7         62 return 1;
177             }
178              
179              
180             sub _sanitize_path {
181              
182 21     21   46 my $self = shift;
183 21         31 my $inargs = shift;
184 21         44 my $data = shift;
185              
186 21         68 my @args = $self->_build_path_with_prefix( $inargs );
187              
188 21         109 my $file = $self->_render_local_path( \@args, $data );
189              
190 21         98 my $filename = $self->{LOCATION}.'/'.$file;
191              
192 21         607 $self->log()->debug('Filename evaluated to ' . $filename);
193              
194 21         229 return $filename;
195             }
196              
197 2     2   17299 no Moose;
  2         6  
  2         14  
198             __PACKAGE__->meta->make_immutable;
199              
200             1;
201             __END__
202              
203             =head1 Name
204              
205             Connector::Builtin::File::Path
206              
207             =head1 Description
208              
209             Highly configurable file writer/reader.
210              
211             =head1 Parameters
212              
213             =over
214              
215             =item LOCATION
216              
217             The base directory where the files are located. This parameter is mandatory.
218              
219             =item file/path
220              
221             Pattern for Template Toolkit to build the filename.
222             The path components are available in the key ARGS. In set mode the unfiltered
223             data is available in key DATA.
224              
225             See also Connector::Role::LocalPath
226              
227             =item content
228              
229             Pattern for Template Toolkit to build the content. The data is passed
230             "as is". If data is a scalar, it is wrapped into a hash using DATA as key.
231              
232             =item ifexists
233              
234             =over 2
235              
236             =item * append: opens the file for appending write.
237              
238             =item * fail: call C<die>
239              
240             =item * silent: fail silently.
241              
242             =item * replace: replace the file with the new content.
243              
244             =back
245              
246             =item mode
247              
248             Filesystem permissions to apply to the file when a file is written using the
249             set method. Must be given in octal notation, e.g. 0644. Default is to not set
250             the permissions and rely on the systems umask.
251              
252             =item user / group
253              
254             Name of a user / group that the file should belong to.
255              
256             =back
257              
258             =head1 Supported Methods
259              
260             =head2 set
261              
262             Write data to a file.
263              
264             $conn->set('filename', { NAME => 'Oliver', 'ROLE' => 'Administrator' });
265              
266             See the file parameter how to control the filename.
267             By default, files are silently overwritten if they exist. See the I<ifexists>
268             parameter for an alternative behaviour.
269              
270             =head2 get
271              
272             Fetch data from a file. See the file parameter how to control the filename.
273              
274             my $data = $conn->get('filename');
275              
276             =head1 Example
277              
278             my $conn = Connector::Builtin::File::Path->new({
279             LOCATION: /var/data/
280             file: [% ARGS.0 %].txt
281             content: Hello [% NAME %]
282             });
283              
284             $conn->set('test', { NAME => 'Oliver' });
285              
286             Results in a file I</var/data/test.txt> with the content I<Hello Oliver>.