local.coretag

# Copyright 2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: local.coretag,v 1.2 2007-08-09 13:40:52 pajamian Exp $

UserTag local Order scratch
UserTag local attrAlias scratches scratch
UserTag local attrAlias value values
UserTag local posNumber 1
UserTag local hasEndTag
UserTag local addAttr
UserTag local Description Tag to localize scratch and/or values for block
UserTag local Routine <<EOR
sub {
	my ($scratch, $opt, $body) = @_;

	use Storable qw/ dclone /;
	$Storable::forgive_me = 1;

	## It may seem simpler just to clone the top-level reference and
	## be done with it, but we are going through all these gyrations
	## to prevent the problem of overwriting code, which is not
	## preserved with a cloning operation.
	##
	## Obviously (or maybe not) if you pass a top-level array which
	## happens to contain a code reference, you are going to lose it.
	## But code references which are in non-localized hash keys will
	## survive.

	my %delete_top;
	my %delete;
	my %settings;

	# Perhaps {extra} is a bad option, but it has to be something. We
	# don't have the _ intro for a key, alas. Doubt it will often be
    # used, but discounts could be localized, I suppose.

	my @extra = split /[,\s\0]+/, $opt->{extra};

	for my $top (qw/ values scratch /, @extra) {

		exists $Vend::Session->{$top}
			or do {
				$delete_top{$top} = 1;
				next;
			};

		my $v = $Vend::Session->{$top};

		unless (ref($v) eq 'HASH') {
			if(! ref $v) {
				$settings{$top} = $v;
			}
			else {
				$settings{$top} = dclone($v);
			}
			next;
		}

		my @values = Text::ParseWords::shellwords($opt->{$top});

		for(@values) {
			if( ! exists $v->{$_}) {
				$delete{$top}{$_} = 1;
			}
			elsif(! ref $v->{$_}) {
				$settings{$top}{$_} = $v->{$_};
			}
			else {
				$settings{$top}{$_} = dclone($v->{$_});
			}
		}
	}

	my $result = interpolate_html($body);

	for my $top (qw/ values scratch /, @extra) {
		if(my $d = $delete_top{$top}) {
			delete $Vend::Session->{$top};
			next;
		}

		unless (ref($settings{$top}) eq 'HASH') {
			$Vend::Session->{$top} = $settings{$top};
			next;
		}

		my $s = $settings{$top};
		my $d = $delete{$top};
		my $v = $Vend::Session->{$top};

		for(keys %$d) {
			delete $v->{$_};
		}

		for(keys %$s) {
			$v->{$_} = $settings{$top}{$_};
		}
	}

	return $result;

}
EOR

UserTag local Documentation <<EOT
=head1 NAME

local -- localize scratch, values, etc. for code block.

=head1 SYNOPSIS

	[set foo]bar[/set]

	[local scratch="foo"]
		[set foo]nonbar[/set]
		foo=[scratch foo]
	[/local]

	[if scratch foo eq bar]
		local worked.
	[else]
		local did not work, kept at [scratch foo].
	[/else]
	[/if]

=head1 DESCRIPTION

The local tag allows you to drop some code using scratch or values settings
in a page without the possibility of affecting the overall operation of the
site.

EOT