view release on metacpan or  search on metacpan

lib/HTML/Template/Compiled.pm  view on Meta::CPAN

}


{
    my $lock_fh;

    sub lock {
        my $file = File::Spec->catfile( $_[0]->get_cache_dir, "lock" );
        unless ( -f $file ) {
            # touch
            open $lock_fh, '>', $file
              or croak "Could not open lockfile '$file' for writing: $!";
            close $lock_fh;
        }
        open $lock_fh, '+<', $file
          or croak "Could not open lockfile '$file' for read/write: $!";
        flock $lock_fh, LOCK_EX;
    }

    sub unlock {
        close $lock_fh;
    }
}


{
    my $loaded = 0;
    my $error = 0;
    sub require_storable {
        return 1 if $loaded;
        return 0 if $error;
        eval {
            require Storable;
        };
        if ($@) {
            $error = 1;
            return 0;
        }
        eval "use B::Deparse 0.61";
        if ($@) {
            $error = 1;
            return 0;
        }
        return 1;
    }
}

sub debug_code {
    my ($self, $html) = @_;
    my $perl = $self->get_perl;
    require B::Deparse;
    my $deparse = B::Deparse->new("-p", "-sC");
    my $body = $deparse->coderef2text($perl);
    my $filename = $self->get_file;
    #warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$body], ['body']);
    my $message = '';
    if ($LAST_EXCEPTION and $LAST_EXCEPTION =~ m/at (?:\(eval \d*\)|\S+) line (\d+)\./) {
        my $rline = $1;
        my $line = $rline;
        $line--;
        my @lines = split m#$/#, $body;
        if ($line > $#lines) {
            $line = $#lines;
        }
        my $pre = $line > 0 ? join $/, @lines[0 .. $line - 1] : '';
        my $post = $line < $#lines ? join $/, @lines[$line + 1 .. $#lines] : '';
        my $error = "$/$/# ------------------- ERROR line $rline in template $filename -----------------$/";
        my $last = $LAST_EXCEPTION;
        $LAST_EXCEPTION =~ s#$/# #g;
        $error .= "# $last$/$lines[$line]$/";
        if ($html) {
            for ($pre, $error, $post) {
                s/</&lt;/g;
                s/>/&gt;/g;
            }
            $message = <<"EOM";
<table border="0" style="background-color: #eeeeee;"><tr><td><pre>$pre</pre></td></tr>
<tr><td style="background-color: #ffffff; color: #ff0000"><pre>$error</pre></td></tr>
<tr><td><pre>$post</pre></td></tr></table>
EOM
        }
        else {
            $message .= $pre;
            $message .= $error;
            $message .= $post;
        }
    }
    else {
        $message = $LAST_EXCEPTION;
    }
    return $message;

}

1;

__END__

=pod

=head1 NAME

HTML::Template::Compiled - Template System Compiles HTML::Template files to Perl code

=head1 SYNOPSIS

  use HTML::Template::Compiled;
  # recommended options:
  # case_sensitive => 1
  # search_path_on_include => 1
  # use_query => 0
  # default_escape => 'HTML' # <-- HIGHLY RECOMMENDED

  # note that the following
  # use HTML::Template::Compiled speed => 1
  # is deprecated (can be problematic under persistent environments)

  # or for the biggest compatibility with HTML::Template
  # case_sensitive => 0
  # search_path_on_include => 0
  # use_query => 1