File Coverage

blib/lib/Env/Path.pm

Criterion	Covered	Total	%
statement	80	164	48.7
branch	26	70	37.1
condition	4	30	13.3
subroutine	15	24	62.5
pod	16	17	94.1
total	141	305	46.2

package Env::Path;

$VERSION = '0.19';

require 5.004;
use strict;

use constant MSWIN => $^O =~ /MSWin|Windows_NT/i ? 1 : 0;

use Config;

my $dsep = $Config::Config{path_sep};

sub new {
    my $class = shift;
    my $pathvar = shift;
    my $pathref = \$ENV{$pathvar};
    bless $pathref, $class;
    $pathref->Assign(@_) if @_;
    return $pathref if defined wantarray;
    eval "\@$pathvar\::ISA = '$class'";
}

sub import {
    my $class = shift;
    return unless @_;
    my @list = @_;
    @list = keys %ENV if $list[0] eq ':all';
    for my $pathvar (@list) {
	$class->new($pathvar);
    }
}

sub AUTOLOAD {
    my $class = shift;
    (my $pathvar = $Env::Path::AUTOLOAD) =~ s/.*:://;
    return if $pathvar eq 'DESTROY';
    $class->new($pathvar, @_);
}

sub _class2ref {
    my $proto = shift;
    ref $proto ? $proto : \$ENV{$proto};
}

sub PathSeparator {
    shift;
    $dsep = shift if @_;
    return $dsep;
}

sub Name {
    my $pathref = _class2ref(shift);
    for my $name (keys %ENV) {
	return $name if $pathref == \$ENV{$name};
    }
    return undef;
}

sub List {
    my $pathref = _class2ref(shift);
    return split /$dsep/, $$pathref;
}

sub Contains {
    my $pathref = _class2ref(shift);
    my $entry = shift;
    my @list = $pathref->List;
    if (MSWIN) {
	for ($entry, @list) {
	    $_ = lc($_);
	    s%\\%/%g;
	}
    }
    my %has = map {$_ => 1} @list;
    return $has{$entry};
}
*Has = \&Contains;	# backward compatibility

sub Assign {
    my $pathref = _class2ref(shift);
    $$pathref = join($dsep, @_);
    return $pathref;
}

sub Prepend {
    my $pathref = _class2ref(shift);
    $pathref->Remove(@_);
    $$pathref = $dsep.$$pathref if $$pathref;
    $$pathref = join($dsep, @_) . $$pathref;
    return $pathref;
}

sub Append {
    my $pathref = _class2ref(shift);
    $pathref->Remove(@_);
    $$pathref .= $dsep if $$pathref;
    $$pathref .= join($dsep, @_);
    return $pathref;
}

sub InsertBefore {
    my $pathref = _class2ref(shift);
    my $marker = shift;
    $pathref->Remove(@_);
    my $insert = join($dsep, map {split ','} @_);
    my $temp = $$pathref || '';
    $$pathref = '';
    for (split /$dsep/, $temp) {
	$_ ||= '.';
	$$pathref .= $dsep if $$pathref;
	if ($marker && $_ eq $marker) {
	    $$pathref .= $insert . $dsep;
	    undef $marker;
	}
	$$pathref .= $_;
    }
    if (defined $marker) {
	$$pathref = $$pathref ? "$insert$dsep$$pathref" : $insert;
    }
    return $pathref;
}

sub InsertAfter {
    my $pathref = _class2ref(shift);
    my $marker = shift;
    $pathref->Remove(@_);
    my $insert = join($dsep, map {split ','} @_);
    my $temp = $$pathref || '';
    $$pathref = '';
    for (split /$dsep/, $temp) {
	$_ ||= '.';
	$$pathref .= $dsep if $$pathref;
	$$pathref .= $_;
	if ($marker && $_ eq $marker) {
	    $$pathref .= $dsep . $insert;
	    undef $marker;
	}
    }
    if (defined $marker) {
	$$pathref = $$pathref ? "$$pathref$dsep$insert" : $insert;
    }
    return $pathref;
}

