nix results from the CPAN

Apache2-SSI

## Modified 2024/09/04
## All rights reserved
## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Apache2::SSI::Finfo;
BEGIN
{
    use strict;
    use warnings;
    use warnings::register;
    use parent qw( Module::Generic );
    use vars qw( $VERSION $AUTOLOAD %EXPORT_TAGS @EXPORT_OK $ERROR );
    use Apache2::SSI::File::Type;
    use Exporter qw( import );
    use DateTime;
    use DateTime::Format::Strptime;
    use File::Basename ();
    our( $AUTOLOAD, $ERROR );
    use overload (
        q{""}    => sub    { $_[0]->{filepath} },
        bool     => sub () { 1 },
        fallback => 1,
    );
    if( exists( $ENV{MOD_PERL} ) )
    {
        require APR::Pool;
        require APR::Finfo;
        require APR::Const;
        APR::Const->import( -compile => qw( :filetype FINFO_NORM ) );
    }
    use constant FINFO_DEV => 0;
    use constant FINFO_INODE => 1;
    use constant FINFO_MODE => 2;
    use constant FINFO_NLINK => 3;
    use constant FINFO_UID => 4;
    use constant FINFO_GID => 5;
    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 );

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

    use Apache2::RequestRec ();
    use apache2::RequestUtil ();
    my $r = Apache2::RequestUtil->request;
    my $finfo = Apache2::SSI::Finfo->new( '/some/file/path.html', apache_request => $r );
    # Direct access to APR::Finfo
    my $apr = $finfo->apr_finfo;
    # Get access time as a DateTime object
    $finfo->atime;
    # Block site
    $finfo->blksize;
    # Number of blocks
    $finfo->blocks;
    if( $finfo->can_read )
    {
        # Do something
    }
    # 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:

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

=head2 nlink

Returns the number of (hard) links to the file.

=head2 protection

=head2 rdev

Returns the device identifier (special files only).

=head2 size

Returns the total size of file, in bytes. Same as L</csize>

=head2 stat

Provided with a file path and this returns a new L<Apache2::SSI::Finfo> object.

=head2 uid

=head2 user

Returns the numeric user ID of file's owner. Same as L</uid>

=head2 uid

Returns the numeric user ID of file's owner. Same as L</user>

=head1 CONSTANTS

=head2 FILETYPE_NOFILE

File type constant to indicate the file does not exist.

=head2 FILETYPE_REG

Regular file

=head2 FILETYPE_DIR

The element is a directory

=head2 FILETYPE_CHR

The element is a character block

=head2 FILETYPE_BLK

A block device

=head2 FILETYPE_PIPE

The file is a FIFO or a pipe

=head2 FILETYPE_LNK

The file is a symbolic link

=head2 FILETYPE_SOCK

The file is a (unix domain) socket

=head2 FILETYPE_UNKFILE

The file is of some other unknown type or the type cannot be determined

=head1 AUTHOR

Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>

CPAN ID: jdeguest

L<https://gitlab.com/jackdeguest/Apache2-SSI>

=head1 SEE ALSO

L<Apache2::SSI::File>, L<Apache2::SSI::URI>, L<Apache2::SSI>

mod_include, mod_perl(3), L<APR::Finfo>, L<perlfunc/stat>
L<https://httpd.apache.org/docs/current/en/mod/mod_include.html>,
L<https://httpd.apache.org/docs/current/en/howto/ssi.html>,
L<https://httpd.apache.org/docs/current/en/expr.html>
L<https://perl.apache.org/docs/2.0/user/handlers/filters.html#C_PerlOutputFilterHandler_>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2020-2021 DEGUEST Pte. Ltd.

You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.

=cut

( run in 2.131 seconds using v1.01-cache-2.11-cpan-437f7b0c052 )