File Coverage

blib/lib/Connector/Builtin/File/Path.pm
Criterion Covered Total %
statement 84 94 89.3
branch 27 42 64.2
condition 7 11 63.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   90666 use strict;
  2         11  
  2         54  
10 2     2   9 use warnings;
  2         4  
  2         42  
11 2     2   8 use English;
  2         3  
  2         12  
12 2     2   734 use File::Spec;
  2         4  
  2         43  
13 2     2   535 use Data::Dumper;
  2         5886  
  2         87  
14 2     2   1969 use Template;
  2         34161  
  2         52  
15              
16 2     2   462 use Moose;
  2         405097  
  2         28  
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 1190 my $self = shift;
64 6         13 my $path = shift;
65              
66 6         16 my $filename = $self->_sanitize_path( $path );
67              
68 6 50       120 if (! -r $filename) {
69 0         0 return $self->_node_not_exists( $path );
70             }
71              
72 6         39 my $content = do {
73 6         27 local $INPUT_RECORD_SEPARATOR;
74 6         197 open my $fh, '<', $filename;
75 6         236 <$fh>;
76             };
77 6         44 return $content;
78             }
79              
80             sub get_meta {
81 2     2 1 8 my $self = shift;
82              
83             # If we have no path, we tell the caller that we are a connector
84 2         7 my @path = $self->_build_path_with_prefix( shift );
85 2 100       8 if (scalar @path == 0) {
86 1         9 return { TYPE => "connector" };
87             }
88              
89 1         16 return {TYPE => "scalar" };
90             }
91              
92              
93             sub exists {
94              
95 4     4 1 10 my $self = shift;
96              
97             # No path = connector root which always exists
98 4         10 my @path = $self->_build_path_with_prefix( shift );
99 4 100       12 if (scalar @path == 0) {
100 1         5 return 1;
101             }
102              
103 3         12 my $filename = $self->_sanitize_path( \@path );
104              
105 3         83 return -r $filename;
106             }
107              
108              
109             # return the content of the file
110             sub set {
111              
112 12     12 1 37 my $self = shift;
113 12         20 my $file = shift;
114 12         18 my $data = shift;
115              
116 12         38 my $filename = $self->_sanitize_path( $file, $data );
117              
118 12         18 my $content;
119 12 100       301 if ($self->content()) {
120 10         183 $self->log()->debug('Process template for content ' . $self->content());
121 10         83 my $template = Template->new({});
122              
123 10 100       3499 $data = { DATA => $data } if (ref $data eq '');
124              
125 10 50       289 $template->process( \$self->content(), $data, \$content) || die "Error processing content template.";
126             } else {
127 2 50       20 if (ref $data ne '') {
128 0         0 die "You need to define a content template if data is not a scalar";
129             }
130 2         5 $content = $data;
131             }
132              
133 12         15430 my $mode = $self->ifexists();
134 12 100 66     67 if ($mode eq 'fail' && -f $filename) {
135 1         26 die "File $filename exists";
136             }
137              
138 11 100 66     47 if ($mode eq 'silent' && -f $filename) {
139 1         7 return;
140             }
141              
142 10 100       258 if (my $mode = $self->mode()) {
143 2 100       11 if ($mode =~ m{\A[0-7]{4}\z}) {
144 1   50     47 chmod oct($mode), $filename || die "Unable to change mode to $mode";
145             } else {
146 1         15 die "Given umask '$mode' is not valid";
147             }
148             }
149              
150 9         25 my $uid = -1;
151 9         12 my $gid;
152 9 50       220 if (my $user = $self->user()) {
153 0 0       0 $uid = getpwnam($user) or die "$user not known";
154 0         0 $gid = -1;
155             }
156              
157 9 50       213 if (my $group = $self->group()) {
158 0 0       0 $gid = getgrnam($group) or die "$group not known";
159             }
160              
161 9 100 66     54 if ($mode eq 'append' && -f $filename) {
162 1 50       33 open (FILE, ">>",$filename) || die "Unable to open file for appending";
163             } else {
164 8 100       757 open (FILE, ">", $filename) || die "Unable to open file for writing";
165             }
166              
167 7         69 print FILE $content;
168 7         698 close FILE;
169              
170 7 50       32 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         59 return 1;
177             }
178              
179              
180             sub _sanitize_path {
181              
182 21     21   35 my $self = shift;
183 21         28 my $inargs = shift;
184 21         28 my $data = shift;
185              
186 21         59 my @args = $self->_build_path_with_prefix( $inargs );
187              
188 21         101 my $file = $self->_render_local_path( \@args, $data );
189              
190 21         74 my $filename = $self->{LOCATION}.'/'.$file;
191              
192 21         499 $self->log()->debug('Filename evaluated to ' . $filename);
193              
194 21         185 return $filename;
195             }
196              
197 2     2   16029 no Moose;
  2         5  
  2         15  
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>.