HTML-Element-Extended-1.18/0000755000175000017500000000000011404212325014032 5ustar sisksiskHTML-Element-Extended-1.18/test.pl0000644000175000017500000000156710207754442015372 0ustar sisksisk# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..4\n"; } END {print "not ok 1\n" unless $loaded;} use HTML::ElementSuper; $loaded = 1; print "HTML::ElementSuper ok\n"; use HTML::ElementGlob; $loaded = 1; print "HTML::ElementGlob ok\n"; use HTML::ElementRaw; $loaded = 1; print "HTML::ElementRaw ok\n"; use HTML::ElementTable; $loaded = 1; print "HTML::ElementTable ok\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): HTML-Element-Extended-1.18/MANIFEST0000644000175000017500000000033410426216115015167 0ustar sisksiskREADME Makefile.PL test.pl Changes MANIFEST lib/HTML/ElementSuper.pm lib/HTML/ElementGlob.pm lib/HTML/ElementTable.pm lib/HTML/ElementRaw.pm META.yml Module meta-data (added by MakeMaker) HTML-Element-Extended-1.18/Makefile.PL0000644000175000017500000000055011404212311015777 0ustar sisksisk# HTML-Element-Extended $NAME = 'HTML-Element-Extended'; use ExtUtils::MakeMaker; WriteMakefile( NAME => $NAME, VERSION_FROM => 'lib/HTML/ElementTable.pm', dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, PREREQ_PM => { # Avoid older HTML::Element w/o new methods HTML::Element => 3.01, Data::Dumper => 0, } ); HTML-Element-Extended-1.18/lib/0000755000175000017500000000000011404212325014600 5ustar sisksiskHTML-Element-Extended-1.18/lib/HTML/0000755000175000017500000000000011404212325015344 5ustar sisksiskHTML-Element-Extended-1.18/lib/HTML/ElementSuper.pm0000644000175000017500000004325411404000032020310 0ustar sisksiskpackage HTML::ElementSuper; # Extend the HTML::Element class to allow the following: # positional reporting # content replacement # masking (i.e., in the structure but invisible to traverse) # content wrapping # cloning of self and arbitrary elements use strict; use vars qw($VERSION @ISA $AUTOLOAD); use Carp; use Data::Dumper; # Make sure we have access to the new methods. These were added sometime # in early 2000 but we'll just anchor off of the new numbering system. use HTML::Element 3.01; @ISA = qw(HTML::Element); $VERSION = '1.18'; ### attr extension ### sub push_attr { my $self = shift; my($attr, @new) = @_; my(%seen, @vals); if (defined(my $spec = $self->attr($attr))) { for my $v (split(/\s+/, $spec)) { next if $seen{$v}; push(@vals, $seen{$v} = $v); } } for my $v (grep { defined $_ } @new) { next if $seen{$v}; push(@vals, $seen{$v} = $v); } $self->SUPER::attr($attr, join(' ', @vals)); } ### positional extension ### sub addr { my $self = shift; my $p = $self->parent; return undef unless $p; my @sibs = $p->content_list; foreach my $i (0..$#sibs) { return $i if defined $sibs[$i] && $sibs[$i] eq $self; } Carp::confess "major oops, no addr found for $self\n"; } sub position { # Report coordinates by chasing addr's up the HTML::ElementSuper tree. # We know we've reached the top when a) there is no parent, or b) the # parent is some HTML::Element unable to report it's position. my $p = shift; my @pos; while ($p) { my $pp = $p->parent; last unless ref $pp && $pp->isa(__PACKAGE__); my $a = $p->addr; unshift(@pos, $a) if defined $a; $p = $pp; } @pos; } sub depth { my $self = shift; my $depth = 0; my $p = $self; while ($p = $p->parent) { ++$depth; } $depth; } # Handy debugging tools sub push_position { # Push positional coordinates into own content my $self = shift; $self->push_content(' (' . join(',', $self->position) . ')'); } sub push_depth { # Push HTML tree depth into own content my $self = shift; $self->push_content('(' . $self->depth . ')'); } ### cloner extension ### sub clone { # Clone HTML::Element style trees. # Clone self unless told otherwise. # Cloning comes in handy when distributing methods such as # push_content - you don't want the same HTML::Element tree across # multiple nodes, just a copy of it - since HTML::Element nodes only # recognize one parent. # # Note: The new cloning functionality of HTML::Element is insufficent # for our purposes. Syntax aside, the native clone() does not # clone the element globs associated with a table...the globs # continue to affect the original element structure. my $self = shift; my @args = @_; @args || push(@args, $self); my($clone, $node, @clones); my($VAR1, $VAR2, $VAR3); $Data::Dumper::Purity = 1; foreach $node (@args) { _cloning($node, 1); eval(Dumper($node)); carp("$@ $node") if $@; _cloning($node, 0); _cloning($VAR1, 0); # Retie the watchdogs $VAR1->traverse(sub { my($node, $startflag) = @_; return unless $startflag; if ($node->can('watchdog')) { $node->watchdog(1); $node->watchdog->mask(1) if $node->mask; } 1; }, 'ignore_text') if ref $VAR1; push(@clones, $VAR1); } $#clones ? @clones : $clones[0]; } sub _cloning { # Ugh. We need to do this when we clone and happen to be masked, # otherwise masked content will not make it into the clone. my $node = shift; return unless ref $node; if (@_) { if ($_[0]) { $node->traverse(sub { my($node, $startflag) = @_; return unless $startflag; $node->_clone_state(1) if $node->can('_clone_state'); 1; }, 'ignore_text'); } else { $node->traverse(sub { my($node, $startflag) = @_; return unless $startflag; $node->_clone_state(0) if $node->can('_clone_state'); 1; }, 'ignore_text'); } } $node->can('watchdog') && $node->watchdog ? $node->watchdog->cloning : 0; } sub _clone_state { my($self, $state) = @_; return 0 unless $self->watchdog; if (defined $state) { if ($state) { $self->watchdog->cloning(1); } else { $self->watchdog->cloning(0); } } $self->watchdog->cloning; } ### maskable extension ### sub mask { my($self, $mode) = @_; if (defined $mode) { # We count modes since masking can come from overlapping influences, # theoretically. if ($mode) { if (! $self->{_mask}) { # deactivate (mask) content $self->watchdog(1) unless $self->watchdog; $self->watchdog->mask(1); } ++$self->{_mask}; } else { --$self->{_mask} unless $self->{_mask} <= 0; if (! $self->{_mask}) { # activate (unmask) content if ($self->watchdog_listref) { $self->watchdog->mask(0); } else { $self->watchdog(0); } } } } $self->{_mask}; } sub starttag { my $self = shift; return '' if $self->mask; $self->SUPER::starttag(@_); } sub endtag { my $self = shift; return '' if $self->mask; $self->SUPER::endtag(@_); } sub starttag_XML { my $self = shift; return '' if $self->mask; $self->SUPER::starttag_XML(@_); } sub endtag_XML { my $self = shift; return '' if $self->mask; $self->SUPER::endtag_XML(@_); } # Oh, the horror! This used to be all that was necessary to implement # masking -- overriding traverse. But the new HTML::Element does NOT # call traverse on a per-element basis, so now when we're masked we have # to play dead -- no tags, no content. To make matters worse, we can't # just override the content method because the new traverse() # implentation is playing directly wiht the data structures rather than # calling content(). # # See below for the current solution: HTML::ElementSuper::TiedContent # # For the time being, I've kept the old code and commentary here: # ## Routines that use traverse, such as as_HTML, are not called ## on a per-element basis. as_HTML always belongs to the top level ## element that initiated the call. A maskable element should not ## be seen, though. Overriding as_HTML will not do the trick since ## we cannot guarantee that the top level element is a maskable-aware ## element with the overridden method. Therefore, for maskable ## elements, we override traverse itself, which does get called on a ## per-element basis. If this element is masked, simply return from ## traverse, making this element truly invisible to parents. This ## means that traverse is no longer guranteed to actually visit all ## elements in the tree. For that, you must rely on the actual ## contents of each element. #sub traverse { # my $self = shift; # return if $self->mask; # $self->SUPER::traverse(@_); #} # #sub super_traverse { # # Saftey net for catching wayward masked elements. # my $self = shift; # $self->SUPER::traverse(@_); #} ### replacer extension ### sub replace_content { my $self = shift; $self->delete_content; $self->push_content(@_); } ### wrapper extension ### sub wrap_content { my($self, $wrap) = @_; my $content = $self->content; if (ref $content) { $wrap->push_content(@$content); @$content = ($wrap); } else { $self->push_content($wrap); } $wrap; } ### watchdog extension ### sub watchdog_listref { my $self = shift; @_ ? $self->{_wa} = shift : $self->{_wa}; } sub watchdog { my $self = shift; if (@_) { if ($_[0]) { # Install the watchdog hash my $wa = shift; if (ref $wa eq 'ARRAY') { $self->watchdog_listref($wa); } else { $wa = $self->watchdog_listref; } my $cr = $self->content; my @content = @$cr; @$cr = (); $self->{_wd} = tie @$cr, 'HTML::ElementSuper::ContentWatchdog'; @$cr = @content; $self->{_wd}->watchdog($wa) if ref $wa eq 'ARRAY'; } else { # Release the watchdog my @content = $self->{_wd}->fetchall; # in case it's masked my $cr = $self->content; # Delete obj ref before untie in order to hush -w delete $self->{_wd}; untie @$cr; @$cr = @content; } } $self->{_wd}; } ### sub new { my $that = shift; my $class = ref($that) || $that; my $self = $class->SUPER::new(@_); # force init of content with array ref $self->content_array_ref; bless $self,$class; $self; } ### deprecated ### sub delete_attr { # Deprecated by new HTML::Element functionality. Should now use # attr($attr, undef) for attribute deletions. Still returning the old # value here for backwards compatability. my($self, $attr) = @_; $attr = lc $attr; my $old = $self->attr($attr); $self->attr($attr, undef); $old; } ### temporary Overrides (until bugs fixed in HTML::Element) ### sub replace_with { my $self = shift; my $p = $self->parent; $self->SUPER::replace_with(@_); grep { $_->parent($p) } @_; $self; } ### bag o kludgy tricks ### { package HTML::ElementSuper::ContentWatchdog; use strict; use Carp; use vars qw( @ISA ); use Tie::Array; @ISA = qw( Tie::Array ); # I got tired of jumping through hoops dealing with the new # HTML::Element semantics. Since I could no longer override traverse() # I was having to go through all sorts of contortions to "hide" # elements in the tree when masked. In a cohesive tree like # HTML::ElementTable, this was still insufficient because globbed # access to the masked elements still needed to be retained. # # The hoops in question involved either a) breaking containment all # over the place, or b) overriding *all* content methods, or c) # swapping in a doppleganger element for the masked element, which # then involved overriding just about everything since the positional # methods needed to look at the doppleganger, but everything else # needed to look at the original. # # So here I provide a class for tying the content array and doing the # right thing when masked. Note that starttag() and endtag() still # need to be overridden, but this tied class should take care of # traverse rifling through masked content. # # Note that all content manipulation works as expected, except for # FETCH. This is intentional. # # Technically, this is not breaking containment since the content() # method returns the content array reference. Even though this is a # read-only method, we can still tie() over the array pointed to by # the reference! # # See mask() for implementation. # # I'll probably go to programmer hell for this, but what the hey. # # UPDATE: Since I was already doing this for masking, I decided to to # general content policing with the same mechanism, but only when # requested via the watchdog parameter, passed as a code reference. # Alas, this meant a full implmentation rather than just subclassing # Tie::StdArray and overriding FETCH(). # Object methods sub fetchall { @{shift->{_array}} } sub watchdog { my($self, $classes_ref) = @_; if ($classes_ref) { $self->{watchdog} = {}; foreach (@$classes_ref) { ++$self->{watchdog}{$_}; } } $self->{watchdog}; } sub permit { my($self, @objects) = @_; return 1 unless $self->{watchdog}; foreach (@objects) { my $type = ref($_) || $_; croak "Adoption of type $type, which is not of type " . join(', ', sort keys %{$self->{watchdog}}) . "\n" unless $self->{watchdog}{$type}; } 1; } sub mask { my $self = shift; @_ ? $self->{mask} = shift : $self->{mask}; } sub cloning { my $self = shift; @_ ? $self->{cloning} = shift : $self->{cloning}; } # Tied array methods sub TIEARRAY { my $that = shift; my $class = (ref $that) || $that; my $self = {}; bless $self, $class; %$self = @_; $self->{_array} = []; $self; } sub FETCH { my($self, $k) = @_; return if $self->{mask} && !$self->{cloning}; $self->{_array}[$k]; } sub STORE { my($self, $k, $v) = @_; my $vc = ref $v; $self->permit($v) if $self->{watchdog}; $self->{_array}[$k] = $v; } sub PUSH { my $self = shift; $self->permit(@_) if $self->{watchdog}; push(@{$self->{_array}}, @_); } sub UNSHIFT { my $self = shift; $self->permit(@_) if $self->{watchdog}; unshift(@{$self->{_array}}, @_); } sub SPLICE { my($self, $offset, $length, @list) = @_; if (@list && $self->{watchdog}) { $self->permit(@list); } splice(@{$self->{_array}}, @_); } #### The rest of these are just native ops on the inner array. sub FETCHSIZE { scalar @{shift->{_array}} } sub STORESIZE { my($self, $size) = @_; $#{$self->{_array}} = $size - 1; } sub CLEAR { @{shift->{_array}} = () } sub POP { pop(@{shift->{_array}}) } sub SHIFT { shift(@{shift->{_array}}) } } ### End HTML::ElementSuper::ContentWatchdog 1; __END__ =head1 NAME HTML::ElementSuper - Perl extension for HTML::Element(3) =head1 SYNOPSIS use HTML::ElementSuper; ### Positional extension $e = new HTML::ElementSuper 'font'; $sibling_number = $e->addr(); $e2 = new HTML::ElementSuper 'p'; $e2->push_content($e); # @coords = $e->position(); $depth_in_pos_tree = $e->depth(); ### Replacer extension $er = new HTML::ElementSuper 'font'; # Tree beneath $er, if present, is dropped. $er->replace_content(new HTML::Element 'p'); ### Wrapper extension $ew = new HTML::ElementSuper; $ew->push_content("Tickle me, baby"); $ew->wrap_content(new HTML::Element 'font', color => 'pink'); print $ew->as_HTML(); ### Maskable extension $em = new HTML::ElementSuper 'td'; $em->mask(1); print $em->as_HTML; # nada $em->mask(0); print $em->as_HTML; # $e and its children are visible ### Cloning of own tree or another element's tree ### (is this the correct clomenature? :-) $a = new HTML::ElementSuper 'font', size => 2; $b = new HTML::ElementSuper 'font', color => 'red'; $a_clone = $a->clone; $b_clone = $a->clone($b); # Multiple elements can be cloned @clone_clones = $a_clone->clone($a_clone, $b_clone); =head1 DESCRIPTION HTML::ElementSuper is an extension for HTML::Element(3) that provides several new methods to assist in element manipulation. An HTML::ElementSuper has the following additional properties: * report is coordinate position in a tree of its peers * replace its contents * wrap its contents in a new element * mask itself so that it and its descendants are invisible to traverse() * clone itself and other HTML::Element based object trees * handle multiple values for attributes Note that these extensions were originally developed to assist in implementing the HTML::ElementTable(3) class, but were thought to be of general enough utility to warrant their own package. =head1 METHODS =over =item new('tag', attr => 'value', ...) Return a new HTML::ElementSuper object. Exactly like the constructor for HTML::Element(3), takes a tag type and optional attributes. =item push_attr(attr => @values) Extend the value string for a particular attribute. An example of this might be when you'd like to assign multiple CSS classes to a single element. The attribute value is extended using white space as a separator. =item addr() Returns the position of this element in relation to its siblings based on the content of the parent, starting with 0. Returns undef if this element has no parent. In other words, this returns the index of this element in the content array of the parent. =item position() Returns the coordinates of this element in the tree it inhabits. This is accomplished by succesively calling addr() on ancestor elements until either a) an element that does not support these methods is found, or b) there are no more parents. The resulting list is the n-dimensional coordinates of the element in the tree. =item replace_content(@new_content) Simple shortcut method that deletes the current contents of the element before adding the new. =item wrap_content($wrapper_element) Wraps the existing content in the provided element. If the provided element happens to be a non-element, a push_content is performed instead. =item mask =item mask(mode) Toggles whether or not this element is visible to parental methods that visit the element tree using traverse(), such as as_HTML(). Valid arguments for mask() are 0 and 1. Returns the current setting without an argument. This might seem like a strange method to have, but it helps in managing dynamic tree structures. For example, in HTML::ElementTable(3), when you expand a table cell you simply mask what it covers rather than destroy it. Shrinking the table cell reveals that content to as_HTML() once again. =item clone =item clone(@elements) Returns a clone of elements and all of their descendants. Without arguments, the element clones itself, otherwise it clones the elements provided as arguments. Any element can be cloned as long as it is HTML::Element(3) based. This method is very handy for duplicating tree structures since an HTML::Element cannot have more than one parent at any given time...hence "tree". =back =head1 REQUIRES HTML::Element(3), Data::Dumper(3) =head1 AUTHOR Matthew P. Sisk, EFE =head1 COPYRIGHT Copyright (c) 1998-2010 Matthew P. Sisk. All rights reserved. All wrongs revenged. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO HTML::Element(3), HTML::ElementGlob(3), HTML::ElementRaw(3), HTML::ElementTable(3), perl(1). HTML-Element-Extended-1.18/lib/HTML/ElementGlob.pm0000644000175000017500000001763511403735127020124 0ustar sisksiskpackage 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__ =head1 NAME HTML::ElementGlob - Perl extension for managing HTML::Element based objects as a single object. =head1 SYNOPSIS use HTML::ElementGlob; $element_a = new HTML::Element 'font', color => 'red'; $element_b = new HTML::Element 'font', color => 'blue'; $element_a->push_content('red'); $element_b->push_content('blue'); $p = new HTML::Element 'p'; $p->push_content($element_a, ' and ', $element_b, ' boo hoo hoo'); # Tag type of the glob is not really relevant unless # you plan on seeing the glob as_HTML() $eglob = new HTML::ElementGlob 'p'; $eglob->glob_push_content($element_a, $element_b); # Alter both elements at once $eglob->attr(size => 5); # They still belong to their original parent print $p->as_HTML; =head1 DESCRIPTION HTML::ElementGlob is a managing object for multiple HTML::Element(3) style elements. The children of the glob element retain their original parental elements and have no knowledge of the glob that manipulates them. All methods that do not start with 'glob_' will be passed, sequentially, to all elements contained within the glob element. Methods starting with 'glob_' will operate on the glob itself, rather than being passed to its foster children. For example, $eglob->attr(size => 3) will invoke attr(size => 3) on all children contained by $eglob. $eglob->glob_attr(size => 3), on the other hand, will set the attr attribute on the glob itself. The tag type passed to HTML::Element::Glob is largely irrrelevant as far as how methods are passed to children. However, if you choose to invoke $eglob->as_HTML(), you might want to pick a tag that would sensibly contain the globbed children for debugging or display purposes. The 'glob_*' methods that operate on the glob itself are limited to those available in an HTML::Element(3). All other methods get passed blindly to the globbed children, which can be enhanced elements with arbitrary methods, such as HTML::ElementSuper(3). Element globs can contain other element globs. In such cases, the plain methods will cascade down to the leaf children. 'glob_*' methods, of course, will not be propogated to children globs. You will have to rely on glob_content() to access those glob children and access their 'glob_*' methods directly. =head1 REQUIRES HTML::ElementSuper(3) =head1 AUTHOR Matthew P. Sisk, EFE =head1 COPYRIGHT Copyright (c) 1998-2010 Matthew P. Sisk. All rights reserved. All wrongs revenged. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO HTML::Element(3), HTML::ElementSuper, HTML::ElementRaw, HTML::Element::Table(3), perl(1). =cut HTML-Element-Extended-1.18/lib/HTML/ElementTable.pm0000644000175000017500000006226111404020413020245 0ustar sisksiskpackage HTML::ElementTable; use strict; use vars qw($VERSION @ISA $AUTOLOAD); use Carp; use HTML::ElementGlob; @ISA = qw(HTML::ElementTable::Element); $VERSION = '1.18'; my $DEBUG = 0; # Enforced adoption policy such that positional coords are untainted. my @Valid_Children = qw( HTML::ElementTable::RowElement ); ################## # Native Methods # ################## sub extent { my $self = shift; @_ || return ($self->maxrow,$self->maxcol); my($maxrow, $maxcol) = @_; defined $maxrow && defined $maxcol or croak "Max row and col dimensions required"; # Hit rows $self->_adjust_content($self, $maxrow, $self->maxrow) if $maxrow != $self->maxrow; # Hit columns my @rows = (); foreach ($self->content_list) { push(@rows, $_) if ref && $_->tag eq 'tr'; } if ($maxcol != $self->maxcol) { grep { $self->_adjust_content($_, $maxcol, $self->maxcol) } @rows; } # New data cells caused by new rows will be automatically taken care # of within _adjust_content # Re-glob $self->refresh; } sub refresh { my $self = shift; my($row,$col,$p_row,$p_col); # Reconstruct globs. There are two main globs - the row and column # collections - plus the globs representing each row and each column # of cells. # Clear old row and column globs grep { $_->glob_delete_content } @{$self->_rows->glob_content} unless $self->_rows->glob_is_empty; grep { $_->glob_delete_content } @{$self->_cols->glob_content} unless $self->_cols->glob_is_empty; $self->_rows->glob_delete_content; $self->_cols->glob_delete_content; my $colcnt; my $maxcol = -1; foreach $row ($self->content_list) { # New glob for each row, added to rows glob next unless ref $row; $p_row = $self->_rowglob; $p_row->alias($row); $self->_rows->glob_push_content($p_row); $colcnt = 0; foreach $col ($row->is_empty ? () : @{$row->content}) { # Add each cell to the individual row glob next unless ref $col; $p_row->glob_push_content($col); if ($colcnt > $maxcol) { # If a new column, make column glob $p_col = $self->_colglob; $self->_cols->glob_push_content($p_col); ++$maxcol; } else { # Otherwise use the existing column glob $p_col = $self->_cols->glob_content->[$colcnt]; } # Add the cell to the column glob $p_col->glob_push_content($col); ++$colcnt; } } $self; } sub _adjust_content { my $self = shift; my($e,$limit,$old) = @_; ref $e or croak "Element required"; defined $limit or croak "Index limit required"; if (!defined $old) { grep { ++$old } @{$e->content}; } if ($limit < $old) { # We are trimming my($i, $c, $found); $i = $c = -1; # We mess with $i like this to avoid having non data elements throw # off our grid count foreach (@{$e->content}) { ++$c; next unless ref; ++$i; if ($i == $limit) { $found = $c; next; } $_->delete if $found; } @{$e->content} = @{$e->content}[0..$found]; } elsif ($limit > $old) { # We are growing my($tag,$d,$r); foreach ($old+1..$limit) { if ($e->tag eq 'table') { $r = HTML::ElementTable::RowElement->new(); if ($self->maxcol != -1) { # Brand new colums...use -1 as old to get 0 $self->_adjust_content($r,$self->maxcol,-1); } $e->push_content($r); } else { $d = HTML::ElementTable::DataElement->new(); $d->blank_fill($self->blank_fill); $e->push_content($d); } } } $e; } sub maxrow { my($self, $maxrow) = @_; $self->extent($maxrow,$self->maxcol) if defined $maxrow; $self->_rows->glob_is_empty ? -1 : $#{$self->_rows->glob_content}; } sub maxcol { my($self, $maxcol) = @_; $self->extent($self->maxrow, $maxcol) if defined $maxcol; $self->_cols->glob_is_empty ? -1 : $#{$self->_cols->glob_content}; } # Index and glob hooks sub cell { my $self = shift; my @elements; while (@_) { my($r, $c) = splice(@_, 0, 2); defined $r && defined $c || croak "Missing coordinate"; my $row = $self->row($r); croak "Row $r is empty" if $row->glob_is_empty; if ($#{$row->glob_content} < $c || $c < 0) { croak "Cell ($r,$c) is out of range"; } push(@elements, $row->glob_content->[$c]); } return undef unless @elements; @elements > 1 ? $self->_cellglob(@elements) : $elements[0]; } sub row { my $self = shift; @_ || croak "Index required"; my @out = grep { $_ > $self->maxrow } @_; croak "Rows(@out) out of range" if @out; @_ > 1 ? $self->_rowglob(@{$self->_rows->glob_content}[@_]) : $self->_rows->glob_content->[$_[0]]; } sub col { my $self = shift; @_ || croak "Index required"; my @out = grep { $_ > $self->maxcol } @_; if (@out) { croak "Columns(" . join(',', @out) . ") out of range"; } @_ > 1 ? $self->_colglob(@{$self->_cols->glob_content}[@_]) : $self->_cols->glob_content->[$_[0]]; } sub box { my $self = shift; my($r1,$c1,$r2,$c2) = @_; defined $r1 && defined $c1 && defined $r2 && defined $c2 || croak "Two coordinate pairs required"; # Normalize for ascending counts ($r1, $r2) = ($r2, $r1) if $r2 < $r1; ($c1, $c2) = ($c2, $c1) if $c2 < $c1; # Optimize on rows if we can if ($c1 == 0 && $c2 == $self->maxcol) { return $self->row($r1 .. $r2); } # Otherwise glob the box my(@coords,$r,$c); foreach $r ($r1 .. $r2) { foreach $c ($c1 .. $c2) { push(@coords,$r,$c); } } $self->cell(@coords); } sub table { my $self = shift; # Both _rows and _cols are effectively globs of the whole table. We # return row here so that valid TR attrs can be captured. $self->_rows; } sub mask_mode { # Should span antics of children push/pull or mask/reveal siblings? my($self,$mode) = @_; $self->{_maskmode} = $mode if defined $mode; $self->{_maskmode}; } # Main glob hooks sub _rows { my $self = shift; return $self->{_rows}; } sub _cols { my $self = shift; return $self->{_cols}; } sub _glob { my $self = shift; my $tag = shift || croak "No tag"; my $g = HTML::ElementGlob->new($tag); $g->glob_push_content(@_) if @_; $g; } sub _colglob { my $self = shift; $self->_glob('tr',@_); } sub _rowglob { my $self = shift; my $g = HTML::ElementTable::RowGlob->new(); $g->glob_push_content(@_) if @_; $g; } sub _cellglob { my $self = shift; $self->_glob('tr',@_); } sub rowspan_dispatch { my $self = shift; $self->_dimspan_dispatch('rowspan', @_); } sub colspan_dispatch { my $self = shift; $self->_dimspan_dispatch('colspan', @_); } sub _dimspan_dispatch { # Dispatch for children to use to send notice of span changes, in rows # or columns. my($self, $attr, $row, $col, $span) = @_; defined $row && defined $col || croak "Cell row and column required"; defined $span || croak "Span setting required"; my $orth_attr = $attr eq 'colspan' ? 'rowspan' : 'colspan'; $span = 1 unless $span; my $oldspan = $self->cell($row,$col)->attr($attr); $oldspan = 1 unless $oldspan; return if $span == $oldspan; my $ospan = $self->cell($row,$col)->attr($orth_attr); $ospan = 1 unless $ospan; # We are either masking or revealing my $mask = $span > $oldspan ? 1 : 0; ($span, $oldspan) = ($oldspan, $span) if $oldspan > $span; my $tc; my($dim,$odim) = $attr eq 'colspan' ? ($col,$row) : ($row,$col); foreach my $d ($dim + $oldspan .. $dim + $span - 1) { foreach my $o ($odim .. $odim + $ospan - 1) { next if $d == $dim && $o == $odim; $tc = $self->cell($attr eq 'colspan' ? ($o,$d) : ($d,$o)) || next; $tc->mask($mask & $self->mask_mode); } } } sub blank_fill { # Should blank cells be populated with " " in order for BGCOLOR # to show up? my $self = shift; my $mode = shift; if (defined $mode) { $self->{_blank_fill} = $mode; $self->table->blank_fill($mode); } $self->{_blank_fill}; } sub beautify { # Set mode for making as_HTML output human readable. Broadcasts to # component elements. my $self = shift; my $mode = shift; if (defined $mode) { $self->{_beautify} = $mode; # Broadcast to row elements as well as data elements $self->row(0..$self->maxrow)->beautify($mode); $self->col(0..$self->maxcol)->beautify($mode); } $self->{_beautify}; } sub new { my $that = shift; my $class = ref($that) || $that; # Extract complex attributes my($attr,$val,$maxrow,$maxcol,%e_attrs); while ($attr = shift) { $val = shift; if ($attr =~ /^maxrow/) { $maxrow = $val; } elsif ($attr =~ /^maxcol/) { $maxcol = $val; } else { $e_attrs{$attr} = $val; } } my $self = $class->SUPER::new('table', %e_attrs); bless $self,$class; # Default to single cell $maxrow ||= 0; $maxcol ||= 0; $self->_initialize_table; $self->extent($maxrow, $maxcol); $self; } sub new_from_tree { # takes a regular HTML::Element table tree structure and reblesses and # configures it into an HTML::ElementTable structure. # # Dealing with row and column span issues properly is a real PITA, so # we cheat here a little bit by creating a new table structure with # fully rendered spans and use that as a template for normalizing the # old table. my($class, $tree) = @_; ref $tree or croak "Ref to element tree required.\n"; $tree->tag eq 'table' or croak "element tree should represent a table.\n"; # First get rid of non elements -- note this WILL zap comments within # the html of the table structure (i.e. in between adjacent tr tags or # td/th tags). While we're at it, determine dimensions. my($maxrow, $maxcol) = (-1, -1); my @rows; my @content = reverse $tree->detach_content; while (@content) { my $row = pop @content; next unless UNIVERSAL::isa($row, 'HTML::Element'); my $tag = $row->tag; # hack around tbody, thead, tfoot - yes, this means they get # stripped out of the resulting table tree if ($tag eq 'tbody' || $tag eq 'thead' || $tag eq 'tfoot') { push(@content, reverse $row->detach_content); next; } if ($tag eq 'tr') { ++$maxrow; my @cells; foreach my $cell ($row->detach_content) { if (UNIVERSAL::isa($cell, 'HTML::Element') && ($cell->tag eq 'td' || $cell->tag eq 'th')) { push(@cells, $cell); } } $maxcol = $#cells if $#cells > $maxcol; $row->push_content(@cells); push(@rows, $row); } } $tree->push_content(@rows); # Rasterize the tree table into a grid template -- use that as a guide # to flesh out our new H::ET eval "use HTML::TableExtract 2.08 qw(tree)"; croak "Problem loading HTML::TableExtract : $@\n" if $@; my $rasterizer = HTML::TableExtract::Rasterize->make_rasterizer; @rows = $tree->content_list; foreach my $r (0 .. $#rows) { my $row = $rows[$r]; foreach my $cell ($row->content_list) { my $rowspan = $cell->attr('rowspan') || 1; my $colspan = $cell->attr('colspan') || 1; $rasterizer->($r, $rowspan, $colspan); } } my $grid = $rasterizer->(); # Flesh out the tree structure, inserting masked cells where # appropriate foreach my $r (0 .. $#$grid) { my $row = $rows[$r]; my $grid_row = $grid->[$r]; my $content = $row->content_array_ref; print STDERR "Flesh row $r ($#$content) to $#$grid_row\n" if $DEBUG; foreach my $c (0 .. $#$grid_row) { my $cell = $content->[$c]; print STDERR $grid_row->[$c] ? '1' : '0' if $DEBUG; if ($grid_row->[$c]) { bless $cell, 'HTML::ElementTable::DataElement'; next; } else { my $masked = HTML::ElementTable::DataElement->new; $masked->mask(1); $row->splice_content($c, 0, $masked); } } print STDERR "\n" if $DEBUG; croak "row $r splice mismatch: $#$content vs $#$grid_row\n" unless $#$content == $#$grid_row; bless $row, 'HTML::ElementTable::RowElement'; } bless $tree, 'HTML::ElementTable'; $tree->_initialize_table; $tree->refresh; print $tree->as_HTML, "\n" if $DEBUG > 1; return $tree; } sub _initialize_table { my $self = shift; # Content police for aggregate integrity $self->watchdog(\@Valid_Children); # The tag choices for globs are arbitrary, but these should at least # make some sort of since if the globs are rendered as_HTML. $self->{_rows} = $self->_rowglob; $self->{_rows}->tag('table'); $self->{_cols} = $self->_colglob; $self->mask_mode(1); $self->blank_fill(0); $self; } ################ # Sub packages # ################ { package HTML::ElementTable::Element; use strict; use vars qw( @ISA ); use HTML::ElementSuper; @ISA = qw(HTML::ElementSuper); # "Beautify" mode # Primarily intended for as_HTML, this mode affects how the source HTML # appears. When beautified, the starttag and endtags are modified to # include indentation. sub beautify { my $self = shift; defined $_[0] ? $self->{_beautify} = shift : $self->{_beautify}; } sub starttag { my $self = shift; my $spc = ''; if ($self->beautify && !$self->mask) { $spc = ' ' x $self->depth; $spc = "\n$spc"; } $spc . $self->SUPER::starttag; } sub new { my $that = shift; my $class = ref($that) || $that; my $self = $class->SUPER::new(@_); bless $self, $class; $self; } # End HTML::ElementTable::Element } { package HTML::ElementTable::DataElement; use strict; use vars qw( @ISA $AUTOLOAD ); @ISA = qw(HTML::ElementTable::Element); #################### # Override Methods # #################### sub attr { # Keep tabs on colspan and rowspan my($self, $attr) = splice(@_, 0, 2); $attr = lc $attr; if (@_) { my $val = $_[0]; if (defined $val) { if ($attr eq 'colspan') { $self->parent->colspan_dispatch($self->addr, $val); } elsif ($attr eq 'rowspan') { $self->parent->rowspan_dispatch($self->addr, $val); } } else { # Deleting an attr if ($attr eq 'colspan' || $attr eq 'rowspan') { # Make sure and dispatch zero value $self->attr($attr, 0); } } } $self->SUPER::attr($attr, @_); } sub blank_fill { # Set/return mode for populating empty cells with " " so that # BGCOLOR will show up. my $self = shift; @_ ? $self->{_blank_fill} = shift : $self->{_blank_fill}; } ################## # Codus horribilus # #################### # This bit of unfortunate code is necessary because of the shortcomings # of the as_HTML method in HTML::Element. as_HTML uses # HTML::Entity::encode_entities to process nodes that are not elements. # For some reason, "<>&" is passed to the encode_entities method, which # effectively makes it impossible to pass a literal "&" into your HTML # output. Specifically, in order for the BGCOLOR to show up in an empty # table cell, you must include a " ". However, you cannot pass a # literal "&", for it always gets translated to "&", thus placing # " " as literal text in your cells. Nor can you pass the code for # a non-breaking space - it remains unchanged since the encode list is # limited. # # So we cheat. We override the starttag method, including the " " # along with the starttag if the cell is empty. This could be avoided if # HTML::Element relaxed a little and laid off the hand holding. # # Oh - we can't just override as_HTML() and do it correctly, because # as_HTML() is only invoked from the top level element - which could be # a plain jane HTML::Element and know nothing of HTML::Element::Table # elements. # # Ooo-glay! sub starttag { my $self = shift; my @c = $self->content_list; (!@c) && $self->blank_fill && !$self->mask ? $self->SUPER::starttag . "  " : $self->SUPER::starttag; } # Constructor sub new { my $that = shift; my $class = ref($that) || $that; my @args = @_ ? @_ : ('td'); my $self = $class->SUPER::new(@args); bless $self, $class; $self->blank_fill(0); $self; } # End HTML::ElementTable::DataElement } { package HTML::ElementTable::HeaderElement; use strict; use vars qw( @ISA ); use Carp; @ISA = qw(HTML::ElementTable::DataElement); sub new { my $that = shift; my $class = ref($that) || $that; my @args = @_ ? @_ : ('th'); my $self = $class->SUPER::new(@args); bless $self, $class; $self; } # End HTML::ElementTable::HeaderElement } { package HTML::ElementTable::RowElement; use strict; use vars qw( @ISA $AUTOLOAD ); use Carp; @ISA = qw(HTML::ElementTable::Element); # Restrict children so that Table coordinate system is untainted. my @Valid_Children = qw( HTML::ElementTable::DataElement HTML::ElementTable::HeaderElement ); ################## # Native Methods # ################## sub colspan_dispatch { # Dispatch for children to send notice of colspan changes my $self = shift; $self->parent->colspan_dispatch($self->addr, @_); } sub rowspan_dispatch { # Dispatch for children to send notice of rowspan changes my $self = shift; $self->parent->rowspan_dispatch($self->addr, @_); } sub new { my $that = shift; my $class = ref($that) || $that; my @args = @_ ? @_ : ('tr'); my $self = $class->SUPER::new(@args); bless $self,$class; # Content police for aggregate integrity $self->watchdog(\@Valid_Children); $self; } # End HTML::ElementTable::RowElement } { package HTML::ElementTable::RowGlob; use strict; use vars qw( @ISA ); use HTML::ElementGlob; @ISA = qw(HTML::ElementGlob); # Designate attributes that are valid for tags. my %TR_ATTRS; grep { ++$TR_ATTRS{$_} } qw( id class align valign bgcolor ); sub alias { # alias() allows us to designate an actual row element that contains # our data/header elements. If we can optimize an attribute on the # tag rather than each or tag, then we do so. my $self = shift; my $alias = shift; if (ref $alias) { $self->{_alias} = $alias; } $self->{_alias}; } sub attr { # alias intercept my $self = shift; if ($self->alias && $TR_ATTRS{lc $_[0]}) { return $self->alias->attr(@_); } $self->SUPER::attr(@_); } sub mask { # In addition to masking all children and tags, we have to # mask the row itself - accessible via the alias(). my $self = shift; if ($self->alias) { return $self->alias->mask(@_); } $self->SUPER::mask(@_); } sub beautify { # Broadcast beautify to alias my $self = shift; if ($self->alias) { return $self->alias->beautify(@_); } $self->SUPER::beautify(@_); } sub new { my $that = shift; my $class = ref($that) || $that; my @args = @_ ? @_ : ('table'); my $self = $class->SUPER::new(@args); bless $self, $class; $self; } # End HTML::ElementTable::RowGlob } 1; __END__ =head1 NAME HTML::ElementTable - Perl extension for manipulating a table composed of HTML::Element style components. =head1 SYNOPSIS use HTML::ElementTable; # Create a table 0..10 x 0..12 $t = new HTML::ElementTable maxrow => 10, maxcol => 12; # Populate cells with coordinates $t->table->push_position; # Manipulate tag $t->attr('cellspacing',0); $t->attr('border',1); $t->attr('bgcolor','#DDBB00'); # Manipulate entire table - optimize on or pass to all if possible) $t->row(0,2,4,6)->attr('bgcolor','#9999FF'); # Manipulate columns (all go to ) $t->box(7,1 => 10,3)->attr('bgcolor','magenta'); $t->box(7,7 => 10,5)->attr('bgcolor','magenta'); $t->box(8,9 => 9,11)->attr('bgcolor','magenta'); $t->box(7,10 => 10,10)->attr('bgcolor','magenta'); # individual element or the collected
$t->table->attr('align','left'); $t->table->attr('valign','top'); # Manipulate rows (optimizes on
tags within column) $t->col(0,4,8,12)->attr('bgcolor','#BBFFBB'); # Manipulate boxes (all go to elements # unless it contains full rows, then
or attributes $t->cell(8,6)->attr('bgcolor','#FFAAAA'); $t->cell(9,6)->attr('bgcolor','#FFAAAA'); $t->cell(7,9, 10,9, 7,11, 10,11)->attr('bgcolor','#FFAAAA'); # Take a look print $t->as_HTML; =head1 DESCRIPTION HTML::ElementTable provides a highly enhanced HTML::ElementSuper structure with methods designed to easily manipulate table elements by using coordinates. Elements can be manipulated in bulk by individual cells, arbitrary groupings of cells, boxes, columns, rows, or the entire table. =head1 PUBLIC METHODS Table coordinates start at 0,0 in the upper left cell. CONSTRUCTORS =over 4 =item new() =item new(maxrow => row, maxcol => col) Return a new HTML::ElementTable object. If the number of rows and columns were provided, all elements required for the rows and columns will be initialized as well. See extent(). =item new_from_tree($tree) Takes an existing top-level HTML::Element representing a table and converts the entire table structure into a cohesive HTML::ElementTable construct. (this is potentially useful if you want to use the power of this module for editing HTML tables I within an HTML::Element tree). =back TABLE CONFIGURATION =over 4 =item extent() =item extent(maxrow, maxcolumn) Set or return the extent of the current table. The I and I parameters indicate the maximum row and column coordinates you desire in the table. These are the coordinates of the lower right cell in the table, starting from (0,0) at the upper left. Providing a smaller extent than the current one will shrink the table with no ill effect, provided you do not mind losing the information in the clipped cells. =item maxrow() Set or return the coordinate of the last row. =item maxcol() Set or return the coordinate of the last column. =back ELEMENT ACCESS Unless accessing a single element, most table element access is accomplished through I, which are collections of elements that behave as if they were a single element object. Whenever possible, globbed operations are optimized into the most appropriate element. For example, if you set an attribute for a row glob, the attribute will be set either on the
elements, whichever is appropriate. See L for more information on element globs. =over =item cell(row,col,[row2,col2],[...]) Access an individual cell or collection of cells by their coordinates. =item row(row,[row2,...]) Access the contents of a row or collection of rows by row coordinate. =item col(col,[col2,...]) Access the contents of a column or collection of columns by column coordinate. =item box(row_a1,col_a1,row_a2,col_a2,[row_b1,col_b1,row_b2,col_b2],[...]) Access the contents of a span of cells, specified as a box consisting of two sets of coordinates. Multiple boxes can be specified. =item table() Access all cells in the table. This is different from manipulating the table object itself, which is reserved for such things as CELLSPACING and other attributes specific to the tag. However, since table() returns a glob of cells, if the attribute is more appropriate for the top level
tag, it will be placed there rather than in each tag or every
tag. =back ELEMENT/GLOB METHODS The interfaces to a single table element or a glob of elements are identical. All methods available from the HTML::ElementSuper class are also available to a table element or glob of elements. See L for details on these methods. Briefly, here are some of the more useful methods provided by HTML::ElementSuper: =over =item attr() =item push_content() =item replace_content() =item wrap_content() =item clone([element]) =item mask([mode]) =back TABLE SPECIFIC EXTENSIONS =over =item blank_fill([mode]) Set or return the current fill mode for blank cells. The default is 0 for HTML::Element::Table elements. When most browsers render tables, if they are empty you will get a box the color of your browser background color rather than the BGCOLOR of that cell. When enabled, empty cells are provided with an ' ', or invisible content, which will trigger the rendering of the BGCOLOR for that cell. =back =head1 NOTES ON GLOBS Globbing was a convenient way to treat arbitrary collections of table cells as if they were a single HTML element. Methods are generally passed blindly and sequentially to the elements they contain. Most of the time, this is fairly intuitive, such as when you are setting the attributes of the cells. Other times, it might be problematic, such as with push_content(). Do you push the same object to all of the cells? HTML::Element based classes only support one parent, so this breaks if you try to push the same element into multiple parental hopefuls. In the specific case of push_content() on globs, the elements that eventually get pushed are clones of the originally provided content. It works, but it is not necessarily what you expect. An incestuous HTML element tree is probably not what you want anyway. See L for more details on how globs work. =head1 REQUIRES HTML::ElementSuper, HTML::ElementGlob =head1 AUTHOR Matthew P. Sisk, EFE =head1 ACKNOWLEDGEMENTS Thanks to William R. Ward for some conceptual nudging. =head1 COPYRIGHT Copyright (c) 1998-2010 Matthew P. Sisk. All rights reserved. All wrongs revenged. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO A useful page of HTML::ElementTable examples can be found at http://www.mojotoad.com/sisk/projects/HTML-Element-Extended/examples.html. HTML::ElementSuper(3), HTML::ElementGlob(3), HTML::Element(3), HTML::TableExtract(3), perl(1). =cut HTML-Element-Extended-1.18/lib/HTML/ElementRaw.pm0000644000175000017500000000502511403731021017745 0ustar sisksiskpackage HTML::ElementRaw; # Allow raw html as content so that special characters # do not get encoded. The string is incorporated as part # of the start tag in order to bypass the regular HTML::Element # encoding. use strict; use vars qw($VERSION @ISA); require HTML::Element; @ISA = qw(HTML::Element); $VERSION = '1.18'; # Whole lotta overrides # # Have to store the string somewhere besides _content, because # traverse looks in the attribute directly rather than calling # content(). sub push_content { # Flatten elements into an HTML string if found, # otherwise just slap the text in. my @text = map(defined (ref $_ ? $_->as_HTML : $_) ? $_ : '', @_); shift->{_string}[0] .= join('',@text); } sub insert_element { push_content(@_); } sub starttag { shift->{_string}[0]; } sub as_HTML { starttag(@_); } # These become degenerate sub endtag { return } sub pos { return } sub attr { return } sub content { return } sub tag { return } sub new { my $that = shift; my $class = ref($that) || $that; # The tag type does not get displayed. We keep it # around anyway, just in case. my @args = @_ ? @_ : 'p'; my $self = new HTML::Element @args; bless $self,$class; $self; } 1; __END__ =head1 NAME HTML::ElementRaw - Perl extension for HTML::Element(3). =head1 SYNOPSIS use HTML::ElementRaw; $er = new HTML::ElementRaw; $text = '

