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

package Lchmod;

use strict;
use warnings;
use FFI::Me;

$Lchmod::VERSION = '0.01';

my $LCHMOD_AVAILABLE = 0;
sub LCHMOD_AVAILABLE { return 1 if $LCHMOD_AVAILABLE; return; }

sub import {
    shift;
    my $caller = caller;

    if (@_) {

        # TODO ?: warn if @_ contains someting other than lchmod or LCHMOD_AVAILABLE

        no strict 'refs';    ## no critic
        *{ $caller . "::lchmod" }           = \&lchmod           if grep m/^lchmod$/,           @_;
        *{ $caller . "::LCHMOD_AVAILABLE" } = \&LCHMOD_AVAILABLE if grep m/^LCHMOD_AVAILABLE$/, @_;
    }
    else {
        no strict 'refs';    ## no critic
        *{ $caller . "::lchmod" } = \&lchmod;
    }
}

{
    local $@;
    eval {                   # 1st: try current process
        ffi _sys_lchmod => (
            rv  => ffi::int,
            arg => [ ffi::str, ffi::int ],
            sym => 'lchmod',
        );
    };
    $LCHMOD_AVAILABLE = 1 if !$@;
}

# ? needed ?
# if (!$LCHMOD_AVAILABLE) {
#     local $@;
#     eval { # 2nd: try explicit libc
#         ffi _sys_lchmod => (
#             lib => $^O eq 'darwin' ? 'libc.dylib' : 'libc.so', # or whatever
#             rv  => ffi::int,
#             arg => [ffi::str,ffi::int],
#             sym => 'lchmod',
#         );
#     };
#     $LCHMOD_AVAILABLE = 1 if !$@;
# }

sub lchmod {
    my ( $mode, @files ) = @_;

    if ( !LCHMOD_AVAILABLE() ) {
        $! = _get_errno_func_not_impl();    # ENOSYS
        return undef;                       ## no critic
    }

    my $count = 0;
    my $normalized_mode = sprintf( "%04o", $mode & 07777 );    ## no critic

    for my $path (@files) {
        if ( -l $path ) {
            _sys_lchmod( $path, oct($normalized_mode) );
        }
        else {
            chmod( oct($normalized_mode), $path );
        }

        my $current_mode = ( lstat($path) )[2];
        next if !$current_mode;

        $current_mode = sprintf( "%04o", $current_mode & 07777 );    ## no critic
        $count++ if $current_mode eq $normalized_mode;
    }

    return $count;
}

sub _get_errno_func_not_impl {

    # we don't want to load POSIX but if its there we want to use it
    # CONSTANTs are weird when not defined so we have to:

    local $^W = 0;
    no warnings;
    no strict;    ## no critic
    my $posix = POSIX::ENOSYS;
    return
        $posix ne 'POSIX::ENOSYS' ? POSIX::ENOSYS
      : $^O =~ /linux/i           ? 38
      :                             78;
}

1;

__END__