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.06";

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 - The HyperScript like library for Perl.

=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 string generator like as hyperscirpt.

The name of this module contains B,
but this module features isn't same of another language or original implementation.

This module has submodule for some tagset:

HTML5: L

=head1 FUNCTIONS

=head2 h

This function makes html/xml text by perl code.

This function is complex. but it's powerful.

B:

    h($tag, [ \%attrs, $content, ...])

=over

=item C<$tag>

Tag name of element.

This value should be C value.

=item C<\%attrs>

Attributes of element.

Result of attributes sorted by alphabetical according.

You could pass to theses types as attribute values:

=over

=item C

If you passed to this type, attribute value became a C value.

For example:

    h('hr', { id => 'id' }); # => ''

=item C

If you passed to this type, attribute value became a value-less attribute.

For example:

    # `true()` returns Text::HyperScript::Boolean value as !!1 (true)
    h('script', { crossorigin => true }); # => ''

=item C

If you passed to this type, attribute value became a B (alphabetical according),
delimited by whitespace C value,

For example:

    h('hr', { class => [qw( foo bar baz )] });
    # => ''

=item C

This type is a shorthand of prefixed attributes.

For example:

    h('hr', { data => { id => 'foo', flags => [qw(bar baz)], enabled => true } });
    # => ''

=back

=item C<$contnet>

Contents of element.

You could pass to these types:

=over

=item C

Plain text as content.

This value always applied html/xml escape.

=item C

Raw html/xml string as content.

B,
B.

=item C

The ArrayRef of C<$content>.

This type value is flatten of other C<$content> value.

=back

=back

=head2 text

This function returns a html/xml escaped text.

If you use untrusted stirng for display,
you should use this function for wrapping untrusted content.

=head2 raw

This function makes a instance of C.

Instance of C has C method,
that return text with html/xml markup.

The value of C always does not escaped,
you should not use this function for display untrusted content.
Please use C instead of this function.

=head2 true / false

This functions makes instance of C value.

Instance of C has two method like as C and C,
these method returns that value pointed C or C values.

Usage of these functions for make html5 value-less attribute.

For example:

    h('script', { crossorigin => true }, ''); # => ''

=head1 QUESTION AND ANSWERS

=head2 How do I get element of empty content like as `script`?

This case you chould gets element string by pass to empty string.

For example:

    h('script', ''); #

=head2 Why all attributes and attribute values sorted by alphabetical according?

This reason that gets same result on randomized orderd hash keys.

=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]

=head1 SEE ALSO

L

=cut