File Coverage

blib/lib/Blatte/HTML.pm

Criterion	Covered	Total	%
statement	106	106	100.0
branch	38	40	95.0
condition	17	18	94.4
subroutine	15	15	100.0
pod	2	2	100.0
total	178	181	98.3

use strict;

package Blatte::HTML::Element;

sub new {
  my $class = shift;
  bless [@_], $class;
}

sub name { $_[0]->[0] }

sub attrs { $_[0]->[1] }

sub content {
  my $self = shift;
  @$self[2..$#$self];
}

package Blatte::HTML;

BEGIN {
  @Blatte::HTML::builtins = qw($html_bool_yes $html_bool_no
                               $html_p_yes $html_p_no
                               $html_ent_yes $html_ent_no
                               $a $abbr $acronym $address $applet $area $b
                               $base $basefont $bdo $big $blockquote $body $br
                               $button $caption $center $cite $code $col
                               $colgroup $dd $del $dfn $dir $div $dl $dt $em
                               $fieldset $font $form $frame $frameset $h1 $h2
                               $h3 $h4 $h5 $h6 $head $hr $html $i $iframe $img
                               $input $ins $isindex $kbd $label $legend $li
                               $link $map $menu $meta $noframes $noscript
                               $object $ol $optgroup $option $p $param $pre $q
                               $s $samp $script $select $small $span $strike
                               $strong $style $sub $sup $table $tbody $td
                               $textarea $tfoot $th $thead $title $tr $tt $u
                               $ul $var);
}

use vars (qw(@ISA @EXPORT @EXPORT_OK $VERSION), @Blatte::HTML::builtins);

use Exporter;

@ISA = qw(Exporter);

@EXPORT = @Blatte::HTML::builtins;
@EXPORT_OK = qw(make_start_tag render);

$VERSION = '0.9';

use Blatte;
use HTML::Entities;
use HTML::Tagset;
use Symbol;

my $_html_bool_yes = gensym();
my $_html_bool_no  = gensym();

$html_bool_yes = sub { $_html_bool_yes };
$html_bool_no  = sub { $_html_bool_no };

$html_p_yes   = sub { new Blatte::HTML::Element('_p', 1, @_[1 .. $#_]) };
$html_p_no    = sub { new Blatte::HTML::Element('_p', 0, @_[1 .. $#_]) };
$html_ent_yes = sub { new Blatte::HTML::Element('_ent', 1, @_[1 .. $#_]) };
$html_ent_no  = sub { new Blatte::HTML::Element('_ent', 0, @_[1 .. $#_]) };

$a          = sub { new Blatte::HTML::Element('a',          @_) };
$abbr       = sub { new Blatte::HTML::Element('abbr',       @_) };
$acronym    = sub { new Blatte::HTML::Element('acronym',    @_) };
$address    = sub { new Blatte::HTML::Element('address',    @_) };
$applet     = sub { new Blatte::HTML::Element('applet',     @_) };
$area       = sub { new Blatte::HTML::Element('area',       @_) };
$b          = sub { new Blatte::HTML::Element('b',          @_) };
$base       = sub { new Blatte::HTML::Element('base',       @_) };
$basefont   = sub { new Blatte::HTML::Element('basefont',   @_) };
$bdo        = sub { new Blatte::HTML::Element('bdo',        @_) };
$big        = sub { new Blatte::HTML::Element('big',        @_) };
$blockquote = sub { new Blatte::HTML::Element('blockquote', @_) };
$body       = sub { new Blatte::HTML::Element('body',       @_) };
$br         = sub { new Blatte::HTML::Element('br',         @_) };
$button     = sub { new Blatte::HTML::Element('button',     @_) };
$caption    = sub { new Blatte::HTML::Element('caption',    @_) };
$center     = sub { new Blatte::HTML::Element('center',     @_) };
$cite       = sub { new Blatte::HTML::Element('cite',       @_) };
$code       = sub { new Blatte::HTML::Element('code',       @_) };
$col        = sub { new Blatte::HTML::Element('col',        @_) };
$colgroup   = sub { new Blatte::HTML::Element('colgroup',   @_) };
$dd         = sub { new Blatte::HTML::Element('dd',         @_) };
$del        = sub { new Blatte::HTML::Element('del',        @_) };
$dfn        = sub { new Blatte::HTML::Element('dfn',        @_) };
$dir        = sub { new Blatte::HTML::Element('dir',        @_) };
$div        = sub { new Blatte::HTML::Element('div',        @_) };
$dl         = sub { new Blatte::HTML::Element('dl',         @_) };
$dt         = sub { new Blatte::HTML::Element('dt',         @_) };
$em         = sub { new Blatte::HTML::Element('em',         @_) };
$fieldset   = sub { new Blatte::HTML::Element('fieldset',   @_) };
$font       = sub { new Blatte::HTML::Element('font',       @_) };
$form       = sub { new Blatte::HTML::Element('form',       @_) };
$frame      = sub { new Blatte::HTML::Element('frame',      @_) };
$frameset   = sub { new Blatte::HTML::Element('frameset',   @_) };
$h1         = sub { new Blatte::HTML::Element('h1',         @_) };
$h2         = sub { new Blatte::HTML::Element('h2',         @_) };
$h3         = sub { new Blatte::HTML::Element('h3',         @_) };
$h4         = sub { new Blatte::HTML::Element('h4',         @_) };
$h5         = sub { new Blatte::HTML::Element('h5',         @_) };
$h6         = sub { new Blatte::HTML::Element('h6',         @_) };
$head       = sub { new Blatte::HTML::Element('head',       @_) };
$hr         = sub { new Blatte::HTML::Element('hr',         @_) };
$html       = sub { new Blatte::HTML::Element('html',       @_) };
$i          = sub { new Blatte::HTML::Element('i',          @_) };
$iframe     = sub { new Blatte::HTML::Element('iframe',     @_) };
$img        = sub { new Blatte::HTML::Element('img',        @_) };
$input      = sub { new Blatte::HTML::Element('input',      @_) };
$ins        = sub { new Blatte::HTML::Element('ins',        @_) };
$isindex    = sub { new Blatte::HTML::Element('isindex',    @_) };
$kbd        = sub { new Blatte::HTML::Element('kbd',        @_) };
$label      = sub { new Blatte::HTML::Element('label',      @_) };
$legend     = sub { new Blatte::HTML::Element('legend',     @_) };
$li         = sub { new Blatte::HTML::Element('li',         @_) };
$link       = sub { new Blatte::HTML::Element('link',       @_) };
$map        = sub { new Blatte::HTML::Element('map',        @_) };
$menu       = sub { new Blatte::HTML::Element('menu',       @_) };
$meta       = sub { new Blatte::HTML::Element('meta',       @_) };
$noframes   = sub { new Blatte::HTML::Element('noframes',   @_) };
$noscript   = sub { new Blatte::HTML::Element('noscript',   @_) };
$object     = sub { new Blatte::HTML::Element('object',     @_) };
$ol         = sub { new Blatte::HTML::Element('ol',         @_) };
$optgroup   = sub { new Blatte::HTML::Element('optgroup',   @_) };
$option     = sub { new Blatte::HTML::Element('option',     @_) };
$p          = sub { new Blatte::HTML::Element('p',          @_) };
$param      = sub { new Blatte::HTML::Element('param',      @_) };
$pre        = sub { new Blatte::HTML::Element('pre',        @_) };
$q          = sub { new Blatte::HTML::Element('q',          @_) };
$s          = sub { new Blatte::HTML::Element('s',          @_) };
$samp       = sub { new Blatte::HTML::Element('samp',       @_) };
$script     = sub { new Blatte::HTML::Element('script',     @_) };
$select     = sub { new Blatte::HTML::Element('select',     @_) };
$small      = sub { new Blatte::HTML::Element('small',      @_) };
$span       = sub { new Blatte::HTML::Element('span',       @_) };
$strike     = sub { new Blatte::HTML::Element('strike',     @_) };
$strong     = sub { new Blatte::HTML::Element('strong',     @_) };
$style      = sub { new Blatte::HTML::Element('style',      @_) };
$sub        = sub { new Blatte::HTML::Element('sub',        @_) };
$sup        = sub { new Blatte::HTML::Element('sup',        @_) };
$table      = sub { new Blatte::HTML::Element('table',      @_) };
$tbody      = sub { new Blatte::HTML::Element('tbody',      @_) };
$td         = sub { new Blatte::HTML::Element('td',         @_) };
$textarea   = sub { new Blatte::HTML::Element('textarea',   @_) };
$tfoot      = sub { new Blatte::HTML::Element('tfoot',      @_) };
$th         = sub { new Blatte::HTML::Element('th',         @_) };
$thead      = sub { new Blatte::HTML::Element('thead',      @_) };
$title      = sub { new Blatte::HTML::Element('title',      @_) };
$tr         = sub { new Blatte::HTML::Element('tr',         @_) };
$tt         = sub { new Blatte::HTML::Element('tt',         @_) };
$u          = sub { new Blatte::HTML::Element('u',          @_) };
$ul         = sub { new Blatte::HTML::Element('ul',         @_) };
$var        = sub { new Blatte::HTML::Element('var',        @_) };

# Hmm, why did HTML::Tagset neglect to do this?
my %p_closure_barriers = map { ($_ => 1) } @HTML::Tagset::p_closure_barriers;

sub make_start_tag {
  my $obj = shift;
  my $result = $obj->name();
  my $attrs = $obj->attrs();
  foreach my $attr (keys %$attrs) {
    my $val = $attrs->{$attr};
    if ($val ne $_html_bool_no) {
      if ($val eq $_html_bool_yes) {
        $result .= " $attr";
      } else {
        $result .= sprintf(' %s="%s"',
                           $attr,
                           &encode_entities(&Blatte::flatten($val, '')));
      }
    }
  }
  "<$result>";
}

sub render {
  my($val, $render_cb) = @_;
  my $do_p = 1;
  my $do_entities = 1;
  my @stack;
  my $traverse_cb;
  $traverse_cb = sub {
    my($ws, $obj) = @_;

    my $old_do_p        = $do_p;
    my $old_do_entities = $do_entities;

    my $obj_is_html_elt = &UNIVERSAL::isa($obj, 'Blatte::HTML::Element');

    my $obj_is__p   = ($obj_is_html_elt && ($obj->name() eq '_p'));
    my $obj_is__ent = ($obj_is_html_elt && ($obj->name() eq '_ent'));
    my $obj_is_control = ($obj_is__p || $obj_is__ent);

    if ($obj_is__p) {
      $do_p = $obj->attrs();
    } elsif ($obj_is__ent) {
      $do_entities = $obj->attrs();
    }

    my $obj_is_p        = ($obj_is_html_elt && ($obj->name() eq 'p'));
    my $newpar          = ($do_p &&
                           ($obj_is_p || (defined($ws) && ($ws =~ /\n.*\n/))));

    my $close_needed;

    if ($newpar) {
      for (my $i = $#stack; $i >= 0; --$i) {
        my $elt = $stack[$i];
        my $name = $elt->[0];
        last if ($p_closure_barriers{$name});
        if ($name eq 'p') {
          $close_needed = $i;
          last;
        }
      }

      if (defined($close_needed)) {
        for (my $i = $#stack; $i >= $close_needed; --$i) {
          my $elt = $stack[$i];
          my $name = $elt->[0];
          &$render_cb("");
        }

        splice(@stack, $close_needed, 1) if $obj_is_p;
      }
    }

    &$render_cb($ws) if defined($ws);

    if ($newpar) {
      if (defined($close_needed)) {
        for (my $i = $close_needed; $i <= $#stack; ++$i) {
          my $elt = $stack[$i];
          my($name, $tag) = @$elt;
          &$render_cb($tag);
        }
      } elsif (!$obj_is_p) {
        my $tag = '';
        &$render_cb($tag);
        push(@stack, ['p', $tag]);
      }
    }

    if ($obj_is_html_elt) {
      my $tag;
      my $name;

      unless ($obj_is_control) {
        $tag = &make_start_tag($obj);
        &$render_cb($tag);
        $name = $obj->name();
      }

      if ($obj_is_control || !$HTML::Tagset::emptyElement{$name}) {
        my $pair;

        unless ($obj_is_control) {
          $pair = [$name, $tag];
          push(@stack, $pair);
        }

        &Blatte::traverse([$obj->content()], $traverse_cb);

        unless ($obj_is_control) {
          for (my $i = $#stack; $i >= 0; --$i) {
            my $elt = $stack[$i];
            if ($elt eq $pair) {
              for (my $j = $#stack; $j >= $i; --$j) {
                my $elt2 = $stack[$j];
                my $name2 = $elt2->[0];
                &$render_cb("");
              }
              splice(@stack, $i);
              last;
            }
          }
        }
      }
    } else {
      &$render_cb($do_entities ? &encode_entities($obj) : $obj);
    }

    $do_p = $old_do_p;
    $do_entities = $old_do_entities;
  };
  &Blatte::traverse($val, $traverse_cb);
}

1;

__END__