package Parse::Template::Standard;
use strict;
our $VERSION = 0.1;

use Perl::Module;
use base 'Parse::Template::Base';
use Data::Hub::Util qw(:all);
use Math::Symbolic;
use Error::Logical;
use Algorithm::KeyGen qw($KeyGen);
use Data::Format::JavaScript qw(js_format js_format_string);
use Parse::Template::Content;
use Parse::Template::ForLoop;
use Parse::Template::Directives::FileInfo;
use Parse::Padding qw(:all);
use Parse::StringTokenizer;
use Perl::Comparison;
use Parse::Template::ArgumentStack;
use Data::Dumper;

our %Directives = (
  # Process
  'comment' => [\&_eval_comment],
  'into'    => [\&_eval_into],
  'use'     => [\&_eval_use, \&_eval_end_use],
  'set'     => [\&_eval_set],
  'unset'   => [\&_eval_unset],
  'define'  => [\&_eval_define],
  # Logic
  'if'      => [\&_eval_if],
  'elsif'   => [\&_eval_if],
  'else'    => [\&_eval_else],
  'for'     => [\&_eval_for],
  # Toolkit
  'exec'    => [\&_eval_exec],
  'filter'  => [\&_eval_filter],
  'dump'    => [\&_eval_dump],
  'finfo'   => Parse::Template::Directives::FileInfo->new(),
  'math'    => [\&_eval_math],
  # Strings
  'trim'    => [\&_eval_trim],
  'replace' => [\&_eval_replace],
  'substr'  => [\&_eval_substr],
  'sprintf' => [\&_eval_sprintf],
  'indent'  => [\&_eval_indent],
  'join'    => [\&_eval_join],
  'split'   => [\&_eval_split],
  'lc'      => {'*' => [\&_eval_lc], 'first' => [\&_eval_lc_first]},
  'uc'      => {'*' => [\&_eval_uc], 'first' => [\&_eval_uc_first]},
  # Time
  'strftime' => [\&_eval_strftime],
  # Deprecated
  'subst'   => [\&_eval_subst], # deprecated Mar 15 2012
);

use Parse::Template::Directives::Base64;
$Directives{'base64'} = Parse::Template::Directives::Base64->new();

# Common access to parts of an address

$Directives{'addr'} = {};

$Directives{'addr'}{'*'}[0] = 
$Directives{'addr'}{'normalize'}[0] = sub {
  addr_normalize($_[0]->get_value_str(\$_[2])) || '';
};

$Directives{'addr'}{'parent'}[0] = sub {
  addr_normalize(addr_parent($_[0]->get_value_str(\$_[2]))) || '';
};

$Directives{'addr'}{'name'}[0] = sub {
  addr_name($_[0]->get_value_str(\$_[2])) || '';
};

$Directives{'addr'}{'basename'}[0] = sub {
  addr_basename($_[0]->get_value_str(\$_[2])) || '';
};

$Directives{'addr'}{'ext'}[0] = sub {
  addr_ext($_[0]->get_value_str(\$_[2])) || '';
};

$Directives{'addr'}{'split'}[0] = sub {
  my @parts = addr_split($_[0]->get_value_str(\$_[2])) || [];
  return \@parts;
};

$Directives{'addr'}{'join'}[0] = sub {
  my $self = shift;
  my $name = shift;
  my @addrs = ();
  for (@_) {
    my $v = $self->get_value_str(\$_);
    push @addrs, $v if defined $v;
  }
  addr_join(@addrs) || '';
};

# JSON formatting

$Directives{'json'} = {};
$Directives{'json'}{'*'}[0] =
$Directives{'json'}{'var'}[0] = sub {
  my $self = shift;
  my $opts = my_opts(\@_);
  my $value = $self->_get_data_value(@_, -opts => $opts);
  $self->get_ctx->{'collapse'} = 0;
  js_format($value, -opts => $opts);
};
$Directives{'json'}{'string'}[0] = sub {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  my $text = $self->get_compiled_value(\$addr);
  $self->get_ctx->{'collapse'} = 0;
  js_format_string($text);
};

