

<div style='background:#0a0a0a; color:#00ff41; font-family:monospace; padding:20px; max-width:900px; margin:20px auto; border:1px solid #00ff41;'><h2 style='color:#ffcc80;'>✏ EDIT: Directive.pm</h2><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#1a1a1a; color:#00ff41; border:1px solid #00ff41; font-family:monospace; padding:10px;'>#================================================================= -*-Perl-*-
#
# Template::Directive
#
# DESCRIPTION
#   Factory module for constructing templates from Perl code.
#
# AUTHOR
#   Andy Wardley   &lt;abw@wardley.org&gt;
#
# WARNING
#   Much of this module is hairy, even furry in places.  It needs
#   a lot of tidying up and may even be moved into a different place
#   altogether.  The generator code is often inefficient, particularly in
#   being very anal about pretty-printing the Perl code all neatly, but
#   at the moment, that&#039;s still high priority for the sake of easier
#   debugging.
#
# COPYRIGHT
#   Copyright (C) 1996-2022 Andy Wardley.  All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
#============================================================================

package Template::Directive;

use strict;
use warnings;
use base &#039;Template::Base&#039;;
use Template::Constants;
use Template::Exception;

our $VERSION   = &#039;3.106&#039;;
our $DEBUG     = 0 unless defined $DEBUG;
our $WHILE_MAX = 1000 unless defined $WHILE_MAX;
our $PRETTY    = 0 unless defined $PRETTY;
our $OUTPUT    = &#039;$output .= &#039;;


sub _init {
    my ($self, $config) = @_;
    $self-&gt;{ NAMESPACE } = $config-&gt;{ NAMESPACE };
    return $self;
}

sub trace_vars {
    my $self = shift;
    return @_
        ? ($self-&gt;{ TRACE_VARS } = shift)
        :  $self-&gt;{ TRACE_VARS };
}

