Tagging 0.6

Changes

@@ -13,4 +13,12 @@ Revision history for HTML-Tiny
     Added empty array ref => empty attribute functionality.
 
 0.4 2007-05-31
-    Renamed to HTML::Tiny to avoid name clash with TOMC's module
+    Renamed to HTML::Tiny to avoid name clash with TOMC's module
+
+0.5 2007-05-31
+    Made empty tags generate at least one tag pair.
+
+0.6 2007-06-01
+    Added validate_tag subclassing hook.
+    Made it possible to specify the open/closed behaviour of tags.
+    Added auto-newline functionality, prefix/suffix specification.

MANIFEST

@@ -9,5 +9,7 @@ README
 t/00.load.t
 t/10.simple.t
 t/20.tags.t
+t/30.validate_tag.t
+t/40.prefix_suffix.t
 t/pod-coverage.t
 t/pod.t

README

@@ -1,4 +1,4 @@
-HTML-Tiny version 0.4
+HTML-Tiny version 0.6
 
 INSTALLATION
 

TODO

@@ -1,4 +0,0 @@
-Attributes:
-
-    Since undef means 'skip this attr' we need a way of specifying a
-    valueless attr - like 'checked'

andy/hash.pl

@@ -6,13 +6,26 @@
 
 $| = 1;
 
-my @l = ( { a => 'hash' }, ['array'], { another => 'hash' } );
+# my @l = ( { a => 'hash' }, ['array'], { another => 'hash' } );
+#
+# my %p = map { %$_ } grep { 'HASH' eq ref $_ } @l;
+#
+# my (@args, @attr);
+# push( @{ 'HASH' eq ref $_ ? \@args : \@attr }, $_ ) for @l;
+#
+# print Dumper( \%p );
+# print Dumper( \@args );
+# print Dumper( \@attr );
 
-my %p = map { %$_ } grep { 'HASH' eq ref $_ } @l;
+my %pog = (
+    say   => 'hello',
+    wave  => 'goodbye',
+    would => 'should',
+    could => 'did'
+);
 
-my (@args, @attr);
-push( @{ 'HASH' eq ref $_ ? \@args : \@attr }, $_ ) for @l;
+my $pr = \%pog;
 
-print Dumper( \%p );
-print Dumper( \@args );
-print Dumper( \@attr );
+delete @{$pr}{qw(say would)};
+
+print Dumper(\$pr);

andy/id.pl

@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Scalar::Util qw/refaddr/;
+
+$| = 1;
+
+use constant EMPTY => \my($anon_scalar);
+use constant FULL  => \my($anon_scalar);
+
+print EMPTY == FULL ? 'yes' : 'no', "\n";
+print refaddr EMPTY == refaddr FULL ? 'yes' : 'no', "\n";
+print EMPTY == EMPTY ? 'yes' : 'no', "\n";
+print refaddr EMPTY == refaddr EMPTY ? 'yes' : 'no', "\n";

lib/HTML/Tiny.pm

@@ -5,30 +5,31 @@ use strict;
 use Carp;
 use Scalar::Util qw(blessed looks_like_number refaddr);
 
-use version; our $VERSION = qv( '0.4' );
+use version; our $VERSION = qv( '0.6' );
 
 BEGIN {
 
     # http://www.w3schools.com/tags/default.asp
     for my $tag (
-        qw( a abbr acronym address area b base bdo big blockquote body
+        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 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 )
+        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 )
       ) {
         no strict 'refs';
-        *$tag = sub { shift->tag( $tag, @_ ) };
-    }
-
-    for my $tag ( qw( br img input ) ) {
-        no strict 'refs';
-        *$tag = sub { shift->closed( $tag, @_ ) };
+        *$tag = sub { shift->auto_tag( $tag, @_ ) };
     }
 }
 