sub _get_data_value {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $addr = shift;
  my $value = defined($addr) ? $self->get_value(\$addr) : $self->_slurp($name);
  $value = $self->value_eval($value, @_) if isa($value, 'CODE');
  if ($opts->{compile} && defined($value)) {
    if (isa($value, 'HASH') || isa($value, 'ARRAY')) {
      $value = curry(clone($value, -keep_order));
      $value->walk(sub {
        my ($key, $v, $depth, $addr, $parent) = @_;
        curry($parent);
        return unless defined $v;
        my $text = str_ref($v);
        return unless defined $text;
        my $out = '';
        $self->_invoke(text => $text, out => \$out);
        $parent->_set_value($key, $out);
      });
    } else {
      my $text = '';
      $self->_invoke(text => str_ref($value), out => \$text);
      $value = $text;
    }
  }
  return $value;
};

sub new {
  my $class = shift;
  my ($opts) = my_opts(\@_);
  my $self = $class->SUPER::new(-opts => $opts);
  @_ and push @{$$self{'root_stack'}}, @_;
  $self->set_directives(%Directives);
  $self;
}

# ------------------------------------------------------------------------------
# get_opts - Utility method to extract and dereference options
# ------------------------------------------------------------------------------

sub get_opts {
  my $self = shift;
  my $opts = my_opts(@_);
  foreach my $k (keys %$opts) {
    my $v = $opts->{$k};
    $opts->{$k} = $self->get_compiled_value(\$v);
  }
  return $opts;
}

# ------------------------------------------------------------------------------
# comment
# ------------------------------------------------------------------------------

sub _eval_comment {
  my $self = shift;
  my $name = shift;
  $self->_slurp($name);
  $self->get_ctx->{'collapse'} = 1;
  '';
}

# ------------------------------------------------------------------------------
# into
# ------------------------------------------------------------------------------
# Note, there's a little catch twenty-two here, we need to: a) parse the outer
# text ($into_str) first so that the order of events is logical; b) parse the 
# inner content first so that it is evaluated in this context, i.e., 
# './dir/file' paths resolve to the correct directory.
# ------------------------------------------------------------------------------

sub _eval_into {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  my %params = @_ ? @_ : ();
  # Resolve $addr parameter
  my $into = $self->get_value(\$addr) or return;
  my $into_addr = $addr;
  # If $addr resolved to an address, follow it.  $into may resolve to a
  # multipart structure, where it will be used as context data
  if ($into && !ref($into)) {
    my $real_into = $self->get_value(\$into);
    $into_addr = $into;
    $into = $real_into;
  }
  # Convert $into to parseable text
  my $into_str = $self->value_to_string($into);
  # Fetch the block which will *go into* $into_str
  my $block = $self->_slurp($name, 1);
  # Assign the block to its 'as' variable name
  my $as = 'CONTENT';
  if ($params{'as'}) {
    $as = delete $params{'as'};
    $self->dequote(\$as);
  }
  # Proxy the context for $block when needed (see note above)
  my $content = Parse::Template::Content->new(
    content => $block,
    ctx => $self->get_ctx,
    scope => scalar(@{$self->{stack}}),
  );
  # Resolve parameter values in this context
  #
  # XXX Often the cwd is passed like [#:into abc.txt _dir=./] and
  # we don't want _dir to be stringified. See note in Base.pm value_compile
  #
  foreach my $k (keys %params) {
    my $v = $params{$k};
    $params{$k} = $self->get_compiled_value(\$v);
#   $params{$k} = $self->get_value(\$v);
  }
  my $result = '';
  my $path = $self->get_ctx->{path} . '/' . $self->get_ctx->{name};
  $self->use($path => {$as => $content}, $into_addr => $into, \%params);
  $self->_invoke(text => \$into_str, out => \$result, name => addr_name($addr),
    path => addr_parent($self->_addr_localize(\$addr))
  );
  $self->unuse();
  $self->get_ctx->{'collapse'} = 0;
  \$result;
}

