Apache2-SSI
10 results

 view release on metacpan or  search on metacpan

lib/Apache2/SSI/Finfo.pm  view on Meta::CPAN 

    use constant FINFO_RDEV => 6;
    use constant FINFO_SIZE => 7;
    use constant FINFO_ATIME => 8;
    use constant FINFO_MTIME => 9;
    use constant FINFO_CTIME => 10;
    use constant FINFO_BLOCK_SIZE => 11;
    use constant FINFO_BLOCKS => 12;
    # Sames constant value as in APR::Const
    #  the file type is undetermined.
    use constant FILETYPE_NOFILE => 0;
    # a file is a regular file.
    use constant FILETYPE_REG => 1;
    # a file is a directory
    use constant FILETYPE_DIR => 2;
    # a file is a character device
    use constant FILETYPE_CHR => 3;
    # a file is a block device
    use constant FILETYPE_BLK => 4;
    # a file is a FIFO or a pipe.
    use constant FILETYPE_PIPE => 5;
    # a file is a symbolic link
    use constant FILETYPE_LNK => 6;
    # a file is a [unix domain] socket.
    use constant FILETYPE_SOCK => 7;
    # a file is of some other unknown type or the type cannot be determined.
    use constant FILETYPE_UNKFILE => 127;
    our %EXPORT_TAGS = ( all => [qw( FILETYPE_NOFILE FILETYPE_REG FILETYPE_DIR FILETYPE_CHR FILETYPE_BLK FILETYPE_PIPE FILETYPE_LNK FILETYPE_SOCK FILETYPE_UNKFILE )] );
    our @EXPORT_OK = qw( FILETYPE_NOFILE FILETYPE_REG FILETYPE_DIR FILETYPE_CHR FILETYPE_BLK FILETYPE_PIPE FILETYPE_LNK FILETYPE_SOCK FILETYPE_UNKFILE );
    our $VERSION = 'v0.1.3';
};

use strict;
use warnings;

sub init
{
    my $self = shift( @_ );
    my $file = shift( @_ ) || return( $self->error( "No file provided to instantiate a ", ref( $self ), " object." ) );
    # return( $self->error( "File or directory \"$file\" does not exist." ) ) if( !-e( $file ) );
    $self->{apache_request} = '';
    $self->{apr_finfo} = '';
    $self->{_init_strict_use_sub} = 1;
    $self->SUPER::init( @_ );
    $self->{filepath} = $file;
    $self->{_data} = [];
    my $r = $self->{apache_request};
    if( $r )
    {
        # <https://perl.apache.org/docs/2.0/api/Apache2/RequestRec.html#toc_C_filename_>
        local $@;
        # try-catch
        eval
        {
            my $finfo;
            if( $r->filename eq $file )
            {
                $finfo = $r->finfo;
            }
            else
            {
                $finfo = APR::Finfo::stat( $file, &APR::Const::FINFO_NORM, $r->pool );
                $r->finfo( $finfo );
            }
            $self->{apr_finfo} = $finfo;
        };
        if( $@ )
        {
            # This makes it possible to query this api even if provided with a non-existing file
            if( $@ =~ /No[[:blank:]\h]+such[[:blank:]\h]+file[[:blank:]\h]+or[[:blank:]\h]+directory/i )
            {
                $self->{_data} = [];
            }
            else
            {
                return( $self->error( "Unable to set the APR::Finfo object: $@" ) );
            }
        }
    }
    else
    {
        $self->{_data} = [CORE::stat( $file )];
    }
    return( $self );
}

sub apache_request { return( shift->_set_get_object_without_init( 'apache_request', 'Apache2::RequestRec', @_ ) ); }

sub apr_finfo { return( shift->_set_get_object( 'apr_finfo', 'APR::Finfo', @_ ) ); }

sub atime
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    my $t;
    if( $f )
    {
        $t = $f->atime;
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        $t = $data->[ FINFO_ATIME ];
    }
    return( $self->_datetime( $t ) );
}

sub blksize { return( shift->block_size( @_ ) ); }

sub block_size
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( ( CORE::stat( $self->{filepath} ) )[ FINFO_BLOCK_SIZE ] );
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        return( $data->[ FINFO_BLOCK_SIZE ] );
    }
}

