#! /usr/bin/perl -w

use strict;

#
# This script checks the behavior of filetest -x _ 
# and demonstrates a problem in Win2k where filetest2() and filetest3() below
# fail to classify the 2 test files (a script and the perl interpreter) as executable.
# By rudif@bluemail.ch 26 Jun 2001
# 

my ($script, $exe);
if ($^O =~ /Win/) { 
	# assume the usual directory - please edit if different on your machine
	($script, $exe) = qw ( c:/perl/bin/pod2html.bat c:/perl/bin/perl.exe );
}
else { 
	# assume *nix
	# assume the usual directory - please edit if different on your machine
	($script, $exe) = qw ( /usr/bin/pod2html /usr/bin/perl );
}

die "no such file $script" unless -f $script;
die "no such file $exe" unless -f $exe;

printf "OS $^O, perl %vd\n\n", $^V;

compare(filetest0($exe), filetest1($exe));
compare(filetest0($exe), filetest2($exe));
compare(filetest0($exe), filetest3($exe));
compare(filetest0($exe), filetest4($exe));
print "\n";

compare(filetest0($script), filetest1($script));
compare(filetest0($script), filetest2($script));
compare(filetest0($script), filetest3($script));
compare(filetest0($script), filetest4($script));
print "\n";

sub filetest0 {		# reference - not using _
	my $file = shift;
	my @props;
    push @props, "Readable" if -r $file;
    push @props, "Writable" if -w $file;
    push @props, "Executable" if -x $file;
    push @props, "Binary" if -B $file;
    push @props, "Text" if -T $file;
	join ' ', "filetest0 $file: ", sort @props; 
}

sub filetest1 {		
	my $file = shift;
    stat($file);
	my @props;
    push @props, "Readable" if -r _;
    push @props, "Writable" if -w _;
    push @props, "Executable" if -x _;	# before -B and -T
    push @props, "Binary" if -B _;
    push @props, "Text" if -T _;
	join ' ', "filetest1 $file: ", sort @props; 
}

sub filetest2 {		
	my $file = shift;
    stat($file);
	my @props;
    push @props, "Readable" if -r _;
    push @props, "Writable" if -w _;
    push @props, "Text" if -T _;
    push @props, "Executable" if -x _; # after -T _
    push @props, "Binary" if -B _;
	join ' ', "filetest2 $file: ", sort @props; 
}

sub filetest3 {
	my $file = shift;
    stat($file);
	my @props;
    push @props, "Readable" if -r _;
    push @props, "Writable" if -w _;
    push @props, "Text" if -T $file; # after -T $file
    push @props, "Executable" if -x _;
    push @props, "Binary" if -B _;
	join ' ', "filetest3 $file: ", sort @props; 
}

sub filetest4 {
	my $file = shift;
    stat($file);
	my @props;
    push @props, "Readable" if -r _;
    push @props, "Writable" if -w _;
    push @props, "Text" if -T _;
    push @props, "Executable" if -x $file; # not using _
    push @props, "Binary" if -B _;
	join ' ', "filetest4 $file: ", sort @props; 
}

sub compare {
	my ($ref, $other) = @_;
	(my $_ref = $ref) =~ s/.*://;
	(my $_other = $other) =~ s/.*://;
	if ($_ref eq $_other) {
		printf "    ok $other\n", 
	}
	else {
		printf "not ok $other\n", 
	}
}


__END__

# output on Win2k

OS MSWin32, perl 5.6.1

    ok filetest1 c:/perl/bin/perl.exe:  Binary Executable Readable Writable
not ok filetest2 c:/perl/bin/perl.exe:  Binary Readable Writable
not ok filetest3 c:/perl/bin/perl.exe:  Binary Readable Writable
    ok filetest4 c:/perl/bin/perl.exe:  Binary Executable Readable Writable

    ok filetest1 c:/perl/bin/pod2html.bat:  Executable Readable Text Writable
not ok filetest2 c:/perl/bin/pod2html.bat:  Readable Text Writable
not ok filetest3 c:/perl/bin/pod2html.bat:  Readable Text Writable
    ok filetest4 c:/perl/bin/pod2html.bat:  Executable Readable Text Writable