File Coverage

blib/lib/Catmandu/Fix/Condition/file_test.pm
Criterion Covered Total %
statement 29 30 96.6
branch 2 4 50.0
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 39 43 90.7


line stmt bran cond sub pod time code
1             package Catmandu::Fix::Condition::file_test;
2 2     2   295458 use Catmandu::Sane;
  2         5  
  2         13  
3 2     2   392 use Moo;
  2         3  
  2         11  
4 2     2   499 use Carp qw(confess);
  2         7  
  2         121  
5 2     2   9 use Catmandu::Util qw();
  2         2  
  2         31  
6 2     2   8 use namespace::clean;
  2         2  
  2         14  
7 2     2   430 use Catmandu::Fix::Has;
  2         3  
  2         15  
8              
9             my $allowed_tests = [qw(r w o x R W O X e z s f d l p S b c t u g k B)];
10              
11             has path => (fix_arg => 1);
12             has test => (fix_arg => 1);
13             has _tests => ( is => 'ro', lazy => 1, builder => '_build_tests' );
14              
15             sub _build_tests {
16 6     6   361 my $self = $_[0];
17 6         39 my @vals = split( //o, $self->test );
18             my $tests = [
19 6 50       19 grep { Catmandu::Util::array_includes( $allowed_tests, $_ ) or confess("invalid test $_"); } @vals
  7         305  
20             ];
21 6 50       1353 unless( @$tests ){
22 0         0 confess "no valid tests supplied";
23             }
24 6         21 $tests;
25             }
26              
27             with 'Catmandu::Fix::Condition::SimpleAllTest';
28              
29             sub emit_test {
30 6     6 0 29756 my ($self, $var, $fixer) = @_;
31 6         11 my $tests = join(' && ',map { "-$_ ${var}" } @{$self->_tests()});
  7         25  
  6         111  
32 6         31 "(is_value( ${var} ) ? $tests : 0)"
33             }
34              
35             =head1 NAME
36              
37             Catmandu::Fix::Condition::file_test - only execute fixes of file test is successfull
38              
39             =head1 SYNOPSIS
40              
41             add_field('path','/home/njfranck')
42              
43             if file_test('path','dw')
44             add_field('messages.$append','path is a directory')
45             add_field('messages.$append','path is writable')
46             end
47              
48             =head1 ARGUMENTS
49              
50             =over
51              
52             =item path
53              
54             =item tests
55              
56             List of file tests, all in one string.
57              
58             Possible file tests (taken from <http://perldoc.perl.org/functions/-X.html>):
59              
60             R File is readable by real uid/gid.
61              
62             W File is writable by real uid/gid.
63              
64             X File is executable by real uid/gid.
65              
66             O File is owned by real uid.
67              
68             e File exists.
69              
70             z File has zero size (is empty).
71              
72             s File has nonzero size (returns size in bytes).
73              
74             f File is a plain file.
75              
76             d File is a directory.
77              
78             l File is a symbolic link (false if symlinks aren't supported by the file system).
79              
80             p File is a named pipe (FIFO), or Filehandle is a pipe.
81              
82             S File is a socket.
83              
84             b File is a block special file.
85              
86             c File is a character special file.
87              
88             t Filehandle is opened to a tty.
89              
90             u File has setuid bit set.
91              
92             g File has setgid bit set.
93              
94             k File has sticky bit set.
95              
96             T File is an ASCII or UTF-8 text file (heuristic guess).
97              
98             B File is a "binary" file (opposite of -T).
99              
100             =back
101              
102             =head1 AUTHOR
103              
104             Nicolas Franck, C<< <nicolas.franck at ugent.be> >>
105              
106             =head1 SEE ALSO
107              
108             L<Catmandu::Fix>
109              
110             =cut
111              
112             1;