=head1 NAME

CFX5::FileStat - stat wrappers for testing file properties

=head1 SYNOPSIS

  use CFX5::FileStat;

=head1 DESCRIPTION

This module provides a set of wrappers for the perl -X file test
switches, which detect when failures happen due to large files and
implement some sort of workaround for it.

B<This is a hack>, to get around the fact that we do not want to
recompile perl for large file support at this stage in the project.
It should be removed as soon as is practical.

=cut

package CFX5::FileStat;

use vars qw($CVSVersion);
$CVSVersion='$Id$ ';

use strict;

=head2 EXPORTED FUNCTIONS

All the C<test_*> routines are exported by default.  This is
considered bad style in many cases, but seems appropriate here because
the only reason to use this module is to use these functions and I
want to save myself typing inserting it into everywhere!

=cut

use Exporter;
use vars qw(@ISA @EXPORT);
push @ISA, 'Exporter';
push @EXPORT, qw(test_e test_d test_f test_w test_r test_l);

use CFX5::Output qw(:all);

=head3 sh_test

I<internal>

Runs a test in the shell (sh -c test -op file) and gives a reasonable
return value.

=cut

sub sh_test {
  my $file=shift;
  my $op=shift;

  # undefined return value.  This may be the correct answer, but if
  # this is a large file the operator will fail with "Value too large
  # to be stored in data type" or some similar whinge, in which case
  # we have to sort something else out.
  if ("$!" =~ 'too large') {
    my $sysrv=system('/bin/sh','-c',"test $op $file");
    _debug("Return value $sysrv from sh -c test $op $file");
    if (!$sysrv) {
      # success => 0
      return 1;
    }
    if ($sysrv == 0x100) {
      # return value 1 => things worked but it failed the test
      return '';
    }
    # anything else and the system command failed.  We'll just assume
    # there's nothing else we can do and give up.
  }
  return undef;
}

=head3 test_e

  if (test_e 'file') {
    ...
  }

Replaces the C<-e> test.

=cut

sub test_e {
  my $file=shift;
  my $rv=-e $file;
  # if the return value is defined, the operator worked, and we can
  # trust the answer.  Also, on Windows, we don't support large files
  # so we can trust it anyway!
  return $rv if defined $rv or $^O eq 'MSWin32';

  # test -e doesn't work with all shells (although I forgot to record
  # which ones it fails in!)
  return sh_test($file, '-e') || sh_test($file, '-f') || sh_test($file, '-d');
}

=head3 test_f

=cut

sub test_f {
  my $file=shift;
  my $rv=-f $file;
  return $rv if defined $rv or $^O eq 'MSWin32';
  return sh_test($file, '-f');
}

=head3 test_d

=cut

sub test_d {
  my $file=shift;
  my $rv=-d $file;
  return $rv if defined $rv or $^O eq 'MSWin32';
  return sh_test($file, '-d');
}

=head3 test_l

Interestingly, the C<-l> test seems to work fine with large files (in
that it correctly reports true on a symlink to a large file).  It will
still fail if the file is a large file, but then such a file is not a
link anyway, so there is no problem with this.

The routine is provided here for completeness, and in case it becomes
necessary on other systems.

=cut

sub test_l {
  my $file=shift;
  return -l $file;
}

=head3 test_r

=cut

sub test_r {
  my $file=shift;
  my $rv=-r $file;
  return $rv if defined $rv or $^O eq 'MSWin32';
  return sh_test($file, '-r');
}

=head3 test_w

=cut

sub test_w {
  my $file=shift;
  my $rv=-w $file;
  return $rv if defined $rv or $^O eq 'MSWin32';
  return sh_test($file, '-w');
}

1;
