File Coverage

blib/lib/Text/HyperScript.pm

Criterion	Covered	Total	%
statement	87	91	95.6
branch	20	22	90.9
condition	4	6	66.6
subroutine	14	15	93.3
pod	5	5	100.0
total	130	139	93.5

use 5.008001;
use strict;
use warnings;

package Text::HyperScript;

our $VERSION = "0.07";

use Exporter::Lite;

our @EXPORT = qw(raw true false text h);

sub raw {
    my $html = $_[0];
    return bless \$html, 'Text::HyperScript::NodeString';
}

sub true {
    my $true = !!1;
    return bless \$true, 'Text::HyperScript::Boolean';
}

sub false {
    my $false = !!0;
    return bless \$false, 'Text::HyperScript::Boolean';
}

# copied from HTML::Escape::PurePerl
my %escape = (
    '&'  => '&',
    '>'  => '>',
    '<'  => '<',
    q{"} => '"',
    q{'} => ''',
    q{`} => '`',
    '{'  => '{',
    '}'  => '}',
);

sub text {
    my ($src) = @_;
    $src =~ s/([&><"'`{}])/$escape{$1}/ge;
    return $src;
}

sub h {
    my $tag  = text(shift);
    my $html = qq(<${tag});

    my %attrs;
    my @contents;

    for my $data (@_) {
        if ( ref $data eq 'Text::HyperScript::NodeString' ) {
            push @contents, ${$data};
            next;
        }

        if ( ref $data eq 'HASH' ) {
            %attrs = ( %attrs, %{$data} );
            next;
        }

        if ( ref $data eq 'ARRAY' ) {
            push @contents, @{$data};
            next;
        }

        push @contents, text($data);
    }

    for my $prefix ( sort keys %attrs ) {
        my $data = $attrs{$prefix};
        if ( !ref $data ) {
            $html .= q{ } . text($prefix) . q{="} . text($data) . q{"};

            next;
        }

        if ( ref $data eq 'Text::HyperScript::Boolean' && ${$data} ) {
            $html .= " " . text($prefix);

            next;
        }

        if ( ref $data eq 'HASH' ) {
        PREFIX:
            for my $suffix ( sort keys %{$data} ) {
                my $key   = text($prefix) . '-' . text($suffix);
                my $value = $data->{$suffix};

                if ( !ref $value ) {
                    $html .= qq( ${key}=") . text($value) . qq(");

                    next PREFIX;
                }

                if ( ref $value eq 'Text::HyperScript::Boolean' && ${$value} ) {
                    $html .= qq( ${key});

                    next PREFIX;
                }

                if ( ref $value eq 'ARRAY' ) {
                    $html .= qq( ${key}=") . ( join q{ }, map { text($_) } sort @{$value} ) . qq(");

                    next PREFIX;
                }

                $html .= qq( ${key}=") . text($value) . qq(");
            }

            next;
        }

        if ( ref $data eq 'ARRAY' ) {
            $html .= q( ) . text($prefix) . q(=") . ( join q{ }, map { text($_) } sort @{$data} ) . q(");

            next;
        }

        $html .= q{ } . text($prefix) . q(=") . text($data) . q(");
    }

    if ( @contents == 0 ) {
        $html .= " />";
        return bless \$html, 'Text::HyperScript::NodeString';
    }

    $html .= q(>) . join( q{}, @contents ) . qq();
    return bless \$html, 'Text::HyperScript::NodeString';
}

package Text::HyperScript::NodeString;

use overload q("") => \&to_string;

sub new {
    my ( $class, $html ) = @_;
    return bless \$html, $class;
}

sub to_string {
    return ${ $_[0] };
}

package Text::HyperScript::Boolean;

use overload ( q(bool) => \&is_true, q(==) => \&is_true );

sub is_true {
    return !!${ $_[0] };
}

sub is_false {
    return !${ $_[0] };
}

package Text::HyperScript;

1;

=encoding utf-8

=head1 NAME

Text::HyperScript - Let's write html/xml templates as perl code!

=head1 SYNOPSIS

    use feature qw(say);
    use Text::HyperScript qw(h true);

    # tag only
    say h('hr');          # => ''
    say h(script => q{}); # => ''

    # tag with content
    say h('p', 'hi,');    # => 'hi,'
    say h('p', ['hi,']);  # => 'hi,'

    say h('p', 'hi', h('b', ['anonymous']));  # => 'hi,anonymous'
    say h('p', 'foo', ['bar'], 'baz');        # => 'foobarbarz'

    # tag with attributes
    say h('hr', { id => 'foo' });                     # => ''
    say h('hr', { id => 'foo', class => 'bar'});      # => ''
    say h('hr', { class => ['foo', 'bar', 'baz'] });  # => ''

    # tag with prefixed attributes
    say h('hr', { data => { foo => 'bar' } });              # => ''
    say h('hr', { data => { foo => [qw(foo bar baz)] } });  # => ''

    # tag with value-less attribute
    say h('script', { crossorigin => true }, ""); #

=head1 DESCRIPTION

This module is a html/xml tags generator like as hyperscript-ish style.

=head1 FEATURES

=over

=item All html/xml tags write as perl code!

We're able to write html/xml templates witout raw markup.

=item Generates automatic escaped html/xml tags

This module generates automatic escaped html/xml tags by default.

Like this:

    use feature qw(say);

    say h('p', 'hello, alert("XSS!")')
    # => hello, <scrip>alert("XSS!")</script>

=item Includes shorthand for multiple class name and prefixed attributes

This module has shorthand multiple class name, and data or aria and others prefixed attributes.

For examples:

    use feature qw(say);

    say h('h1', { class => [qw/ C B A /] }, 'msg');
    # => msg

    say h('button', { data => { click => '1' } }, 'label');
    # => label

    say h('a', { href => '#', aria => {label => 'label' } }, 'link');
    # => link

=item Enable to generate empty and empty content tags

This module supports empty element and empty content tags.

Like that:

    use feature qw(say);

    say h('hr'); # empty tag
    # =>

    say h('script', '') # empty content tag
    # =>

=back

=head1 TAGSETS

This modules includes shorthand modules for writes tag name as subroutine.

Currently Supported:

HTML5: L

=head1 MODULE FUNCTIONS

=head2 text

This function generates html/xml escaped text.

=head2 raw

This function generates raw text B.

This function B.

=head2 true / false (constants)

This constants use for value-less attributes.

For examples, if we'd like to use C attriute on C tag, </td>
</tr>

<tr>
<td  class="h" >
<a name="278">278</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> we're able to use these contants like this: </td>
</tr>

<tr>
<td  class="h" >
<a name="279">279</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> &nbsp; </td>
</tr>

<tr>
<td  class="h" >
<a name="280">280</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     use feature qw(say); </td>
</tr>

<tr>
<td  class="h" >
<a name="281">281</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> &nbsp; </td>
</tr>

<tr>
<td  class="h" >
<a name="282">282</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     say h('scirpt', { crossorigin => true }, '') </td>
</tr>

<tr>
<td  class="h" >
<a name="283">283</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     # => <scritp crossorigin>

C constants exists for override value-less attributes.
If set C to value-less attribute, that attribute ignored.

=head2 h

This function makes html/xml text from perl code.

The first argument is tag name, and after argument could be passed these values as repeatable.

NOTICE:

The all element attributes sorted by ascendant.

This behaviour is intentional for same result of reproducible output.

=over

=item $text : Str

The text string uses as a element content.

For example:

    use feature qw(say);

    say h('p', 'hi,') # <- 'hi,' is a plain text string
    # => hi,

=item \%attributes : HashRef[Str | ArrayRef[Str] | HashRef[Str] ]

The element attributes could be defined by these styles:

=over

=item \%attributes contains Str

In this case, Str value uses for single value of attribute.

    use feature qw(say);

    say h('p', { id => 'msg' }, 'hi,')
    # => hi,

=item \%attributes contains ArrayRef[Str]

If attribute is ArrayRef[Str], these Str values joined by whitespace and sorted ascendant.

    use feature qw(say);

    say h('p', { class => [qw/ foo bar baz /] }, 'hi,')
    # => hi,

=item HashRef[Str]

If attribute is HashRef[Str], this code means shorthand for prefixed attribute.

    use feature qw(say);

    say h('p', { data => { label => 'foo' } }, 'hi,')
    # =>

=back

=item \@nested : ArrayRef

The all ArrayRef passed to C function is flatten by internally.

This ArrayRef supported all content type of C function.

=back

=head1 LICENSE

Copyright (C) OKAMURA Naoki a.k.a nyarla.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

OKAMURA Naoki a.k.a nyarla: [e-mail]

=cut