package File::stat::Extra;
use strict;
use warnings;
use warnings::register;

# ABSTRACT: An extension of the File::stat module, provides additional methods.
our $VERSION = '0.002'; # VERSION

#pod =for test_synopsis
#pod my ($st, $file);
#pod
#pod =head1 SYNOPSIS
#pod
#pod   use File::stat::Extra;
#pod
#pod   $st = lstat($file) or die "No $file: $!";
#pod
#pod   if ($st->isLink) {
#pod       print "$file is a symbolic link";
#pod   }
#pod
#pod   if (-x $st) {
#pod       print "$file is executable";
#pod   }
#pod
#pod   use Fcntl 'S_IRUSR';
#pod   if ( $st->cando(S_IRUSR, 1) ) {
#pod       print "My effective uid can read $file";
#pod   }
#pod
#pod   if ($st == stat($file)) {
#pod       printf "%s and $file are the same", $st->file;
#pod   }
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module's default exports override the core stat() and lstat()
#pod functions, replacing them with versions that return
#pod C<File::stat::Extra> objects when called in scalar context. In list
#pod context the same 13 item list is returned as with the original C<stat>
#pod and C<lstat> functions.
#pod
#pod C<File::stat::Extra> is an extension of the L<File::stat>
#pod module.
#pod
#pod =for :list
#pod * Returns non-object result in list context.
#pod * You can now pass in bare file handles to C<stat> and C<lstat> under C<use strict>.
#pod * File tests C<-t> C<-T>, and C<-B> have been implemented too.
#pod * Convenience functions C<filetype> and C<permissions> for direct access to filetype and permission parts of the mode field.
#pod * Named access to common file tests (C<isRegular> / C<isFile>, C<isDir>, C<isLink>, C<isBlock>, C<isChar>, C<isFIFO> / C<isPipe>, C<isSocket>).
#pod * Access to the name of the file / file handle used for the stat (C<file>, C<abs_file> / C<target>).
#pod
#pod =head1 SEE ALSO
#pod
#pod =for :list
#pod * L<File::stat> for the module for which C<File::stat::Extra> is the extension.
#pod * L<stat> and L<lstat> for the original C<stat> and C<lstat> functions.
#pod
#pod =head1 COMPATIBILITY
#pod
#pod As with L<File::stat>, you can no longer use the implicit C<$_> or the
#pod special filehandle C<_> with this module's versions of C<stat> and
#pod C<lstat>.
#pod
#pod Currently C<File::stat::Extra> only provides an object interface, the
#pod L<File::stat> C<$st_*> variables and C<st_cando> funtion are not
#pod available. This may change in a future version of this module.
#pod
#pod =head1 WARNINGS
#pod
#pod When a file (handle) can not be (l)stat-ed, a warning C<Unable to
#pod stat: %s>. To disable this warning, specify
#pod
#pod     no warnings "File::stat::Extra";
#pod
#pod The following warnings are inhereted from C<File::stat>, these can all
#pod be disabled with
#pod
#pod     no warnings "File::stat";
#pod
#pod =over 4
#pod
#pod =item File::stat ignores use filetest 'access'
#pod
#pod You have tried to use one of the C<-rwxRWX> filetests with C<use
#pod filetest 'access'> in effect. C<File::stat> will ignore the pragma, and
#pod just use the information in the C<mode> member as usual.
#pod
#pod =item File::stat ignores VMS ACLs
#pod
#pod VMS systems have a permissions structure that cannot be completely
#pod represented in a stat buffer, and unlike on other systems the builtin
#pod filetest operators respect this. The C<File::stat> overloads, however,
#pod do not, since the information required is not available.
#pod
#pod =back
#pod
#pod =cut

# Note: we are not defining File::stat::Extra as a subclass of File::stat
# as we need to add an additional field and can not rely on the fact that
# File::stat will always be implemented as an array (struct).

our @ISA = qw(Exporter);
our @EXPORT = qw(stat lstat);

use File::stat ();
use File::Spec ();
use Cwd ();
use Fcntl ();

require Carp;
$Carp::Internal{ (__PACKAGE__) }++; # To get warnings reported at correct caller level

#pod =func stat( I<FILEHANDLE> )
#pod
#pod =func stat( I<DIRHANDLE> )
#pod
#pod =func stat( I<EXPR> )
#pod
#pod =func lstat( I<FILEHANDLE> )
#pod
#pod =func lstat( I<DIRHANDLE> )
#pod
#pod =func lstat( I<EXPR> )
#pod
#pod When called in list context, these functions behave as the original
#pod C<stat> and C<lstat> functions, returning the 13 element C<stat> list.
#pod When called in scalar context, a C<File::stat::Extra> object is
#pod returned with the methods as outlined below.
#pod
#pod =cut