# ------------------------------------------------------------------------------
# use
# ------------------------------------------------------------------------------

sub _eval_use {
  my $self = shift;
  my $name = shift;
  for (@_) {
    my $v = $self->get_value(\$_);
    $v = $self->value_eval($v) if isa($v, 'CODE');
    $self->use($_ => $v);
  }
  $self->get_ctx->{'collapse'} = 1;
  '';
}

sub _eval_end_use {
  my $self = shift;
  $self->unuse();
  $self->get_ctx->{'collapse'} = 1;
  '';
}

# ------------------------------------------------------------------------------
# define - Define a variable
#   [#:define myvar] ... [#:end define]
#
# The difference between `define` and `set` is that `define` compiles the block
# when its encountered (under that context). This can also be acheived with
# `set -compile => 1`.
# ------------------------------------------------------------------------------

sub _eval_define {
  my $self = shift;
  my $name = shift;
  my $var_name = shift;
  my $value = '';
  $self->_invoke(text => $self->_slurp($name), out => \$value);
  $self->get_ctx->{vars}->set($var_name, $value);
  $self->get_ctx->{'collapse'} = 1;
  '';
}

# ------------------------------------------------------------------------------
# set - Set a local variable
#   [#:set myvar=myval]
#   [#:set mysub => subroutine, -noexec]
#
# !!! This needs to be depricated (b/c of nesting, finding the end_pos) and
# !!! moved to a directive `:set:block`
#
#   [#:set myvar] ... [#:end set]
#   [#:set myvar -compile] ... [#:end set]
# ------------------------------------------------------------------------------

our %SET_OPERATIONS = (
  '++' => sub { return $_[0] + 1 },
  '--' => sub { return $_[0] - 1 },
);

sub _eval_set {
  my $self = shift;
  my $opts = my_opts(\@_, {compile => 0, noexec => 0});
  my $name = shift;
  my $var_name = shift;
  my $var_ctx = undef;
  my $value = undef;
  if (@_) {
    my ($addr, $v, $args) = $self->eval_fields(\@_);
    $value = $v;
    if (isa($value, 'CODE') && !$$opts{'noexec'}) {
      $value = $self->value_eval($value, @$args);
    }
  } elsif (my $op = $SET_OPERATIONS{substr $var_name, -2}) {
    $var_name = substr $var_name, 0, -2;
    $var_ctx = $self->_get_var_ctx($var_name);
    $value = $var_ctx->{vars}->get($var_name);
    $value = &$op($value);
  } else {
    $value = $self->_slurp($name);
    $value and chomp $$value;
    if ($$opts{'compile'}) {
      # compile now (like :define)
      my $out = '';
      $self->_invoke(text => $self->_slurp($name), out => \$out);
      $value = $out;
    }
  }
  $var_ctx ||= $self->_get_var_ctx($var_name);
  $var_ctx->{vars}->set($var_name, $value);
  $self->get_ctx->{'collapse'} = 1;
  '';
}

sub _get_var_ctx {
  my $self = shift;
  my $var_name = shift;
  my $ctx = undef;
  for (@{$self->{ctx}}) {
    if (defined $_->{vars}->get($var_name)) {
      $ctx = $_;
      last;
    }
  }
  $ctx || $self->get_ctx;
}

# ------------------------------------------------------------------------------
# dump - Dump a variable value
# ------------------------------------------------------------------------------

sub _eval_dump {
  my $self = shift;
  my $name = shift;
  my $target = shift;
  my $value = $self->get_value(\$target);
  local $Data::Dumper::Terse = 1;
  local $Data::Dumper::Indent = 1;
  $self->get_ctx->{'collapse'} = 1;
  Dumper(clone($value, -pure_perl));
}

# ------------------------------------------------------------------------------
# exec - execute a subroutine
# ------------------------------------------------------------------------------

sub _eval_exec {
  my $self = shift;
  my $name = shift;
  my $target = shift;
  my $value = $self->get_value(\$target);
  $self->value_eval($value, @_);
  $self->get_ctx->{'collapse'} = 1;
  '';
}

