=head1 NAME

Konstrukt::Plugin::perlvar - Access to Perl variables

=head1 SYNOPSIS
	
B<Usage:>

	<!-- set value -->
	<& perlvar var="$Foo::Bar" set="baz" / &>
	
	<!-- print out value -->
	<& perlvar var="$Foo::Bar" / &>
	<& perlvar var="undef" &>this default will be used<& / &>

	<!-- unset value -->
	<& perlvar var="$Foo::Bar" unset="1" / &>
	
B<Result:>

	<!-- set value -->
	
	<!-- print out value -->
	baz
	this default will be used
	
	<!-- unset value -->
	
=head1 DESCRIPTION

Plugin to support access to variables.

In fact the statement in the var-attribute is eval'ed. so when using it without set,
the return value of any perl statement will be returned. Use it with care!

=cut

package Konstrukt::Plugin::perlvar;

use strict;
use warnings;

use base 'Konstrukt::SimplePlugin'; #inheritance

use Konstrukt::Parser::Node;

=head1 METHODS

=head2 prepare

The date is a very volatile data. We don't want to cache it...

B<Parameters>:

=over

=item * $tag - Reference to the tag (and its children) that shall be handled.

=back

=cut
sub prepare {
	my ($self, $tag) = @_;
	
	#Don't do anything beside setting the dynamic-flag
	$tag->{dynamic} = 1;
	
	return undef;
}
#= /prepare

=head2 execute

Checks the passed tag for attributes like var="varname" and set="value".

With only var being passed, the value of the will be put out.

With additionaly set being passed, the according value of the variable will be changed and nothing will be put out.

B<Parameters>:

=over

=item * $tag - Reference to the tag (and its children) that shall be handled.

=back

=cut
sub execute {
	my ($self, $tag) = @_;

	#reset the collected nodes
	$self->reset_nodes();

	if (exists $tag->{tag}->{attributes}->{var} and defined $tag->{tag}->{attributes}->{var}) {
		#var attribute is set
		if (exists $tag->{tag}->{attributes}->{set} and defined $tag->{tag}->{attributes}->{set}) {
			#set attribute is also set
			#set the value and return an empty string
			eval $tag->{tag}->{attributes}->{var}." = '".$tag->{tag}->{attributes}->{set}."';";#TODO: without eval?
			if ($@) {
				$Konstrukt::Debug->error_message("Error @ '" . $Konstrukt::Handler->{filename} . "'! Could not set perl variable $tag->{tag}->{attributes}->{var}") if Konstrukt::Debug::ERROR;
			}
		} elsif (exists $tag->{tag}->{attributes}->{unset} and $tag->{tag}->{attributes}->{unset}) {
			#unset attribute is set. undef the var.
			eval $tag->{tag}->{attributes}->{var} . " = undef";
			if ($@) {
				$Konstrukt::Debug->error_message("Error @ '" . $Konstrukt::Handler->{filename} . "'! Could not unset perl variable $tag->{tag}->{attributes}->{var}") if Konstrukt::Debug::ERROR;
			}
		} else {
			#only var attribute. no set
			#return the value if defined
			if (defined $tag->{tag}->{attributes}->{var}) {
				my $result = eval $tag->{tag}->{attributes}->{var};
				if ($@) {
					$Konstrukt::Debug->error_message("Error @ '" . $Konstrukt::Handler->{filename} . "'! Could not read perl variable $tag->{tag}->{attributes}->{var}") if Konstrukt::Debug::ERROR;
				} else {
					if (defined $result) {
						$self->add_node($result);
					} else {
						#replace by default value
						return $tag;
					}
				}
			} else {
				$Konstrukt::Debug->debug_message("The variable '$tag->{tag}->{attributes}->{var}' is not defined!") if Konstrukt::Debug::INFO;
			}
		}
	}

	return $self->get_nodes();
}
#= /execute

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