# Runs stat or lstat on "file"
sub __stat_lstat {
    my $func = shift;
    my $file = shift;

    return $func eq 'lstat' ? CORE::lstat($file) : CORE::stat($file);
}

# Wrapper around stat/lstat, handles passing of file as a bare handle too
sub _stat_lstat {
    my $func = shift;
    my $file = shift;

    my @stat = __stat_lstat($func, $file);

    if (@stat) {
        # We have a file, so make it absolute (NOT resolving the symlinks)
        $file = File::Spec->rel2abs($file) if !ref $file;
    } else {
        # Try again, interpretting $file as handle
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
        local $! = undef;
        require Symbol;
        my $fh = \*{ Symbol::qualify($file, caller(1)) };
        if (defined fileno $fh) {
            @stat = __stat_lstat($func, $fh);
        }
        if (!@stat) {
            warnings::warnif("Unable to stat: $file");
            return;
        }
        # We have a (valid) file handle, so we make file point to it
        $file = $fh;
    }

    if (wantarray) {
        return @stat;
    } else {
        return bless [ File::stat::populate(@stat), $file ], 'File::stat::Extra';
    }
}

sub stat(*) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
    return _stat_lstat('stat', shift);
}

sub lstat(*) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
    return _stat_lstat('lstat', shift);
}

#pod =method dev
#pod
#pod =method ino
#pod
#pod =method mode
#pod
#pod =method nlink
#pod
#pod =method uid
#pod
#pod =method gid
#pod
#pod =method rdev
#pod
#pod =method size
#pod
#pod =method atime
#pod
#pod =method mtime
#pod
#pod =method ctime
#pod
#pod =method blksize
#pod
#pod =method blocks
#pod
#pod These methods provide named acced to the same fields in the original
#pod C<stat> result. Just like the original L<File::stat>.
#pod
#pod =method cando( I<ACCESS>, I<EFFECTIVE> )
#pod
#pod Interprets the C<mode>, C<uid> and C<gid> fields, and returns whether
#pod or not the current process would be allowed the specified access.
#pod
#pod I<ACCESS> is one of C<S_IRUSR>, C<S_IWUSR> or C<S_IXUSR> from the
#pod L<Fcntl|Fcntl> module, and I<EFFECTIVE> indicates whether to use
#pod effective (true) or real (false) ids.
#pod
#pod =cut

BEGIN {
    # Define the main field accessors and the cando method using the File::stat version
    for my $f (qw(dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks cando)) {
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
        *{$f} = sub { $_[0][0]->$f; }
    }
}

#pod =method file
#pod
#pod Returns the full path to the original file (or the filehandle) on which
#pod C<stat> or C<lstat> was called.
#pod
#pod Note: Symlinks are not resolved. And, like C<rel2abs>, neither are
#pod C<x/../y> constructs. Use the C<abs_file> / C<target> methods to
#pod resolve these too.
#pod
#pod =cut

sub file {
    return $_[0][1];
}

#pod =method abs_file
#pod
#pod =method target
#pod
#pod Returns the absolute path of the file. In case of a file handle, this is returned unaltered.
#pod
#pod =cut

sub abs_file {
    return ref $_[0]->file ? $_[0]->file : Cwd::abs_path($_[0]->file);
}

*target = *abs_file;

#pod =method permissions
#pod
#pod Returns just the permissions (including setuid/setgid/sticky bits) of the C<mode> stat field.
#pod
#pod =cut

sub permissions {
    return Fcntl::S_IMODE($_[0]->mode);
}

#pod =method filetype
#pod
#pod Returns just the filetype of the C<mode> stat field.
#pod
#pod =cut

sub filetype {
    return Fcntl::S_IFMT($_[0]->mode);
}

#pod =method isFile
#pod
#pod =method isRegular
#pod
#pod Returns true if the file is a regular file (same as -f file test).
#pod
#pod =cut

sub isFile {
    return -f $_[0];
}

*isRegular = *isFile;

#pod =method isDir
#pod
#pod Returns true if the file is a directory (same as -d file test).
#pod
#pod =cut

sub isDir {
    return -d $_[0];
}

#pod =method isLink
#pod
#pod Returns true if the file is a symbolic link (same as -l file test).
#pod
#pod Note: Only relevant when C<lstat> was used!
#pod
#pod =cut

sub isLink {
    return -l $_[0];
}

#pod =method isBlock
#pod
#pod Returns true if the file is a block special file (same as -b file test).
#pod
#pod =cut

sub isBlock {
    return -b $_[0];
}

#pod =method isChar
#pod
#pod Returns true if the file is a character special file (same as -c file test).
#pod
#pod =cut

sub isChar {
    return -c $_[0];
}

#pod =method isFIFO
#pod
#pod =method isPipe
#pod
#pod Returns true if the file is a FIFO file or, in case of a file handle, a pipe  (same as -p file test).
#pod
#pod =cut

