stat\( results from the CPAN

stat\(

Apache2-SSI

view release on metacpan or search on metacpan

        $io->close;
        # We explicitly return 1 or 0, because otherwise upon failure perl would return undef which we reserve for errors
        return( $shebang =~ /^\#\!(.*?)\bperl\b/i ? 1 : 0 );
    }
    return( 0 );
}

sub _lastmod                                                                                                                                                                                                                                              ...
{
    my( $self, $file, $format ) = @_;
    return( $self->_format_time( ( stat( "$file" ) )[9], $format ) );
}

# This is different from the env() method. This one is obviously private
# whereas the env() one has triggers that could otherwise create an infinite loop.
sub _set_env
{
    my $self = shift( @_ );
    my $name = shift( @_ );
    return( $self->error( "No environment variable name provided." ) ) if( !length( $name ) );
    $self->{_env} = {} if( !ref( $self->{_env} ) );

lib/Apache2/SSI/File/Type.pm view on Meta::CPAN

        else
        {
            $desc .= "unable to read '$base_file': Permission denied.";
            return( "x-system/x-error; $desc" );
        }
    }
    
    # 2) Check for various special files first
    if( $self->follow_links ) 
    {
        CORE::stat( $file ); 
    } 
    else 
    {
        CORE::lstat( $file );
    }
    # Avoid doing many useless redondant system stat, use '_'. See perlfunc man page
    if( !-f( _ ) || -z( _ ) ) 
    {
        if( !$self->follow_links && -l( _ ) ) 
        { 
            #$desc .= " symbolic link to ". readlink( $file );
            return( 'application/x-link' );
        }
        elsif( -d( _ ) ) { return( 'application/x-directory' ); }

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

        # 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
{

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

}

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 ) ); }

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

{
    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( _ ) )
        {

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

{
    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

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

    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

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

        mode    => $self->mode,
        destroy => $self->destroy,
    ) || return;
    $new->id( $id );
    $new->semid( $semid );
    if( !defined( $new->op( @{$SEMOP_ARGS->{LOCK_SH}} ) ) )
    {
        return( $self->error( "Unable to set lock on sempahore: $!" ) );
    }
    
    my $there = $new->stat( SEM_MARKER );
    $new->size( $opts->{size} );
    $new->flags( $flags );
    if( $there == SHM_EXISTS )
    {
    }
    else
    {
        # We initialise the semaphore with value of 1
        $new->stat( SEM_MARKER, SHM_EXISTS ) ||
            return( $self->error( "Unable to set semaphore during object creation: $!" ) );
        $SHEM_REPO->{ $id } = $new;
    }
    $new->op( @{$SEMOP_ARGS->{(LOCK_SH | LOCK_UN)}} );
    return( $new );
}

sub owner { return( shift->_set_get_scalar( 'owner', @_ ) ); }

