File Coverage

blib/lib/DTL/Fast.pm

Criterion	Covered	Total	%
statement	116	117	99.1
branch	21	38	55.2
condition	26	64	40.6
subroutine	17	17	100.0
pod	8	9	88.8
total	188	245	76.7

package DTL::Fast;
use strict; use warnings FATAL => 'all';
use Exporter 'import';
use Digest::MD5 qw(md5_hex);

use 5.010;
our $VERSION = '1.623'; # ==> ALSO update the version in the pod text below!

# loaded modules
our %TAG_HANDLERS;
our %FILTER_HANDLERS;
our %OPS_HANDLERS;

# known but not loaded modules
our %KNOWN_TAGS;        # plain map tag => module
our %KNOWN_SLUGS;       # reversed module => tag
our %KNOWN_FILTERS;     # plain map filter => module
our %KNOWN_OPS;         # complex map priority => operator => module
our %KNOWN_OPS_PLAIN;   # plain map operator => module
our @OPS_RE = ();

# modules hash to avoid duplicating on deserializing
our %LOADED_MODULES;

require XSLoader;
XSLoader::load('DTL::Fast', $VERSION);

our $RUNTIME_CACHE;

our @EXPORT_OK = qw(
    count_lines
    get_template
    select_template
    register_tag
    preload_operators
    register_operator
    preload_tags
    register_filter
    preload_filters
    );

sub get_template
{
    my( $template_name, %kwargs ) = @_;

    die  "Template name was not specified"
        if not $template_name;

    die "Template directories array was not specified"
        if
            not defined $kwargs{'dirs'}
            or ref $kwargs{'dirs'} ne 'ARRAY'
            or not scalar @{$kwargs{'dirs'}}
        ;

    my $cache_key = _get_cache_key( $template_name, %kwargs );

    my $template;

    $RUNTIME_CACHE //= DTL::Fast::Cache::Runtime->new();

    if(
        $kwargs{'no_cache'}
        or not defined ( $template = $RUNTIME_CACHE->get($cache_key))
    )
    {
        $template = read_template($template_name, %kwargs );

        if( defined $template )
        {
            $RUNTIME_CACHE->put($cache_key, $template);
        }
        else
        {
            die  sprintf( <<'_EOT_', $template_name, join("\n", @{$kwargs{'dirs'}}));
Unable to find template %s in directories:
%s
_EOT_
        }
    }

    return $template;
}

sub _get_cache_key
{
    my( $template_name, %kwargs ) = @_;

    return md5_hex(
        sprintf( '%s:%s:%s:%s'
            , __PACKAGE__
            , $template_name
            , join( ',', @{$kwargs{'dirs'}} )
            , join( ',', @{$kwargs{'ssi_dirs'}//[]})
            # shouldn't we pass uri_handler here?
        )
    )
    ;
}

sub read_template
{
    my( $template_name, %kwargs ) = @_;

    my $template = undef;
    my $template_path = undef;

    die "Template directories array was not specified"
        if not defined $kwargs{'dirs'}
            or not ref $kwargs{'dirs'}
            or not scalar @{$kwargs{'dirs'}}
        ;

    my $cache_key = _get_cache_key( $template_name, %kwargs );

    if(
        $kwargs{'no_cache'}
        or not exists $kwargs{'cache'}
        or not $kwargs{'cache'}
        or not $kwargs{'cache'}->isa('DTL::Fast::Cache')
        or not defined ($template = $kwargs{'cache'}->get($cache_key))
    )
    {
        ($template, $template_path) = _read_file($template_name, $kwargs{'dirs'});

        if( defined $template )
        {
            $kwargs{'file_path'} = $template_path;
            $template = DTL::Fast::Template->new( $template, %kwargs);

            $kwargs{'cache'}->put( $cache_key, $template )
                if
                    defined $template
                    and exists $kwargs{'cache'}
                    and $kwargs{'cache'}
                    and $kwargs{'cache'}->isa('DTL::Fast::Cache')
                ;
        }
    }

    if( defined $template )
    {
        $template->{'cache'} = $kwargs{'cache'} if $kwargs{'cache'};
        $template->{'url_source'} = $kwargs{'url_source'} if $kwargs{'url_source'};
    }

    return $template;
}

sub _read_file
{
    my $template_name = shift;
    my $dirs = shift;
    my $template;
    my $template_path;

    foreach my $dir (@$dirs)
    {
        $dir =~ s/[\/\\]+$//xgsi;
        $template_path = sprintf '%s/%s', $dir, $template_name;
        if(
            -e $template_path
            and -f $template_path
            and -r $template_path
        )
        {
            $template = __read_file( $template_path );
            last;
        }
    }

    return ($template, $template_path);
}


sub __read_file
{
    my( $file_name ) = @_;
    my $result;

    if( open my $IF, '<', $file_name )
    {
        local $/ = undef;
        $result = <$IF>;
        close $IF;
    }
    else
    {
        die  sprintf(
            'Error opening file %s, %s'
            , $file_name
            , $!
        );
    }
    return $result;
}

# result should be cached with full list of params
sub select_template
{
    my( $template_names, %kwargs ) = @_;

    die  "First parameter must be a template names array reference"
        if(
            not ref $template_names
            or ref $template_names ne 'ARRAY'
            or not scalar @$template_names
        );

    my $result = undef;

    foreach my $template_name (@$template_names)
    {
        if( ref ( $result = get_template( $template_name, %kwargs )) eq 'DTL::Fast::Template' )
        {
            last;
        }
    }

    return $result;
}

# registering tag as known
sub register_tag
{
    my( %tags ) = @_;

    while( my( $slug, $module) = each %tags )
    {
        $DTL::Fast::KNOWN_TAGS{lc($slug)} = $module;
        $DTL::Fast::KNOWN_SLUGS{$module} = $slug;
    }

    return;
}

# registering tag as known
sub preload_tags
{
    require Module::Load;

    while( my( $keyword, $module) = each %KNOWN_TAGS )
    {
        Module::Load::load($module);
        $LOADED_MODULES{$module} = time;
        delete $TAG_HANDLERS{$keyword} if exists $TAG_HANDLERS{$keyword} and $TAG_HANDLERS{$keyword} ne $module;
    }

    return 1;
}


# registering filter as known
sub register_filter
{
    my( %filters ) = @_;

    while( my( $slug, $module) = each %filters )
    {
        $DTL::Fast::KNOWN_FILTERS{$slug} = $module;
        delete $FILTER_HANDLERS{$slug} if exists $FILTER_HANDLERS{$slug} and $FILTER_HANDLERS{$slug} ne $module;
    }

    return;
}

sub preload_filters
{
    require Module::Load;

    while( my( undef, $module) = each %KNOWN_FILTERS )
    {
        Module::Load::load($module);
        $LOADED_MODULES{$module} = time;
    }

    return 1;
}

# invoke with parameters:
#
#   '=' => [ priority, module ]
#
sub register_operator
{
    my %ops = @_;

    my %recompile = ();
    foreach my $operator (keys %ops)
    {
        my($priority, $module) = @{$ops{$operator}};

        die "Operator priority must be a number from 0 to 8"
            if $priority !~ /^[012345678]$/;

        $KNOWN_OPS{$priority} //= {};
        $KNOWN_OPS{$priority}->{$operator} = $module;
        $recompile{$priority} = 1;
        $KNOWN_OPS_PLAIN{$operator} = $module;
        delete $OPS_HANDLERS{$operator} if exists $OPS_HANDLERS{$operator} and $OPS_HANDLERS{$operator} ne $module;
    }

    foreach my $priority (keys(%recompile))
    {
        my @ops = sort{ length $b <=> length $a } keys(%{$KNOWN_OPS{$priority}});
        my $ops = join '|', map{ "\Q$_\E" } @ops;
        $OPS_RE[$priority] = $ops;
    }
}


sub preload_operators
{
    require Module::Load;

    while( my( undef, $module) = each %KNOWN_OPS_PLAIN )
    {
        Module::Load::load($module);
        $LOADED_MODULES{$module} = time;
    }

    return 1;
}


require DTL::Fast::Template;
require DTL::Fast::Cache::Runtime;

1;

__END__