sub blocks
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( ( CORE::stat( $self->{filepath} ) )[ FINFO_BLOCKS ] );
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        return( $data->[ FINFO_BLOCKS ] );
    }
}

sub can_read { return( -r( shift->filepath ) ); }

sub can_write { return( -w( shift->filepath ) ); }

sub can_exec { return( -x( shift->filepath ) ); }

sub can_execute { return( -x( shift->filepath ) ); }

sub csize { return( shift->size ); }

sub ctime
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    my $t;
    if( $f )
    {
        $t = $f->ctime;
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        $t = $data->[ FINFO_CTIME ];
    }
    return( $self->_datetime( $t ) );
}

sub dev { return( shift->device( @_ ) ); }

sub device
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( $f->device );
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        return( $data->[ FINFO_DEV ] );
    }
}

sub exists { return( shift->filetype == FILETYPE_NOFILE ? 0 : 1 ); }

# Read-only
sub filepath { return( shift->_set_get_scalar( 'filepath' ) ); }

sub filetype
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( $f->filetype );
    }
    else
    {
        my $file = $self->{filepath};
        CORE::stat( $file );
        if( !-e( _ ) )
        {
            return( FILETYPE_NOFILE );
        }
        elsif( -f( _ ) )
        {
            return( FILETYPE_REG );
        }
        elsif( -d( _ ) )
        {
            return( FILETYPE_DIR );
        }
        elsif( -l( _ ) )
        {
            return( FILETYPE_LNK );
        }
        elsif( -p( _ ) )
        {
            return( FILETYPE_PIPE );
        }
        elsif( -S( _ ) )
        {
            return( FILETYPE_SOCK );
        }
        elsif( -b( _ ) )
        {
            return( FILETYPE_BLK );
        }
        elsif( -c( _ ) )
        {
            return( FILETYPE_CHR );
        }
        else
        {
            return( FILETYPE_UNKFILE );
        }
    }
}

sub fname
{
    my $self = shift( @_ );
    my $r = $self->apache_request;
    if( $r )
    {
        return( $r->fname );
    }
    else
    {
        return( $self->{filepath} );
    }
}

sub gid { return( shift->group ); }

sub group
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )

lib/Apache2/SSI/Finfo.pm  view on Meta::CPAN 


sub mtime
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    my $t;
    if( $f )
    {
        $t = $f->mtime;
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        $t = $data->[ FINFO_MTIME ];
    }
    return( $self->_datetime( $t ) );
}

sub name
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( $f->name || File::Basename::basename( $f->fname ) );
    }
    else
    {
        return( File::Basename::basename( $self->fname ) );
    }
}

sub nlink
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( $f->nlink );
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        return( $data->[ FINFO_NLINK ] );
    }
}

sub protection
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        # Will return something like 1860 (i.e. 744 = hex(1860))
        return( $f->protection );
    }
    else
    {
        my @stat = CORE::stat( $self->filepath );
        return( '' ) if( !scalar( @stat ) );
        return( hex( sprintf( '%04o', $stat[2] & 07777 ) ) );
    }
}

sub rdev
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( ( CORE::stat( $self->{filepath} ) )[ FINFO_RDEV ] );
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        return( $data->[ FINFO_RDEV ] );
    }
}

sub size
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( $f->size );
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        return( $data->[ FINFO_SIZE ] );
    }
}

sub stat
{
    my $self = shift( @_ );
    my $r = $self->apache_request;
    my $file = shift( @_ );
    my $p = scalar( @_ ) ? { @_ } : {};
    $p->{apache_request} = $r if( $r && !$p->{apache_request} );
    return( $self->new( $file, $p ) );
}

sub uid { return( shift->user ); }

sub user
{
    my $self = shift( @_ );
    my $f = $self->apr_finfo;
    if( $f )
    {
        return( $f->user );
    }
    else
    {
        my $data = $self->{_data};
        return( '' ) if( !scalar( @$data ) );
        return( $data->[ FINFO_UID ] );
    }
}