+# Tags that default to closed (<br /> versus <br></br>)
+my @DEFAULT_CLOSED = qw( area base br col frame hr img input meta param );
+
+# Tags that get a trailing newline by default
+my @DEFAULT_NEWLINE = qw( html head body div p tr table );
+
 my %ENT_MAP = (
     '&' => '&amp;',
     '<' => '&lt;',
@@ -61,6 +62,45 @@ sub new {
 
 sub _initialize {
     my $self = shift;
+    $self->set_closed( @DEFAULT_CLOSED );
+    $self->set_suffix( "\n", @DEFAULT_NEWLINE );
+}
+
+sub _set_auto {
+    my $self  = shift;
+    my $kind  = shift;
+    my $value = shift;
+
+    if ( defined $value ) {
+        $self->{autotag}->{$kind}->{$_} = $value for @_;
+    }
+    else {
+        delete @{ $self->{autotag}->{$kind} }{@_};
+    }
+}
+
+sub set_open {
+    my $self = shift;
+    $self->_set_auto( 'method', undef, @_ );
+}
+
+sub set_closed {
+    my $self = shift;
+    $self->_set_auto( 'method', 'closed', @_ );
+}
+
+sub set_prefix {
+    my $self   = shift;
+    my $prefix = shift;
+
+    $self->_set_auto( 'prefix', $prefix, @_ );
+}
+
+sub set_suffix {
+    my $self   = shift;
+    my $suffix = shift;
+
+    $self->_set_auto( 'suffix', $suffix, @_ );
 }
 
 sub _str {
@@ -115,6 +155,13 @@ sub _tag_value {
     return '="' . $self->entity_encode( $val ) . '"';
 }
 
+sub validate_tag {
+    my $self = shift;
+    my ( $closed, $name, $attr ) = @_;
+    # Do nothing. Subclass to throw an error for invalid tags
+    return;
+}
+
 sub _tag {
     my $self   = shift;
     my $closed = shift;
@@ -126,6 +173,8 @@ sub _tag {
     # Merge attribute hashes
     my %attr = map { %$_ } @_;
 
+    $self->validate_tag( $closed, $name, \%attr );
+
     # Generate markup
     return "<$name"
       . join( '',
@@ -155,6 +204,10 @@ sub tag {
         }
     }
 
+    # Special case: generate an empty tag pair if there's no content
+    push @out, $self->_tag( 0, $name, \%attr ) . $self->close( $name )
+      unless @out;
+
     return wantarray ? @out : join '', @out;
 }
 
@@ -168,6 +221,16 @@ sub close {
     return "</$name>";
 }
 
+sub auto_tag {
+    my $self   = shift;
+    my $name   = shift;
+    my $method = $self->{autotag}->{method}->{$name} || 'tag';
+    my $pre    = $self->{autotag}->{prefix}->{$name} || '';
+    my $post   = $self->{autotag}->{suffix}->{$name} || '';
+    my @out    = map { "${pre}${_}${post}" } $self->$method( $name, @_ );
+    return wantarray ? @out : join '', @out;
+}
+
 # Minimal JSON encoder
 sub json_encode {
     my $self = shift;
@@ -208,11 +271,11 @@ __END__
 
 =head1 NAME
 
-HTML::Tiny - Tiny HTML generation utilities
+HTML::Tiny - Lightweight, dependency free HTML/XML generation
 
 =head1 VERSION
 
-This document describes HTML::Tiny version 0.4
+This document describes HTML::Tiny version 0.6
 
 =head1 SYNOPSIS
 
@@ -380,10 +443,9 @@ would print
 
     <p><b>Foo</b><b>Bar</b></p>
 
-This behaviour is powerful but can take a little time to master. If
-you imagine '[' and ']' preventing the propagation of the 'tag
-individual items' behaviour you might be close to being able to
-visualise how it works.
+This behaviour is powerful but can take a little time to master. If you
+imagine '[' and ']' preventing the propagation of the 'tag individual
+items' behaviour it might help visualise how it works.
 
 Here's an HTML table (using the tag-name convenience methods - see
 below) that demonstrates it in more detail:
@@ -462,7 +524,52 @@ would print:
 
     <marker lat="57.0" lon="-2" />
 
-=item Methods named after tags
+=item C<< auto_tag( $name, ... ) >>
+
+Calls either C<< tag >> or C<< closed >> based on built in rules
+for the tag. Used internally to implement the tag-named methods.
+
+=back
+
+=head2 Controlling auto_tag
+
+The format of tags generated by C<< auto_tag >> (i.e. tags created by a
+direct call to auto_tag or to one of the tag-named convenience methods)
+may be modified in a number of ways.
+
+Use C<< set_open >> / C<< set_closed >> to control whether the tags
+default to open (<br></br>) or closed (<br />).
+
+Use C<< set_prefix >> / C<< set_suffix >> to inject the specific string
+before / after each generated tag. Typically set_suffix is used to
+control which tags automatically have a newline appended after them.
+
+B<Note:> These settings I<only> affect tags generated by C<auto_tag> and
+the tag-named convenience methods. C<tag>, C<open>, C<close> and
+C<closed> provide a more primitive interface for tag creation which
+bypasses the auto-decoration stage.
+
+=over
+
+=item C<< set_open( $tagname, ... ) >>
+
+Specify a list of tags that will be generated in open form (<tag></tag>).
+
+=item C<< set_closed( $tagname, ... ) >>
+
+Specify a list of tags that will be generated in closed form (<tag />).
+
+=item C<< set_prefix( $prefix, $tagname, ... ) >>
+
+Set a prefix string to be added to the named tags.
+
+=item C<< set_suffix( $suffix, $tagname, ... ) >>
+
+Set a suffix string to be added to the named tags.
+
+=back
+
+=head2 Methods named after tags
 
 In addition to the methods described above C<< HTML::Tiny >> provides
 all of the following HTML generation methods:
@@ -475,32 +582,37 @@ all of the following HTML generation methods:
     small span strong style sub sup table tbody td textarea tfoot th
     thead title tr tt ul var
 
-With the exception of C<< br >>, C<< img >> and C<< input >> they are
-all called in the same way as C<< tag >> above - but with the tag
-name missing.
-
-So the following are equivalent:
-
-    print $h->a({ href => 'http://hexten.net' }, 'Hexten');
+The following methods generate closed XHTML (<br />) tags by default:
 
-and
-
-    print $h->tag('a', { href => 'http://hexten.net' }, 'Hexten');
+    area base br col frame hr img input meta param
 
-C<< br >> and C<< input >> always generate closed XML style tags (in
-fact they call C<< closed >>).
+So:
 
     print $h->br;   # prints <br />
     print $h->input({ name => 'field1' });
                     # prints <input name="field1" />
     print $h->img({ src => 'pic.jpg' });
                     # prints <img src="pic.jpg" />
 
-There's no way to override this default behaviour. If you need finer
-control over whether the tag is open or closed call C<tag>, C<open>,
-C<close> and C<closed> directly.
+This default behaviour can be overridden by calling C<< set_open >> or
+C<< set_closed >> with a list of tag names.
 
-=back
+All other tag methods generate tags to wrap whatever content they
+are passed:
+
+    print $h->p('Hello, World');
+
+prints:
+
+    <p>Hello, World</p>
+
+So the following are equivalent:
+
+    print $h->a({ href => 'http://hexten.net' }, 'Hexten');
+
+and
+
+    print $h->tag('a', { href => 'http://hexten.net' }, 'Hexten');
 
 =head2 Utility Methods
 
@@ -569,6 +681,19 @@ Because JSON is valid Javascript this method can be useful when generating ad-ho
 
 =back
 
+=head2 Subclassing
+
+An C<< HTML::Tiny >> is a blessed hash ref.
+
+=over
+
+=item C<< validate_tag( $closed, $name, $attr ) >>
+
+Subclass C<validate_tag> to throw an error or issue a warning when an
+attempt is made to generate an invalid tag.
+
+=back
+
 =head1 CONFIGURATION AND ENVIRONMENT
 
 HTML::Tiny requires no configuration files or environment variables.