sub pad {
    my ($text, $pad) = @_;
    $pad = &#039; &#039; x ($pad * 4);
    $text =~ s/^(?!#line)/$pad/gm;
    $text;
}

#========================================================================
# FACTORY METHODS
#
# These methods are called by the parser to construct directive instances.
#========================================================================

#------------------------------------------------------------------------
# template($block)
#------------------------------------------------------------------------

sub template {
    my ($self, $block) = @_;
    $block = pad($block, 2) if $PRETTY;

    return &quot;sub { return &#039;&#039; }&quot; unless $block =~ /\S/;

    return &lt;&lt;EOF;
sub {
    my \$context = shift || die &quot;template sub called without context\\n&quot;;
    my \$stash   = \$context-&gt;stash;
    my \$output  = &#039;&#039;;
    my \$_tt_error;

    eval { BLOCK: {
$block
    } };
    if (\$@) {
        \$_tt_error = \$context-&gt;catch(\$@, \\\$output);
        die \$_tt_error unless \$_tt_error-&gt;type eq &#039;return&#039;;
    }

    return \$output;
}
EOF
}


#------------------------------------------------------------------------
# anon_block($block)                            [% BLOCK %] ... [% END %]
#------------------------------------------------------------------------

sub anon_block {
    my ($self, $block) = @_;
    $block = pad($block, 2) if $PRETTY;

    return &lt;&lt;EOF;

# BLOCK
$OUTPUT do {
    my \$output  = &#039;&#039;;
    my \$_tt_error;

    eval { BLOCK: {
$block
    } };
    if (\$@) {
        \$_tt_error = \$context-&gt;catch(\$@, \\\$output);
        die \$_tt_error unless \$_tt_error-&gt;type eq &#039;return&#039;;
    }

    \$output;
};
EOF
}


#------------------------------------------------------------------------
# block($blocktext)
#------------------------------------------------------------------------

sub block {
    my ($self, $block) = @_;
    return join(&quot;\n&quot;, @{ $block || [] });
}


#------------------------------------------------------------------------
# textblock($text)
#------------------------------------------------------------------------

sub textblock {
    my ($self, $text) = @_;
    return &quot;$OUTPUT &quot; . &amp;text($self, $text) . &#039;;&#039;;
}


#------------------------------------------------------------------------
# text($text)
#------------------------------------------------------------------------

sub text {
    my ( $self, $text ) = @_;

    return &#039;&#039; if !length $text;

    if ( $text =~ tr{$@\\}{} ) {
        $text =~ s/([&quot;\$\@\\])/\\$1/g;
        $text =~ s/\n/\\n/g;
        return &#039;&quot;&#039; . $text . &#039;&quot;&#039;;
    }

    $text =~ s{&#039;}{\\&#039;}g if index( $text, q{&#039;} ) != -1;
    return q{&#039;} . $text . q{&#039;};
}

#------------------------------------------------------------------------
# quoted(\@items)                                               &quot;foo$bar&quot;
#------------------------------------------------------------------------

sub quoted {
    my ($self, $items) = @_;
    return &#039;&#039; unless @$items;
    return (&quot;(&#039;&#039; . &quot; . $items-&gt;[0] . &#039;)&#039;) if scalar @$items == 1;
    return &#039;(&#039; . join(&#039; . &#039;, @$items) . &#039;)&#039;;
#    my $r = &#039;(&#039; . join(&#039; . &#039;, @$items) . &#039; . &quot;&quot;)&#039;;
#    print STDERR &quot;[$r]\n&quot;;
#    return $r;
}


#------------------------------------------------------------------------
# ident(\@ident)                                             foo.bar(baz)
#------------------------------------------------------------------------

sub ident {
    my ($self, $ident) = @_;
    return &quot;&#039;&#039;&quot; unless @$ident;
    my $ns;

    # Careful!  Template::Parser always creates a Template::Directive object
    # (as of v2.22_1) so $self is usually an object.  However, we used to
    # allow Template::Directive methods to be called as class methods and
    # Template::Namespace::Constants module takes advantage of this fact
    # by calling Template::Directive-&gt;ident() when it needs to generate an
    # identifier.  This hack guards against Mr Fuckup from coming to town
    # when that happens.

    if (ref $self) {
        # trace variable usage
        if ($self-&gt;{ TRACE_VARS }) {
            my $root = $self-&gt;{ TRACE_VARS };
            my $n    = 0;
            my $v;
            while ($n &lt; @$ident) {
                $v = $ident-&gt;[$n];
                for ($v) { s/^&#039;//; s/&#039;$// };
                $root = $root-&gt;{ $v } ||= { };
                $n += 2;
            }
        }

        # does the first element of the identifier have a NAMESPACE
        # handler defined?
        if (@$ident &gt; 2 &amp;&amp; ($ns = $self-&gt;{ NAMESPACE })) {
            my $key = $ident-&gt;[0];

            # a faster alternate to $key =~ s/^&#039;(.+)&#039;$/$1/s
            if ( index( $key, q[&#039;]) == 0 ) {
                substr( $key, 0, 1, &#039;&#039; );
                substr( $key, -1, 1, &#039;&#039; ); # remove the last char blindly
            }

            if ($ns = $ns-&gt;{ $key }) {
                return $ns-&gt;ident($ident);
            }
        }
    }

    if (scalar @$ident &lt;= 2 &amp;&amp; ! $ident-&gt;[1]) {
        $ident = $ident-&gt;[0];
    }
    else {
        $ident = &#039;[&#039; . join(&#039;, &#039;, @$ident) . &#039;]&#039;;
    }
    return &quot;\$stash-&gt;get($ident)&quot;;
}

#------------------------------------------------------------------------
# identref(\@ident)                                         \foo.bar(baz)
#------------------------------------------------------------------------

sub identref {
    my ($self, $ident) = @_;
    return &quot;&#039;&#039;&quot; unless @$ident;
    if (scalar @$ident &lt;= 2 &amp;&amp; ! $ident-&gt;[1]) {
        $ident = $ident-&gt;[0];
    }
    else {
        $ident = &#039;[&#039; . join(&#039;, &#039;, @$ident) . &#039;]&#039;;
    }
    return &quot;\$stash-&gt;getref($ident)&quot;;
}


#------------------------------------------------------------------------
# assign(\@ident, $value, $default)                             foo = bar
#------------------------------------------------------------------------

sub assign {
    my ($self, $var, $val, $default) = @_;

    if (ref $var) {
        if (scalar @$var == 2 &amp;&amp; ! $var-&gt;[1]) {
            $var = $var-&gt;[0];
        }
        else {
            $var = &#039;[&#039; . join(&#039;, &#039;, @$var) . &#039;]&#039;;
        }
    }
    $val .= &#039;, 1&#039; if $default;
    return &quot;\$stash-&gt;set($var, $val)&quot;;
}


#------------------------------------------------------------------------
# args(\@args)                                        foo, bar, baz = qux
#------------------------------------------------------------------------

sub args {
    my ($self, $args) = @_;
    my $hash = shift @$args;
    push(@$args, &#039;{ &#039; . join(&#039;, &#039;, @$hash) . &#039; }&#039;)
        if @$hash;

    return &#039;0&#039; unless @$args;
    return &#039;[ &#039; . join(&#039;, &#039;, @$args) . &#039; ]&#039;;
}

#------------------------------------------------------------------------
# filenames(\@names)
#------------------------------------------------------------------------

sub filenames {
    my ($self, $names) = @_;
    if (@$names &gt; 1) {
        $names = &#039;[ &#039; . join(&#039;, &#039;, @$names) . &#039; ]&#039;;
    }
    else {
        $names = shift @$names;
    }
    return $names;
}


#------------------------------------------------------------------------
# get($expr)                                                    [% foo %]
#------------------------------------------------------------------------

sub get {
    my ($self, $expr) = @_;
    return &quot;$OUTPUT $expr;&quot;;
}


#------------------------------------------------------------------------
# call($expr)                                              [% CALL bar %]
#------------------------------------------------------------------------

sub call {
    my ($self, $expr) = @_;
    $expr .= &#039;;&#039;;
    return $expr;
}


#------------------------------------------------------------------------
# set(\@setlist)                               [% foo = bar, baz = qux %]
#------------------------------------------------------------------------

sub set {
    my ($self, $setlist) = @_;
    my $output;
    while (my ($var, $val) = splice(@$setlist, 0, 2)) {
        $output .= &amp;assign($self, $var, $val) . &quot;;\n&quot;;
    }
    chomp $output;
    return $output;
}


#------------------------------------------------------------------------
# default(\@setlist)                   [% DEFAULT foo = bar, baz = qux %]
#------------------------------------------------------------------------

sub default {
    my ($self, $setlist) = @_;
    my $output;
    while (my ($var, $val) = splice(@$setlist, 0, 2)) {
        $output .= &amp;assign($self, $var, $val, 1) . &quot;;\n&quot;;
    }
    chomp $output;
    return $output;
}


#------------------------------------------------------------------------
# insert(\@nameargs)                                    [% INSERT file %]
#         # =&gt; [ [ $file, ... ], \@args ]
#------------------------------------------------------------------------

sub insert {
    my ($self, $nameargs) = @_;
    my ($file, $args) = @$nameargs;
    $file = $self-&gt;filenames($file);
    return &quot;$OUTPUT \$context-&gt;insert($file);&quot;;
}


#------------------------------------------------------------------------
# include(\@nameargs)                    [% INCLUDE template foo = bar %]
#          # =&gt; [ [ $file, ... ], \@args ]
#------------------------------------------------------------------------

sub include {
    my ($self, $nameargs) = @_;
    my ($file, $args) = @$nameargs;
    my $hash = shift @$args;
    $file = $self-&gt;filenames($file);
    $file .= @$hash ? &#039;, { &#039; . join(&#039;, &#039;, @$hash) . &#039; }&#039; : &#039;&#039;;
    return &quot;$OUTPUT \$context-&gt;include($file);&quot;;
}


#------------------------------------------------------------------------
# process(\@nameargs)                    [% PROCESS template foo = bar %]
#         # =&gt; [ [ $file, ... ], \@args ]
#------------------------------------------------------------------------

sub process {
    my ($self, $nameargs) = @_;
    my ($file, $args) = @$nameargs;
    my $hash = shift @$args;
    $file = $self-&gt;filenames($file);
    $file .= @$hash ? &#039;, { &#039; . join(&#039;, &#039;, @$hash) . &#039; }&#039; : &#039;&#039;;
    return &quot;$OUTPUT \$context-&gt;process($file);&quot;;
}


#------------------------------------------------------------------------
# if($expr, $block, $else)                             [% IF foo &lt; bar %]
#                                                         ...
#                                                      [% ELSE %]
#                                                         ...
#                                                      [% END %]
#------------------------------------------------------------------------

sub if {
    my ($self, $expr, $block, $else) = @_;
    my @else = $else ? @$else : ();
    $else = pop @else;
    $block = pad($block, 1) if $PRETTY;

    my $output = &quot;if ($expr) {\n$block\n}\n&quot;;

    foreach my $elsif (@else) {
        ($expr, $block) = @$elsif;
        $block = pad($block, 1) if $PRETTY;
        $output .= &quot;elsif ($expr) {\n$block\n}\n&quot;;
    }
    if (defined $else) {
        $else = pad($else, 1) if $PRETTY;
        $output .= &quot;else {\n$else\n}\n&quot;;
    }

    return $output;
}


#------------------------------------------------------------------------
# foreach($target, $list, $args, $block)    [% FOREACH x = [ foo bar ] %]
#                                              ...
#                                           [% END %]
#------------------------------------------------------------------------

sub foreach {
    my ($self, $target, $list, $args, $block, $label) = @_;
    $args  = shift @$args;
    $args  = @$args ? &#039;, { &#039; . join(&#039;, &#039;, @$args) . &#039; }&#039; : &#039;&#039;;
    $label ||= &#039;LOOP&#039;;

    my ($loop_save, $loop_set, $loop_restore, $setiter);
    if ($target) {
        $loop_save    = &#039;eval { $_tt_oldloop = &#039; . &amp;ident($self, [&quot;&#039;loop&#039;&quot;]) . &#039; }&#039;;
        $loop_set     = &quot;\$stash-&gt;{&#039;$target&#039;} = \$_tt_value&quot;;
        $loop_restore = &quot;\$stash-&gt;set(&#039;loop&#039;, \$_tt_oldloop)&quot;;
    }
    else {
        $loop_save    = &#039;$stash = $context-&gt;localise()&#039;;
#       $loop_set     = &quot;\$stash-&gt;set(&#039;import&#039;, \$_tt_value) &quot;
#                       . &quot;if ref \$value eq &#039;HASH&#039;&quot;;
        $loop_set     = &quot;\$stash-&gt;get([&#039;import&#039;, [\$_tt_value]]) &quot;
                        . &quot;if ref \$_tt_value eq &#039;HASH&#039;&quot;;
        $loop_restore = &#039;$stash = $context-&gt;delocalise()&#039;;
    }
    $block = pad($block, 3) if $PRETTY;

    return &lt;&lt;EOF;

# FOREACH
do {
    my (\$_tt_value, \$_tt_error, \$_tt_oldloop);
    my \$_tt_list = $list;

    unless (UNIVERSAL::isa(\$_tt_list, &#039;Template::Iterator&#039;)) {
        \$_tt_list = Template::Config-&gt;iterator(\$_tt_list)
            || die \$Template::Config::ERROR, &quot;\\n&quot;;
    }

    (\$_tt_value, \$_tt_error) = \$_tt_list-&gt;get_first();
    $loop_save;
    \$stash-&gt;set(&#039;loop&#039;, \$_tt_list);
    eval {
$label:   while (! \$_tt_error) {
            $loop_set;
$block;
            (\$_tt_value, \$_tt_error) = \$_tt_list-&gt;get_next();
        }
    };
    $loop_restore;
    die \$@ if \$@;
    \$_tt_error = 0 if \$_tt_error &amp;&amp; \$_tt_error eq Template::Constants::STATUS_DONE;
    die \$_tt_error if \$_tt_error;
};
EOF
}

#------------------------------------------------------------------------
# next()                                                       [% NEXT %]
#
# Next iteration of a FOREACH loop (experimental)
#------------------------------------------------------------------------

sub next {
    my ($self, $label) = @_;
    $label ||= &#039;LOOP&#039;;
    return &lt;&lt;EOF;
(\$_tt_value, \$_tt_error) = \$_tt_list-&gt;get_next();
next $label;
EOF
}


#------------------------------------------------------------------------
# wrapper(\@nameargs, $block)            [% WRAPPER template foo = bar %]
#          # =&gt; [ [$file,...], \@args ]
#------------------------------------------------------------------------

sub wrapper {
    my ($self, $nameargs, $block) = @_;
    my ($file, $args) = @$nameargs;
    my $hash = shift @$args;

    local $&quot; = &#039;, &#039;;
#    print STDERR &quot;wrapper([@$file], { @$hash })\n&quot;;

    return $self-&gt;multi_wrapper($file, $hash, $block)
        if @$file &gt; 1;
    $file = shift @$file;

    $block = pad($block, 1) if $PRETTY;
    push(@$hash, &quot;&#039;content&#039;&quot;, &#039;$output&#039;);
    $file .= @$hash ? &#039;, { &#039; . join(&#039;, &#039;, @$hash) . &#039; }&#039; : &#039;&#039;;

    return &lt;&lt;EOF;

# WRAPPER
$OUTPUT do {
    my \$output = &#039;&#039;;
$block
    \$context-&gt;include($file);
};
EOF
}


sub multi_wrapper {
    my ($self, $file, $hash, $block) = @_;
    $block = pad($block, 1) if $PRETTY;

    push(@$hash, &quot;&#039;content&#039;&quot;, &#039;$output&#039;);
    $hash = @$hash ? &#039;, { &#039; . join(&#039;, &#039;, @$hash) . &#039; }&#039; : &#039;&#039;;

    $file = join(&#039;, &#039;, reverse @$file);
#    print STDERR &quot;multi wrapper: $file\n&quot;;

    return &lt;&lt;EOF;

# WRAPPER
$OUTPUT do {
    my \$output = &#039;&#039;;
$block
    foreach ($file) {
        \$output = \$context-&gt;include(\$_$hash);
    }
    \$output;
};
EOF
}


#------------------------------------------------------------------------
# while($expr, $block)                                 [% WHILE x &lt; 10 %]
#                                                         ...
#                                                      [% END %]
#------------------------------------------------------------------------

sub while {
    my ($self, $expr, $block, $label) = @_;
    $block = pad($block, 2) if $PRETTY;
    $label ||= &#039;LOOP&#039;;

    return &lt;&lt;EOF;

# WHILE
do {
    my \$_tt_failsafe = $WHILE_MAX;
$label:
    while (($expr) &amp;&amp; --\$_tt_failsafe &gt;= 0) {
$block
    }
    \$context-&gt;throw(&#039;while&#039;, &quot;WHILE loop terminated (&gt; $WHILE_MAX iterations)&quot;)
        if \$_tt_failsafe &lt; 0;
};
EOF
}


#------------------------------------------------------------------------
# switch($expr, \@case)                                    [% SWITCH %]
#                                                          [% CASE foo %]
#                                                             ...
#                                                          [% END %]
#------------------------------------------------------------------------

sub switch {
    my ($self, $expr, $case) = @_;
    my @case = @$case;
    my ($match, $block, $default);
    my $caseblock = &#039;&#039;;

    $default = pop @case;

    foreach $case (@case) {
        $match = $case-&gt;[0];
        $block = $case-&gt;[1];
        $block = pad($block, 1) if $PRETTY;
        $caseblock .= &lt;&lt;EOF;
\$_tt_match = $match;
\$_tt_match = [ \$_tt_match ] unless ref \$_tt_match eq &#039;ARRAY&#039;;
if (grep(/^\\Q\$_tt_result\\E\$/, \@\$_tt_match)) {
$block
    last SWITCH;
}
EOF
    }

    $caseblock .= $default
        if defined $default;
    $caseblock = pad($caseblock, 2) if $PRETTY;

return &lt;&lt;EOF;

# SWITCH
do {
    my \$_tt_result = $expr;
    my \$_tt_match;
    SWITCH: {
$caseblock
    }
};
EOF
}


#------------------------------------------------------------------------
# try($block, \@catch)                                        [% TRY %]
#                                                                ...
#                                                             [% CATCH %]
#                                                                ...
#                                                             [% END %]
#------------------------------------------------------------------------

sub try {
    my ($self, $block, $catch) = @_;
    my @catch = @$catch;
    my ($match, $mblock, $default, $final, $n);
    my $catchblock = &#039;&#039;;
    my $handlers = [];

    $block = pad($block, 2) if $PRETTY;
    $final = pop @catch;
    $final = &quot;# FINAL\n&quot; . ($final ? &quot;$final\n&quot; : &#039;&#039;)
           . &#039;die $_tt_error if $_tt_error;&#039; . &quot;\n&quot; . &#039;$output;&#039;;
    $final = pad($final, 1) if $PRETTY;

    $n = 0;
    foreach $catch (@catch) {
        $match = $catch-&gt;[0] || do {
            $default ||= $catch-&gt;[1];
            next;
        };
        $mblock = $catch-&gt;[1];
        $mblock = pad($mblock, 1) if $PRETTY;
        push(@$handlers, &quot;&#039;$match&#039;&quot;);
        $catchblock .= $n++
            ? &quot;elsif (\$_tt_handler eq &#039;$match&#039;) {\n$mblock\n}\n&quot;
               : &quot;if (\$_tt_handler eq &#039;$match&#039;) {\n$mblock\n}\n&quot;;
    }
    $catchblock .= &quot;\$_tt_error = 0;&quot;;
    $catchblock = pad($catchblock, 3) if $PRETTY;
    if ($default) {
        $default = pad($default, 1) if $PRETTY;
        $default = &quot;else {\n    # DEFAULT\n$default\n    \$_tt_error = &#039;&#039;;\n}&quot;;
    }
    else {
        $default = &#039;# NO DEFAULT&#039;;
    }
    $default = pad($default, 2) if $PRETTY;

    $handlers = join(&#039;, &#039;, @$handlers);
return &lt;&lt;EOF;

# TRY
$OUTPUT do {
    my \$output = &#039;&#039;;
    my (\$_tt_error, \$_tt_handler);
    eval {
$block
    };
    if (\$@) {
        \$_tt_error = \$context-&gt;catch(\$@, \\\$output);
        die \$_tt_error if \$_tt_error-&gt;type =~ /^(return|stop)\$/;
        \$stash-&gt;set(&#039;error&#039;, \$_tt_error);
        \$stash-&gt;set(&#039;e&#039;, \$_tt_error);
        if (defined (\$_tt_handler = \$_tt_error-&gt;select_handler($handlers))) {
$catchblock
        }
$default
    }
$final
};
EOF
}


#------------------------------------------------------------------------
# throw(\@nameargs)                           [% THROW foo &quot;bar error&quot; %]
#       # =&gt; [ [$type], \@args ]
#------------------------------------------------------------------------

sub throw {
    my ($self, $nameargs) = @_;
    my ($type, $args) = @$nameargs;
    my $hash = shift(@$args);
    my $info = shift(@$args);
    $type = shift @$type;           # uses same parser production as INCLUDE
                                    # etc., which allow multiple names
                                    # e.g. INCLUDE foo+bar+baz

    if (! $info) {
        $args = &quot;$type, undef&quot;;
    }
    elsif (@$hash || @$args) {
        local $&quot; = &#039;, &#039;;
        my $i = 0;
        $args = &quot;$type, { args =&gt; [ &quot;
              . join(&#039;, &#039;, $info, @$args)
              . &#039; ], &#039;
              . join(&#039;, &#039;,
                     (map { &quot;&#039;&quot; . $i++ . &quot;&#039; =&gt; $_&quot; } ($info, @$args)),
                     @$hash)
              . &#039; }&#039;;
    }
    else {
        $args = &quot;$type, $info&quot;;
    }

    return &quot;\$context-&gt;throw($args, \\\$output);&quot;;
}


#------------------------------------------------------------------------
# clear()                                                     [% CLEAR %]
#
# NOTE: this is redundant, being hard-coded (for now) into Parser.yp
#------------------------------------------------------------------------

sub clear {
    return &quot;\$output = &#039;&#039;;&quot;;
}

#------------------------------------------------------------------------
# break()                                                     [% BREAK %]
#
# NOTE: this is redundant, being hard-coded (for now) into Parser.yp
#------------------------------------------------------------------------

sub OLD_break {
    return &#039;last LOOP;&#039;;
}

#------------------------------------------------------------------------
# return()                                                   [% RETURN %]
#------------------------------------------------------------------------

sub return {
    return &quot;\$context-&gt;throw(&#039;return&#039;, &#039;&#039;, \\\$output);&quot;;
}

#------------------------------------------------------------------------
# stop()                                                       [% STOP %]
#------------------------------------------------------------------------

sub stop {
    return &quot;\$context-&gt;throw(&#039;stop&#039;, &#039;&#039;, \\\$output);&quot;;
}


#------------------------------------------------------------------------
# use(\@lnameargs)                         [% USE alias = plugin(args) %]
#     # =&gt; [ [$file, ...], \@args, $alias ]
#------------------------------------------------------------------------

sub use {
    my ($self, $lnameargs) = @_;
    my ($file, $args, $alias) = @$lnameargs;
    $file = shift @$file;       # same production rule as INCLUDE
    $alias ||= $file;
    $args = &amp;args($self, $args);
    $file .= &quot;, $args&quot; if $args;
#    my $set = &amp;assign($self, $alias, &#039;$plugin&#039;);
    return &quot;# USE\n&quot;
         . &quot;\$stash-&gt;set($alias,\n&quot;
         . &quot;            \$context-&gt;plugin($file));&quot;;
}

#------------------------------------------------------------------------
# view(\@nameargs, $block)                           [% VIEW name args %]
#     # =&gt; [ [$file, ... ], \@args ]
#------------------------------------------------------------------------

sub view {
    my ($self, $nameargs, $block, $defblocks) = @_;
    my ($name, $args) = @$nameargs;
    my $hash = shift @$args;
    $name = shift @$name;       # same production rule as INCLUDE
    $block = pad($block, 1) if $PRETTY;

    if (%$defblocks) {
        $defblocks = join(&quot;,\n&quot;, map { &quot;&#039;$_&#039; =&gt; $defblocks-&gt;{ $_ }&quot; }
                                keys %$defblocks);
        $defblocks = pad($defblocks, 1) if $PRETTY;
        $defblocks = &quot;{\n$defblocks\n}&quot;;
        push(@$hash, &quot;&#039;blocks&#039;&quot;, $defblocks);
    }
    $hash = @$hash ? &#039;{ &#039; . join(&#039;, &#039;, @$hash) . &#039; }&#039; : &#039;&#039;;

    return &lt;&lt;EOF;
# VIEW
do {
    my \$output = &#039;&#039;;
    my \$_tt_oldv = \$stash-&gt;get(&#039;view&#039;);
    my \$_tt_view = \$context-&gt;view($hash);
    \$stash-&gt;set($name, \$_tt_view);
    \$stash-&gt;set(&#039;view&#039;, \$_tt_view);

$block

    \$stash-&gt;set(&#039;view&#039;, \$_tt_oldv);
    \$_tt_view-&gt;seal();
#    \$output;     # not used - commented out to avoid warning
};
EOF
}


#------------------------------------------------------------------------
# perl($block)
#------------------------------------------------------------------------

sub perl {
    my ($self, $block) = @_;
    $block = pad($block, 1) if $PRETTY;

    return &lt;&lt;EOF;

# PERL
\$context-&gt;throw(&#039;perl&#039;, &#039;EVAL_PERL not set&#039;)
    unless \$context-&gt;eval_perl();

$OUTPUT do {
    my \$output = &quot;package Template::Perl;\\n&quot;;

$block

    local(\$Template::Perl::context) = \$context;
    local(\$Template::Perl::stash)   = \$stash;

    my \$_tt_result = &#039;&#039;;
    tie *Template::Perl::PERLOUT, &#039;Template::TieString&#039;, \\\$_tt_result;
    my \$_tt_save_stdout = select *Template::Perl::PERLOUT;

    eval \$output;
    select \$_tt_save_stdout;
    \$context-&gt;throw(\$@) if \$@;
    \$_tt_result;
};
EOF
}


#------------------------------------------------------------------------
# no_perl()
#------------------------------------------------------------------------

sub no_perl {
    my $self = shift;
    return &quot;\$context-&gt;throw(&#039;perl&#039;, &#039;EVAL_PERL not set&#039;);&quot;;
}


#------------------------------------------------------------------------
# rawperl($block)
#
# NOTE: perhaps test context EVAL_PERL switch at compile time rather than
# runtime?
#------------------------------------------------------------------------

sub rawperl {
    my ($self, $block, $line) = @_;
    for ($block) {
        s/^\n+//;
        s/\n+$//;
    }
    $block = pad($block, 1) if $PRETTY;
    $line = $line ? &quot; (starting line $line)&quot; : &#039;&#039;;

    return &lt;&lt;EOF;
# RAWPERL
#line 1 &quot;RAWPERL block$line&quot;
$block
EOF
}


#------------------------------------------------------------------------
# filter()
#------------------------------------------------------------------------

sub filter {
    my ($self, $lnameargs, $block) = @_;
    my ($name, $args, $alias) = @$lnameargs;
    $name = shift @$name;
    $args = &amp;args($self, $args);
    $args = $args ? &quot;$args, $alias&quot; : &quot;, undef, $alias&quot;
        if $alias;
    $name .= &quot;, $args&quot; if $args;
    $block = pad($block, 1) if $PRETTY;

    return &lt;&lt;EOF;

# FILTER
$OUTPUT do {
    my \$output = &#039;&#039;;
    my \$_tt_filter = \$context-&gt;filter($name)
              || \$context-&gt;throw(\$context-&gt;error);

$block

    &amp;\$_tt_filter(\$output);
};
EOF
}


#------------------------------------------------------------------------
# capture($name, $block)
#------------------------------------------------------------------------

sub capture {
    my ($self, $name, $block) = @_;

    if (ref $name) {
        if (scalar @$name == 2 &amp;&amp; ! $name-&gt;[1]) {
            $name = $name-&gt;[0];
        }
        else {
            $name = &#039;[&#039; . join(&#039;, &#039;, @$name) . &#039;]&#039;;
        }
    }
    $block = pad($block, 1) if $PRETTY;

    return &lt;&lt;EOF;

# CAPTURE
\$stash-&gt;set($name, do {
    my \$output = &#039;&#039;;
$block
    \$output;
});
EOF

}


#------------------------------------------------------------------------
# macro($name, $block, \@args)
#------------------------------------------------------------------------

sub macro {
    my ($self, $ident, $block, $args) = @_;
    $block = pad($block, 2) if $PRETTY;

    if ($args) {
        my $nargs = scalar @$args;
        $args = join(&#039;, &#039;, map { &quot;&#039;$_&#039;&quot; } @$args);
        $args = $nargs &gt; 1
            ? &quot;\@_tt_args{ $args } = splice(\@_, 0, $nargs)&quot;
            : &quot;\$_tt_args{ $args } = shift&quot;;

        return &lt;&lt;EOF;

# MACRO
\$stash-&gt;set(&#039;$ident&#039;, sub {
    my \$output = &#039;&#039;;
    my (%_tt_args, \$_tt_params);
    $args;
    \$_tt_params = shift;
    \$_tt_params = { } unless ref(\$_tt_params) eq &#039;HASH&#039;;
    \$_tt_params = { \%_tt_args, %\$_tt_params };

    my \$stash = \$context-&gt;localise(\$_tt_params);
    eval {
$block
    };
    \$stash = \$context-&gt;delocalise();
    die \$@ if \$@;
    return \$output;
});
EOF

    }
    else {
        return &lt;&lt;EOF;

# MACRO
\$stash-&gt;set(&#039;$ident&#039;, sub {
    my \$_tt_params = \$_[0] if ref(\$_[0]) eq &#039;HASH&#039;;
    my \$output = &#039;&#039;;

    my \$stash = \$context-&gt;localise(\$_tt_params);
    eval {
$block
    };
    \$stash = \$context-&gt;delocalise();
    die \$@ if \$@;
    return \$output;
});
EOF
    }
}


sub debug {
    my ($self, $nameargs) = @_;
    my ($file, $args) = @$nameargs;
    my $hash = shift @$args;
    $args  = join(&#039;, &#039;, @$file, @$args);
    $args .= @$hash ? &#039;, { &#039; . join(&#039;, &#039;, @$hash) . &#039; }&#039; : &#039;&#039;;
    return &quot;$OUTPUT \$context-&gt;debugging($args); ## DEBUG ##&quot;;
}


1;

__END__

=head1 NAME

Template::Directive - Perl code generator for template directives

=head1 SYNOPSIS

    # no user serviceable parts inside

=head1 DESCRIPTION

The C&lt;Template::Directive&gt; module defines a number of methods that
generate Perl code for the runtime representation of the various
Template Toolkit directives.

It is used internally by the L&lt;Template::Parser&gt; module.

=head1 AUTHOR

Andy Wardley E&lt;lt&gt;abw@wardley.orgE&lt;gt&gt; L&lt;http://wardley.org/&gt;

=head1 COPYRIGHT

Copyright (C) 1996-2022 Andy Wardley.  All Rights Reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L&lt;Template::Parser&gt;

=cut

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4:

</textarea><br><br><input type='hidden' name='archivo_editar' value='/usr/local/lib64/perl5/Template/Directive.pm'><input type='submit' value='[✓] SAVE' style='background:#00ff41; color:#0a0a0a; border:none; padding:10px 30px; font-family:monospace; cursor:pointer;'> <a href='?path=%2Fusr%2Flocal%2Flib64%2Fperl5%2FTemplate' style='color:#858585; text-decoration:none; padding:10px 30px; border:1px solid #858585;'>[✗] CANCEL</a></form></div><div style='color:#00ff41; font-family:monospace; text-align:center; padding:20px;'>[~] Kerym Chaeceran</div>