File Coverage

blib/lib/Catmandu/Fix/Condition/file_test.pm
Criterion Covered Total %
statement 18 30 60.0
branch 0 4 0.0
condition n/a
subroutine 6 8 75.0
pod 0 1 0.0
total 24 43 55.8


line stmt bran cond sub pod time code
1             package Catmandu::Fix::Condition::file_test;
2 1     1   4 use Catmandu::Sane;
  1         1  
  1         5  
3 1     1   133 use Moo;
  1         1  
  1         3  
4 1     1   202 use Carp qw(confess);
  1         1  
  1         49  
5 1     1   3 use Catmandu::Util qw();
  1         1  
  1         12  
6 1     1   2 use namespace::clean;
  1         1  
  1         5  
7 1     1   225 use Catmandu::Fix::Has;
  1         1  
  1         6  
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 0     0     my $self = $_[0];
17 0           my @vals = split( //o, $self->test );
18             my $tests = [
19 0 0         grep { Catmandu::Util::array_includes( $allowed_tests, $_ ) or confess("invalid test $_"); } @vals
  0            
20             ];
21 0 0         unless( @$tests ){
22 0           confess "no valid tests supplied";
23             }
24 0           $tests;
25             }
26              
27             with 'Catmandu::Fix::Condition::SimpleAllTest';
28              
29             sub emit_test {
30 0     0 0   my ($self, $var, $fixer) = @_;
31 0           my $tests = join(' && ',map { "-$_ ${var}" } @{$self->_tests()});
  0            
  0            
32 0           "(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;