X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=lib%2FHTML%2FElement%2FLibrary.pm;h=cb9cec3e5d423454e19e29c82f24e38ef3bbe48e;hb=271d5078dc10f92db0d9927bd84065a0b9a38397;hp=fa037657ea21e95eda9f5800418f99e31d306215;hpb=237e950667eebb2a48da037136a4a73044e6ada8;p=html-element-library.git

diff --git a/lib/HTML/Element/Library.pm b/lib/HTML/Element/Library.pm
index fa03765..cb9cec3 100644
--- a/lib/HTML/Element/Library.pm
+++ b/lib/HTML/Element/Library.pm
@@ -1,5 +1,5 @@
 package HTML::Element::Library;
-
+# ABSTRACT: Convenience methods for HTML::TreeBuilder and HTML::Element
 
 use strict;
 use warnings;
@@ -25,7 +25,7 @@ our @EXPORT      = qw();
 
 
 
-our $VERSION = '4.2.b';
+our $VERSION = '4.3';
 
 
 
@@ -72,6 +72,71 @@ sub HTML::Element::defmap {
 
 }
 
+sub HTML::Element::_only_empty_content {
+  my ($self)=@_;
+  my @c = $self->content_list;
+  my $length  = scalar @c;
+
+  #use Data::Dumper;
+  #warn sprintf 'Testing %s (%s)' , $self->starttag, Dumper(\@c);
+  #warn sprintf "\t\tlength of content: %d ", $length;
+
+  scalar @c == 1 and not length($c[0]);
+}
+
+sub HTML::Element::prune {
+  my ($self)=@_;
+
+  for my $c ($self->content_list) {
+    next unless ref $c;
+    #warn "C: " . Dumper($c);
+    $c->prune;
+  }
+
+  # post-order:
+  $self->delete if ($self->is_empty or $self->_only_empty_content);
+  $self;
+}
+
+sub HTML::Element::newnode {
+  my ($lol, $node_label, $new_node)=@_;
+
+  use Data::Rmap qw(rmap_array);
+
+  my ($mapresult) = rmap_array {
+ 
+
+  if ($_->[0] eq $node_label) {
+    $_ = $new_node;
+    Data::Rmap::cut($_);
+  } else {
+    $_;
+  }
+
+  } $lol;
+
+  $mapresult;
+
+}
+
+sub HTML::Element::crunch {
+    my $container = shift;
+
+    my %p = validate(@_, {
+			  look_down => { type => ARRAYREF },
+			  leave => { default => 1 },
+			 });
+
+    my @look_down = @{$p{look_down}} ;
+    my @elem = $container->look_down( @look_down ) ;
+    
+    my $left;
+    
+    for my $elem (@elem) {
+	$elem->detach if $left++ >= $p{leave} ;
+    }
+
+}
 
 sub HTML::Element::hash_map {
     my $container = shift;