File Coverage

blib/lib/YAPE/HTML/Element.pm

Criterion	Covered	Total	%
statement	54	121	44.6
branch	14	36	38.8
condition	15	23	65.2
subroutine	16	38	42.1
pod	4	4	100.0
total	103	222	46.4

package YAPE::HTML::Element;

$VERSION = '1.10';


sub text { $_[0]{TEXT} }
sub string { $_[0]->text }
sub fullstring { $_[0]->string }
sub type { $_[0]{TYPE} }


package YAPE::HTML::tag;

sub new {
  my ($class, $tag, $attr, $text, $closed, $impl) = @_;
  bless {
    TYPE => 'tag',
    TAG => $tag,
    ATTR => $attr || {},
    TEXT => $text || [],
    CLOSED => $closed || 0,
    IMPLIED => $impl || 0,
  }, $class;
}

sub string {
  my $self = shift;
  my $str = "<$self->{TAG}";
  for (sort keys %{ $self->{ATTR} }) {
    $str .= " $_";
    if (defined $self->{ATTR}{$_}) {
      $str .= "=" . YAPE::HTML::quote($self->{ATTR}{$_});
    }
  }
  $str .= " /" if $self->{IMPLIED};
  $str .= ">";
  return $str;
}

sub fullstring {
  my $self = shift;
  my ($taghash, $taglist) = ({}, []);
  @$taghash{@{ $taglist = shift }} = () if ref $_[0];
  my $d = @_ ? $_[0] : -1;
  my $str;

  $str = $self->string if $d and not exists $taghash->{$self->{TAG}};
  $str .= join "", map
    $_->fullstring($taglist, $d > 0 ? $d-1 : $d),
    @{ $self->{TEXT} };
  $str .= "{TAG}>" if
    $self->{CLOSED} and $d and not exists $taghash->{$self->{TAG}};
  return $str;
}

sub get_attr {
  my $self = shift;
  return %{ $self->{ATTR} } if not @_;
  return $self->{ATTR}{$_[0]} if @_ == 1;
  return @{ $self->{ATTR} }{map lc, @_};
}

sub has_attr {
  my $self = shift;
  return exists $self->{ATTR}{lc $_[0]} if @_ == 1;
  return map exists $self->{ATTR}{lc $_}, @_;
}

sub set_attr {
  my $self = shift;
  while (my $k = shift) { $self->{ATTR}{lc $k} = shift }
}

sub rem_attr {
  my $self = shift;
  delete @{ $self->{ATTR} }{map lc, @_};
}

sub closed { $_[0]{CLOSED} }
sub implied_closed { $_[0]{IMPLIED} }
sub tag { $_[0]{TAG} }



package YAPE::HTML::closetag;

sub new {
  my ($class, $tag) = @_;
  bless { TYPE => 'closetag', TAG => $tag }, $class;
}

sub string { "" }
sub tag { $_[0]{TAG} }



package YAPE::HTML::text;

sub new {
  my ($class, $text) = @_;
  bless { TYPE => 'text', TEXT => $text }, $class;
}



package YAPE::HTML::comment;

sub new {
  my ($class, $comment) = @_;
  bless { TYPE => 'comment', TEXT => $comment }, $class;
}

sub string { "" }



package YAPE::HTML::dtd;

sub new {
  my ($class, $attr) = @_;
  my $hattr;

  $attr ||= [];
  @{$hattr}{@$attr} = ();
  bless { TYPE => 'dtd', ATTR => $attr, HATTR => $hattr }, $class;
}

sub get_attr { @{ $_[0]{ATTR} } }
sub set_attr { @{ $_[0]{HATTR} }{ @{ $_[0]{ATTR} } = @_[1..$#_] } = () }
sub string { "" }



package YAPE::HTML::pi;

sub new {
  my ($class, $name, $attr) = @_;
  bless { TYPE => 'pi', NAME => $name, ATTR => $attr || {} }, $class;
}

sub string {
  my $self = shift;
  my $str = "{NAME}";
  for (sort keys %{ $self->{ATTR} }) {
    $str .= " $_";
    if (defined $self->{ATTR}{$_}) {
      $str .= "=" . YAPE::HTML::quote($self->{ATTR}{$_});
    }
  }
  $str .= "?>";
  return $str;
}

sub get_attr {
  my $self = shift;
  return %{ $self->{ATTR} } if not @_;
  return $self->{ATTR}{$_[0]} if @_ == 1;
  return @{ $self->{ATTR} }{map lc, @_};
}

sub has_attr {
  my $self = shift;
  return exists $self->{ATTR}{lc $_[0]} if @_ == 1;
  return map exists $self->{ATTR}{lc $_}, @_;
}

sub set_attr {
  my $self = shift;
  while (my $k = shift) { $self->{ATTR}{lc $k} = shift }
}

sub rem_attr {
  my $self = shift;
  delete @{ $self->{ATTR} }{map lc, @_};
}

sub name { $_[0]{NAME} }



package YAPE::HTML::ssi;

sub new {
  my ($class, $com, $attr) = @_;
  bless { TYPE => 'ssi', COM => $com, ATTR => $attr || {} }, $class;
}

sub string {
  my $self = shift;
  my $str = "";
  return $str;
}

sub get_attr {
  my $self = shift;
  return %{ $self->{ATTR} } if not @_;
  return $self->{ATTR}{$_[0]} if @_ == 1;
  return @{ $self->{ATTR} }{map lc, @_};
}

sub has_attr {
  my $self = shift;
  return exists $self->{ATTR}{lc $_[0]} if @_ == 1;
  return map exists $self->{ATTR}{lc $_}, @_;
}

sub set_attr {
  my $self = shift;
  while (my $k = shift) { $self->{ATTR}{lc $k} = shift }
}

sub rem_attr {
  my $self = shift;
  delete @{ $self->{ATTR} }{map lc, @_};
}

sub command { $_[0]{COM} }



1;

__END__