HTML-Tiny-1.05/0000755000076500001200000000000011155001371011716 5ustar andyadminHTML-Tiny-1.05/Changes0000644000076500001200000000376311155001261013220 0ustar andyadminRevision history for HTML-Tiny 0.1 2007-05-30 Initial release. 0.2 2007-05-30 More examples. More documentation. json_encode now uses Scalar::Util::looks_like_number to test for numberness rather than the crappy re-based match. 0.3 2007-05-31 Added empty array ref => empty attribute functionality. 0.4 2007-05-31 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. 0.7 2007-06-03 Removed non-core dependencies. Oops. 0.8 2007-06-03 Speeded up _str. 0.9 2007-06-08 Made everything work with Perl 5.0.4. 0.10 2007-06-09 Reinstated Test::More based tests. 0.11 2007-07-17 Simplicate and add lightness. Removed a load of cruft that nobody will ever use. The various set_ accessors are gone. 0.901 Really must work out what to do with version numbers. 0.902 2007-09-25 Added recursion blocker to json_encode. Thanks to Yuval Kogman for the suggestion. 0.903 2007-09-26 Added new deferred method call syntax. 0.904 2007-10-23 Minor documentation fixes. Fixed (invisible) bug in _set_auto arg handling. 1.00 2007-12-11 url_encode now encodes '~' as '~'. 1.01 2007-12-18 url_decode now handles uppercase hex correctly. 1.02 2008-08-07 Added support for strict HTML output. Fixes #34378. Thanks JUERD and SIGZERO for the report and VRK for the patch that fixes it. 1.03 2008-08-07 Forgot the Changelog for 1.02. Oops. 1.04 2009-03-07 Make link default to being closed. See #40990. 1.05 2009-03-08 Add support for TO_JSON in json_encode. HTML-Tiny-1.05/MANIFEST0000644000076500001200000000051211155001365013050 0ustar andyadminChanges examples/js.pl examples/simple.pl examples/table.pl lib/HTML/Tiny.pm Makefile.PL MANIFEST META.yml README t/000-load.t t/010-simple.t t/020-coverage.t t/030-tags.t t/040-lazy.t t/050-validate_tag.t xt/author/pod-coverage.t xt/author/pod.t SIGNATURE Public-key signature (added by MakeMaker) HTML-Tiny-1.05/META.yml0000644000076500001200000000100511155001365013166 0ustar andyadmin--- #YAML:1.0 name: HTML-Tiny version: 1.05 abstract: Lightweight, dependency free HTML/XML generation author: - Andy Armstrong license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 requires: Test::More: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.48 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 HTML-Tiny-1.05/Makefile.PL0000644000076500001200000000142311154743417013705 0ustar andyadminuse strict; #use warnings; use ExtUtils::MakeMaker; eval 'use ExtUtils::MakeMaker::Coverage'; warn "Optional ExtUtils::MakeMaker::Coverage not available\n" if $@; WriteMakefile( ( MM->can( 'signature_target' ) ? ( SIGN => 1 ) : () ), license( 'perl' ), NAME => 'HTML::Tiny', AUTHOR => 'Andy Armstrong ', VERSION_FROM => 'lib/HTML/Tiny.pm', ABSTRACT_FROM => 'lib/HTML/Tiny.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'HTML-Tiny-*' }, ); sub license { my $lic = shift; local $^W = 0; # Silence warning about non-numeric version return unless $ExtUtils::MakeMaker::VERSION >= '6.31'; return ( LICENSE => $lic ); } HTML-Tiny-1.05/README0000644000076500001200000000052711154527152012613 0ustar andyadminHTML-Tiny version 1.05 INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install DEPENDENCIES None. COPYRIGHT AND LICENCE Copyright (C) 2008, Andy Armstrong This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. HTML-Tiny-1.05/SIGNATURE0000644000076500001200000000333511155001371013206 0ustar andyadminThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 62e87f19330fb069a70c6ca5d9f46a3fd1496fb8 Changes SHA1 2154be00d1d4424cbcf120a4877b821bcfb7a462 MANIFEST SHA1 472edf6015f28af38ab13ad559ff37d38847590b META.yml SHA1 f5916918a7a71bed9bf24bd75b15a7cb68b09a79 Makefile.PL SHA1 d1941d887c402d594cb2b1821596da8e4ee53ed2 README SHA1 e43a62a1d9e28cb27aa0398d04fdb3375525bec1 examples/js.pl SHA1 d4252e83b7c13702f6b63da1d780c11ff85c22dc examples/simple.pl SHA1 75ca2ec3d063d1df8879d1c1eeb3f697e4f20e92 examples/table.pl SHA1 1674fa60eabf9c3950066383a517b6cbe9b90cda lib/HTML/Tiny.pm SHA1 5c74290159e6f8bcbb090a644b3c0281e5d7df62 t/000-load.t SHA1 a2637e357b8ccd9b8d61a8137e034369f3af5a4e t/010-simple.t SHA1 8548114d87260c3a9819f29197063f1044fcae83 t/020-coverage.t SHA1 1353dd0c96cd9571dab11704b294409f4a63857d t/030-tags.t SHA1 668745e9922e535b23a418e4d00d2a224cf2e4bb t/040-lazy.t SHA1 67b4a151629f18d53d24e884da1ed6f6a8e6d114 t/050-validate_tag.t SHA1 34d21850c846fb06ba19fefcab02265760b2dbcd xt/author/pod-coverage.t SHA1 0190346d7072d458c8a10a45c19f86db641dcc48 xt/author/pod.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.9 (Darwin) iEYEARECAAYFAkm0AvUACgkQwoknRJZQnCF9SgCguXdQ3oSPntbttg3f0nNSQ0Ct Ib4AoIoqoJejnoRYU7kERTPgLuLe43Mg =Hy4e -----END PGP SIGNATURE----- HTML-Tiny-1.05/examples/0000755000076500001200000000000011155001364013536 5ustar andyadminHTML-Tiny-1.05/examples/js.pl0000644000076500001200000000072211075713655014526 0ustar andyadmin#!/usr/bin/perl use strict; use warnings; use HTML::Tiny; $| = 1; my $h = HTML::Tiny->new; my $some_perl_data = { score => 45, name => 'Fred', history => [ 32, 37, 41, 45 ] }; # Transfer value to Javascript print $h->script( { type => 'text/javascript' }, "\nvar someVar = " . $h->json_encode( $some_perl_data ) . ";\n " ); # Prints # HTML-Tiny-1.05/examples/simple.pl0000644000076500001200000000107311075713655015403 0ustar andyadmin#!/usr/bin/perl use strict; use warnings; use HTML::Tiny; $| = 1; my $h = HTML::Tiny->new; # Output a simple HTML page print $h->html( [ $h->head( $h->title( 'Sample page' ) ), $h->body( [ $h->h1( { class => 'main' }, 'Sample page' ), $h->p( 'Hello, World', { class => 'detail' }, 'Second para' ), $h->form( { method => 'POST' }, [ $h->input( { type => 'text', name => 'q' } ), $h->br, $h->input( { type => 'submit' } ) ] ) ] ) ] ), "\n"; HTML-Tiny-1.05/examples/table.pl0000644000076500001200000000110711075713655015177 0ustar andyadmin#!/usr/bin/perl use strict; use warnings; use HTML::Tiny; $| = 1; my $h = HTML::Tiny->new; # Output a simple HTML page print $h->table( [ $h->tr( [ $h->th( 'Name', 'Score', 'Position' ) ], [ $h->td( 'Therese', 90, 1 ) ], [ $h->td( 'Chrissie', 85, 2 ) ], [ $h->td( 'Andy', 50, 3 ) ] ) ] ); # Outputs # # # # # #
NameScorePosition
Therese901
Chrissie852
Andy503
HTML-Tiny-1.05/lib/0000755000076500001200000000000011155001364012466 5ustar andyadminHTML-Tiny-1.05/lib/HTML/0000755000076500001200000000000011155001364013232 5ustar andyadminHTML-Tiny-1.05/lib/HTML/Tiny.pm0000644000076500001200000004651111155001166014522 0ustar andyadminpackage HTML::Tiny; use strict; use Carp; =head1 NAME HTML::Tiny - Lightweight, dependency free HTML/XML generation =head1 VERSION This document describes HTML::Tiny version 1.05 =cut use vars qw/$VERSION/; $VERSION = '1.05'; BEGIN { # http://www.w3schools.com/tags/default.asp for my $tag ( 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 ) ) { no strict 'refs'; *$tag = sub { shift->auto_tag( $tag, @_ ) }; } } # Tags that are closed (
versus

) my @DEFAULT_CLOSED = qw( area base br col frame hr img input link meta param ); # Tags that get a trailing newline my @DEFAULT_NEWLINE = qw( html head body div p tr table ); my %DEFAULT_AUTO = ( suffix => '', method => 'tag' ); =head1 SYNOPSIS use HTML::Tiny; my $h = HTML::Tiny->new; # Generate a simple page print $h->html( [ $h->head( $h->title( 'Sample page' ) ), $h->body( [ $h->h1( { class => 'main' }, 'Sample page' ), $h->p( 'Hello, World', { class => 'detail' }, 'Second para' ) ] ) ] ); # Outputs Sample page

