add hash extend() method for templating

diff --git a/site/cgi-bin/modules/Squirrel/Template/Expr/WrapHash.pm b/site/cgi-bin/modules/Squirrel/Template/Expr/WrapHash.pm
index 037d3b393b08e138a01c838bb1559c18316718c7..09a1143e33e906a1d0585f8384ff56760b80b09d 100644 (file)
--- a/site/cgi-bin/modules/Squirrel/Template/Expr/WrapHash.pm
+++ b/site/cgi-bin/modules/Squirrel/Template/Expr/WrapHash.pm
@@ -1,8 +1,9 @@
 package Squirrel::Template::Expr::WrapHash;
 use strict;
 use base qw(Squirrel::Template::Expr::WrapBase);
+use Scalar::Util;
 
-our $VERSION = "1.007";
+our $VERSION = "1.008";
 
 sub _do_size {
   my ($self) = @_;
@@ -52,6 +53,22 @@ sub _do_set {
   return $args->[1];
 }
 
+sub _do_extend {
+  my ($self, $args) = @_;
+
+  my %out = %{$self->[0]};
+  for my $arg (@$args) {
+    Scalar::Util::reftype($arg) eq "HASH"
+       or die "Argument to extend() isn't a hash\n";
+    Scalar::Util::blessed($args)
+       and die "Argument to extend() can't be blessed\n";
+
+    @out{keys %$arg} = values %$arg;
+  }
+
+  return \%out;
+}
+
 sub _do_is_list {
   return 0;
 }
@@ -166,6 +183,11 @@ Test if this object is a code object.  Always false for a hash.
 
 Always true for hashes.
 
+=item extend(hash1, ...)
+
+Return a new hash that is a shallow copy of the subject hash, with
+keys from the parameter hashes added or replacing existing keys.
+
 =back
 
 =head1 SEE ALSO

diff --git a/t/020-templater/040-original.t b/t/020-templater/040-original.t
index c1c620b38b70b1a64696d31fcc85894a9735852c..e1a73a80b2ffc6681266e395fdb727ba4fdb6dd2 100644 (file)
--- a/t/020-templater/040-original.t
+++ b/t/020-templater/040-original.t
@@ -1,7 +1,7 @@
 #!perl -w
 # Basic tests for Squirrel::Template
 use strict;
-use Test::More tests => 188;
+use Test::More tests => 189;
 use HTML::Entities;
 
 sub template_test($$$$;$$);
@@ -609,6 +609,7 @@ OUT
      # WrapHash
      [ '{ "foo": 1 }.is_list', 0 ],
      [ '{ "foo": 1 }.is_hash', 1 ],
+     [ '{ foo: 1, bar: 1 }.extend({ bar:2 })["bar"]', 2 ],
     );
   for my $test (@expr_tests) {
     my ($expr, $result) = @$test;