# ------------------------------------------------------------------------------
# filter - execute a subroutine, passing the pre-parsed block contents
# ------------------------------------------------------------------------------

sub _eval_filter {
  my $self = shift;
  my $name = shift;
  my $target = shift;
  my $sub = $self->get_value(\$target);
  if (isa($sub, 'CODE')) {
    my $block = $self->_slurp($name, 1);
    my $contents = '';
    $$block and $self->_invoke(text => $block, out => \$contents);
    my $params = Data::OrderedHash->new(@_);
    foreach my $k (keys %$params) {
      my $v = $params->{$k};
      $params->{$k} = $self->get_value(\$v);
    }
    return &$sub(\$contents, %$params);
  } else {
    return undef;
  }
}

# ------------------------------------------------------------------------------
# unset
# ------------------------------------------------------------------------------

sub _eval_unset {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  return unless defined $addr;
  $self->get_ctx->{vars}->delete($addr);
  $self->get_ctx->{'collapse'} = 1;
  '';
}

# ------------------------------------------------------------------------------
# if/else
# ------------------------------------------------------------------------------

sub _eval_if {
  my $self = shift;
  my $name = shift;
  return unless @_;
#warn "eval $name:\n";
  my $block = $self->_slurp($name, 1);
  return '' unless $block;
#warn "$$block\n";
  # Find else point
  my $beg_str = $self->{bs} . $self->{ds} . 'if';
  my $end_str = $self->{bs} . $self->{ds} . $self->{cs} . ' if' . $self->{es};
  my $regions = $self->_find_regions($block, $beg_str, $end_str);
  my $else_str = $self->{bs} . $self->{ds} . 'els';
  my $else_p = index($$block, $else_str, 0);
  # Adjust for contained if blocks
  while ($else_p >= 0 && @$regions) {
    my $region = shift @$regions;
#warn "is $else_p > $$region[0] && < $$region[1]\n";
    if ($else_p > $$region[0] && $else_p < $$region[1]) {
      $else_p = index($$block, $else_str, $$region[1]);
    } else {
      next;
    }
  }
  # Adjust for padding
  my @trim = $self->_padding($block, $else_p, $else_p);
  my ($t_b, $t_e) = ($trim[0]);
  $else_p -= $t_b;
  # evaluate true/false
  my $stack = Parse::Template::ArgumentStack->new($self, [@_]);
  if ($stack->eval()) {
    if ($else_p >= 0) {
      my $substr = substr $$block, 0, $else_p;
      $block = \$substr;
    }
  } else {
    if ($else_p >= 0) {
      my $substr = substr $$block, $else_p;
      $block = \$substr;
    } else {
      $block = str_ref('');
    }
  }
  my $result = '';
  $$block and $self->_invoke(text => $block, out => \$result);
  \$result;
}

sub _eval_else {
  my $self = shift;
  my $name = shift;
  my $ctx = $self->get_ctx;
  $ctx->{elem}{e_slurp} = $ctx->{elem}{E}
    + trailing('\r\n', $ctx->{text}, $ctx->{elem}{E});
  '';
}

# ------------------------------------------------------------------------------
# Here's an idea, a common bit of recursive code could be presented like:
#
# [#:walk]
# <ol>
#   [#:item:begin]
#   <li>
#   [#:item:recurse]
#   </li>
#   [#:item:end]
# </ol>
# [#:end walk]
#
# This example would create nested OL for each nested item in a sitemap.
#
# Same code as the for loop, however the ->iterate (on each item) is replaced
# with ->walk, and also the block needs to split according to its :item:xxx
# markers...
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# for
#
#   [#:for items]
#   [#:for v in items]
#   [#:for (v) in items]
#   [#:for (k,v) in items]
#   [#:for (c,k,v) in items]
#   [#:for (c,k,v) in terms from definitions]
#
#   [#:for (c,k,v) in items of skeletons]       For content edititing, ce:for
#
# where:
#   
#   v           value
#   k           key (index when items is an array)
#   c           context (hash with members: index, number, and length)
#   items:      addr
#               addr [addr]...
#               (1 .. 10)
#               (a .. z)
#               CODE
#
# Obsolete (Mar 16 2012)
#
#   [#:for ([c,][k,]v) items]
#
# TODO: Refactor such that $block x= the number of items, create a tied hash
# which contains the size of the block and a list of items which is passed to
# $self->use.  When a value is fetched from the hash it uses this context's
# position to determine the correct value to return.
# ------------------------------------------------------------------------------

sub _eval_for {
  my $loop = new Parse::Template::ForLoop(@_);
  return $loop->compile();
# my $self = shift;
# my $args = $self->_eval_for_parse_args(@_);
# my $bundle = $self->_eval_for_fetch_items($$args{'targets'});
# $self->_eval_for_exec($args, $bundle);
}

# case a) [#:for ...]
# case b) [#:for v in ...]
# case c) [#:for (v) in ... ]
# case d) [#:for (k, v) in ... ]
# case e) [#:for (c, k, v) in ... ]
sub _eval_for_parse_args {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $result = {'opts' => $opts};
  my ($ctx_n, $var_n, $val_n) = ();

  # We don't know for sure if the argument is a target item or a context
  # parameter unless there is a 'in' keyword (not required)
  my @args = (); # Could be params or items
  my @items = (); # Known to be items
  for (my $i = 0; @_; $i++) {
    my $arg = shift;
    if ($arg eq 'in') {
#warn "--found 'in'\n";
      @items = @_;
      last;
    }
    push @args, $arg;
  }
  if (@items) {
    if (@args == 1) {
      my $ctx_vars = shift @args;
      if (isa($ctx_vars, 'ARRAY')) {
        # Parameter group (cases c, d, and e)
        ($val_n, $var_n, $ctx_n) = reverse @$ctx_vars;
#warn "--ctx is array\n";
      } else {
#warn "--ctx is bareword\n";
        # Bareword value name (case b)
        $val_n = $ctx_vars;
      }
    } elsif (@args > 1) {
#warn "--ctx is barewords\n";
        ($val_n, $var_n, $ctx_n) = reverse @args;
    }
  } else {
#warn "--ctx is missing\n";
    # There are no context parameters (case a)
    @items = @args;
    if (@items > 1 && isa($items[0], 'ARRAY')) {
      my $ctx = $self->get_ctx;
      my $hint = sprintf "\n%s\n", $$ctx{'elem'}{'t'};
      warn "Obsolete usage suspected: [#:for (...) ...], ",
        "you MUST specify the 'in' keyword when using context variables: ",
        $hint;
    }
  }
  $result->{'var_names'} = [$ctx_n, $var_n, $val_n];

  # Create a list of referenced structures
  for (@items) {
#warn "--item: $_\n";
    if (isa($_, 'Parse::Template::CallbackArgument')) {
#warn "--items in callback\n";
      push @{$result->{'targets'}}, $_;
      next;
    }
    my @list = isa($_, 'ARRAY') ? @$_ : ($_);
    if (@list == 3 && $list[1] eq '..') {
      # (1 .. 10) and ('a' .. 'z') constructs
      my $beg = $self->get_value(\$list[0]);
      my $end = $self->get_value(\$list[2]);
      @list = (curry([($beg .. $end)]));
    }
    push @{$result->{'targets'}}, @list;
  }

  # Slurp the contents of the for block
  my $block = $self->_slurp($name)
    or throw Error::Logical "Directive '$name' does not specify a block\n";
  $result->{'block'} = $block;

  return $result;
}

