File Coverage

blib/lib/String/Tagged/HTML.pm

Criterion	Covered	Total	%
statement	54	56	96.4
branch	19	24	79.1
condition			n/a
subroutine	8	8	100.0
pod	2	2	100.0
total	83	90	92.2

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2011 -- [e-mail]

package String::Tagged::HTML;

use strict;
use warnings;

use base qw( String::Tagged );
String::Tagged->VERSION( '0.07' );

our $VERSION = '0.01';

=head1 NAME

C - format HTML output using C

=head1 SYNOPSIS

 use String::Tagged::HTML;

 my $st = String::Tagged::HTML->new( "An important message" );

 $st->apply_tag( 3, 9, b => 1 );

 print $st->as_html( "h1" );

=head1 DESCRIPTION

This subclass of L provides a method, C, for rendering
the string as an HTML fragment, using the tags to provide formatting. For
example, the SYNOPSIS example will produce the output

 An important message

With the exception of tags named C, a tag applied to an extent of the
C will be rendered using start and end HTML tags of the
same name. If the tag's value is a C reference, then this hash will be
used to provide additional attributes for the HTML element.

 my $str = String::Tagged::HTML->new( "click here" );
 $str->apply_tag( 6, 4, a => { href => "/see/other.html" } );

 print $str->as_html( "p" );

Z<>

 click here

If it is not a C reference, then its value ought to be a simple boolean
true value, such as C<1>.

The special tag named C disables HTML entity escaping over its extent.

 my $str = String::Tagged::HTML->new( "This  is escaped" );

 my $br = String::Tagged::HTML->new( "" );
 $br->apply_tag( 0, $br->length, raw => 1 );

 print +( $str . $br )->as_html( "p" );

Z<>

 This <content> is escaped

=head2 Tag Nesting

Because of the arbitrary way that C tags may be applied, as
compared to the strict nesting requirements in HTML, the C method may
have to break a single C tag into multiple regions. In the
following example, the C tag has been split in two to allow it to overlap
correctly with C.

 my $str = String::Tagged::HTML->new( "bbb b+i iii" );
 $str->apply_tag( 0, 7, b => 1 );
 $str->apply_tag( 4, 7, i => 1 );

 print $str->as_html

Z<>

 bbb b+i iii

=cut

=head1 CONSTRUCTORS

As well as the standard C and C constructors provided by
L, the following is provided.

=cut

=head2 $st = String::Tagged::HTML->new_raw( $str )

Returns a new C instance with the C tag applied
over its entire length. This convenience is provided for creating objects
containing already-rendered HTML fragments.

=cut

sub new_raw
{
   my $class = shift;
   my ( $str ) = @_;
   return $class->new_tagged( $str, raw => 1 );
}

=head1 METHODS

The following methods are provided in addition to those provided by
L.

=cut

sub _escape_html
{
   my $s = $_[0];
   $s =~ s/([<>&"'])/$1 eq "<" ? "<" :
                     $1 eq ">" ? ">" :
                     $1 eq "&" ? "&" :
                     $1 eq '"' ? """ :
                     $1 eq "'" ? "'" : ""/eg;
   $s;
}

sub _cmp_tag_values
{
   my $self = shift;
   my ( $name, $v1, $v2 ) = @_;

   return ( $v1 == $v2 ) if grep { $name eq $_ } qw( b i u small );
   return ( $v1->{href} eq $v2->{href} ) if $name eq "a";
   die "Unknown tag name $name\n";
}

=head2 $html = $st->as_html( $element )

Returns a string containing an HTML rendering of the current contents of the
object. If C<$element> is provided, the output will be wrapped in an element
of the given name. If not defined, no outer wrapping will be performed.

=cut

sub as_html
{
   my $self = shift;
   my ( $elem ) = @_;

   my $ret = "";

   my @tags_in_effect; # of [ $name, $value ]

   $self->iter_extents_nooverlap(
      sub {
         my ( $e, %tags ) = @_;

         # Look for the first tag that no longer applies, as we'll have to
         # unwind the entire tag stack to that point

         my $i;
         for( $i = 0; $i < @tags_in_effect; $i++ ) {
            my ( $tag, $value ) = @{ $tags_in_effect[$i] };
            last if !exists $tags{$tag};
            last if !$self->_cmp_tag_values( $tag, $value, $tags{$tag} );
            delete $tags{$tag};
         }

         while( @tags_in_effect > $i ) {
            my ( $tag ) = @{ pop @tags_in_effect };
            $ret .= "";
         }

         # TODO: Sort these into an optimal order
         foreach my $tag ( keys %tags ) {
            my $value = $tags{$tag};
            if( ref $value eq "HASH" ) {
               my $attrs = join "", map { qq( $_=") . _escape_html($value->{$_}) . q(") } sort keys %$value;
               $ret .= "<$tag$attrs>";
            }
            else {
               $ret .= "<$tag>";
            }
            push @tags_in_effect, [ $tag, $value ];
         }

         $self->iter_substr_nooverlap(
            sub {
               my ( $str, %tags ) = @_;
               $ret .= ( $tags{raw} ? $str : _escape_html( $str ) );
            },
            start => $e->start,
            end   => $e->end,
         );
      },
      except => [qw( raw )],
   );

   while( @tags_in_effect ) {
      my ( $tag ) = @{ pop @tags_in_effect };
      $ret .= "";
   }

   return "<$elem>$ret" if defined $elem;
   return "$ret";
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;