sub _datetime
{
    my $self = shift( @_ );
    my $t = shift( @_ );
    return( $self->error( "No epoch time was provided." ) ) if( !length( $t ) );
    return( $self->error( "Invalid epoch time provided \"$t\"." ) ) if( $t !~ /^\d+$/ );
    local $@;

lib/Apache2/SSI/Finfo.pm  view on Meta::CPAN 

    # Can also use
    $finfo->can_write;
    $finfo->can_exec;
    $finfo->csize;
    # Inode change time as a DateTime object
    $finfo->ctime;
    $finfo->dev;
    if( $finfo->exists )
    {
        # Do something
    }
    print "File path is: ", $finfo->filepath;
    if( $finfo->filetype == Apache2::SSI::Finfo::FILETYPE_NOFILE )
    {
        # File does not exist
    }
    # Same as $finfo->filepath
    print "File path is: ", $finfo->fname;
    print "File group id is: ", $finfo->gid;
    # Can also use $finfo->group which will yield the same result
    $finfo->ino;
    # or $finfo->inode;
    if( $finfo->is_block )
    {
        # Do something
    }
    elsif( $finfo->is_char )
    {
        # Do something else
    }
    elsif( $finfo->is_dir )
    {
        # It's a directory
    }
    elsif( $finfo->is_file )
    {
        # It's a regular file
    }
    elsif( $finfo->is_link )
    {
        # A file alias
    }
    elsif( $info->is_pipe )
    {
        # A Unix pipe !
    }
    elsif( $finfo->is_socket )
    {
        # It's a socket
    }
    elsif( ( $info->mode & 0100 ) )
    {
        # Can execute
    }
    $finfo->mtime->strftime( '%A %d %B %Y %H:%m:%S' );
    print "File base name is: ", $finfo->name;
    printf "File has %d links\n", $finfo->nlink;
    print "File permission in hexadecimal: ", $finfo->protection;
    $finfo->rdev;
    $finfo->size;
    my $new_object = $finfo->stat( '/some/other/file.txt' );
    # Get the user id
    $finfo->uid;
    # Or
    $finfo->user;

=head1 VERSION

    v0.1.3

=head1 DESCRIPTION

This class provides a file info object oriented consistant whether it is accessed from Apache/mod_perl2 environment or from outside of it.

The other advantage is that even if a non-existing file is provided, an object is returned. Obviously many of this module's methods will return an empty value since the file does not actually exist. This is an advantage, because one cannot create an ...

=head1 METHODS

=head2 new

This instantiate an object that is used to access other key methods. It takes a file path followed by the following parameters:

=over 4

=item C<apache_request>

This is the L<Apache2::RequestRec> object that is provided if running under mod_perl.

it can be retrieved from L<Apache2::RequestUtil/request> or via L<Apache2::Filter/r>

You can get this L<Apache2::RequestRec> object by requiring L<Apache2::RequestUtil> and calling its class method L<Apache2::RequestUtil/request> such as C<Apache2::RequestUtil->request> and assuming you have set C<PerlOptions +GlobalRequest> in your ...

Note that there is a main request object and subprocess request object, so to find out which one you are dealing with, use L<Apache2::RequestUtil/is_initial_req>, such as:

    use Apache2::RequestUtil (); # extends Apache2::RequestRec objects
    my $r = $r->is_initial_req ? $r : $r->main;

=back

=head2 apache_request

Sets or gets the L<Apache2::RequestRec> object. As explained in the L</new> method, you can get this Apache object by requiring the package L<Apache2::RequestUtil> and calling L<Apache2::RequestUtil/request> such as C<Apache2::RequestUtil->request> a...

When running under Apache mod_perl this is set automatically from the special L</handler> method, such as:

    my $r = $f->r; # $f is the Apache2::Filter object provided by Apache

=head2 apr_finfo

Sets or gets the L<APR::Finfo> object when running under Apache/mod_perl. Note that this value might be empty if the file does not exist. This is mentioned here for completeness only.

=head2 atime

Returns the file last access time as a L<Apache2::SSI::Datetime> object, which stringifies to its value in second since epoch. L<Apache2::SSI::Datetime> is just a wrapper around L<DateTime> to allow a L<DateTime> to be used in comparison with another...

For example:

    if( $finfo->atime > time() + 86400 )
    {
        print( "You are traveling in the future\n" );
    }



( run in 0.482 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )