gistfile1.pl

package ArkApp::View::MTFile;
use Ark 'View::MTFile';

has '+wrapper' => default => 'wrapper';

has '+wrapper_pre' => default => sub {
    my $self = shift;
    return '<? $self->wrapper_file(\'' . $self->wrapper . $self->extension . "')->( sub {?>";
};

has external_cache => (
    is => 'rw',
    isa => 'Bool',
    default => 1,
);

has store_class => (
     is      => 'rw',
     isa     => 'Cache::FastMmap',
     lazy    => 1,
     default => sub {
         my $self = shift;
         $self->app->ensure_class_loaded('Cache::FastMmap');
         use FindBin;
         my $cache = Cache::FastMmap->new(
             {   expire_time    => '14d',
                 share_file     => "$FindBin::Bin/../tmp/tmpl.cache",
                 unlink_on_exit => 0
             }
         );
         $cache;
     }
);

sub BUILD {
    my $self = shift;

    $self->append_external_cache if $self->external_cache;
}

sub append_external_cache {
    my $self = shift;

    Carp::croak('need to define store_class!') unless $self->can('store_class');

    my $__cache_template = sub {
        my $orig = shift;
        my ( $self, $file ) = @_;

        return $self->cache->{$file}->[1] if $self->cache->{$file};

        $self->app->ensure_class_loaded('Storable');
        no warnings 'once';
        local $Storable::Deparse = 1;
        local $Storable::Eval    = 1;
        use warnings 'once';

        if ( my $renderer = $self->store_class->get($file) ) {
            return Storable::thaw($renderer);
        }
        else {
            my $r = $orig->(@_);
            my $f = Storable::nfreeze($r);
            $self->store_class->set( $file, $f );
            return $r;
        }
    };

    $self->meta->add_around_method_modifier( build_template => $__cache_template );
    $self->meta->add_around_method_modifier( build_template_with_wrapper => $__cache_template );
}

sub wrapper_file {
    my $self = shift;
    my $file = shift;
    my $mtref = do {
        no strict 'refs';
        my $__mt = $self->mt;
        ${"$__mt->{package_name}::_MTREF"};
    };
    my $before = $$mtref;
    $$mtref = '';
    return sub {
        my $inner_func = shift;
        my $content = $inner_func->(@_);
        my $renderer = $self->build_template($file);
        $$mtref = $before . $renderer->($self, $self->context, $content)->as_string;
    }
}

1;