#!/usr/bin/perl
use strict;
use warnings;

sub slurp {
    my ($file) = @_;
    my $fh;
    if (ref $file) {
        $fh = $file;
    } else {
        open $fh, '<', $file or
            die "can't open file to read: $file: $!";
    }
    local $/;
    return <$fh>;
}

sub enen {
    local ($_) = @_;
    if (defined $_) {
        s/&/&amp;/g;
        s/</&lt;/g;
        s/>/&gt;/g;
        s/"/&quot;/g;
    } else {
        $_ = 'NULL';
    }
    return $_;
}

sub tag {
    my ($tag, @attrs) = @_;
    my $single = $tag =~ s{/$}{} ? '/' : '';
    my $attr = '';
    while (my ($name, $value) = splice @attrs, 0, 2) {
        next if !defined $value;
        my $venc = enen($value);
        $attr .= qq{ $name="$venc"};
    }
    return "<$tag$attr$single>";
}

sub wrap {
    my ($tag, @elements) = @_;
    my $attrs = ref $elements[0] ? shift @elements : [];
    my $content = join('', @elements);
    return tag($tag, @$attrs)
        .$content
        .tag("/$tag");
}

our $td_col;
our @td_boxes;
our $td_box;

sub td_box_classes {
    my ($d0, $d1, $col, $span) = @_;
    my @class;
    my $next = $col + $span;
    if (!$td_box) {
        for my $box (@td_boxes) {
            next if !exists $box->{col0};
            if ($box->{col0} == $col) {
                warn "there is a box here\n";
                $td_box = $box;
                push @class, 'left';
                $td_box->{top} = 0;
                if ($d1 eq "\\") {
                    $td_box->{bot} = 1;
                    warn "bot\n";
                }
                last;
            }
        }
    }
    if (!$td_box && $d0 eq '/') {
        $td_box = {col0=>$col, top=>1};
        push @td_boxes, $td_box;
        push @class, 'left';
        warn "adding box\n";
    }
    if ($td_box && $td_box->{top}) {
        push @class, 'top';
        if ($d1 eq "\\") {
            $td_box->{col1} = $next;
            delete $td_box->{top};
        }
    }
    if ($td_box && $td_box->{bot}) {
        push @class, 'bottom';
    }
    if ($td_box && defined $td_box->{col1} && $next == $td_box->{col1}) {
        push @class, 'right';
        if ($td_box->{bot}) {
            if ($d0 eq '/') {
                warn "clearing box";
                %$td_box = ();
            } else {
                die "/ not found or not bot? $td_box->{bot}";
            }
        }
        undef $td_box;
    }
        # TODO error handling?
    return @class;
}

sub td {
    my ($text, $tabs) = @_;
    $text =~ s/^\.//;
    my $colspan = length($tabs);
    my $tag = $text =~ /:$/ ? 'th' : 'td';   # heading?
    $text = "&nbsp;" if $text eq "";
    my ($d0, $d1) = ('', '');
    if ($text =~ s{^/|/$}{}) {
        $d0 = '/';
    }
    if ($text =~ s{^\\|\\$}{}) {
        $d1 = '\\';
    }
    my @class = td_box_classes($d0, $d1, $td_col, $colspan);
    my $class = @class ? "@class" : undef;
    $td_col += $colspan;
    return wrap($tag, [colspan=>$colspan == 1 ? undef : $colspan, class => $class], $text);
}

our %close_for = ( '['=>']', '<'=>'>', '('=>')', '{'=>'}', '_'=>'_' );
our %n_class = (''=>'single required', '?'=>'optional', '*'=>'multi optional', '+'=>'multi required');

sub text2form {
    my ($tmpl, $stash) = @_;

    my $body = "";

    my %need_hidden;

    my @grid;
    my $rows = 0;
    my $cols = 0;

    @td_boxes = ();
    undef $td_box;

    my $max_tabs = 1;

    my @lines = split /\r?\n/, $tmpl;
    for (@lines) {

        # fix whitespace
        s/\r//g; chomp; $_ .= "\t";             # fix whitespace
        (my $line_tabs = $_) =~ s/[^\t]//g;
        $line_tabs = length($line_tabs);
        if ($line_tabs < $max_tabs) {
            $_ .= "\t" x ($max_tabs - $line_tabs);
        } else {
            $max_tabs = $line_tabs;
        }

        # text, encode entities
        s{([^\t][<>&"][^\t])}{enen($1)}ge;

        # input fields: text, select, checkbox
        s%([[<{_])(\S[^\t]*?)(\t*)([]>}_])([?*+]|)([^\t[<{_]*)%
            my ($open, $id, $tabs, $close, $n, $rest) = ($1, $2, $3, $4, $5, $6);
            die "mismatched brackets: $_" if $close ne $close_for{$open};
            my $colspan = length($tabs) + 1;
            if ($open eq '[') {  # text input
                $_ = tag('input/', name=>$id, id=>$id, value=>$stash->{$id}, size=>5*$colspan, class => $n_class{$n});
            } elsif ($open eq '<') {  # select
                $_ = wrap('select', [name=>$id, id=>$id, value=>$stash->{$id}, class => $n_class{$n}]);
                # TODO finish this
            } elsif ($open eq '{') {  # button
                $_ = tag('input/', type=>'submit', name=>$id, id=>$id, value=>$stash->{$id}||$id);
            } elsif ($open eq '_') {  # link
                $_ = wrap('a', [href=>$stash->{$id}||'#'], enen($id));
            }
            $_ .= $rest . $tabs;
            $_;
        %ge;

        # checkbox
        s{\?(\?|\S+?)([?*+]|\b)}{
            my ($id, $n) = ($1, $2);
            if ($id eq '?') {
                '?'.$n
            } else {
                tag('input/', type => 'checkbox', name=>$id, id=>$id, value=>1, checked => $stash->{$id} ? 1 : undef, class => $n_class{$n});
            }
        }ge;

        # TODO textarea

        # data
        s{\$(\$|\d+|\S+)}{
            my ($id) = ($1);
            if ($id eq '$') {
                '$'
            } elsif ($id =~ /^\d/) {
                "\$$id"
            } else {
                $need_hidden{$id} = 1;
                enen($stash->{$id});
            }
        }ge;

        # spacing
        s/  /&nbsp; /g;

        (my $warn = $_) =~ s{\t}{ x\t}g;
        warn "$warn\n";

        # td tags
        $td_col = 0;
        s{(.*?)(\t+)}{td($1, $2)}ge;

        # tr tags
        $_ = wrap('tr', $_);

        $body .= "$_\n";
    }

    # add one row with all the cells to ensure sensible layout
    $body .= wrap('tr', map {wrap('td')} 1..$max_tabs);

    for my $id (sort keys %need_hidden) {
        $body .= tag('input/', type=>'hidden', name=>$id, id=>$id, value=>$stash->{$id})."\n";
    }

    return wrap('form', [name=>'form', method=>'post', action=>'?=[% unique %]'],
        wrap('table', [class=>'layout'], $body));
}

my $tmpl = slurp(\*STDIN);
my $stash = {};

my $html = text2form($tmpl, $stash);

print wrap('html',
    wrap('head',
        tag('link/', rel=>'stylesheet', type=>'text/css', href=>'http://10.3.180.115:3331/static/css/main.css')),
    wrap('body', $html))."\n";