sub pid

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

            $r = $r->is_initial_req ? $r : $r->main;
            my $rr = $r->lookup_file( $newfile );
            if( $rr->status == &Apache2::Const::HTTP_OK )
            {
                $newfile = $rr->filename;
            }
            else
            {
                $r->filename( $self->collapse_dots( $newfile, { separator => $DIR_SEP }) );
                # <https://perl.apache.org/docs/2.0/api/Apache2/RequestRec.html#toc_C_filename_>
                $r->finfo( APR::Finfo::stat( $newfile, &APR::Const::FINFO_NORM, $r->pool ) );
                $self->finfo( $newfile );
            }
            $r->subprocess_env( SCRIPT_FILENAME => $newfile );
            # Force to create new Apache2::SSI::URI object
            $self->{filename} = $newfile;
            $self->{_uri_reset} = 'filename' unless( $caller eq "${class}\::document_uri" );
        }
        elsif( !length( $self->{filename} ) )
        {
            $self->{filename} = $r->filename;

t/37.flastmod.t view on Meta::CPAN


my( $inc_ts, $me_ts, $year );
local $@;
# try-catch
eval
{
    my $dt = DateTime->now( time_zone => 'local' );
    $year = $dt->year;
    my $inc = "./t/htdocs${BASE_URI}/include.01.txt";
    ## diag( "File $inc last modified time is ", $inc->stat->mtime, " (", scalar( localtime( $inc->stat->mtime ) ), ")." );
    $inc_ts = DateTime->from_epoch( epoch => (CORE::stat( $inc ))[9], time_zone => 'local' );
    my $params =
    {
        pattern => '%A %B %d, %Y',
        time_zone => 'local',
    };
    $params->{locale} = $ENV{lang} if( length( $ENV{lang} ) );
    my $fmt = DateTime::Format::Strptime->new( %$params );
    $inc_ts->set_formatter( $fmt );
    my $me = "./t/htdocs${BASE_URI}/07.03.flastmod.html";
    $me_ts = DateTime->from_epoch( epoch => (CORE::stat( $me ))[9], time_zone => 'local' );
    my $fmt2 = DateTime::Format::Strptime->new(
        pattern => '%D',
        time_zone => 'local',
        locale => 'en_US',
    );
    $me_ts->set_formatter( $fmt2 );
    diag( __FILE__, " last modification date time is '$me_ts'." ) if( $DEBUG );
};
if( $@ )
{

t/50.finfo.t view on Meta::CPAN


{
    no warnings 'Apache2::SSI::Finfo';
    my $failed = Apache2::SSI::Finfo->new( './not-existing.txt' );
    ok( defined( $failed ), 'Non-existing file' );
    ok( $failed->filetype == Apache2::SSI::Finfo::FILETYPE_NOFILE, 'Non-existing file type' );
};

ok( FILETYPE_REG == Apache2::SSI::Finfo::FILETYPE_REG && FILETYPE_SOCK == Apache2::SSI::Finfo::FILETYPE_SOCK, 'import of constants' );

my @finfo = stat( $file );
is( $f->size, $finfo[ FINFO_SIZE ], 'size' );
is( $f->csize, $finfo[ FINFO_SIZE ], 'csize' );

is( $f->device, $finfo[ FINFO_DEV ], 'device' );

is( $f->filetype, Apache2::SSI::Finfo::FILETYPE_REG, 'file type' );

is( $f->fname, $file, 'file name' );

ok( $f->gid == $finfo[ FINFO_GID ], 'gid' );

t/50.finfo.t view on Meta::CPAN

}
else
{
    is( $f->name, 'include.cgi', 'file base name' );
}

is( $f->nlink, $finfo[ FINFO_NLINK ], 'nlink' );

is( $f->protection, hex( sprintf( '%04o', ( $finfo[ FINFO_MODE ] & 07777 ) ) ), 'File mode in hexadecimal' );

my $new = $f->stat( './t/htdocs/index.html' );
isa_ok( $new, 'Apache2::SSI::Finfo', 'stat' );

ok( $f->uid == $finfo[ FINFO_UID ], 'uid' );

ok( $f->user == $finfo[ FINFO_UID ], 'user' );

diag( "Checking finfo atime (", $f->atime, ") against file atime (", $finfo[ FINFO_ATIME ], ")." ) if( $DEBUG );
ok( $f->atime == $finfo[ FINFO_ATIME ], 'atime' );

ok( $f->mtime == $finfo[ FINFO_MTIME ], 'mtime' );

t/60.uri.t view on Meta::CPAN

    $f2->filename( "${doc_root}/ssi/../ssi/plop.pl" );
}

diag( "Document filename is: ", $f2->filename, " and I am expecting ", File::Spec->catdir( URI::file->new( $doc_root_full_path )->file( $^O ), URI::file->new( '/ssi/plop.pl' )->file( $^O ) ) ) if( $DEBUG );
ok( $f2->filename eq File::Spec->catdir( URI::file->new( $doc_root_full_path )->file( $^O ), URI::file->new( '/ssi/plop.pl' )->file( $^O ) ), 'filename' );

ok( $f2->document_uri eq "/ssi/plop.pl/some/pathinfo?q=something&l=ja_JP", "document_uri updated with filename" );