sub isFIFO {
    return -p $_[0];
}

*isPipe = *isFIFO;

#pod =method isSocket
#pod
#pod Returns true if the file is a socket file (same as -S file test).
#pod
#pod =cut

sub isSocket {
    return -S $_[0];
}

#pod =method -X operator
#pod
#pod You can use the file test operators on the C<File::stat::Extra> object
#pod just as you would on a file (handle). However, instead of querying the
#pod file system, these operators will use the information from the
#pod object itself.
#pod
#pod Note: in case of the special file tests C<-t>, C<-T>, and C<-B>, the
#pod file (handle) I<is> tested the I<first> time the operator is
#pod used. After the first time, the initial result is re-used.
#pod
#pod =method Unary "" (stringification) and other operators
#pod
#pod The unary "" operator is overloaded to return the the device and inode
#pod numbers separated by a C<.> (C<I<dev>.I<ino>>). This yields a uniqe file identifier.
#pod
#pod All other operators are automagically generated based on this
#pod representation, meaning you can easily compare two
#pod C<File::stat::Extra> objects to see if they are the same (hardlinked)
#pod file.
#pod
#pod =cut

my %op = (
    # Defer implementation of normal tests to File::stat
    r => sub { -r $_[0][0] },
    w => sub { -w $_[0][0] },
    x => sub { -x $_[0][0] },
    o => sub { -o $_[0][0] },

    R => sub { -R $_[0][0] },
    W => sub { -W $_[0][0] },
    X => sub { -X $_[0][0] },
    O => sub { -O $_[0][0] },

    e => sub { -e $_[0][0] },
    z => sub { -z $_[0][0] },
    s => sub { -s $_[0][0] },

    f => sub { -f $_[0][0] },
    d => sub { -d $_[0][0] },
    l => sub { -l $_[0][0] },
    p => sub { -p $_[0][0] },
    S => sub { -S $_[0][0] },
    b => sub { -b $_[0][0] },
    c => sub { -c $_[0][0] },

    u => sub { -u $_[0][0] },
    g => sub { -g $_[0][0] },
    k => sub { -k $_[0][0] },

    M => sub { -M $_[0][0] },
    C => sub { -C $_[0][0] },
    A => sub { -A $_[0][0] },

    # Implement these operators by testing the underlying file, caching the result
    t => sub { $_[0][2] // -t $_[0]->file }, ## no critic (InputOutput::ProhibitInteractiveTest)
    T => sub { $_[0][3] // -T $_[0]->file },
    B => sub { $_[0][4] // -B $_[0]->file },
);

use overload
    fallback => 1,

    # File test operators
    -X => sub {
        my ($s, $op) = @_;
        if ($op{$op}) {
            return $op{$op}->($s);
        } else {
             # We should have everything covered so this is just a safegauard
            Carp::croak "-$op is not implemented on a File::stat::Extra object";
        }
    },

    # Unary "" returns the object as "dev.ino", this should be a
    # unique number so one can test file equality easily (hard links
    # are equal)
    '""' => sub { $_[0]->dev . "." . $_[0]->ino },

    ;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

File::stat::Extra - An extension of the File::stat module, provides additional methods.

=head1 VERSION

version 0.002

=head1 SYNOPSIS

  use File::stat::Extra;

  $st = lstat($file) or die "No $file: $!";

  if ($st->isLink) {
      print "$file is a symbolic link";
  }

  if (-x $st) {
      print "$file is executable";
  }

  use Fcntl 'S_IRUSR';
  if ( $st->cando(S_IRUSR, 1) ) {
      print "My effective uid can read $file";
  }

  if ($st == stat($file)) {
      printf "%s and $file are the same", $st->file;
  }

=head1 DESCRIPTION

This module's default exports override the core stat() and lstat()
functions, replacing them with versions that return
C<File::stat::Extra> objects when called in scalar context. In list
context the same 13 item list is returned as with the original C<stat>
and C<lstat> functions.

C<File::stat::Extra> is an extension of the L<File::stat>
module.

=over 4

=item *

Returns non-object result in list context.

=item *

You can now pass in bare file handles to C<stat> and C<lstat> under C<use strict>.

=item *

File tests C<-t> C<-T>, and C<-B> have been implemented too.

=item *

Convenience functions C<filetype> and C<permissions> for direct access to filetype and permission parts of the mode field.

=item *

Named access to common file tests (C<isRegular> / C<isFile>, C<isDir>, C<isLink>, C<isBlock>, C<isChar>, C<isFIFO> / C<isPipe>, C<isSocket>).

=item *

Access to the name of the file / file handle used for the stat (C<file>, C<abs_file> / C<target>).

=back

=head1 FUNCTIONS

=head2 stat( I<FILEHANDLE> )

=head2 stat( I<DIRHANDLE> )

=head2 stat( I<EXPR> )

=head2 lstat( I<FILEHANDLE> )

=head2 lstat( I<DIRHANDLE> )

=head2 lstat( I<EXPR> )

When called in list context, these functions behave as the original
C<stat> and C<lstat> functions, returning the 13 element C<stat> list.
When called in scalar context, a C<File::stat::Extra> object is
returned with the methods as outlined below.

=head1 METHODS

=head2 dev

=head2 ino

=head2 mode

=head2 nlink

=head2 uid

=head2 gid

=head2 rdev

=head2 size

=head2 atime

=head2 mtime

=head2 ctime

=head2 blksize

=head2 blocks

These methods provide named acced to the same fields in the original
C<stat> result. Just like the original L<File::stat>.

=head2 cando( I<ACCESS>, I<EFFECTIVE> )

Interprets the C<mode>, C<uid> and C<gid> fields, and returns whether
or not the current process would be allowed the specified access.

I<ACCESS> is one of C<S_IRUSR>, C<S_IWUSR> or C<S_IXUSR> from the
L<Fcntl|Fcntl> module, and I<EFFECTIVE> indicates whether to use
effective (true) or real (false) ids.

=head2 file

Returns the full path to the original file (or the filehandle) on which
C<stat> or C<lstat> was called.

Note: Symlinks are not resolved. And, like C<rel2abs>, neither are
C<x/../y> constructs. Use the C<abs_file> / C<target> methods to
resolve these too.

=head2 abs_file

=head2 target

Returns the absolute path of the file. In case of a file handle, this is returned unaltered.

=head2 permissions

Returns just the permissions (including setuid/setgid/sticky bits) of the C<mode> stat field.

=head2 filetype

Returns just the filetype of the C<mode> stat field.

=head2 isFile

=head2 isRegular

Returns true if the file is a regular file (same as -f file test).

=head2 isDir

Returns true if the file is a directory (same as -d file test).

=head2 isLink

Returns true if the file is a symbolic link (same as -l file test).

Note: Only relevant when C<lstat> was used!

=head2 isBlock

Returns true if the file is a block special file (same as -b file test).

=head2 isChar

Returns true if the file is a character special file (same as -c file test).

=head2 isFIFO

=head2 isPipe

Returns true if the file is a FIFO file or, in case of a file handle, a pipe  (same as -p file test).

=head2 isSocket

Returns true if the file is a socket file (same as -S file test).

=head2 -X operator

You can use the file test operators on the C<File::stat::Extra> object
just as you would on a file (handle). However, instead of querying the
file system, these operators will use the information from the
object itself.

Note: in case of the special file tests C<-t>, C<-T>, and C<-B>, the
file (handle) I<is> tested the I<first> time the operator is
used. After the first time, the initial result is re-used.

=head2 Unary "" (stringification) and other operators

The unary "" operator is overloaded to return the the device and inode
numbers separated by a C<.> (C<I<dev>.I<ino>>). This yields a uniqe file identifier.

All other operators are automagically generated based on this
representation, meaning you can easily compare two
C<File::stat::Extra> objects to see if they are the same (hardlinked)
file.

=for test_synopsis my ($st, $file);

=head1 WARNINGS

When a file (handle) can not be (l)stat-ed, a warning C<Unable to
stat: %s>. To disable this warning, specify

    no warnings "File::stat::Extra";

The following warnings are inhereted from C<File::stat>, these can all
be disabled with

    no warnings "File::stat";

=over 4

=item File::stat ignores use filetest 'access'

You have tried to use one of the C<-rwxRWX> filetests with C<use
filetest 'access'> in effect. C<File::stat> will ignore the pragma, and
just use the information in the C<mode> member as usual.

=item File::stat ignores VMS ACLs

VMS systems have a permissions structure that cannot be completely
represented in a stat buffer, and unlike on other systems the builtin
filetest operators respect this. The C<File::stat> overloads, however,
do not, since the information required is not available.

=back

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
https://github.com/HayoBaan/File-stat-Extra/issues

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 COMPATIBILITY

As with L<File::stat>, you can no longer use the implicit C<$_> or the
special filehandle C<_> with this module's versions of C<stat> and
C<lstat>.

Currently C<File::stat::Extra> only provides an object interface, the
L<File::stat> C<$st_*> variables and C<st_cando> funtion are not
available. This may change in a future version of this module.

=head1 SEE ALSO

=over 4

=item *

L<File::stat> for the module for which C<File::stat::Extra> is the extension.

=item *

L<stat> and L<lstat> for the original C<stat> and C<lstat> functions.

=back

=head1 AUTHOR

Hayo Baan <info@hayobaan.nl>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Hayo Baan.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
