File Coverage

blib/lib/Unix/Whereis.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	41	42	97.6
condition	45	54	83.3
subroutine	9	9	100.0
pod	3	3	100.0
total	164	174	94.2

package Unix::Whereis;

use strict;
use warnings;

$Unix::Whereis::VERSION = '0.1';

use File::Spec;

our $sep;
our $cache;

sub import {
    my $caller = caller();
    no strict 'refs';    ## no critic
    *{ $caller . '::whereis' } = \&whereis;

    if ( defined $_[1] && $_[1] eq 'whereis_everyone' ) {
        *{ $caller . '::whereis_everyone' } = \&whereis_everyone;
    }
}

sub pathsep {
    $sep = $_[0] if @_;

    if ( !defined $sep ) {

        # only use %Config::Config if loaded already (keys() is the key!):
        #     pkit -e 'd(scalar keys %Config::Config);require Config;d(scalar keys %Config::Config)'
        #     pkit -e 'd(scalar keys %Config::Config)'
        #     pkit -MConfig -e 'd(scalar keys %Config::Config)'
        if ( keys %Config::Config && exists $Config::Config{'path_sep'} && length $Config::Config{'path_sep'} ) {
            $sep = $Config::Config{'path_sep'};
        }
        else {
            $sep = ':';
        }
    }

    return $sep;
}

sub whereis {
    my ( $name, $conf_hr ) = @_;
    return if !defined $name || $name eq '';

    $conf_hr = {} if !defined $conf_hr || ref $conf_hr ne 'HASH';

    if ( $conf_hr->{'cache'} && $cache->{'whereis'}{$name} ) {
        delete $cache->{'whereis'}{$name} if $conf_hr->{'cache'} eq 'clear';
        return $cache->{'whereis'}{$name} if $conf_hr->{'cache'} && exists $cache->{'whereis'}{$name};
    }

    local $ENV{'PATH'} = _build_env_path($conf_hr);

    for my $PATH ( split( pathsep(), $ENV{'PATH'} ) ) {
        my $bin = File::Spec->catfile( $PATH, $name );
        if ( -f $bin && -x _ && -s _ ) {
            $cache->{'whereis'}{$name} = $bin if $conf_hr->{'cache'};
            return $bin;
        }
    }

    return $name if $conf_hr->{'fallback'};
    return;
}

sub whereis_everyone {
    my ( $name, $conf_hr ) = @_;
    $conf_hr = {} if !defined $conf_hr || ref $conf_hr ne 'HASH';

    if ( $conf_hr->{'cache'} && $cache->{'whereis_everyone'}{$name} ) {
        delete $cache->{'whereis_everyone'}{$name} if $conf_hr->{'cache'} eq 'clear';
        return @{ $cache->{'whereis_everyone'}{$name} } if $conf_hr->{'cache'} && exists $cache->{'whereis_everyone'}{$name};
    }

    my @found;

    local $ENV{'PATH'} = _build_env_path($conf_hr);

    for my $PATH ( split( pathsep(), $ENV{'PATH'} ) ) {
        my $bin = File::Spec->catfile( $PATH, $name );
        push( @found, $bin ) if -f $bin && -x _ && -s _;
    }

    $cache->{'whereis_everyone'}{$name} = \@found if $conf_hr->{'cache'};
    return @found;
}

sub _build_env_path {
    my ($conf_hr) = @_;

    $sep ||= pathsep();

    my $path = $ENV{'PATH'};
    $path = $conf_hr->{'mypath'} if exists $conf_hr->{'mypath'} && length $conf_hr->{'mypath'};
    $path =~ s/\Q$sep\E+$//;
    $path =~ s/^\Q$sep\E+//;

    if ( exists $conf_hr->{'prepend'} && length $conf_hr->{'prepend'} ) {
        $conf_hr->{'prepend'} =~ s/\Q$sep\E+$//;
        $conf_hr->{'prepend'} =~ s/^\Q$sep\E+//;
        $path = "$conf_hr->{'prepend'}$sep$path";
    }

    if ( exists $conf_hr->{'append'} && length $conf_hr->{'append'} ) {
        $conf_hr->{'append'} =~ s/\Q$sep\E+$//;
        $conf_hr->{'append'} =~ s/^\Q$sep\E+//;
        $path .= $sep . $conf_hr->{'append'};
    }

    return $path;
}

1;

__END__