#TODO: parse again?
#FEATURE: use Safe; ?
#FEATURE: compile?
# http://search.cpan.org/author/INGY/Module-Compile-0.15/lib/Module/Compile.pm
# http://groups.google.de/group/de.comp.lang.perl.misc/browse_thread/thread/5b6fb02b0883e529/6f6d09cdcbb92925?lnk=st&q=Perl-Code+w%C3%A4hrend+der+Laufzeit+kompilieren%2Feval()+vorkompilieren&rnum=1#6f6d09cdcbb92925
# http://search.cpan.org/~nwclark/perl-5.8.6/ext/B/B/Bytecode.pm
# my $compiled = `perl -MO=Bytecode,-H -e 'print "hi!\n"`;
#
# use ByteLoader 0.05;
# <byte code>
=head1 NAME
Konstrukt::Plugin::perl - Embedding perl code in your pages/templates
=head1 SYNOPSIS
B<Usage:>
<& perl &>print "foo"<& / &>
B<Result:>
foo
=head1 DESCRIPTION
With this plugin you may embed Perl code into the source code of an Konstrukt-webpage.
Those variables will be available to your code: $L<Konstrukt::Handler>, $L<Konstrukt::Settings>,
$L<Konstrukt::Lib>, $L<Konstrukt::Debug>, $L<Konstrukt::File>, $template_values.
The variable C<$template_values> contains the template values passed to the file, which
contains the perl tag. It can be used to produce output for these values.
The structure of this data will look like described in L<Konstrukt::Plugin::template/node>.
The values may be scalars (strings) or L<Konstrukt::Parser::Node>s. You should B<not>
modify this data!
Note that it would be wise in some cases to enclose the perl code within a comment
to prevent parsing of the perl code by the Konstrukt-parser:
<& perl &>
#<--
sub one { return 1; }
if (0<&one()) { print "hi!"; }
#-->
<& / &>
Otherwise C<0E<lt>&one()> would lead into incorrect parsing as C<E<lt>&> would get
recognized as a plugin tag start.
For more general information about plugins take a look at L<Konstrukt::Plugin>.
=head1 CONFIGURATION
You may configure the perl plugin to parse the printed output for new tags:
#per default the output won't be parsed again
perl/parse_output_for_tags 0
=cut
package Konstrukt::Plugin::perl;
use strict;
use warnings;
use base 'Konstrukt::Plugin'; #inheritance
use Konstrukt::Plugin; #import use_plugin
use Konstrukt::Debug;
use Konstrukt::Parser::Node;
=head1 METHODS
=head2 init
Initialization. Will only be used internally.
=cut
sub init {
my ($self) = @_;
#set default settings
$Konstrukt::Settings->default("perl/parse_output_for_tags", 0);
return 1;
}
#= /init
=head2 prepare_again
The executed perl code B<may> generate plaintext that will be parsed to new tag
nodes.
If you plan to do it (although it is better to directly push the according tag
nodes), you have to set the setting perl/parse_output_for_tags to 1.
=cut
sub prepare_again {
return $Konstrukt::Settings->get('perl/parse_output_for_tags');
}
#= /prepare_again
=head2 execute_again
Yes, this plugin will very likely generate new tags.
=cut
sub execute_again {
return 1;
}
#= /execute_again
=head2 prepare
We cannot prepare anything as the perl code generally will be completely dynamic.
=cut
sub prepare {
my ($self, $tag) = @_;
#Don't do anything beside setting the dynamic-flag
$tag->{dynamic} = 1;#TODO: neccessary? could be detected by the parser!
return undef;
}
#= /prepare
=head2 execute
All the work is done in the execute step.
The result of C<print>-statements will be put into the page at the position
of the perl-tag.
=cut
sub execute {
my ($self, $tag) = @_;
#collect the comment and plaintext nodes that will be executed
my $code = "#line 1 \"perl block @ " . $Konstrukt::File->relative_path($Konstrukt::File->current_file()) . "\"\n";
my $node = $tag->{first_child};
while (defined $node) {
if ($node->{type} eq 'plaintext' or $node->{type} eq 'comment') {
$code .= $node->{content};
}
$node = $node->{next};
}
#reset the dummy node to collect the output, activate print redirection, register for print events
$self->reset_nodes();
$Konstrukt::PrintRedirector->activate();
$Konstrukt::Event->register("Konstrukt::PrintRedirector::print", $self, \&print_event);
#access to template fields:
my $template_values = $tag->{template_values};
#execute the perl block
eval $code;
#check for errors
if (Konstrukt::Debug::ERROR and $@) {
#Errors in eval
my $errors = $@;
chomp $errors;
$Konstrukt::Debug->error_message("Error while executing embedded perl!\n$errors");
$self->add_node("[ERROR: Error while executing embedded perl! $errors" . "]");
}
#deactivate print redirection, deregister for print events
$Konstrukt::PrintRedirector->deactivate();
$Konstrukt::Event->deregister_all_by_object("Konstrukt::PrintRedirector::print", $self);
return $self->get_nodes();
}
#= /execute
=head2 print_event
Accepts the C<printredirector_print>-event and adds a plaintext node
B<Parameters>:
=over
=item * @data - The data passed to the print function
=back
=cut
sub print_event {
my ($self, @data) = @_;
if (defined $self->{collector_node}->{last_child} and $self->{collector_node}->{last_child}->{type} eq 'plaintext') {
$self->{collector_node}->{last_child}->{content} .= join('', @data);
} else {
$self->add_node(join '', @data);
}
return 1;
}
return 1;
=head1 AUTHOR
Copyright 2006 Thomas Wittek (mail at gedankenkonstrukt dot de). All rights reserved.
This document is free software.
It is distributed under the same terms as Perl itself.
=head1 SEE ALSO
L<Konstrukt::Plugin>, L<Konstrukt>
=cut