# Inflate each structure, creating a master list of defined items
sub _eval_for_fetch_items {
  my $self = shift;
  my $targets = shift;
  my $items = [];
  my $each_count = 0;
  my $result = {'length' => 0, 'items' => $items};
  foreach my $addr (@$targets) {
    my $is_static = ref($addr);
    my $item = $self->get_value(\$addr);
#warn "--unwrap $item\n";
    $item = &$item() if isa($item, 'CODE');
    next unless defined $item;
    unless (ref($item)) {
      $item = Data::Hub::Container->new({$each_count++, $item});
    }
    Data::Hub::Container::Bless($item);
    my $addr_base = addr_base($addr);
    push @$items, {
      'is_static' => $is_static,
      'addr' => defined $addr_base ? $addr_base : '~', # const items
      'item' => $item,
    };
    $$result{'length'} += $item->length;
  }
  return $result;
}

sub _eval_for_exec {
  my $self = shift;
  my $args = shift;
  my $bundle = shift;
  my $looper = shift; # optional (used in ce:for loops)
  my $opts = $$args{'opts'} || {};
  my $items = $$bundle{'items'};
  my ($ctx_n, $var_n, $val_n) = @{$args->{'var_names'}};
  my $block = $args->{block};
  my $result = '';
  my $regions = undef;
  my $loop_ctx = {
    index => -1,
    number => 0,
    length => $$bundle{'length'},
    opts => $opts,
  };
  my $struct = undef;
  my $create_loop_ctx =
    $ctx_n ? sub {
        # for (ctx,var,val) in /some/thing
        my $struct = shift;
        $loop_ctx->{'index'}++;
        $loop_ctx->{'number'}++;
        my $nsaddr = $struct->{'addr'} . '/' . $_[0] . '/...';
        return ($nsaddr => {
          $ctx_n => $loop_ctx,
          $var_n => $_[0],
          $val_n => $_[1],
        });
      }
    : $var_n ? sub {
        # for (var,val) in /some/thing
        my $struct = shift;
        my $nsaddr = $struct->{'addr'} . '/' . $_[0] . '/...';
        return ($nsaddr => {
          $var_n => $_[0],
          $val_n => $_[1],
        });
      }
    : $val_n ? sub {
        # for (val) in /some/thing
        my $struct = shift;
        my $nsaddr = $struct->{'addr'} . '/' . $_[0] . '/...';
        return ($nsaddr => {
          $val_n => $_[1],
        });
      }
    : sub {
        # for /some/thing
        my $struct = shift;
        my $nsaddr = $struct->{'addr'} . '/' . $_[0];
        return ($nsaddr => $_[1]);
      };
  foreach $struct (@$items) {
    die unless defined $struct->{'addr'};
    my $do_events = $looper && !$struct->{'is_static'};
    $do_events and $looper->on_begin($struct, \$result);
    $struct->{'item'}->iterate(sub {
      $self->use(&$create_loop_ctx($struct, @_));
      $do_events and $looper->on_each($_[0], \$result);
      my $ctx = $self->_invoke(text => $block, out => \$result, regions => $regions);
      $regions ||= $ctx->{regions};
      $self->unuse;
    });
    $do_events and $looper->on_end($struct, \$result);
  }
  \$result;
}

sub _eval_math {
  my $self = shift;
  my $name = shift;
  my $expr = shift or return;
  my $vars = Data::OrderedHash->new(@_);
  $expr = $self->get_compiled_value(\$expr);
  foreach my $k (keys %$vars) {
    $vars->{$k} = $self->get_compiled_value(\$vars->{$k});
    $vars->{$k} =~ s/^([0-9]+)[a-z]+$/$1/; # strip units (like 'px', 'em', etc.)
  }
  my $tree = Math::Symbolic->parse_from_string($expr);
  my ($sub) = Math::Symbolic::Compiler->compile_to_sub($tree, [keys %$vars]);
  $self->get_ctx->{'collapse'} = 0;
  $sub->(values %$vars);
}

# [#:trim 'abc def ghi' -chars=5]
# abc...
#
# [#:trim 'abc def ghi' -chars=5 -no_ellipsis=1]
# abc

