File Coverage

blib/lib/HTML/ElementGlob.pm

Criterion	Covered	Total	%
statement	9	76	11.8
branch	0	26	0.0
condition	0	3	0.0
subroutine	3	14	21.4
pod	0	9	0.0
total	12	128	9.3

package HTML::ElementGlob;

use strict;
use vars qw($VERSION $AUTOLOAD);

use HTML::ElementSuper;

$VERSION = '1.18';

####################################################
# glob_* methods do the HTML::Element type methods #
# on the glob structure itself, rather than muxing #
# the methods to its children. Most of these are   #
# taken care of in AUTOLOAD, but we override some. #
####################################################

sub glob_delete_content {
  # Do not propogate delete_content to children, as
  # this should be the job of the real parent.
  my $self = shift;
  @{$self->glob_content} = () unless $self->glob_is_empty;
  $self;
}

sub glob_delete {
  # Do not propogate delete to children, either.
  my $self = shift;
  $self->glob_delete_content;
  %{$self} = ();
}

sub context_is_glob {
  # The newer HTML::Element class invokes detach() quite a bit
  # during content operations -- *without* prepending glob_,
  # obviously.  We have to have some way of indicating to children
  # globs that they should NOT broadcast methods to children --
  # otherwise, all the regular elements in the child glob will get
  # detach() invoked as well. So...if a glob knows it is about to
  # perform an operation on another glob that should not be
  # broadcast -- set this flag, then unset it afterwards.
  my $self = shift;
  @_ ? $self->{_context_is_glob} = shift : $self->{_context_is_glob};
}

######################################################
# MUXed methods (pass invocation to children)        #
# Some methods do not really make sense in a globbed #
# context, so we try to 'do the right thing' here.   #
######################################################

# HTML::Element based methods
sub push_content    { shift->_content_manipulate('push_content', @_) }
sub unshift_content { shift->_content_manipulate('unshift_content', @_) }
sub splice_content  { shift->_content_manipulate('splice_content', @_) }
# replace_with_content does not apply, as elements are not passed
# in the argument list, they are summoned from each individual
# element's content.

# HTML::ElementSuper based methods
sub wrap_content    { shift->_content_manipulate('wrap_content', @_) }
sub replace_content { shift->_content_manipulate('replace_content', @_) }

sub _content_manipulate {
  # Generic method for cloning and broadcasting the
  # element trees provided to content methods
  my $self = shift;
  my $name = shift;
  my @children = $self->{_element}->content_list;
  # Find the first child that will have the method
  # invoked.
  my $first = undef;
  foreach (0 .. $#children) {
    if (ref $children[$_]) {
      $first = $_;
      last;
    }
  }
  return undef unless defined $first;
  # Deal with the tail elements first
  if ($first < $#children) {
    foreach ($first+1 .. $#children) {
      next unless ref $children[$_];
      $children[$_]->$name($self->{_element}->clone(@_));
    }
  }
  # First child can have the real copy
  $children[$first]->$name(@_);
}

# Constructor

sub new {
  my $that = shift;
  my $class = ref($that) || $that;
  my $self = {};
  bless $self,$class;
  $self->{_element}    = new HTML::ElementSuper @_;
  $self->{_babysitter} = new HTML::ElementSuper @_;
  $self;
}

sub AUTOLOAD {
  # Methods starting with glob deal with glob management,
  # otherwise they get passed blindly to all children unless
  # they have been overridden above.
  my $self = shift;
  my $name = $AUTOLOAD;
  $name =~ s/.*:://;
  return if $name =~ /^DESTROY/;

  # First, deal with glob_* induced methods
  if ($name =~ s/^glob_//) {
    # First, indicate to other globs that subsequent method
    # calls are glob_ induced.
    foreach (grep { ref $_ eq ref $self } @_) {
      $_->context_is_glob(1);
    }
    # Store the pedigree of all elements, including globs,
    # since no matter what a glob does it should not disturb
    # the original lineage of an element.  With the new
    # HTML::Element, detach() gets called which also
    # adjusts the content of the parent if available,
    # so we give them to the babysitter for now (there
    # is no publicly available method for just dropping
    # a parent, and I'm loathe to mess with internal state
    # variables and break containment on HTML::Element)
    my @result;
    my %parents;
    for (grep { ref $_->parent } grep { ref $_ } @_) {
      next if $parents{$_};
      $parents{$_} = $_->parent;
      $_->parent($self->{_babysitter});
    }
    # Invoke the method on our internal element
    @result = $self->{_element}->$name(@_);
    # Restore the lineages.

    for (grep { ref $_ } @_) {
      $_->parent(delete $parents{$_}) if $parents{$_};
    }
    # Cancel glob_ induced context.
    foreach (grep { ref $_ eq ref $self } @_) {
      $_->context_is_glob(0);
    }
    return wantarray ? @result : $result[$#result];
  }
  elsif ($self->context_is_glob) {
    # Here, we have intercepted a native method call that should
    # actually be executing in glob_ context -- so we do so in
    # order to ensure any overriden glob_* methods get properly
    # invoked.
    $name = "glob_$name";
    return $self->$name(@_);
  }

  # Otherwise broadcast to component elements.
  if (!$self->{_element}->is_empty) {
    my @results;
    foreach (grep { ref $_ } $self->{_element}->content_list) {
      push(@results, $_->$name(@_));
    }
    return @results;
  }
}

1;
__END__