Sample page

Hello, World

Second para

=head1 DESCRIPTION C<< HTML::Tiny >> is a simple, dependency free module for generating HTML (and XML). It concentrates on generating syntactically correct XHTML using a simple Perl notation. In addition to the HTML generation functions utility functions are provided to =over =item * encode and decode URL encoded strings =item * entity encode HTML =item * build query strings =item * JSON encode data structures =back =head1 INTERFACE =over =item C<< new >> Create a new C<< HTML::Tiny >>. The constructor takes one optional argument: C<< mode >>. C<< mode >> can be either C<< 'xml' >> (default) or C<< 'html' >>. The difference is that in HTML mode, closed tags will not be closed with a forward slash; instead, closed tags will be returned as single open tags. Example: # Set HTML mode. my $h = HTML::Tiny->new( mode => 'html' ); # The default is XML mode, but this can also be defined explicitly. $h = HTML::Tiny->new( mode => 'xml' ); HTML is a dialect of SGML, and is not XML in any way. "Orphan" open tags or unclosed tags are legal and in fact expected by user agents. In practice, if you want to generate XML or XHTML, supply no arguments. If you want valid HTML, use C<< mode => 'html' >>. =back =cut sub new { my $self = bless {}, shift; my %params = @_; my $mode = $params{'mode'} || 'xml'; croak "Unknown mode: $mode" unless $mode eq 'xml' or $mode eq 'html'; $self->{'_mode'} = $mode; $self->_set_auto( 'method', 'closed', @DEFAULT_CLOSED ); $self->_set_auto( 'suffix', "\n", @DEFAULT_NEWLINE ); return $self; } sub _set_auto { my ( $self, $kind, $value ) = splice @_, 0, 3; $self->{autotag}->{$kind}->{$_} = $value for @_; } =head2 HTML Generation =over =item C<< tag( $name, ... ) >> Returns HTML (or XML) that encloses each of the arguments in the specified tag. For example print $h->tag('p', 'Hello', 'World'); would print

Hello

World

notice that each argument is individually wrapped in the specified tag. To avoid this multiple arguments can be grouped in an anonymous array: print $h->tag('p', ['Hello', 'World']); would print

HelloWorld

