File::Stat::Moose - Status info for a file - Moose-based

  use File::Stat::Moose;
  $st = File::Stat::Moose->new( file => '/etc/passwd' );
  print "Size: ", $st->size, "\n";    # named attribute
  print "Blocks: ". $st->[12], "\n";  # numbered attribute

  use File::Stat::Moose 'stat';
  stat "/etc/passwd";  # set the special filehandle _
  @st = stat _;        # does not work
  @st = stat \*_;      # ok

#!/usr/bin/perl -c

package File::Stat::Moose;

use 5.008;
use strict;
use warnings FATAL => 'all';

our $VERSION = '0.06';

use Moose;

# Additional types
use MooseX::Types::OpenHandle;
use MooseX::Types::CacheFileHandle;

# Run-time Assertions
use Test::Assert ':assert';

# TRUE/FALSE
use constant::boolean;

# atime, ctime, mtime attributes
use DateTime;

use Scalar::Util 'reftype';


use Exception::Base (
    '+ignore_package' => [ __PACKAGE__, qr/^File::Spec(::|$)/, 'Sub::Exporter', qr/^Moose::/, qr/^Class::MOP::/ ],
);
use Exception::Argument;
use Exception::IO;


use overload (
    '@{}' => '_deref_array',
    fallback => TRUE,
);


use Sub::Exporter -setup => {
    exports => [

        # Get file status
        stat => sub {
            sub (;*) {
                my $st = __PACKAGE__->new(
                    file   => (defined $_[0] ? $_[0] : $_),
                    follow => TRUE,
                );
                return wantarray ? @{ $st } : $st;
            };
        },

        # Get link status
        lstat => sub {
            sub (;*) {
                my $st = __PACKAGE__->new(
                    file   => (defined $_[0] ? $_[0] : $_),
                    follow => FALSE,
                );
                return wantarray ? @{ $st } : $st;
            };
        },

    ],
    groups => { all => [ qw{ stat lstat } ] },
};


# File which is checked with stat
has 'file' => (
    is        => 'ro',
    isa       => 'Str | FileHandle | CacheFileHandle | OpenHandle',
    required  => TRUE,
    predicate => 'has_file',
);

# Follow symlink or read symlink itself
has 'follow' => (
    is        => 'ro',
    isa       => 'Bool',
    default   => FALSE,
);

# Speeds up stat on Win32
has 'sloppy' => (
    is        => 'ro',
    isa       => 'Bool',
    default   => FALSE,
);

# Use accessors rather than direct hash
has 'strict_accessors' => (
    is        => 'rw',
    isa       => 'Bool',
    default   => FALSE,
);

{
    foreach my $attr ( qw{ dev ino mode nlink uid gid rdev size blksize blocks } ) {

        # Numeric informations about a file
        has "$attr" => (
            is       => 'ro',
            isa      => 'Maybe[Int]',
            writer   => "_set_$attr",
        );
    };

};

{
    foreach my $attr ( qw{ atime mtime ctime } ) {

        my $reader = "_get_${attr}_epoch";

        # Numeric informations about a file (time as unix timestamp)
        has "_${attr}_epoch" => (
            isa       => 'Maybe[Int]',
            reader    => $reader,
            writer    => "_set_${attr}_epoch",
        );

        # Time as DateTime object (lazy evaluationed)
        has "$attr" => (
            is        => 'ro',
            isa       => 'Maybe[DateTime]',
            lazy      => TRUE,
            default   => sub {
                defined $_[0]->$reader
                ? DateTime->from_epoch( epoch => $_[0]->$reader )
                : undef
            },
            clearer   => "_clear_$attr",
            predicate => "has_$attr",
        );

    };
};


## no critic (ProhibitBuiltinHomonyms)
## no critic (RequireArgUnpacking)

# Object initialization
sub BUILD {
    my ($self, $params) = @_;

    assert_not_null($self->file) if ASSERT;

    $self->_init_stat;

    return $self;
};


# Call stat method
sub _init_stat {
    my ($self) = @_;

    return $self->stat;    
};


# Call stat or lstat method
sub stat {
    my $self = shift;
    Exception::Argument->throw( message => 'Usage: $st->stat()' ) if @_ > 0 or not blessed $self;

    my $file = $self->file;
    assert_not_null($file) if ASSERT;

    # Clear lazy attributes
    if ($self->strict_accessors) {
        foreach my $attr (qw{ atime mtime ctime }) {
            my $clearer = "_clear_$attr";
            $self->$clearer;
        };
    }
    else {
        delete @{$self}{ qw{ _atime_epoch _mtime_epoch _ctime_epoch } };
    };

    local ${^WIN32_SLOPPY_STAT} = $self->sloppy;

    if ($self->follow or (ref $file || '') eq 'GLOB' or (reftype $file || '') eq 'GLOB') {
        if ($self->strict_accessors) {
            my %stat;
            @stat{ qw{ dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks } }
            = map { defined $_ && $_ eq '' ? undef : $_ }
              CORE::stat $file or Exception::IO->throw( message => 'Cannot stat' );

            foreach my $attr (qw{ dev ino mode nlink uid gid rdev size blksize blocks }) {
                my $writer = "_set_$attr";
                $self->$writer( $stat{$attr} );
            };
            foreach my $attr (qw{ atime mtime ctime }) {
                my $writer = "_set_${attr}_epoch";
                $self->$writer( $stat{$attr} );
            };
        }
        else {
            @{$self}{ qw{ dev ino mode nlink uid gid rdev size _atime_epoch _mtime_epoch _ctime_epoch blksize blocks } }
            = map { defined $_ && $_ eq '' ? undef : $_ }
              CORE::stat $file or Exception::IO->throw( message => 'Cannot stat' );
        };
    }
    else {
        no warnings 'io';  # lstat() on filehandle

        if ($self->strict_accessors) {
            my %stat;
            @stat{ qw{ dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks } }
            = map { defined $_ && $_ eq '' ? undef : $_ }
            CORE::lstat $file or Exception::IO->throw( message => 'Cannot stat' );

            foreach my $attr (qw{ dev ino mode nlink uid gid rdev size blksize blocks }) {
                my $writer = "_set_$attr";
                $self->$writer( $stat{$attr} );
            };
            foreach my $attr (qw{ atime mtime ctime }) {
                my $writer = "_set_${attr}_epoch";
                $self->$writer( $stat{$attr} );
            };
        }
        else {
            @{$self}{ qw{ dev ino mode nlink uid gid rdev size _atime_epoch _mtime_epoch _ctime_epoch blksize blocks } }
            = map { defined $_ && $_ eq '' ? undef : $_ }
              CORE::lstat $file or Exception::IO->throw( message => 'Cannot stat' );
        };
    };

    return $self;
};


# Array dereference
sub _deref_array {
    my ($self) = @_;

    my @stat;
    if ($self->strict_accessors) {
        foreach my $attr (qw{ dev ino mode nlink uid gid rdev size blksize blocks }) {
            my $reader = $attr;
            push @stat, $self->$reader;
        };
        foreach my $attr (qw{ atime mtime ctime }) {
            my $reader = "_get_${attr}_epoch";
            push @stat, $self->$reader;
        };
    }
    else {
        @stat = @{$self}{ qw{ dev ino mode nlink uid gid rdev size _atime_epoch _mtime_epoch _ctime_epoch blksize blocks } }
    };

    return \@stat;
};


# Module initialization
__PACKAGE__->meta->make_immutable();


1;


__END__