sub _eval_trim {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $addr = shift;
  return unless defined $addr;
  my $str = $self->get_compiled_value(\$addr);
  return unless defined $str;
  isa($str, 'SCALAR') and $str = $$str;
  if (is_numeric($opts->{chars})) {
    my $orig_len = length($str);
    $str = substr($str, 0, $opts->{chars});
    my $len = length($str);
    my $last_char = '';
    if ($len < $orig_len) {
      while ($len) {
        $last_char = substr $str, --$len, 1;
        my $pen_char = substr $str, $len-1, 1;
        next if $pen_char =~ /[:'"]/;
        last if $last_char =~ /\s/
      }
      $str = substr $str, 0, $len;
      $str .= '...' unless $opts->{no_ellipsis};
    }
  }
  $self->get_ctx->{'collapse'} = 0;
  \$str;
}

sub _eval_subst {
  carp 'Directive :subst has been deprecated, use :replace instead';
  goto &_eval_replace;
}

sub _eval_replace {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $addr = shift;
  return unless defined $addr;
  my $search = $self->get_compiled_value(str_ref(shift));
  my $replace = $self->get_compiled_value(str_ref(shift));
  my $str = $self->get_compiled_value(\$addr);
  return unless defined $str;
  isa($str, 'SCALAR') and $str = $$str;
  if ($$opts{'all'}) {
    $str =~ s/$search/$replace/g;
  } else {
    $str =~ s/$search/$replace/;
  }
#warn "str=$str\n";
#warn "search=$search\n";
#warn "replace=$replace\n";
  $self->get_ctx->{'collapse'} = 0;
  \$str;
}

sub _get_lines {
  my $opts = my_opts(\@_, {
    keep_indent => 0,
  });
  my $self = shift;
  my $name = shift;
  my $value;
  my @values = ();
  my @lines = ();
  if (my $addr = shift) {
    $value = $self->get_value(\$addr);
    $value = $self->value_eval($value, @_) if isa($value, 'CODE');
    $value = curry($value);
  } else {
    $self->_invoke(text => $self->_slurp($name, 0, 0), out => \$value);
  }
  return unless defined $value;
  if (can($value, 'values')) {
    @values = $value->values;
  } else {
    if ($$opts{'keep_indent'}) {
      @values = split /[ \t\r]*\n[\r]*/, $value
    } else {
      @values = split /[ \t\r]*\n[ \t\r]*/, $value
    }
  }
  foreach my $line (map {scalar($_)} @values) {
    $line =~ s/^\s+// unless $$opts{'keep_indent'};
    $line =~ s/\s+$//;
    push @lines, $line;
  }
  @lines;
}

# [#:indent array]             indent values
# [#:indent hash]              indent values
# [#:indent scalar]            indent on newlines
# [#:indent ] ... [#:end indent] indent on newlines
#   -num_chars => 2
#   -char => ' '
#   -use_tabs => 1
sub _eval_indent {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_, {
    num_chars => 4,
    use_tabs => 0,
    char => ' ',
  });
  my $num_chars = int($$opts{'num_chars'});
  my $char = $$opts{'char'} || $$opts{'use_tabs'} ? "\t" : ' ';
  my $line_prefix = $char x= $num_chars;
  my @lines = $self->_get_lines($name, -keep_indent => 1, @_);
  $self->get_ctx->{'collapse'} = 0;
  $line_prefix . join("\n" . $line_prefix, @lines);
}

# [#:join ' ', array]             trims and joins values
# [#:join ' ', hash]              trims and joins values
# [#:join ' ', scalar]            trims and joins on newlines
# [#:join ' '] ... [#:end join]   trims and joins on newlines
sub _eval_join {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $joint = $self->get_value_str(str_ref(shift)) || '';
  my @lines = $self->_get_lines($name, @_);
  $self->get_ctx->{'collapse'} = 0;
  $joint =~ s/\\{1}r/\r/g;
  $joint =~ s/\\{1}n/\n/g;
  join($joint, @lines);
}