The [ and ] can be thought of as grouping a number of arguments. Attributes may be supplied by including an anonymous hash in the argument list: print $h->tag('p', { class => 'normal' }, 'Foo'); would print

Foo

Attribute values will be HTML entity encoded as necessary. Multiple hashes may be supplied in which case they will be merged: print $h->tag('p', { class => 'normal' }, 'Bar', { style => 'color: red' }, 'Bang!' ); would print

Bar

Bang!

Notice that the class="normal" attribute is merged with the style attribute for the second paragraph. To remove an attribute set its value to undef: print $h->tag('p', { class => 'normal' }, 'Bar', { class => undef }, 'Bang!' ); would print

Bar

Bang!

An empty attribute - such as 'checked' in a checkbox can be encoded by passing an empty array reference: print $h->closed( 'input', { type => 'checkbox', checked => [] } ); would print B In a scalar context C<< tag >> returns a string. In a list context it returns an array each element of which corresponds to one of the original arguments: my @html = $h->tag('p', 'this', 'that'); would return @html = ( '

this

', '

that

' ); That means that when you nest calls to tag (or the equivalent HTML aliases - see below) the individual arguments to the inner call will be tagged separately by each enclosing call. In practice this means that print $h->tag('p', $h->tag('b', 'Foo', 'Bar')); would print

Foo

Bar

You can modify this behavior by grouping multiple args in an anonymous array: print $h->tag('p', [ $h->tag('b', 'Foo', 'Bar') ] ); would print

FooBar

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: print $h->table( [ $h->tr( [ $h->th( 'Name', 'Score', 'Position' ) ], [ $h->td( 'Therese', 90, 1 ) ], [ $h->td( 'Chrissie', 85, 2 ) ], [ $h->td( 'Andy', 50, 3 ) ] ) ] ); which would print the unformatted version of:
NameScorePosition
Therese901
Chrissie852
Andy503
Note how you don't need a td() for every cell or a tr() for every row. Notice also how the square brackets around the rows prevent tr() from wrapping each individual cell. Often when generating nested HTML you will find yourself writing corresponding nested calls to HTML generation methods. The table generation code above is an example of this. If you prefer these nested method calls can be deferred like this: print $h->table( [ \'tr', [ \'th', 'Name', 'Score', 'Position' ], [ \'td', 'Therese', 90, 1 ], [ \'td', 'Chrissie', 85, 2 ], [ \'td', 'Andy', 50, 3 ] ] ); In general a nested call like $h->method( args ) may be rewritten like this [ \'method', args ] This allows complex HTML to be expressed as a pure data structure. See the C method for more information. =cut sub tag { my ( $self, $name ) = splice @_, 0, 2; my %attr = (); my @out = (); for my $a ( @_ ) { if ( 'HASH' eq ref $a ) { # Merge into attributes %attr = ( %attr, %$a ); } else { # Generate markup push @out, $self->_tag( 0, $name, \%attr ) . $self->stringify( $a ) . $self->close( $name ); } } # 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; } =item C<< open( $name, ... ) >> Generate an opening HTML or XML tag. For example: print $h->open('marker'); would print Attributes can be provided in the form of anonymous hashes in the same way as for C<< tag >>. For example: print $h->open('marker', { lat => 57.0, lon => -2 }); would print As for C<< tag >> multiple attribute hash references will be merged. The example above could be written: print $h->open('marker', { lat => 57.0 }, { lon => -2 }); =cut sub open { shift->_tag( 0, @_ ) } =item C<< close( $name ) >> Generate a closing HTML or XML tag. For example: print $h->close('marker'); would print: =cut sub close { "" } =item C<< closed( $name, ... ) >> Generate a closed HTML or XML tag. For example print $h->closed('marker'); would print: As for C<< tag >> and C<< open >> attributes may be provided as hash references: print $h->closed('marker', { lat => 57.0 }, { lon => -2 }); would print: =cut sub closed { shift->_tag( 1, @_ ) } =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. =cut sub auto_tag { my ( $self, $name ) = splice @_, 0, 2; my ( $method, $post ) = map { $self->{autotag}->{$_}->{$name} || $DEFAULT_AUTO{$_} } ( 'method', 'suffix' ); my @out = map { $_ . $post } $self->$method( $name, @_ ); return wantarray ? @out : join '', @out; } =item C<< stringify( $obj ) >> Called internally to obtain string representations of values. It also implements the deferred method call notation (mentioned above) so that my $table = $h->table( [ $h->tr( [ $h->th( 'Name', 'Score', 'Position' ) ], [ $h->td( 'Therese', 90, 1 ) ], [ $h->td( 'Chrissie', 85, 2 ) ], [ $h->td( 'Andy', 50, 3 ) ] ) ] ); may also be written like this: my $table = $h->stringify( [ \'table', [ \'tr', [ \'th', 'Name', 'Score', 'Position' ], [ \'td', 'Therese', 90, 1 ], [ \'td', 'Chrissie', 85, 2 ], [ \'td', 'Andy', 50, 3 ] ] ] ); Any reference to an array whose first element is a reference to a scalar [ \'methodname', args ] is executed as a call to the named method with the specified args. =cut sub stringify { my ( $self, $obj ) = @_; if ( ref $obj ) { # Flatten array refs... if ( 'ARRAY' eq ref $obj ) { # Check for deferred method call specified as a scalar # ref... if ( @$obj && 'SCALAR' eq ref $obj->[0] ) { my ( $method, @args ) = @$obj; return join '', $self->$$method( @args ); } return join '', map { $self->stringify( $_ ) } @$obj; } # ...stringify objects... my $str; return $str if eval { $str = $obj->as_string; 1 }; } # ...default stringification return "$obj"; } =back =head2 Methods named after tags In addition to the methods described above C<< HTML::Tiny >> provides all of the following HTML generation methods: 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 The following methods generate closed XHTML (
) tags by default: area base br col frame hr img input meta param So: print $h->br; # prints
print $h->input({ name => 'field1' }); # prints print $h->img({ src => 'pic.jpg' }); # prints All other tag methods generate tags to wrap whatever content they are passed: print $h->p('Hello, World'); prints:

Hello, World

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 =over =item C<< url_encode( $str ) >> URL encode a string. Spaces become '+' and non-alphanumeric characters are encoded as '%' + their hexadecimal character code. $h->url_encode( ' ' ) # returns '+%3chello%3e+' =cut sub url_encode { my $str = $_[0]->stringify( $_[1] ); $str =~ s/([^A-Za-z0-9_~])/$1 eq ' ' ? '+' : sprintf("%%%02x", ord($1))/eg; return $str; } =item C<< url_decode( $str ) >> URL decode a string. Reverses the effect of C<< url_encode >>. $h->url_decode( '+%3chello%3e+' ) # returns ' ' =cut sub url_decode { my $str = $_[1]; $str =~ s/[+]/ /g; $str =~ s/%([0-9a-f]{2})/chr(hex($1))/ieg; return $str; } =item C<< query_encode( $hash_ref ) >> Generate a query string from an anonymous hash of key, value pairs: print $h->query_encode({ a => 1, b => 2 }) would print a=1&b=2 =cut sub query_encode { my $self = shift; my $hash = shift || {}; return join '&', map { join( '=', map { $self->url_encode( $_ ) } ( $_, $hash->{$_} ) ) } sort grep { defined $hash->{$_} } keys %$hash; } =item C<< entity_encode( $str ) >> Encode the characters '<', '>', '&', '\'' and '"' as their HTML entity equivalents: print $h->entity_encode( '<>\'"&' ); would print: <>'"& =cut { my %ENT_MAP = ( '&' => '&', '<' => '<', '>' => '>', '"' => '"', # shorter than " "'" => ''', # HTML does not define ' "\xA" => ' ', "\xD" => ' ', ); my $text_special = qr/([<>&'"])/; my $attr_special = qr/([<>&'"\x0A\x0D])/; # FIXME needs tests sub entity_encode { my $str = $_[0]->stringify( $_[1] ); my $char_rx = $_[2] ? $attr_special : $text_special; $str =~ s/$char_rx/$ENT_MAP{$1}/eg; return $str; } } sub _attr { my ( $self, $attr, $val ) = @_; if ( ref $val ) { return $attr if not $self->_xml_mode; $val = $attr; } my $enc_val = $self->entity_encode( $val, 1 ); return qq{$attr="$enc_val"}; } sub _xml_mode { $_[0]->{'_mode'} eq 'xml' } sub validate_tag { # Do nothing. Subclass to throw an error for invalid tags } sub _tag { my ( $self, $closed, $name ) = splice @_, 0, 3; croak "Attributes must be passed as hash references" if grep { 'HASH' ne ref $_ } @_; # Merge attribute hashes my %attr = map { %$_ } @_; $self->validate_tag( $closed, $name, \%attr ); # Generate markup my $tag = join( ' ', "<$name", map { $self->_attr( $_, $attr{$_} ) } sort grep { defined $attr{$_} } keys %attr ); return $tag . ( $closed && $self->_xml_mode ? ' />' : '>' ); } { my @UNPRINTABLE = qw( z x01 x02 x03 x04 x05 x06 a x08 t n v f r x0e x0f x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x1a e x1c x1d x1e x1f ); sub _json_encode_ref { my ( $self, $seen, $obj ) = @_; my $type = ref $obj; if ( 'HASH' eq $type ) { return '{' . join( ',', map { $self->_json_encode( $seen, $_ ) . ':' . $self->_json_encode( $seen, $obj->{$_} ) } sort keys %$obj ) . '}'; } elsif ( 'ARRAY' eq $type ) { return '[' . join( ',', map { $self->_json_encode( $seen, $_ ) } @$obj ) . ']'; } elsif ( UNIVERSAL::can( $obj, 'can' ) && $obj->can( 'TO_JSON' ) ) { return $self->_json_encode( $seen, $obj->TO_JSON ); } else { croak "Can't json_encode a $type"; } } # Minimal JSON encoder. Provided here for completeness - it's useful # when generating JS. sub _json_encode { my ( $self, $seen, $obj ) = @_; return 'null' unless defined $obj; if ( my $type = ref $obj ) { croak "json_encode can't handle self referential structures" if $seen->{$obj}++; my $rep = $self->_json_encode_ref( $seen, $obj ); delete $seen->{$obj}; return $rep; } return $obj if $obj =~ /^-?\d+(?:[.]\d+)?$/; $obj = $self->stringify( $obj ); $obj =~ s/\\/\\\\/g; $obj =~ s/"/\\"/g; $obj =~ s/ ( [\x00-\x1f] ) / '\\' . $UNPRINTABLE[ ord($1) ] /gex; return qq{"$obj"}; } } =item C<< json_encode >> Encode a data structure in JSON (Javascript) format: print $h->json_encode( { ar => [ 1, 2, 3, { a => 1, b => 2 } ] } ); would print: {"ar":[1,2,3,{"a":1,"b":2}]} Because JSON is valid Javascript this method can be useful when generating ad-hoc Javascript. For example my $some_perl_data = { score => 45, name => 'Fred', history => [ 32, 37, 41, 45 ] }; # Transfer value to Javascript print $h->script( { type => 'text/javascript' }, "\nvar someVar = " . $h->json_encode( $some_perl_data ) . ";\n " ); # Prints # If you attempt to json encode a blessed object C will look for a C method and, if found, use its return value as the structure to be converted in place of the object. An attempt to encode a blessed object that does not implement C will fail. =cut sub json_encode { shift->_json_encode( {}, @_ ) } 1; __END__ =back =head2 Subclassing An C<< HTML::Tiny >> is a blessed hash ref. =over =item C<< validate_tag( $closed, $name, $attr ) >> Subclass C 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. =head1 DEPENDENCIES By design HTML::Tiny has no non-core dependencies. To run the tests you will require Test::More. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Andy Armstrong C<< >> Aristotle Pagaltzis C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2008, Andy Armstrong C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. HTML-Tiny-1.05/t/0000755000076500001200000000000011155001364012163 5ustar andyadminHTML-Tiny-1.05/t/000-load.t0000644000076500001200000000024511075713655013603 0ustar andyadminuse Test::More tests => 2; BEGIN { ok( $] >= 5.004, "Your perl is new enough" ); use_ok( 'HTML::Tiny' ); } diag( "Testing HTML::Tiny $HTML::Tiny::VERSION" ); HTML-Tiny-1.05/t/010-simple.t0000644000076500001200000001120611155000075014135 0ustar andyadminuse strict; use HTML::Tiny; use Test::More tests => 51; ok my $h = HTML::Tiny->new, 'Create succeeded'; ok my $h_html = HTML::Tiny->new( mode => 'html' ), 'Create succeeded (mode HTML)'; common_checks( $h ); common_checks( $h_html, ' (mode HTML)' ); # Differences between the two output modes. is $h->closed( 'br' ), '
', 'simple closed OK'; is $h_html->closed( 'br' ), '
', 'simple closed OK (mode HTML)'; is $h->closed( 'input', { type => 'checkbox', checked => [] } ), '', 'Empty attr OK'; is $h_html->closed( 'input', { type => 'checkbox', checked => [] } ), '', 'Empty attr OK (mode HTML)'; sub common_checks { my $h = shift; my $mode = shift || ''; # No attributes is $h->open( 'b' ), '', 'simple open OK' . $mode; is $h->close( 'b' ), '', 'simple close OK' . $mode; # Tag options is $h->tag( 'b', '' ), '', 'simple tag OK' . $mode; is $h->tag( 'b', 'a', 'b' ), 'ab', 'multi tag OK' . $mode; is $h->tag( 'b', [ 'a', 'b' ] ), 'ab', 'grouped tag OK' . $mode; is $h->tag( 'p', $h->tag( 'b', 'a', 'b' ) ), '

a

b

', 'nested multi tag OK' . $mode; is $h->tag( 'p', $h->tag( 'b', [ 'a', 'b' ] ) ), '

ab

', 'nested grouped tag OK' . $mode; # Attributes is $h->open( 'p', { class => 'normal' } ), '

', 'simple attr OK' . $mode; is $h->open( 'p', { class => 'normal', style => undef } ), '

', 'skip undef attr OK' . $mode; is $h->tag( 'p', { class => 'small' }, 'a', 'b' ), '

a

b

', 'multi w/ attr OK' . $mode; is $h->tag( 'p', { class => 'small' }, 'a', { class => undef }, 'b' ), '

a

b

', 'change attr OK' . $mode; } # Stringification package T::Obj; sub new { bless {}, shift } sub as_string { 'an object' } sub TO_JSON { 'a json object' } package T::Obj2; sub new { bless {}, shift } package main; my $obj = T::Obj->new; is $h->tag( 'p', $obj ), '

an object

', 'stringification OK'; my $obj2 = T::Obj2->new; like $h->tag( 'p', $obj2 ), '/

T::Obj2=.+?

/', 'non as_string OK'; # Only hashes allowed eval { $h->closed( { src => 'spork' }, 'Text here' ); }; like $@, '/Attributes\s+must\s+be\s+passed\s+as\s+hash\s+references/', 'error on non-hash OK'; # URL encoding, decoding is $h->url_encode( ' ' ), '+%3chello%3e+', 'url_encode OK'; is $h->url_decode( '+%3chello%3e+' ), ' ', 'url_decode OK'; is $h->url_encode( '~' ), '~', 'tilde OK'; is $h->url_decode( '%7B%22m%22:%22setValue%22,' . '%22ns%22:%22http://hexten.net/%22,' . '%22n%22:%22Hexten%20Test%22,' . '%22a%22:[%22porridge%22,1]%7D' ), '{"m":"setValue",' . '"ns":"http://hexten.net/",' . '"n":"Hexten Test",' . '"a":["porridge",1]}', 'complex OK'; # Query encoding is $h->query_encode( { a => 1, b => 2 } ), 'a=1&b=2', 'simple query_encode OK'; is $h->query_encode( { a => 1, b => 2, '&' => '' } ), '%26=%3chtml%3e&a=1&b=2', 'escaped query_encode OK'; is $h->query_encode, '', 'empty query_encode OK'; # Entity encoding is $h->entity_encode( '<>\'"&' ), '<>'"&', 'entity_encode OK'; # JSON encoding is $h->json_encode( 1 ), '1', 'json number OK'; is $h->json_encode( "\x00\x01\x02\x03\x04\x05\x06\x07" . "\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f" . "\x10\x11\x12\x13\x14\x15\x16\x17" . "\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f" ), "\"\\z\\x01\\x02\\x03\\x04\\x05\\x06\\a" . "\\x08\\t\\n\\v\\f\\r\\x0e\\x0f" . "\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17" . "\\x18\\x19\\x1a\\e\\x1c\\x1d\\x1e\\x1f\"", 'json escapes OK'; is $h->json_encode( [] ), '[]', 'json empty array OK'; is $h->json_encode( {} ), '{}', 'json empty hash OK'; is $h->json_encode( [ 1, 2, 3 ] ), '[1,2,3]', 'json simple array OK'; is $h->json_encode( { a => 1, b => 2 } ), '{"a":1,"b":2}', 'json simple hash OK'; is $h->json_encode( { ar => [ 1, 2, 3, { a => 1, b => 2 } ] } ), '{"ar":[1,2,3,{"a":1,"b":2}]}', 'json complex OK'; is $h->json_encode( { obj => $obj } ), '{"obj":"a json object"}', 'TO_JSON used OK'; is $h->json_encode( undef ), 'null', 'json null OK'; is $h->json_encode( [undef] ), '[null]', 'json null in array OK'; # Self referential { my $foo = {}; my $bar = [$foo]; $foo->{bar} = $bar; eval { $h->json_encode( $foo ) }; like $@, qr/referential/, 'self-ref error OK'; } # Not self ref - but duplicated { my $foo = { one => 1 }; my $bar = [ $foo, $foo, $foo ]; my $pog = { bar => $bar, foo => $foo }; is $h->json_encode( $pog ), '{"bar":[{"one":1},{"one":1},{"one":1}],"foo":{"one":1}}', 'repeated reference OK'; } HTML-Tiny-1.05/t/020-coverage.t0000644000076500001200000005407611154526252014465 0ustar andyadminuse strict; use Test::More; use HTML::Tiny; # We have 100% coverage without these tests. Consider these extra # security against something getting twisted out of shape. my %schedule; BEGIN { my @common_schedule = ( { "expect_list" => [ "Hexten", "CPAN Search" ], "args" => [ { "href" => "http://hexten.net" }, "Hexten", { "href" => "http://search.cpan.org" }, "CPAN Search" ], "expect_scalar" => "HextenCPAN Search", "method" => "a" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "abbr" }, { "expect_list" => [ "one", "two" ], "args" => [ {}, "one", { x => 1 }, { x => undef }, "two" ], "expect_scalar" => "onetwo", "method" => "acronym" }, { "expect_list" => [ "
onetwo
", "
threefour
" ], "args" => [ [ "one", "two" ], [ "three", "four" ] ], "expect_scalar" => "
onetwo
threefour
", "method" => "address" }, { "expect_list" => ["two"], "args" => [ "one", "two" ], "expect_scalar" => "two", "method" => "auto_tag" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "b" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "bdo" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "big" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "blockquote" }, { "expect_list" => [ "one\n", "two\n" ], "args" => [ "one", "two" ], "expect_scalar" => "one\ntwo\n", "method" => "body" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "button" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "caption" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "cite" }, { "expect_list" => [""], "args" => ["tag"], "expect_scalar" => "", "method" => "close" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "code" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "colgroup" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "dd" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "del" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "dfn" }, { "expect_list" => [ "
one
\n", "
two
\n" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
\n
two
\n", "method" => "div" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "dl" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "dt" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "em" }, { "expect_list" => ["one"], "args" => [ "one", "two" ], "expect_scalar" => "one", "method" => "entity_encode" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "fieldset" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "form" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "frameset" }, { "expect_list" => [ "

one

", "

two

" ], "args" => [ "one", "two" ], "expect_scalar" => "

one

two

", "method" => "h1" }, { "expect_list" => [ "

one

", "

two

" ], "args" => [ "one", "two" ], "expect_scalar" => "

one

two

", "method" => "h2" }, { "expect_list" => [ "

one

", "

two

" ], "args" => [ "one", "two" ], "expect_scalar" => "

one

two

", "method" => "h3" }, { "expect_list" => [ "

one

", "

two

" ], "args" => [ "one", "two" ], "expect_scalar" => "

one

two

", "method" => "h4" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "h5" }, { "expect_list" => [ "
one
", "
two
" ], "args" => [ "one", "two" ], "expect_scalar" => "
one
two
", "method" => "h6" }, { "expect_list" => [ "one\n", "two\n" ], "args" => [ "one", "two" ], "expect_scalar" => "one\ntwo\n", "method" => "head" }, { "expect_list" => [ "one\n", "two\n" ], "args" => [ "one", "two" ], "expect_scalar" => "one\ntwo\n", "method" => "html" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "i" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "iframe" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "ins" }, { "expect_list" => ["[{},{},null,{\"x\":1}]"], "args" => [ [ {}, {}, undef, { x => 1 } ] ], "expect_scalar" => "[{},{},null,{\"x\":1}]", "method" => "json_encode" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "kbd" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "label" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "legend" }, { "expect_list" => [ "
  • one
    • ", "
  • two
    • " ], "args" => [ "one", "two" ], "expect_scalar" => "
  • one
  • two
    • ", "method" => "li" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "map" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "noframes" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "noscript" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "object" }, { "expect_list" => [ "
      one
    ", "
      two
    " ], "args" => [ "one", "two" ], "expect_scalar" => "
      one
      two
    ", "method" => "ol" }, { "args" => ['pie'], "expect_scalar" => "", "method" => "open" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "optgroup" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "option" }, { "expect_list" => [ "

    one

    \n", "

    two

    \n" ], "args" => [ "one", "two" ], "expect_scalar" => "

    one

    \n

    two

    \n", "method" => "p" }, { "expect_list" => [ "
    one
    ", "
    two
    " ], "args" => [ "one", "two" ], "expect_scalar" => "
    one
    two
    ", "method" => "pre" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "q" }, { "args" => [ { spaces => ' ', '&' => '>' } ], "expect_scalar" => "%26=%3e&spaces=+++", "method" => "query_encode" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "samp" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "script" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "select" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "small" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "span" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "strong" }, { "expect_list" => [ "", "" ], "args" => [ "one", "two" ], "expect_scalar" => "", "method" => "style" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "sub" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "sup" }, { "expect_list" => [ "one
    \n", "two
    \n" ], "args" => [ "one", "two" ], "expect_scalar" => "one
    \ntwo
    \n", "method" => "table" }, { "expect_list" => ["two"], "args" => [ "one", "two" ], "expect_scalar" => "two", "method" => "tag" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "tbody" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "td" }, { "expect_list" => [ "", "" ], "args" => [ "one", { cols => 20 }, "two" ], "expect_scalar" => "", "method" => "textarea" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "tfoot" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "th" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "thead" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "title" }, { "expect_list" => [ "one\n", "two\n" ], "args" => [ "one", "two" ], "expect_scalar" => "one\ntwo\n", "method" => "tr" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "tt" }, { "expect_list" => [ "
      one
    ", "
      two
    " ], "args" => [ "one", "two" ], "expect_scalar" => "
      one
      two
    ", "method" => "ul" }, { "expect_list" => [" !"], "args" => ['++%20%21'], "expect_scalar" => " !", "method" => "url_decode" }, { "expect_list" => ['+++%21'], "args" => [' !'], "expect_scalar" => '+++%21', "method" => "url_encode" }, { "expect_list" => [ "one", "two" ], "args" => [ "one", "two" ], "expect_scalar" => "onetwo", "method" => "var" } ); my @schedule_xml = ( @common_schedule, { "args" => [ { name => 'foo' } ], "expect_scalar" => "", "expect_list" => [""], "method" => "area" }, { "args" => [ { href => 'http://hexten.net/' } ], "expect_scalar" => "", "expect_list" => [""], "method" => "base" }, { "args" => [], "expect_scalar" => "
    ", "method" => "br" }, { "args" => ['frob'], "expect_scalar" => "", "method" => "closed" }, { "args" => [], "expect_scalar" => "", "method" => "col" }, { "args" => [], "expect_scalar" => "", "method" => "frame" }, { "args" => [], "expect_scalar" => "
    ", "method" => "hr" }, { # This is correct according to our hash merging rules "args" => [ { src => 'logo.png' }, { src => 'header.png' } ], "expect_list" => [''], "expect_scalar" => '', "method" => "img" }, { "args" => [ { type => 'text' }, { name => 'widget' } ], "expect_scalar" => "", "method" => "input" }, { "args" => [ { href => 'http://foo.net/' } ], "expect_scalar" => '' , "method" => "link" }, { "args" => [], "expect_scalar" => "", "method" => "meta" }, { "args" => [ { value => 1 } ], "expect_scalar" => "", "method" => "param" }, ); my @schedule_html = ( @common_schedule, { "args" => [ { name => 'foo' } ], "expect_scalar" => "", "expect_list" => [""], "method" => "area" }, { "args" => [ { href => 'http://hexten.net/' } ], "expect_scalar" => "", "expect_list" => [""], "method" => "base" }, { "args" => [], "expect_scalar" => "
    ", "method" => "br" }, { "args" => ['frob'], "expect_scalar" => "", "method" => "closed" }, { "args" => [], "expect_scalar" => "", "method" => "col" }, { "args" => [], "expect_scalar" => "", "method" => "frame" }, { "args" => [], "expect_scalar" => "
    ", "method" => "hr" }, { # This is correct according to our hash merging rules "args" => [ { src => 'logo.png' }, { src => 'header.png' } ], "expect_list" => [''], "expect_scalar" => '', "method" => "img" }, { "args" => [ { type => 'text' }, { name => 'widget' } ], "expect_scalar" => "", "method" => "input" }, { "args" => [ { href => 'http://foo.net/' } ], "expect_scalar" => '' , "method" => "link" }, { "args" => [], "expect_scalar" => "", "method" => "meta" }, { "args" => [ { value => 1 } ], "expect_scalar" => "", "method" => "param" }, ); plan tests => ( @schedule_xml + @schedule_html ) * 3 * 4; @schedule{qw(xml html)} = ( \@schedule_xml, \@schedule_html ); } sub apply_test { my ( $h, $test ) = @_; my $method = $test->{method}; can_ok $h, $method; my $got = $h->$method( @{ $test->{args} } ); is_deeply $got, $test->{expect_scalar}, "$method: scalar result matches"; my $expect_list = $test->{expect_list} || [ $test->{expect_scalar} ]; my @got = $h->$method( @{ $test->{args} } ); is_deeply \@got, $expect_list, "$method: list result matches"; } for my $mode ( qw(xml html) ) { my @schedule = @{ $schedule{$mode} }; # Run the tests three times, forwards and backwards to make sure they # don't interfere with each other. { my $h = HTML::Tiny->new( mode => $mode ); apply_test( $h, $_ ) for @schedule, reverse @schedule, @schedule; } # And once again, this time with a fresh HTML::Tiny for each test apply_test( HTML::Tiny->new( mode => $mode ), $_ ) for @schedule; } HTML-Tiny-1.05/t/030-tags.t0000644000076500001200000000402211075713655013622 0ustar andyadminuse strict; use HTML::Tiny; use Test::More tests => 18; ok my $h = HTML::Tiny->new, 'Create succeeded'; ok my $h_html = HTML::Tiny->new( mode => 'html' ), 'Create succeeded (mode HTML)'; common_checks( $h ); common_checks( $h_html, ' (mode HTML)' ); is $h->br, '
    ', 'br OK'; is $h->input( { name => 'myfield', type => 'text' } ), '', 'input OK'; is $h->img( { src => 'pic.jpg' } ), '', 'img OK'; is $h_html->br, '
    ', 'br OK (mode HTML)'; is $h_html->input( { name => 'myfield', type => 'text' } ), '', 'input OK (mode HTML)'; is $h_html->img( { src => 'pic.jpg' } ), '', 'img OK (mode HTML)'; sub common_checks { my $h = shift; my $mode = shift || ''; is $h->p( 'hello, world' ), "

    hello, world

    \n", 'p OK' . $mode; is $h->a( { href => 'http://hexten.net', title => 'Hexten' }, 'Hexten' ), 'Hexten', 'a OK' . $mode; is $h->textarea(), '', 'empty tag OK' . $mode; is $h->html( [ $h->head( $h->title( 'Sample page' ) ), $h->body( [ $h->h1( { class => 'main' }, 'Sample page' ), $h->p( 'Hello, World', { class => 'detail' }, 'Second para' ) ] ) ] ), "Sample page" . "\n

    Sample page

    " . "

    Hello, World

    \n

    Second para

    \n" . "\n\n", 'complex HTML OK' . $mode; is $h->table( [ $h->tr( [ $h->th( 'Name', 'Score', 'Position' ) ], [ $h->td( 'Therese', 90, 1 ) ], [ $h->td( 'Chrissie', 85, 2 ) ], [ $h->td( 'Andy', 50, 3 ) ] ) ] ), "\n" . "\n" . "\n" . "\n" . "
    NameScorePosition
    Therese901
    Chrissie852
    Andy503
    \n", 'table OK' . $mode; } HTML-Tiny-1.05/t/040-lazy.t0000644000076500001200000000460211075713655013650 0ustar andyadminuse strict; use HTML::Tiny; use Test::More tests => 18; ok my $h = HTML::Tiny->new, 'Create succeeded'; ok my $h_html = HTML::Tiny->new( mode => 'html' ), 'Create succeeded (mode HTML)'; common_checks( $h ); common_checks( $h_html, ' (mode HTML)' ); is $h->stringify( [ \'br' ] ), '
    ', 'br OK'; is $h->stringify( [ \'input', { name => 'myfield', type => 'text' } ] ), '', 'input OK'; is $h->stringify( [ \'img', { src => 'pic.jpg' } ] ), '', 'img OK'; is $h_html->stringify( [ \'br' ] ), '
    ', 'br OK (mode HTML)'; is $h_html->stringify( [ \'input', { name => 'myfield', type => 'text' } ] ), '', 'input OK (mode HTML)'; is $h_html->stringify( [ \'img', { src => 'pic.jpg' } ] ), '', 'img OK (mode HTML)'; sub common_checks { my $h = shift; my $mode = shift || ''; is $h->stringify( [ \'p', 'hello, world' ] ), "

    hello, world

    \n", 'p OK' . $mode; is $h->stringify( [ \'a', { href => 'http://hexten.net', title => 'Hexten' }, 'Hexten' ] ), 'Hexten', 'a OK' . $mode; is $h->stringify( [ \'textarea' ] ), '', 'empty tag OK' . $mode; is $h->stringify( [ \'table', [ \'tr', [ \'th', 'Name', 'Score', 'Position' ], [ \'td', 'Therese', 90, 1 ], [ \'td', 'Chrissie', 85, 2 ], [ \'td', 'Andy', 50, 3 ] ] ] ), "\n" . "\n" . "\n" . "\n" . "
    NameScorePosition
    Therese901
    Chrissie852
    Andy503
    \n", 'table OK' . $mode; is $h->stringify( [ \'html', [ [ \'head', [ \'title', 'Sample page' ] ], [ \'body', [ [ \'h1', { class => 'main' }, 'Sample page' ], [ \'p', 'Hello, World', { class => 'detail' }, 'Second para' ] ] ] ] ] ), "Sample page" . "\n

    Sample page

    " . "

    Hello, World

    \n

    Second para

    \n" . "\n\n", 'complex HTML OK' . $mode; } HTML-Tiny-1.05/t/050-validate_tag.t0000644000076500001200000000130411075713655015312 0ustar andyadminuse strict; use HTML::Tiny; use Test::More tests => 4; package My::HTML::Tiny; use vars qw/@ISA/; @ISA = qw/HTML::Tiny/; use HTML::Tiny; sub validate_tag { my $self = shift; my ( $closed, $name, $attr ) = @_; push @{ $self->{valid_args} }, [ $closed, $name, $attr ]; } sub get_validation { shift->{valid_args} } package main; ok my $h = My::HTML::Tiny->new, 'Created OK'; isa_ok $h, 'HTML::Tiny'; is $h->tag( 'p', { class => 'small' }, 'a', { class => undef }, 'b' ), '

    a

    b

    ', 'change attr OK'; my $got = $h->get_validation; my $want = [ [ 0, 'p', { 'class' => 'small' } ], [ 0, 'p', { 'class' => undef } ] ]; is_deeply $got, $want, 'validation hook called OK'; HTML-Tiny-1.05/xt/0000755000076500001200000000000011155001364012353 5ustar andyadminHTML-Tiny-1.05/xt/author/0000755000076500001200000000000011155001364013655 5ustar andyadminHTML-Tiny-1.05/xt/author/pod-coverage.t0000644000076500001200000000153411075713655016436 0ustar andyadmin#!perl -T use Test::More; plan skip_all => 'Need qr{} to work' if $] < 5.005; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; # Won't compile on 5.0.4: qr didn't exist then. eval <<'EOT'; all_pod_coverage_ok( { private => [qr{^_}], trustme => [ qr{^(?:a|abbr|acronym|address|area|b|base|bdo|big|blockquote|body|button)$}, qr{^(?:caption|cite|code|col|colgroup|dd|del|div|dfn|dl|dt|em|fieldset|form)$}, qr{^(?:frame|frameset|h1|h2|h3|h4|h5|h6|head|hr|html|i|iframe|img|ins|kbd|label)$}, qr{^(?:legend|li|link|map|meta|noframes|noscript|object|ol|optgroup|option|p)$}, qr{^(?:param|pre|q|samp|script|select|small|span|strong|style|sub|sup|table)$}, qr{^(?:tbody|td|textarea|tfoot|th|thead|title|tr|tt|ul|var|br|input)$} ] } ); EOT HTML-Tiny-1.05/xt/author/pod.t0000644000076500001200000000021410716111100014611 0ustar andyadmin#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();