view release on metacpan or  search on metacpan

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

    use Scalar::Util ();
    use URI::file;
    our $VERSION = 'v0.1.3';
    # Translation of type in magic file to unpack template and byte count
    our $TEMPLATES = 
    {
        'byte'      => [ 'c', 1 ],
        'ubyte'     => [ 'C', 1 ],
        'char'      => [ 'c', 1 ],
        'uchar'     => [ 'C', 1 ],
        'short'     => [ 's', 2 ],
        'ushort'    => [ 'S', 2 ],
        'long'      => [ 'l', 4 ],
        'ulong'     => [ 'L', 4 ],
        'date'      => [ 'l', 4 ],
        'ubeshort'  => [ 'n', 2 ],
        'beshort'   => [ [ 'n', 'S', 's' ], 2 ],
        'ubelong'   => [   'N',             4 ],
        'belong'    => [ [ 'N', 'I', 'i' ], 4 ],
        'bedate'    => [   'N',             4 ],
        'uleshort'  => [   'v',             2 ],
        'leshort'   => [ [ 'v', 'S', 's' ], 2 ],
        'ulelong'   => [   'V',             4 ],
        'lelong'    => [ [ 'V', 'I', 'i' ], 4 ],
        'ledate'    => [   'V',             4 ],
        'string'    => undef(),
    };
    
    # For letter escapes in magic file
    our $ESC = 
    {
        'n' => "\n",
        'r' => "\r",
        'b' => "\b",
        't' => "\t",
        'f' => "\f"
    };
    # Cache
    our $MAGIC_DATA = [];
    # Keep a record of the source data file, if any, so we can re-use this cached data instead of re-reading from it
    our $MAGIC_DATA_SOURCE = '';
};

use strict;
use warnings;

sub init
{
    my $self = shift( @_ );
    my $file;
    $file = shift( @_ ) if( @_ % 2 );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts->{magic} = $file if( length( $file ) );
    $self->{follow_links} = 1;
    $self->{check_magic}  = 0;
    # If there is an error or file is empty, it returns undef instead of application/octet-stream
    $self->{error_returns_undef} = 0;
    # Default to returns text/plain. If not, it will return an empty string and leave the caller to set the default mime-type.
    $self->{default_type} = 'text/plain';
    $self->{_init_strict_use_sub} = 1;
    $self->SUPER::init( @_ );
    $self->{magic}        = {};
    $self->{magic_data}   = [];
    my $load_json_data = sub
    {
        my $json_file = shift( @_ ) || return;
        my $io = IO::File->new( "<$json_file" ) ||
            return( $self->error( "Unable to open our own json magic file \"$json_file\": $!" ) );
        local $/;
        my $buf = scalar( <$io> );
        $io->close;
        local $@;
        # try-catch
        my $rv = eval
        {
            my $j = JSON->new->relaxed->allow_nonref;
            $MAGIC_DATA = $self->{magic_data} = $j->decode( $buf );
            return(1);
        };
        if( $@ )
        {
            return( $self->error( "An error occured while trying to json decode ", length( $buf ), " bytes of json data: $@" ) );
        }
        return( $rv );
    };
    
    if( $opts->{magic} )
    {
        $file = $opts->{magic};
        my $file_abs = URI::file->new_abs( $file )->file( $^O );
        if( $file_abs eq $MAGIC_DATA_SOURCE && scalar( @$MAGIC_DATA ) )
        {
            $self->{magic_data} = $MAGIC_DATA;
        }
        else
        {
            my $checksum = Digest::MD5::md5_hex( $file_abs );
            my $base = File::Basename::basename( $file );
            my $path = File::Spec->catpath( File::Spec->tmpdir, $base . "_${checksum}.json" );
            if( -e( $path ) && -s( $path ) )
            {
                $load_json_data->( $path ) || return;
            }
            else
            {
                return( $self->error( "Magic file provided \"$file\" does not exist." ) ) if( !-e( $file ) );
                my $io = IO::File->new( "<$file" ) ||
                    return( $self->error( "Unable to open magic file provided \"$file\": $!" ) );
                $io->binmode;
                $self->parse_magic_file( $io );
                $MAGIC_DATA = $self->{magic_data};
                $io->close;
                my $json = $self->as_json || return;
                my $fh = IO::File->new( ">$path" ) || 
                    return( $self->error( "Unable to write to magic cache json data file \"$path\": $!" ) );
                $fh->binmode;
                $fh->print( $json );
                $fh->close;
            }
            $MAGIC_DATA_SOURCE = $file_abs;
        }