Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add OO interface #41

Draft
wants to merge 5 commits into
base: main
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
139 changes: 96 additions & 43 deletions lib/File/Which.pm
Original file line number Diff line number Diff line change
Expand Up @@ -99,33 +99,86 @@ me.
our @EXPORT = 'which';
our @EXPORT_OK = 'where';

use constant IS_VMS => ($^O eq 'VMS');
use constant IS_MAC => ($^O eq 'MacOS');
use constant IS_WIN => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');
use constant IS_DOS => IS_WIN();
use constant IS_CYG => ($^O eq 'cygwin' || $^O eq 'msys');

our $IMPLICIT_CURRENT_DIR = IS_WIN || IS_VMS || IS_MAC;

# For Win32 systems, stores the extensions used for
# executable files
# For others, the empty string is used
# because 'perl' . '' eq 'perl' => easier
my @PATHEXT = ('');
if ( IS_WIN ) {
# WinNT. PATHEXT might be set on Cygwin, but not used.
if ( $ENV{PATHEXT} ) {
push @PATHEXT, split /;/, $ENV{PATHEXT};
sub _get_osname { @_ == 1 && ref $_[0] ? $_[0]->{osname} : $^O }

sub _is_vms { my $osname = &_get_osname; ($osname eq 'VMS'); }
sub _is_mac { my $osname = &_get_osname; ($osname eq 'MacOS'); }
sub _is_win { my $osname = &_get_osname; ($osname eq 'MSWin32' or $osname eq 'dos' or $osname eq 'os2'); }
sub _is_dos { _is_win(@_); }
sub _is_cyg { my $osname = &_get_osname; ($osname eq 'cygwin' || $osname eq 'msys'); }

sub _default_implicit_current_dir {
my $self = shift;
$self->_is_win || $self->_is_vms || $self->_is_mac;
}
our $IMPLICIT_CURRENT_DIR = do {
File::Which->new->_default_implicit_current_dir;
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I apologize for introducing this interface now. But we have to support it :(

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just a comment (you are already doing that).

};

sub new {
my ($class, %opts) = @_;

my $osname = exists $opts{os} ? $opts{os} : $^O;
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not sure $^O is quite right for this, it has a lot of detail for unix like operating systems and not enough for windows. I think we want to know if it is unix, or win/vms/cyg/os9, and then we want something like win+powershell win+bash.

Copy link
Member

@plicease plicease Oct 16, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe we can have opts for os and shell. I still don't think $^O is right for os as Windows9x and WindowsNT are both MSWin32 unfortunately. I'm not too enthused about inventing our own categories for os, but we may have to. Note #41 (review) and #42


my $self = bless {
osname => $osname,
}, $class;

$self->{implicit_current_dir} =
exists $opts{implicit_current_dir}
? $opts{implicit_current_dir}
: $self->_default_implicit_current_dir;

$self->{PATHEXT} = $self->_default_pathext;

if( exists $opts{fixed_paths} ) {
$self->{fixed_paths} = $opts{fixed_paths};
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would like to delete from %opts and error if there is anything left over, that way we can add new options in the future, and if someone is trying to use those options on an older File::Which they will get an error.

}

$self;
}

sub _default_pathext {
my $self = shift;
# For Win32 systems, stores the extensions used for
# executable files
# For others, the empty string is used
# because 'perl' . '' eq 'perl' => easier
my @PATHEXT = ('');
if ( $self->_is_win ) {
# WinNT. PATHEXT might be set on Cygwin, but not used.
if ( $ENV{PATHEXT} ) {
push @PATHEXT, split /;/, $ENV{PATHEXT};
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I know this is a Windows environment variable, but I think we should use Env qw( @PATHEXT ) for this and other list type environment variables. This will make it easier to test windows behavior on non-windows OS. Any tests that test default behavior can also use Env.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Env is core as of Perl 5, so introducing it as a prereq shouldn't be a problem.

} else {
# Win9X or other: doesn't have PATHEXT, so needs hardcoded.
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I guess this isn't related to this PR, but if PATHEXT isn't supported on Windows 9x or DOS, then we shouldn't use it on those platforms.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

#42

but we should at least consider that we may need to treat DOS/Windows9x as a different OS than WindowsNT.

push @PATHEXT, qw{.com .exe .bat};
}
} elsif ( $self->_is_vms ) {
push @PATHEXT, qw{.exe .com};
} elsif ( $self->_is_cyg ) {
# See this for more info
# http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-exe
push @PATHEXT, qw{.exe .com};
}

\@PATHEXT;
}

sub _default_path {
my $self = shift;
my @path;
if($self->{osname} eq 'MSWin32') {
# File::Spec (at least recent versions)
# add the implicit . for you on MSWin32,
# but we may or may not want to include
# that.
@path = split /;/, $ENV{PATH};
s/"//g for @path;
@path = grep length, @path;
} else {
# Win9X or other: doesn't have PATHEXT, so needs hardcoded.
push @PATHEXT, qw{.com .exe .bat};
@path = File::Spec->path;
}
} elsif ( IS_VMS ) {
push @PATHEXT, qw{.exe .com};
} elsif ( IS_CYG ) {
# See this for more info
# http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-exe
push @PATHEXT, qw{.exe .com};
\@path;
}

=head1 FUNCTIONS
Expand All @@ -152,6 +205,13 @@ matches.
=cut

sub which {
my $self = @_ == 1
? File::Which->new(
# Use global to retain compatibility, but only for the functional
# interface.
implicit_current_dir => $IMPLICIT_CURRENT_DIR,
)
: shift;
my ($exec) = @_;

return undef unless defined $exec;
Expand All @@ -161,15 +221,15 @@ sub which {
my @results = ();

# check for aliases first
if ( IS_VMS ) {
if ( $self->_is_vms ) {
my $symbol = `SHOW SYMBOL $exec`;
chomp($symbol);
unless ( $? ) {
return $symbol unless $all;
push @results, $symbol;
}
}
if ( IS_MAC ) {
if ( $self->_is_mac ) {
my @aliases = split /\,/, $ENV{Aliases};
foreach my $alias ( @aliases ) {
# This has not been tested!!
Expand All @@ -188,24 +248,17 @@ sub which {
}

return $exec ## no critic (ValuesAndExpressions::ProhibitMixedBooleanOperators)
if !IS_VMS and !IS_MAC and !IS_WIN and $exec =~ /\// and -f $exec and -x $exec;
if !$self->_is_vms and !$self->_is_mac and !$self->_is_win and $exec =~ /\// and -f $exec and -x $exec;

my @path;
if($^O eq 'MSWin32') {
# File::Spec (at least recent versions)
# add the implicit . for you on MSWin32,
# but we may or may not want to include
# that.
@path = split /;/, $ENV{PATH};
s/"//g for @path;
@path = grep length, @path;
} else {
@path = File::Spec->path;
}
if ( $IMPLICIT_CURRENT_DIR ) {
my @path = exists $self->{fixed_paths}
? @{ $self->{fixed_paths} }
: @{ $self->_default_path };

if ( $self->{implicit_current_dir} ) {
unshift @path, File::Spec->curdir;
}

my @PATHEXT = @{ $self->{PATHEXT} };
foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
for my $ext ( @PATHEXT ) {
my $file = $base.$ext;
Expand All @@ -218,10 +271,10 @@ sub which {
-x _
or (
# MacOS doesn't mark as executable so we check -e
IS_MAC ## no critic (ValuesAndExpressions::ProhibitMixedBooleanOperators)
$self->_is_mac ## no critic (ValuesAndExpressions::ProhibitMixedBooleanOperators)
||
(
( IS_WIN or IS_CYG )
( $self->_is_win or $self->_is_cyg )
and
grep { ## no critic (BuiltinFunctions::ProhibitBooleanGrep)
$file =~ /$_\z/i
Expand Down
18 changes: 9 additions & 9 deletions t/file_which.t
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ use Test::More tests => 19;
use File::Spec ();
use File::Which qw(which where);

unless (File::Which::IS_VMS or File::Which::IS_MAC or File::Which::IS_WIN ) {
unless (File::Which::_is_vms() or File::Which::_is_mac() or File::Which::_is_win() ) {
foreach my $path (qw(
corpus/test-bin-unix/test3
corpus/test-bin-unix/all
Expand Down Expand Up @@ -35,24 +35,24 @@ unless (File::Which::IS_VMS or File::Which::IS_MAC or File::Which::IS_WIN ) {
);

# Where is the test application
my $test_bin = File::Spec->catdir( 'corpus', File::Which::IS_WIN ? 'test-bin-win' : 'test-bin-unix' );
my $test_bin = File::Spec->catdir( 'corpus', File::Which::_is_win() ? 'test-bin-win' : 'test-bin-unix' );
ok( -d $test_bin, 'Found test-bin' );

# Set up for running the test application
@PATH = $test_bin;
push @PATH, File::Spec->catdir( 'corpus', 'test-bin-win' ) if File::Which::IS_CYG;
push @PATH, File::Spec->catdir( 'corpus', 'test-bin-win' ) if File::Which::_is_cyg();

SKIP: {
skip("Not on DOS-like filesystem", 3) unless File::Which::IS_WIN;
skip("Not on DOS-like filesystem", 3) unless File::Which::_is_win();
is( lc scalar which('test1'), 'corpus\test-bin-win\test1.exe', 'Looking for test1.exe' );
is( lc scalar which('test2'), 'corpus\test-bin-win\test2.bat', 'Looking for test2.bat' );
is( scalar which('test3'), undef, 'test3 returns undef' );
}

SKIP: {
skip("Not on a UNIX filesystem", 1) if File::Which::IS_WIN;
skip("Not on a UNIX filesystem", 1) if File::Which::IS_MAC;
skip("Not on a UNIX filesystem", 1) if File::Which::IS_VMS;
skip("Not on a UNIX filesystem", 1) if File::Which::_is_win();
skip("Not on a UNIX filesystem", 1) if File::Which::_is_mac();
skip("Not on a UNIX filesystem", 1) if File::Which::_is_vms();
is(
scalar(which('test3')),
File::Spec->catfile( $test_bin, 'test3'),
Expand All @@ -61,7 +61,7 @@ unless (File::Which::IS_VMS or File::Which::IS_MAC or File::Which::IS_WIN ) {
}

SKIP: {
skip("Not on a cygwin filesystem", 2) unless File::Which::IS_CYG;
skip("Not on a cygwin filesystem", 2) unless File::Which::_is_cyg();

# Cygwin: should make test1.exe transparent
is(
Expand All @@ -78,7 +78,7 @@ unless (File::Which::IS_VMS or File::Which::IS_MAC or File::Which::IS_WIN ) {

# Make sure that .\ stuff works on DOSish, VMS, MacOS (. is in PATH implicitly).
SKIP: {
unless ( File::Which::IS_WIN or File::Which::IS_VMS ) {
unless ( File::Which::_is_win() or File::Which::_is_vms() ) {
skip("Not on a DOS or VMS filesystem", 1);
}

Expand Down