implement defmap

diff --git a/lib/HTML/Element/Library.pm b/lib/HTML/Element/Library.pm
index 936840ba8a71ab11f4516cdcc1987f82ad96cd97..7573cbd26fda9a57265570e6c1a0ab503df7f06f 100644 (file)
--- a/lib/HTML/Element/Library.pm
+++ b/lib/HTML/Element/Library.pm
@@ -37,6 +37,19 @@ sub HTML::Element::siblings {
   $p->content_list;
 }
 
   $p->content_list;
 }
 

+sub HTML::Element::defmap {
+    my($tree,$attr,$hashref)=@_;
+
+    while (my ($k, $v) = (each %$hashref)) {
+       my $found = $tree->look_down($attr => $k);
+       if ($found) {
+           $found->replace_content( $v );
+       }
+    }
+
+}
+
+

 sub HTML::Element::hash_map {
     my $container = shift;
 
 sub HTML::Element::hash_map {
     my $container = shift;
 


@@ -49,7 +62,7 @@ sub HTML::Element::hash_map {
 
     warn 'The container tag is ', $container->tag if $p{debug} ;
     warn 'hash' . Dumper($p{hash}) if $p{debug} ;
 
     warn 'The container tag is ', $container->tag if $p{debug} ;
     warn 'hash' . Dumper($p{hash}) if $p{debug} ;

-    warn 'at_under' . Dumper(\@_);
+    warn 'at_under' . Dumper(\@_) if $p{debug} ;

 
     my @same_as = $container->look_down( $p{to_attr} => qr/.+/ ) ;
 
 
     my @same_as = $container->look_down( $p{to_attr} => qr/.+/ ) ;
 


@@ -68,6 +81,18 @@ sub HTML::Element::hash_map {
 
 }
 
 
 }
 

+sub HTML::Element::hashmap {
+    my ($container, $attr_name, $hashref, $excluding, $debug) = @_;
+
+    $excluding ||= [] ;
+
+    $container->hash_map(hash => $hashref, 
+                          to_attr => $attr_name,
+                          excluding => $excluding,
+                          debug => $debug);
+
+}
+

 
 sub HTML::Element::passover {
   my ($tree, $child_id) = @_;
 
 sub HTML::Element::passover {
   my ($tree, $child_id) = @_;


@@ -656,6 +681,8 @@ sub HTML::Element::unroll_select {
 
   my $select = {};
 
 
   my $select = {};
 

+  warn "Select Hash: " . Dumper(\%select) if $select{debug};
+

   my $select_node = $s->look_down(id => $select{select_label});
   warn "Select Node: " . $select_node if $select{debug};
 
   my $select_node = $s->look_down(id => $select{select_label});
   warn "Select Node: " . $select_node if $select{debug};
 


@@ -769,7 +796,7 @@ One of these days, I'll around to writing a nice C<EXPORT> section.
 
 =head2 Tree Rewriting Methods
 
 
 =head2 Tree Rewriting Methods
 

-=head3 $elem->hash_map(hash => \%h, to_attr => $attr, excluding => \@excluded)
+=head3 $elem->hashmap($attr_name, \%hashref, \@excluded, $debug)

 
 This method is designed to take a hashref and populate a series of elements. For example:
 
 
 This method is designed to take a hashref and populate a series of elements. For example:
 


@@ -788,11 +815,17 @@ In the table above, there are several attributes named C<< smap >>. If we have a
 
 Then a single API call allows us to populate the HTML while excluding those ones we dont:
 
 
 Then a single API call allows us to populate the HTML while excluding those ones we dont:
 

-  $tree->hash_map(hash => \%data, to_attr => 'sid', excluding => ['password']);
+  $tree->hashmap('sid' => \%data, ['password']);
+

 
 

-Of course, the other way to prevent rendering some of the hash mapping is to not give that element the attr
+Note: the other way to prevent rendering some of the hash mapping is to not give that element the attr

 you plan to use for hash mapping.
 
 you plan to use for hash mapping.
 

+Also note: the function C<< hashmap >> has a simple easy-to-type API. Interally, it calls C<< hash_map >>
+(which has a more verbose keyword calling API). Thus, the above call to C<hashmap()> results in this call:
+
+  $tree->hash_map(hash => \%data, to_attr => 'sid', excluding => ['password']);
+

 
 =head3 $elem->replace_content(@new_elem)
 
 
 =head3 $elem->replace_content(@new_elem)
 


@@ -1725,12 +1758,14 @@ down instead:
 
 L<HTML::Seamstress>
 
 
 L<HTML::Seamstress>
 

-=head1 AUTHOR
+=head1 AUTHOR / SOURCE

 
 Terrence Brannon, E<lt>tbone@cpan.orgE<gt>
 
 Many thanks to BARBIE for his RT bug report.
 
 
 Terrence Brannon, E<lt>tbone@cpan.orgE<gt>
 
 Many thanks to BARBIE for his RT bug report.
 

+The source is at L<http://github.com/metaperl/html-element-library/tree/master>
+

 =head1 COPYRIGHT AND LICENSE
 
 Copyright (C) 2004 by Terrence Brannon
 =head1 COPYRIGHT AND LICENSE
 
 Copyright (C) 2004 by Terrence Brannon

diff --git a/t/defmap.t b/t/defmap.t
new file mode 100644 (file)
index 0000000..9f61672
--- /dev/null
+++ b/t/defmap.t
@@ -0,0 +1,31 @@
+# This might look like shell script, but it's actually -*- perl -*-
+use strict;use warnings;
+use lib qw(t/ t/m/);
+
+use File::Slurp;
+use Test::More qw(no_plan);
+
+use TestUtils;
+use HTML::TreeBuilder;
+use HTML::Element::Library;
+
+sub tage {
+
+  my $root = "t/html/defmap/defmap";
+
+  my $tree = HTML::TreeBuilder->new_from_file("$root.initial")->guts;
+
+  #warn "TREE: $tree" . $tree->as_HTML;
+
+  my %data = (pause => 'arsenal rules');
+
+  $tree->defmap(smap => \%data);
+
+  my $generated_html = ptree($tree, "$root.gen");
+
+  is ($generated_html, File::Slurp::read_file("$root.exp"), "HTML for same_as");
+}
+
+
+tage();
+

diff --git a/t/hashmap.t b/t/hashmap.t
new file mode 100644 (file)
index 0000000..285f64c
--- /dev/null
+++ b/t/hashmap.t
@@ -0,0 +1,43 @@
+# This might look like shell script, but it's actually -*- perl -*-
+use strict;
+use lib qw(t/ t/m/);
+
+use File::Slurp;
+use Test::More qw(no_plan);
+
+use TestUtils;
+use HTML::TreeBuilder;
+use HTML::Element::Library;
+
+sub replace_age { 
+  my $branch = shift;
+  my $age = shift;
+  $branch->look_down(id => 'age')->replace_content($age);
+}
+
+
+sub tage {
+
+  my $root = "t/html/same_as/same_as";
+
+  my $tree = HTML::TreeBuilder->new_from_file("$root.initial");
+
+  #warn "TREE: $tree" . $tree->as_HTML;
+
+  my %data = (people_id => 888, phone => '444-4444', email => 'm@xml.com');
+
+  $tree->hash_map
+    (hash    => \%data, 
+     to_attr => 'sid', 
+     excluding => [ 'email' ],
+     debug   => 1
+    );
+
+  my $generated_html = ptree($tree, "$root.gen");
+
+  is ($generated_html, File::Slurp::read_file("$root.exp"), "HTML for same_as");
+}
+
+
+tage();
+

diff --git a/t/html/defmap/defmap.exp b/t/html/defmap/defmap.exp
new file mode 100644 (file)
index 0000000..f5aabd8
--- /dev/null
+++ b/t/html/defmap/defmap.exp
@@ -0,0 +1,5 @@
+<tr>
+  <td smap="active">Yes</td>
+  <td smap="pause">arsenal rules</td>
+  <td smap="hold">No</td>
+</tr>

diff --git a/t/html/defmap/defmap.gen b/t/html/defmap/defmap.gen
new file mode 100644 (file)
index 0000000..f5aabd8
--- /dev/null
+++ b/t/html/defmap/defmap.gen
@@ -0,0 +1,5 @@
+<tr>
+  <td smap="active">Yes</td>
+  <td smap="pause">arsenal rules</td>
+  <td smap="hold">No</td>
+</tr>

diff --git a/t/html/defmap/defmap.initial b/t/html/defmap/defmap.initial
new file mode 100644 (file)
index 0000000..7e24e57
--- /dev/null
+++ b/t/html/defmap/defmap.initial
@@ -0,0 +1,7 @@
+<tr>
+        <td smap="active" >Yes</td>
+
+        <td smap="pause">No</td>
+
+        <td smap="hold">No</td>
+</tr>

diff --git a/t/html/unroll_select.exp b/t/html/unroll_select.exp
index f44f26a7696bce75ff341b4b567ddcc83e970252..f6a977ead9129a0b46c274ec534ab2492d8adeca 100644 (file)
--- a/t/html/unroll_select.exp
+++ b/t/html/unroll_select.exp
@@ -23,9 +23,9 @@
           <td>Clan Name</td>
           <td>
             <select name="name" id="clan_list">
           <td>Clan Name</td>
           <td>
             <select name="name" id="clan_list">

-              <option value="12" id="clan_name" selected="1">janglers</option>
-              <option value="14" id="clan_name">thugknights</option>
-              <option value="13" id="clan_name">cavaliers</option>
+              <option value="12" selected="1">janglers</option>
+              <option value="14">thugknights</option>
+              <option value="13">cavaliers</option>

             </select>
           </td>
         </tr>
             </select>
           </td>
         </tr>

diff --git a/t/html/unroll_select.gen b/t/html/unroll_select.gen
index f44f26a7696bce75ff341b4b567ddcc83e970252..f6a977ead9129a0b46c274ec534ab2492d8adeca 100644 (file)
--- a/t/html/unroll_select.gen
+++ b/t/html/unroll_select.gen
@@ -23,9 +23,9 @@
           <td>Clan Name</td>
           <td>
             <select name="name" id="clan_list">
           <td>Clan Name</td>
           <td>
             <select name="name" id="clan_list">

-              <option value="12" id="clan_name" selected="1">janglers</option>
-              <option value="14" id="clan_name">thugknights</option>
-              <option value="13" id="clan_name">cavaliers</option>
+              <option value="12" selected="1">janglers</option>
+              <option value="14">thugknights</option>
+              <option value="13">cavaliers</option>

             </select>
           </td>
         </tr>
             </select>
           </td>
         </tr>

diff --git a/t/same_as.t b/t/same_as.t
deleted file mode 100644 (file)
index 285f64c..0000000
--- a/t/same_as.t
+++ /dev/null
@@ -1,43 +0,0 @@
-# This might look like shell script, but it's actually -*- perl -*-
-use strict;
-use lib qw(t/ t/m/);
-
-use File::Slurp;
-use Test::More qw(no_plan);
-
-use TestUtils;
-use HTML::TreeBuilder;
-use HTML::Element::Library;
-
-sub replace_age { 
-  my $branch = shift;
-  my $age = shift;
-  $branch->look_down(id => 'age')->replace_content($age);
-}
-
-
-sub tage {
-
-  my $root = "t/html/same_as/same_as";
-
-  my $tree = HTML::TreeBuilder->new_from_file("$root.initial");
-
-  #warn "TREE: $tree" . $tree->as_HTML;
-
-  my %data = (people_id => 888, phone => '444-4444', email => 'm@xml.com');
-
-  $tree->hash_map
-    (hash    => \%data, 
-     to_attr => 'sid', 
-     excluding => [ 'email' ],
-     debug   => 1
-    );
-
-  my $generated_html = ptree($tree, "$root.gen");
-
-  is ($generated_html, File::Slurp::read_file("$root.exp"), "HTML for same_as");
-}
-
-
-tage();
-