File Coverage

blib/lib/Lchmod.pm
Criterion Covered Total %
statement 49 50 98.0
branch 17 20 85.0
condition n/a
subroutine 11 11 100.0
pod 1 1 100.0
total 78 82 95.1


line stmt bran cond sub pod time code
1             package Lchmod;
2              
3 2     2   19471 use strict;
  2         4  
  2         76  
4 2     2   8 use warnings;
  2         4  
  2         51  
5 2     2   1238 use FFI::Me;
  2         16707  
  2         11  
6              
7             $Lchmod::VERSION = '0.01';
8              
9             my $LCHMOD_AVAILABLE = 0;
10 16 50   16   888 sub LCHMOD_AVAILABLE { return 1 if $LCHMOD_AVAILABLE; return; }
  0         0  
11              
12             sub import {
13 5     5   754 shift;
14 5         10 my $caller = caller;
15              
16 5 100       14 if (@_) {
17              
18             # TODO ?: warn if @_ contains someting other than lchmod or LCHMOD_AVAILABLE
19              
20 2     2   169 no strict 'refs'; ## no critic
  2         4  
  2         202  
21 3 100       19 *{ $caller . "::lchmod" } = \&lchmod if grep m/^lchmod$/, @_;
  2         21  
22 3 100       69 *{ $caller . "::LCHMOD_AVAILABLE" } = \&LCHMOD_AVAILABLE if grep m/^LCHMOD_AVAILABLE$/, @_;
  2         2028  
23             }
24             else {
25 2     2   10 no strict 'refs'; ## no critic
  2         3  
  2         551  
26 2         3 *{ $caller . "::lchmod" } = \&lchmod;
  2         42  
27             }
28             }
29              
30             {
31             local $@;
32             eval { # 1st: try current process
33             ffi _sys_lchmod => (
34             rv => ffi::int,
35             arg => [ ffi::str, ffi::int ],
36             sym => 'lchmod',
37             );
38             };
39             $LCHMOD_AVAILABLE = 1 if !$@;
40             }
41              
42             # ? needed ?
43             # if (!$LCHMOD_AVAILABLE) {
44             # local $@;
45             # eval { # 2nd: try explicit libc
46             # ffi _sys_lchmod => (
47             # lib => $^O eq 'darwin' ? 'libc.dylib' : 'libc.so', # or whatever
48             # rv => ffi::int,
49             # arg => [ffi::str,ffi::int],
50             # sym => 'lchmod',
51             # );
52             # };
53             # $LCHMOD_AVAILABLE = 1 if !$@;
54             # }
55              
56             sub lchmod {
57 14     14 1 8497 my ( $mode, @files ) = @_;
58              
59 14 100       27 if ( !LCHMOD_AVAILABLE() ) {
60 1         6 $! = _get_errno_func_not_impl(); # ENOSYS
61 1         5 return undef; ## no critic
62             }
63              
64 13         14 my $count = 0;
65 13         42 my $normalized_mode = sprintf( "%04o", $mode & 07777 ); ## no critic
66              
67 13         20 for my $path (@files) {
68 17 100       217 if ( -l $path ) {
69 6         19 _sys_lchmod( $path, oct($normalized_mode) );
70             }
71             else {
72 11         149 chmod( oct($normalized_mode), $path );
73             }
74              
75 17         189 my $current_mode = ( lstat($path) )[2];
76 17 100       43 next if !$current_mode;
77              
78 15         28 $current_mode = sprintf( "%04o", $current_mode & 07777 ); ## no critic
79 15 100       42 $count++ if $current_mode eq $normalized_mode;
80             }
81              
82 13         52 return $count;
83             }
84              
85             sub _get_errno_func_not_impl {
86              
87             # we don't want to load POSIX but if its there we want to use it
88             # CONSTANTs are weird when not defined so we have to:
89              
90 1     1   3 local $^W = 0;
91 2     2   10 no warnings;
  2         3  
  2         106  
92 2     2   9 no strict; ## no critic
  2         4  
  2         196  
93 1         6 my $posix = POSIX::ENOSYS;
94             return
95 1 50       8 $posix ne 'POSIX::ENOSYS' ? POSIX::ENOSYS
    50          
96             : $^O =~ /linux/i ? 38
97             : 78;
98             }
99              
100             1;
101              
102             __END__