# Access to finfo
my $finfo = $f->finfo;
diag( "File ${doc_root}/${uri} mode is: '", ( (CORE::stat( File::Spec->catdir( $doc_root_full_path, URI::file->new( $uri )->file( $^O ) ) ))[2] & 07777 ), "' vs finfo one: '", $f->finfo->mode, "'" ) if( $DEBUG );
ok( ( (CORE::stat( File::Spec->catdir( $doc_root_full_path, URI::file->new( $uri )->file( $^O ) ) ))[2] & 07777 ) eq $f->finfo->mode, 'finfo' );

ok( $f->finfo->is_file, 'finfo is_file' );

ok( $f->parent->document_uri eq '/ssi', 'parent' );

ok( $f->uri eq '/ssi/include.cgi', 'uri' );

SKIP:
{
    my $tests = [

t/70.file.t view on Meta::CPAN

    $f2->filename( "${dir}/ssi/../ssi/plop.pl" );
}

diag( "Filename is: ", $f2->filename, " and I am expecting ", File::Spec->catdir( $dir, URI::file->new( '/ssi/plop.pl' )->file( $^O ) ) ) if( $DEBUG );
ok( $f2->filename eq File::Spec->catdir( $dir, URI::file->new( '/ssi/plop.pl' )->file( $^O ) ), 'filename' );

ok( $f2->code == 404, 'code failed' );

# Access to finfo
my $finfo = $f->finfo;
diag( "File ", File::Spec->catdir( $dir, URI::file->new( "/${file}" )->file( $^O ) ), " mode is: '", ( (CORE::stat( File::Spec->catpath( $dir, URI::file->new( "/${file}" )->file( $^O ) ) ))[2] & 07777 ), "' vs finfo one: '", $f->finfo->mode, "'" ) if...
ok( ( (CORE::stat( File::Spec->catdir( $dir, URI::file->new( "/${file}" )->file( $^O ) ) ))[2] & 07777 ) eq $f->finfo->mode, 'finfo' );

ok( $f->finfo->is_file, 'finfo is_file' );

ok( $f->parent->filename eq File::Spec->catdir( $dir, URI::file->new( '/ssi' )->file( $^O ) ), 'parent' );

SKIP:
{
    my $tests = [
        'Apache2::SSI::File object',
        'Non-existing file object',

t/SSITest.pm view on Meta::CPAN

    $f2->query_string( 'q=something&l=ja_JP' );
    $f2->filename( $r->document_root . BASE_URI . "/../ssi/plop.pl" );
    return( $self->ok( $f2->document_uri eq BASE_URI . "/plop.pl/some/pathinfo?q=something&l=ja_JP" ) );
}

sub test16
{
    my $self = shift( @_ );
    my $r = $self->apache_request || return( $self->error( "No Apache2::RequestRec object set!" ) );
    my $f = $self->_get_test_uri_1 || return;
    return( $self->ok( ( (CORE::stat( $r->document_root . '/' . TEST_URI_1 ))[2] & 07777 ) eq $f->finfo->mode ) );
}

sub test17
{
    my $self = shift( @_ );
    my $r = $self->apache_request || return( $self->error( "No Apache2::RequestRec object set!" ) );
    my $f = $self->_get_test_uri_1 || return;
    return( $self->ok( $f->finfo->is_file ) );
}

t/SSITest.pm view on Meta::CPAN

    my $f2 = $f->clone;
    $f2->filename( $self->apache_request->document_root . BASE_URI . "/../ssi/plop.pl" );
    return( $self->ok( $f2->finfo->filetype == Apache2::SSI::Finfo::FILETYPE_NOFILE ) );
}

sub test28
{
    my $self = shift( @_ );
    my $r = $self->apache_request || return( $self->error( "No Apache2::RequestRec object set!" ) );
    my $f = $self->_get_test_file_1 || return;
    return( $self->ok( ( (CORE::stat( $self->apache_request->document_root . '/' . TEST_URI_1 ))[2] & 07777 ) eq $f->finfo->mode ) );
}

sub test29
{
    my $self = shift( @_ );
    my $r = $self->apache_request || return( $self->error( "No Apache2::RequestRec object set!" ) );
    my $f = $self->_get_test_file_1 || return;
    return( $self->ok( $f->finfo->is_file ) );
}

( run in 1.509 second using v1.01-cache-2.11-cpan-49f99fa48dc )