view release on metacpan or  search on metacpan

lib/HTML/Element/Tiny.pm  view on Meta::CPAN

use strict;
local $^W = 1;

package HTML::Element::Tiny;

use vars qw($VERSION %HAS @TAGS %DEFAULT_CLOSED %DEFAULT_NEWLINE %TAG_CLASS);
$VERSION = '0.006';
use 5.004;
BEGIN {
#  @TAGS = 
#      qw( a abbr acronym address area b base bdo big blockquote body br
#      button caption cite code col colgroup dd del div dfn dl dt em
#      fieldset form frame frameset h1 h2 h3 h4 h5 h6 head hr html i
#      iframe img input ins kbd label legend li link map meta noframes
#      noscript object ol optgroup option p param pre q samp script select
#      small span strong style sub sup table tbody td textarea tfoot th
#      thead title tr tt ul var );
  %DEFAULT_CLOSED = map { $_ => 1 }
    qw( area base br col frame hr img input meta param link );
  %DEFAULT_NEWLINE = map { $_ => 1 }
    qw( html head body div p tr table );
  use vars qw(%_modver);
  %_modver = (
    Clone => '0.28',
  );
  for my $module (qw(HTML::Entities Clone)) {
    my $modver = $_modver{$module} || 0;
    $HAS{$module} = eval "use $module $modver (); 1"
      unless defined $HAS{$module};
  }
}

use Scalar::Util ();
use Carp ();

#use overload (
#  q{""} => 'as_string',
#  q{0+} => sub { Scalar::Util::refaddr($_[0]) },
#  fallback => 1,
#);

sub TAG      () { 0 }
sub ID       () { 1 }
sub CLASS    () { 2 }
sub ATTR     () { 3 }
sub CHILDREN () { 4 }

%TAG_CLASS = (
  -text    => "-Text",
  -base    => 'HTML::Element::Tiny',
  -default => 'HTML::Element::Tiny',
);

sub _tag_class {
  my ($class, $tag) = @_;
  my $tag_lookup;
  {
    no strict 'refs';
    if (exists ${$class . '::'}{TAG_CLASS}
      and *{${$class . '::'}{TAG_CLASS}}{HASH}) {
      $tag_lookup = \%{$class . '::TAG_CLASS'};
      # XXX should this really be the case? it seems like a very sane default.
      $tag_lookup->{-base}    ||= $class;
      $tag_lookup->{-default} ||= $class;
    } else {
      $tag_lookup = {};
    }
  }
  my $tag_class;
  for my $href ($tag_lookup, \%TAG_CLASS) {
    if ($tag_class = $href->{$tag}) {
      $tag_class =~ s/^-/$href->{-base}::/;
      last;
    }