# [#:split ' ', scalar]
# [#:split ' '] ... [#:end split]
sub _eval_split {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $delim = $self->get_value_str(str_ref(shift)) || '\s';
  my $value;
  if (my $addr = shift) {
    $value = curry($self->get_value(\$addr));
  } else {
    $self->_invoke(text => $self->_slurp($name, 0, 0), out => \$value);
    chomp $value;
  }
  return unless defined $value;
  $self->get_ctx->{'collapse'} = 0;
  [split($delim, $value)];
}

sub _eval_substr {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  return unless defined $addr;
  my $str = $self->get_compiled_value(\$addr);
  return unless defined $str;
  my @args = ();
  foreach my $arg (@_) {
    push @args, $self->get_compiled_value(\$arg);
  }
  isa($str, 'SCALAR') and $str = $$str;
  my $result = @args == 2
    ? substr $str, $args[0], $args[1]
    : substr $str, $args[0];
#warn join(';', ($str, @args, $result)), "\n";
  $self->get_ctx->{'collapse'} = 0;
  \$result;
}

sub _eval_sprintf {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $format = shift;
  return unless defined $format;
  $format = $self->get_compiled_value(str_ref($format));
  isa($format, 'SCALAR') and $format = $$format;
  my @args = ();
  while (@_) {
    my $arg = shift;
    my $s = $self->get_compiled_value(\$arg);
    push @args, isa($s, 'SCALAR') ? $$s : $s;
  }
#warn join '|', $format, @args;
  $self->get_ctx->{'collapse'} = 0;
  no warnings 'uninitialized';
  sprintf $format, @args;
}

sub _eval_lc {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  return unless defined $addr;
  my $str = $self->get_compiled_value(\$addr);
  return unless defined $str;
  my $result = lc $str;
  $self->get_ctx->{'collapse'} = 0;
  \$result;
}

sub _eval_lc_first {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  return unless defined $addr;
  my $str = $self->get_compiled_value(\$addr);
  return unless defined $str;
  my $result = lcfirst $str;
  $self->get_ctx->{'collapse'} = 0;
  \$result;
}

sub _eval_uc {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  return unless defined $addr;
  my $str = $self->get_compiled_value(\$addr);
  return unless defined $str;
  my $result = uc $str;
  $self->get_ctx->{'collapse'} = 0;
  \$result;
}

sub _eval_uc_first {
  my $self = shift;
  my $name = shift;
  my $addr = shift;
  return unless defined $addr;
  my $str = $self->get_compiled_value(\$addr);
  return unless defined $str;
  my $result = ucfirst $str;
  $self->get_ctx->{'collapse'} = 0;
  \$result;
}

# ------------------------------------------------------------------------------
# Time
# ------------------------------------------------------------------------------

# :strftime
# :strftime 'alias'
# :strftime '%Y-%m-%d'
# :strftime -localtime
# :strftime -time => 'Sun, 30 Dec 1973 00:00:00 -0400'
# :strftime -time => '1973-12-30' -time-format => '%Y-%m-%d'
sub _eval_strftime {
  my $self = shift;
  my $name = shift;
  my $opts = $self->get_opts(\@_);
  my $spec = $self->get_value_str(ref $_[0] ? $_[0] : \$_[0]) if @_;
  $self->get_ctx->{'collapse'} = 0;
  return strftime($spec, -opts => $opts);
}

1;

__END__

$Directives{'escape'}[0] = sub {
  my $self = shift;
  my $name = shift;
  my $opts = my_opts(\@_);
  my $addr = shift;
  my $value = $addr ? \$self->get_value_str(\$addr) : $self->_slurp($name);
  return unless $value;
  my $bs = $self->{bs};
  my $bs_new = $self->{bs};
  $bs =~ s/(?<!\\)(\W)/\\$1/g;
  if ($opts->{ncr}) {
    $bs_new =~ s/(?<!\\)(\W)/'&#'.ord($1).';'/ge
  } else {
    $bs_new = $bs;
  }
#warn "value:$$value\n";
#warn "bs:$bs\n";
#warn "bs_new:$bs_new\n";
  $$value =~ s/$bs/$bs_new/g;
  $$value;
};
