Apache2-SSI
view release on metacpan or search on metacpan
lib/Apache2/SSI/File/Type.pm view on Meta::CPAN
my $desc = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
$opts->{default} = $self->default_type if( !length( $opts->{default} ) );
my $type = '';
# 3) Iterate over each magic entry.
my $match_found = 0;
for( my $m = 0; $m <= $#{ $self->{magic_data} }; $m++ )
{
# Check if the m-th magic entry matches and if it does, then $desc will contain
# an updated description
my $test;
if( ( $test = $self->_magic_match( $self->{magic_data}->[$m], \$desc, $io ) ) )
{
if( defined( $desc ) && $desc ne '' )
{
$match_found = 1;
$type = $desc;
last;
}
}
lib/Apache2/SSI/File/Type.pm view on Meta::CPAN
my $data = shift( @_ );
my $desc = '';
my $type = '';
return( 'application/octet-stream' ) if( length( $data ) <= 0 );
# 3) Iterate over each magic entry.
for( my $m = 0; $m <= $#{ $self->{magic_data} }; $m++ )
{
# Check if the m-th magic entry matches and if it does, then $desc will contain
# an updated description
if( $self->_magic_match_str( $self->{magic_data}->[ $m ], \$desc, $data ) )
{
if( defined( $desc ) && $desc ne '' )
{
$type = $desc;
last;
}
}
# Read another entry from the magic file if we've exhausted all the entries
lib/Apache2/SSI/Notes.pm view on Meta::CPAN
my $v = $data->{ $k };
# try-catch
eval
{
# Code can modify values in-place like:
# sub
# {
# $_[1] = 'new value' if( $_[0] eq 'some_key_name' );
# }
$code->( $k, $v );
# Store possibly updated value
$data->{ $k_orig } = $v;
};
if( $@ )
{
return( $self->error( "Callback died with error: $@" ) );
}
}
# No need to bother if there was no keys in the first place
if( scalar( @keys ) )
{
ok( $f->document_filename eq File::Spec->catdir( $doc_root_full_path, URI::file->new( '/ssi/include.cgi' )->file( $^O ) ), 'document_filename' );
ok( $f->document_root eq $doc_root_full_path, 'document_root' );
ok( $f->document_uri eq "/ssi/include.cgi", 'document_uri' );
my $f2 = $f->clone;
$f2->path_info( '/some/pathinfo' );
ok( $f2->document_uri eq "/ssi/include.cgi/some/pathinfo", "document_uri updated with path info" );
$f2->query_string( 'q=something&l=ja_JP' );
ok( $f2->document_uri eq "/ssi/include.cgi/some/pathinfo?q=something&l=ja_JP", "document_uri updated with query string" );
{
no warnings 'Apache2::SSI::Finfo';
$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' );
'Apache2::SSI::URI object',
'Non existing uri object',
'document_path',
'document_dir',
'base_uri',
'empty path_info',
'empty query_string',
'document_filename',
'document_root',
'document_uri',
'document_uri updated with path info',
'document_uri path info using APR::URI',
'document_uri updated with query string',
'filename',
'document_uri updated with filename',
'finfo',
'finfo is_file',
'parent',
'uri',
];
if( HAS_APACHE_TEST )
{
for( my $i = 0; $i < scalar( @$tests ); $i++ )
{
## Test No 12: Does not work as I expected, i.e. APR::URI is not capable of deducting what is the path info.
t/70.file.t view on Meta::CPAN
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',
'Non-existing file code',
'Non-existing file type',
'filename',
'updated bad filename',
'updated bad filename code',
'updated bad filename filetype',
'finfo',
'finfo is_file',
'parent',
];
if( HAS_APACHE_TEST )
{
for( my $i = 0; $i < scalar( @$tests ); $i++ )
{
my( $ct, $resp ) = &make_request( sprintf( '/tests/test%02d', $i + 20 ) );
ok( $ct->[0] eq 'ok', sprintf( '%s with Apache test No %d', $tests->[$i], ( $i + 1 ) ) );
t/80.notes.t view on Meta::CPAN
key => 'test_key',
size => 2048,
destroy => 1,
mode => 0666,
);
## Clean up
ok( $shem->create == 0, 'create default value' );
$shem->create( 1 );
ok( $shem->create == 1, 'create updated value' );
my $exists = $shem->exists;
## ok( defined( $exists ), 'exists return defined value' );
# ok( !$shem->exists, 'exists' );
ok( defined( $exists ) && !$exists, 'exists' );
my $s = $shem->open;
ok( defined( $s ), 'Shared memory object' );
BAIL_OUT( "Failed to create shared memory object: $!" ) if( !defined( $s ) );
isa_ok( $s, 'Apache2::SSI::SharedMem' );
my $id = $s->id;
t/80.notes.t view on Meta::CPAN
if( $result eq 'ok' )
{
pass( 'shared data with separate process' );
}
else
{
diag( "Failed process with: '$result'" );
fail( 'shared data with separate process' );
}
my $data = $s->read;
ok( ref( $data ) eq 'HASH', 'shared updated data type' );
ok( $data->{year} == 2021, 'updated data value' );
my $data2;
$s->read( $data2 );
ok( ref( $data2 ) eq 'HASH', 'different read usage' );
ok( $data2->{year} == 2021, 'different read data check' );
ok( defined( $s->lock ), 'lock' );
ok( $s->locked, 'locked' );
$data->{test} = 'ok';
ok( defined( $s->write( $data ) ), 'updated data with lock' );
ok( defined( $s->unlock ), 'unlock' );
ok( defined( $s->remove ), 'remove' );
ok( !$s->exists, 'exists after remove' );
## Notes
my $n = Apache2::SSI::Notes->new( debug => $DEBUG, key => 'test_notes' );
isa_ok( $n, 'Apache2::SSI::Notes' );
my $all = $n->get;
t/SSITest.pm view on Meta::CPAN
## Filename match expectation
sub test24
{
my $self = shift( @_ );
my $f = $self->_get_test_file_1;
my $base = $f->base_dir;
return( $self->ok( $f->filename eq $self->apache_request->document_root . BASE_URI . '/include.cgi' ) );
}
## filename updated with non-existing file
sub test25
{
my $self = shift( @_ );
my $f = $self->_get_test_file_1;
my $base = $f->base_dir;
my $f2 = $f->clone;
$f2->filename( $self->apache_request->document_root . BASE_URI . "/../ssi/plop.pl" );
return( $self->ok( $f2->filename eq $self->apache_request->document_root . BASE_URI . "/plop.pl" ) );
}
## Resulting code from filename updated with non-existing file
sub test26
{
my $self = shift( @_ );
my $f = $self->_get_test_file_1;
my $base = $f->base_dir;
my $f2 = $f->clone;
$f2->filename( $self->apache_request->document_root . BASE_URI . "/../ssi/plop.pl" );
return( $self->ok( $f2->code == 404 ) );
}
## Resulting file type from filename updated with non-existing file
sub test27
{
my $self = shift( @_ );
my $f = $self->_get_test_file_1;
my $base = $f->base_dir;
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 ) );
}
( run in 0.284 second using v1.01-cache-2.11-cpan-05444aca049 )