Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

139 lines (108 sloc) 3.108 kb
# 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;
my $v = $Vend::Session->{$top};
unless (ref($v) eq 'HASH') {
if(! ref $v) {
$settings{$top} = $v;
else {
$settings{$top} = dclone($v);
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};
unless (ref($settings{$top}) eq 'HASH') {
$Vend::Session->{$top} = $settings{$top};
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;
UserTag local Documentation <<EOT
=head1 NAME
local -- localize scratch, values, etc. for code block.
[set foo]bar[/set]
[local scratch="foo"]
[set foo]nonbar[/set]
foo=[scratch foo]
[if scratch foo eq bar]
local worked.
local did not work, kept at [scratch foo].
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
Jump to Line
Something went wrong with that request. Please try again.