#
# This file is part of Text-CGILike
#
# This software is copyright (c) 2011 by celogeek <me@celogeek.com>.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package Text::CGILike;

# ABSTRACT: Wrapper to create text file using the CGI syntax

use strict;
use warnings;
use Moo;
use Text::Format;
use Carp;

our $VERSION = '0.4';    # VERSION

my $_DEFAULT_CLASS;

has 'columns' => (
    is      => 'rw',
    default => sub {80},
);

sub DEFAULT_CLASS {
    return _self_or_default(shift);
}

sub start_html {
    my ( $self, @texts ) = _self_or_default(@_);
    my $text;
    if ( @texts > 1 ) {
        my %p = @texts;
        $text = $p{-title} || "";
    }
    else {
        ($text) = @texts;
    }
    $self->{_start_html} = $text;
    return $self->hr . $self->_center( "# ", " #", $text ) . $self->hr . "\n";
}

sub end_html {
    my ($self) = _self_or_default(@_);
    my $text = $self->{_start_html} || "END";
    return "\n" . $self->hr . $self->_center( "# ", " #", $text ) . $self->hr;
}

sub meta {

    #no meta in text
    return "";
}

sub h1 {
    my ( $self, $title ) = _self_or_default(@_);
    return $self->_left( "# ", $title ) . $self->br();
}

sub hr {
    my ($self) = _self_or_default(@_);

    return "#" x ( $self->columns ) . "\n";
}

sub br {
    return "\n";
}

sub center {
    my ( $self, $text ) = _self_or_default(@_);
    return $self->_center( '', '', $text );
}

sub ul {
    my ( $self, @li ) = _self_or_default(@_);
    return join( "", grep {defined} @li );
}

sub li {
    my ( $self, $li ) = _self_or_default(@_);
    my $TF
        = Text::Format->new(
        { firstIndent => 0, bodyIndent => 2, columns => $self->columns - 2 }
        );
    return "- " . $TF->format($li);
}

### PRIVATE ###

sub _self_or_default {
    my ( $may_class, @param ) = @_;
    if ( ref $may_class eq __PACKAGE__ ) {
        return ( $may_class, @param );
    }
    else {
        $_DEFAULT_CLASS ||= __PACKAGE__->new;
        return ( $_DEFAULT_CLASS, $may_class, @param );
    }
}

sub _center {
    my ( $self, $left_pad, $right_pad, $text ) = @_;
    $left_pad  = "" unless defined $left_pad;
    $right_pad = "" unless defined $right_pad;

    my $size = $self->columns - length($left_pad) - length($right_pad);
    my $TF   = Text::Format->new(
        { firstIndent => 0, bodyIndent => 0, columns => $size } );

    my @texts = $TF->format($text);
    return join(
        "",
        map {
            sprintf( $left_pad . "%-" . $size . "s" . $right_pad . "\n", $_ )
            }
            map {
            do { chomp; $_ }
            }
            map { $TF->center($_) } @texts
    );

}

sub _left {
    my ( $self, $left_pad, $text ) = @_;
    $left_pad = "" unless defined $left_pad;

    my $size = $self->columns - length($left_pad);
    my $TF   = Text::Format->new(
        { firstIndent => 0, bodyIndent => 0, columns => $size } );

    my @texts = $TF->format($text);
    return $left_pad . join( "" . $left_pad, @texts );

}

sub _expand_arr {
    my ( $tags, @arr ) = @_;
    my @res;
    for my $tag (@arr) {
        if ( substr( $tag, 0, 1 ) eq ':' ) {
            push @res, _expand_arr( $tags, @{ $tags->{$tag} } );
        }
        else {
            push @res, $tag;
        }
    }
    return @res;
}

my %EXPORT_MAP = (
    ':html2' => [
        'h1' .. 'h6', qw/p br hr ol ul li dl dt dd menu code var strong em
            tt u i b blockquote pre img a address cite samp dfn html head
            base body Link nextid title meta kbd start_html end_html
            input Select option comment charset escapeHTML/
    ],
    ':html3' => [
        qw/div table caption th td TR Tr sup Sub strike applet Param nobr
            embed basefont style span layer ilayer font frameset frame script small big Area Map/
    ],
    ':html4' => [
        qw/abbr acronym bdo col colgroup del fieldset iframe
            ins label legend noframes noscript object optgroup Q
            thead tbody tfoot/
    ],
    ':netscape' => [qw/blink fontsize center/],
    ':form'     => [
        qw/textfield textarea filefield password_field hidden checkbox checkbox_group
            submit reset defaults radio_group popup_menu button autoEscape
            scrolling_list image_button start_form end_form startform endform
            start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/
    ],
    ':cgi' => [
        qw/param upload path_info path_translated request_uri url self_url script_name
            cookie Dump
            raw_cookie request_method query_string Accept user_agent remote_host content_type
            remote_addr referer server_name server_software server_port server_protocol virtual_port
            virtual_host remote_ident auth_type http append
            save_parameters restore_parameters param_fetch
            remote_user user_name header redirect import_names put
            Delete Delete_all url_param cgi_error/
    ],
    ':ssl'     => [qw/https/],
    ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars/],
    ':html'    => [qw/:html2 :html3 :html4 :netscape/],
    ':standard' => [qw/:html2 :html3 :html4 :form :cgi/],
    ':push' =>
        [qw/multipart_init multipart_start multipart_end multipart_final/],
    ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal :html4/]
);

sub import {
    my ( $self, $to_import_str ) = @_;
    my @to_import = $to_import_str =~ /(:?\w+)/gx;
    my $caller = caller;

    for my $sym ( _expand_arr( \%EXPORT_MAP, @to_import ) ) {
        unless ( $caller->can($sym) ) {
            my $meth = $self->can($sym) // sub {
                carp "Missing tag : ", $sym;
                return join( '', @_ );
            };

            {
                ## no critic qw(ProhibitNoStrict)
                no strict qw/refs/;
                *{"${caller}::$sym"} = $meth;
                ## use critic
            }
        }
    }

    return;
}

1;

=pod

=head1 NAME

Text::CGILike - Wrapper to create text file using the CGI syntax

=head1 VERSION

version 0.4

=head1 OVERVIEW

CGI is an old module, and now we can create html or text with a simple template.

I have create this module to be able to format my email in html or text by just changing the module I use.

So I don't use template in that case, just a simple '--format=text/html'

=head1 ATTRIBUTES

=head2 DEFAULT_CLASS

To change columns using keywords

    require Text::CGILike;
    Text::CGILike->import(':standard');

    require Term::Size;
    my ($columns) = Term::Size::chars();
    $columns ||= 80;

    my ($TCGI) = Text::CGILike->DEFAULT_CLASS;
    $TCGI->columns($columns);

=head1 METHODS

=head2 DEFAULT_CLASS

This singleton is use if you don't instanciate Text::CGILike

=head2 start_html

Start the document, you can pass headers like CGI here. Only '-title' will be used.

    start_html('my title');
    start_html(-title => 'my title');

=head2 end_html

Finish the document.

    end_html;

=head2 meta

Completly ignore. no meta in brute text

=head2 h1

Create a box that define the bigger text.

    h1('my big text');

=head2 hr

Create a row of '#' (horizontal rule)

=head2 br

break line

=head2 center

center the text, and respect wrap of text

=head2 ul

create list

=head2 li

do list starting with an asterix '*'

=head2 import

Import tags. check L<CGI> for more information.

=head1 SEE ALSO

L<CGI>

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
https://github.com/celogeek/Text-CGILike/issues

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

celogeek <me@celogeek.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by celogeek <me@celogeek.com>.

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

=cut

__END__