sub Remove {
    my $pathref = _class2ref(shift);
    return $pathref unless $$pathref;
    my %remove = map {$_ => 1} @_;
    if (MSWIN) {
	for (keys %remove) {
	    (my $lcname = lc($_)) =~ s%\\%/%g;
	    delete $remove{$_};
	    $remove{lc($_)} = 1;
	}
    }
    my @entries = map {$_ || '.'} split(/$dsep/, $$pathref);
    if (MSWIN) {
	my @left = ();
	for (@entries) {
	    (my $lcname = lc($_)) =~ s%\\%/%g;
	    push(@left, $_) unless $remove{$lcname};
	}
	$$pathref = join($dsep, @left);
    } else {
	$$pathref = join($dsep, grep {!$remove{$_}} @entries);
    }
    return $pathref;
}

sub Replace {
    my $pathref = _class2ref(shift);
    return $pathref unless $$pathref;
    my $re = shift;
    my @temp = split /$dsep/, $$pathref;
    for (@temp) {
	$_ ||= '.';
	if (/$re/) {
	    $_ = join($dsep, map {split ','} @_);
	}
    }
    $$pathref = join($dsep, @temp);
    return $pathref;
}

sub ListNonexistent {
    my $pathref = _class2ref(shift);
    return $pathref unless $$pathref;
    my @missing = ();
    for (split /$dsep/, $$pathref) {
	push(@missing, $_) if $_ && ! -e $_;
    }
    return @missing;
}

sub DeleteNonexistent {
    my $pathref = _class2ref(shift);
    return $pathref unless $$pathref;
    my $temp = $$pathref;
    $$pathref = '';
    for (split /$dsep/, $temp) {
	$_ ||= '.';
	next if ! -e $_;
	$$pathref .= $dsep if $$pathref;
	$$pathref .= $_;
    }
    return $pathref;
}

sub Uniqify {
    my $pathref = _class2ref(shift);
    my %seen;
    my $temp = $$pathref || '';
    $$pathref = '';
    for (split /$dsep/, $temp) {
	$_ ||= '.';
	my $entry = MSWIN ? lc($_) : $_;
	next if $seen{$entry}++;
	$$pathref .= $dsep if $$pathref;
	$$pathref .= $_;
    }
    return $pathref;
}

sub Whence {
    my $pathref = _class2ref(shift);
    my $pat = shift;
    my(@found, %seen);
    for my $dir (split /$dsep/, $$pathref) {
	$dir ||= '.';
	$dir =~ s%[/\\]+$%%;
	$dir =~ s%([/\\])[/\\]+%$1%;
	# On &^#$ Windows we need to convert paths to use /, then glob
	# using bsd_glob because it will automatically ignore case,
	# then convert back to \ iff the original paths preferred it.
	# Without this some paths, esp UNC paths, get mixed up.
	# We also have to deal with PATHEXT.
	if (MSWIN) {
	    for my $ext ('', split ';', $ENV{PATHEXT}) {
		(my $glob = "$dir/$pat$ext") =~ s%\\%/%g;
		my @matches = File::Glob::bsd_glob($glob);
		if ($dir eq '.' || $dir =~ m%\\%) {
		    $glob =~ s%/%\\%g;
		    for (@matches) { s%/%\\%g }
		}
		push(@found, grep {-f $_ && !$seen{$_}++} $glob, @matches);
	    }
	} else {
	    my $glob = "$dir/$pat";
	    my @matches = glob($glob);
	    if ($^O =~ m%cygwin%i) {
		push(@found, grep {-f $_ && !$seen{$_}++} $glob, @matches);
	    } else {
		push(@found, grep {-f $_ && -x _ && !$seen{$_}++} $glob, @matches);
	    }
	}
    }
    return @found;
}

sub Shell {
    my $pathref = _class2ref(shift);
    my $name = $pathref->Name;
    my $winshell = MSWIN && !$ENV{SHELL};
    my $str = "set " if $winshell;
    $str .= qq($name="$$pathref");
    $str .= "; export $name" if !$winshell;
    return $str;
}

# Nothing to do here, just avoiding interaction with AUTOLOAD.
sub DESTROY { }

1;

__END__