I would like this   HTML to not be encoded

'; $er->push_content($text); $h = new HTML::Element 'h2'; $h->push_content($er); # Now $text will appear as you typed it, non-escaped, # embedded in the HTML produced by $h. print $h->as_HTML; =head1 DESCRIPTION Provides a way to graft raw HTML strings into your HTML::Element(3) structures. Since they represent raw text, these can only be leaves in your HTML element tree. The only methods that are of any real use in this degenerate element are push_content() and as_HTML(). The push_content() method will simply prepend the provided text to the current content. If you happen to pass an HTML::element to push_content, the output of the as_HTML() method in that element will be prepended. =head1 REQUIRES HTML::Element(3) =head1 AUTHOR Matthew P. Sisk, EFE =head1 COPYRIGHT Copyright (c) 1998-2010 Matthew P. Sisk. All rights reserved. All wrongs revenged. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO HTML::Element(3), HTML::ElementSuper(3), HTML::Element::Glob(3), HTML::ElementTable(3), perl(1). =cut HTML-Element-Extended-1.18/Changes0000644000175000017500000000521611404212204015325 0ustar sisksiskRevision history for Perl extension HTML-Element-Extended. 1.18 Thu Jun 10 12:35:20 EDT 2010 - added push_attr() method - tweaked glob dispatch for attr() 1.17 Wed May 3 16:52:03 EDT 2006 - new_from_tree() uses a better rasterizer now, properly handling even more tortuous span issues. Thanks to Roland Schar. - Fixed as_XML rendering Thanks to Roger Crew. 1.16 Sat Feb 25 12:41:57 EST 2006 - Fixed new_from_tree() to handle (ignore) tbody, thead and tfoot tags. Otherwise rows were ignored. 1.15 Fri Feb 24 15:34:13 EST 2006 - Fixed some scoping issues ('my' collisions) - Fixed some undef issues running under -w (thanks to Carl Franks) 1.14 Sun Dec 11 04:01:53 EST 2005 - Revised new_from_tree() to properly handle row and column span issues. Thanks to Mark L. Lott for debugging and prodding. 1.13 Mon Mar 28 15:14:12 EST 2005 - Fixed nasty content bug 1.12 Wed Mar 9 02:30:10 EST 2005 - Added new_from_tree() constructor which takes an HTML::Element object based on a table tag and converts it into a cohesive HTML::ElementTable structure. 1.11 Tue Apr 2 08:37:42 CST 2002 - Added some version dependencies on prereq modules - More -w cleanup (tie/ref dep) 1.10 Mon Jan 8 19:29:59 CST 2001 - Maintenance release (-w cleanup) 1.09 Fri Nov 10 02:21:30 CST 2000 - Various bugs and warnings fixed. 1.08 Tue May 2 15:03:15 CDT 2000 - clone() bug fix regarding text vs ref on first node. - adapted glob class to use content_list() rather than content() 1.07 Wed Apr 26 11:37:11 CDT 2000 - More stable content policing, used for both table integrity and masking; new content methods should automatically be safe. - Deprecated delete_attr(), since this can now be addressed via attr($attr, undef). - Syntactical cleanup, code fleecing. Inherited constructors will work. 1.06 Tue Jan 25 20:05:05 CST 2000 1.05 - Versioning for the sake of CPAN 1.04 Tue Jan 25 20:05:05 CST 2000 - Fixed incompatabilities with HTML::Element 1.45 - Cleaned up -w noise - Improved globbing cascades - Added mailing list information 1.03 Wed Nov 17 23:53:58 CST 1999 - dynamic maxrow, maxcol, extent bug fix 1.02 Thu Sep 16 15:33:41 CDT 1999 - Bundle fix 1.01 Thu Aug 19 14:36:05 CDT 1999 - Minor typos corrected for tests 0.09 Thu Jul 8 19:02:39 CDT 1999 - initial merge from HTML::Element::* 1.00 Tue Jul 27 21:55:43 CDT 1999 - initial release HTML-Element-Extended-1.18/META.yml0000644000175000017500000000064711404212325015312 0ustar sisksisk--- #YAML:1.0 name: HTML-Element-Extended version: 1.18 abstract: ~ license: ~ author: ~ generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: Data::Dumper: 0 HTML::Element: 3.01 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 HTML-Element-Extended-1.18/README0000644000175000017500000000343610213523224014720 0ustar sisksiskHTML-Element-Extended --------------------- HTML-Element-Extended is a package of several enhanced HTML::Element classes, most of which arose during the effort to implement an HTML::Element based table class. The modules are: HTML::ElementTable HTML::ElementSuper HTML::ElementGlob HTML::ElementRaw The resulting functionality enables: tables element globs element coordinates content replacement content wrapping element cloning raw HTML string adoption INSTALLATION You install HTML-Element-Extended, as you would install any perl library, by running these commands: perl Makefile.PL make make test make install DOCUMENTATION POD style documentation is included with each module. This is normally converted to a manual page and installed as part of the "make install" process. You should also be able to use the 'perldoc' utility to extract and read documentation from the module file directly. See Changes for recent changes. There should also be some examples on the web page mentioned below. SUPPORT There is a mailing list for the modules contained in HTML-Element-Extended. To subscribe or view past messages, please visit the following URL: http://lists.sourceforge.net/mailman/listinfo/elementextended-general Questions and comments may also be directed to Matt Sisk AVAILABILITY The library is available from CPAN: http://www.cpan.org/authors/id/M/MS/MSISK/ The latest version is also available at: http://www.mojotoad.com/sisk/projects/HTML-Element-Extended/ COPYRIGHT Copyright (c) 1999-2005 Matthew P. Sisk. All rights reserved. All wrongs revenged. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.