Skip to content

HTTPS clone URL

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;
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
Jump to Line
Something went wrong with that request. Please try again.