# HTML pages generation common functions
# (c) Martin Matousek, 15.01.2002
# $id:$

=head1  NAME

mmHTMLGen - Common functions for HTML pages generation

=head1  SYNOPSIS

  use mmHTML;



=head1  DESCRIPTION

=head2 Members

=over 4

=item $scr->{ 'Rows' };

=item $scr->{ 'Cols' };

=back

=head2 Methods

=over 4

=cut

package mmHTMLGen2;
use strict;
use warnings;

BEGIN {
    use Exporter ();

    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.00;                    # version for version checking
    @ISA = qw(Exporter);
    @EXPORT = qw(html_head
                 ahref
                 html_textbox html_textarea
                 html_select  html_select_set_h html_select_one

                 html_select_text html_select_set_h_text
                 html_hidden html_submit

); 

#

#                  HTMLPrintFrameset HTMLSelect HTMLSelectSet
#                  HTMLSelect_text HTMLSelectSetH HTMLSelectSetH_text
#                  HTMLSelectOne HTMLListSelect textbox TextBox textboxen 
#                  html_select html_select_text 
#                  html_button html_checkbox
#                  TextBoxEn submitbutton SubmitButton checkbox CheckBox
#                  textarea html_textarea TextArea
#                  emi Emi emb Emb par Par br Br hr Hr ahref AHref
#                  span Span


    # optionally exported functions
    @EXPORT_OK = qw(emi Emi emb Emb par Par br Br hr Hr ahref AHref);                  
    %EXPORT_TAGS = ( text => [qw(emi emb)],
                     Text => [qw(Emi emb)]);


}

# ------------------------------------------------------------------------------
# PAGE CONTROL

# 'css', 'title', 'author', 'lang', 'charset', 'raw', 'endtag' (default 1)
# 'icon'
sub html_head {
    my %opt = ref( $_[0] ) ? %{$_[0]} : @_;

    defined( $opt{ 'endtag' } ) or $opt{ 'endtag' } = 1;
    # sgml document type
    my $tx = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n" .
        "           \"http://www.w3.org/TR/html4/strict.dtd\">\n";
    
    $tx .= "<html";
    defined( $opt{ 'lang' } ) and $tx .= " lang=\"$opt{ 'lang' }\"";
    $tx .=  ">\n<head>\n";

    # HTTP eaquiv headers
    defined( $opt{'charset'} ) and $tx .= "  <meta http-equiv=\"Content-Type\"".
        " content=\"text/html;charset=$opt{ 'charset' }\">\n";
    defined( $opt{'lang'} ) and $tx .= "  <meta http-equiv=\"Content-Language\"".
        " content=\"$opt{ 'lang' }\">\n";
    defined( $opt{ 'author' } ) and $tx .= "  <meta name=\"Author\"".
        " content=\"$opt{ 'author' }\">\n";

    defined( $opt{ 'title' } ) and $tx .= "  <title>$opt{ 'title' }</title>\n";
    defined( $opt{ 'css' } ) and do {
        if( ref( $opt{ 'css' } ) ) {
            foreach my $k ( keys( %{ $opt{ 'css' } } ) ) {
                $tx .= "  <link rel=\"stylesheet\" ".
                    "type=\"text/css\" title='$k' " .
                    "href=\"$opt{ 'css' }{$k}\">\n";
            }
        } else {
            $tx .= "  <link rel=\"stylesheet\" ".
                "type=\"text/css\" href=\"$opt{ 'css' }\">\n";
        }
    };

    defined( $opt{ 'default-css' } ) and 
        $tx .=  "  <meta http-equiv=\"Default-Style\"".
        " content=\"$opt{ 'default-css' }\">\n";

    $opt{ 'icon' } and 
        $tx .= "  <link rel=\"shortcut icon\" href=\"$opt{'icon'}\">\n";

    $opt{ 'rawhead' } and $tx .= $opt{'rawhead'};

    $opt{ 'endtag' } and $tx .=  "</head>\n";

    return $tx;
}

# ==============================================================================
# FORMS

sub html_hidden {
    my ($val, $key) = @_;

    ref( $val ) eq 'HASH' and $val = $val->{ $key };
    ref( $val ) and die "The value must be a scalar.";

    return defined( $val ) ? "<input type='hidden' name='$key'" .
        " value='" . FormEncode( $val ) . "'" . '>' : '';
}

# ------------------------------------------------------------------------------
# text input

sub html_textbox {
    my ($val, $key, $size, $en) = @_;
    my $maxlen;

    ref( $val ) eq 'HASH' and $val = $val->{ $key };
    ref( $val ) and die "The value must be a scalar.";
    $val = defined( $val ) ? FormEncode( $val ) : '';

    ref( $size ) eq 'ARRAY' and ( $size, $maxlen ) = @{$size};
    $size = defined( $size ) ? " size='$size'" : '';
#    $size = defined( $size ) ?" style='width:${size}em'" : '';
    $maxlen = defined( $maxlen ) ? " maxlength='$maxlen'" : '';
    defined( $en ) or $en = 1;
    $en = ( defined( $en ) && !$en ) ? ' readonly' : ''; 

    return "<input type='text' name='$key' value='$val'$size$en>"; 
}

sub html_textarea {
    my ($val, $key, $cols, $rows) = @_;

    ref( $val ) eq 'HASH' and $val = $val->{ $key };
    ref( $val ) and die "The value must be a scalar.";
    $val = defined( $val ) ? FormEncode( $val ) : '';

    my $rrows = int( length( $val ) / ( $cols || 60 ) );
    $cols = defined( $cols ) ?" cols='$cols'" : '';
    if( defined( $rows ) and ref( $rows ) ) {
        $rows = $rrows < $rows->[0] ? $rows->[0] : 
            ( $rrows > $rows->[1] ? $rows->[1] : $rrows );
    }

    $rows = defined( $rows ) ? " rows='$rows'"  : '';

    return "<textarea  name=\'$key\'$rows$cols>$val</textarea>"; 
}


# ------------------------------------------------------------------------------

# selections

sub html_select {
    my ($opt, $key, $vals, $texts, $separator ) = @_;
    my ($tx) = ('');

    ref( $opt ) eq 'HASH' and $opt = $opt->{ $key };
    $opt or $opt = '';
    $separator or $separator = '';

    for( my $i = 0; $i <= $#{$vals}; ++ $i )
    {
        $i and $tx .= $separator;     # insert separator
        $tx .= "<input type='radio' name='$key' value='$vals->[$i]'";
        defined( $opt ) and $opt eq $vals->[$i] and $tx .= ' checked';
        $tx .= '>' . $texts->[$i];
    }

    return $tx;
}

sub html_select_text {
    my ( $val, $vals, $texts ) = @_;

    defined( $val ) or return '';

    for( my $i = 0; $i <= $#{$vals}; ++ $i ) {
        $val eq $vals->[$i] and return $texts->[$i];
    }

    return '';
}


sub html_select_one {
    my ($val, $key, $selval, $text ) = @_;

    ref( $val ) eq 'HASH' and $val = $val->{ $key };
    ref( $val ) and die "The value must be a scalar.";
    defined( $text ) or $text = '';

    return "<input type='checkbox' name='$key' value='$selval' " .
        ( ( $val and $val eq $selval ) ? ' checked>' : '>' ) . $text;
}

# hash - version
sub html_select_set_h {
    my ($val, $key, $vals, $texts, $separator ) = @_;
    my ($tx) = ('');

    defined( $val ) or $val = {};
    ref( $val ) eq 'HASH' or die "The value must be a hash.";
    defined( $val->{$key} ) and $val = $val->{ $key };
    ref( $val ) eq 'HASH' or die "The value must be a hash.";

    for( my $i = 0; $i <= $#{$vals}; ++ $i ) {
        $i and $tx .= $separator;       # insert separator
        $tx .= "<input type='checkbox' name='${key}->$vals->[$i]' " .
            "value='$vals->[$i]' " .
            ( $val->{$vals->[$i]} ? ' checked>' : '>' ) . $texts->[$i];
    }

    return $tx;
}


sub html_select_set_h_text {
    my ($val, $key, $vals, $texts, $separator) = @_;

    defined( $val ) or $val = {};
    ref( $val ) eq 'HASH' or die "The value must be a hash.";
    defined( $val->{$key} ) and $val = $val->{ $key };
    ref( $val ) eq 'HASH' or die "The value must be a hash.";

    my $tx = '';

    for( my $i = 0; $i <= $#{$vals}; ++ $i )
    {
        $val->{$vals->[$i]} and do {
            $tx and $tx .= $separator;
            $tx .= $texts->[$i];
        };
    }
    return $tx;
}

# ------------------------------------------------------------------------------
# buttons

sub html_submit {
    my ($val, $key, $t) = @_;

    ref( $val ) eq 'HASH' and $val = $val->{ $key };
    ref( $val ) and die "The value must be a scalar.";

    $t = defined( $t ) ? " $t" : '';

    $key = defined( $key ) ? " name='$key'" : '';

    return "<input$t type='submit'$key value='$val'>"; 
}

# ==============================================================================


#tables
sub trow { "<tr>" . $_[0] . "\n" };

# text formatting
sub emi { "<i>" . $_[0] . "</i>" }
sub emb { "<b>" . $_[0] . "</b>" }


# (href, other, body)
sub ahref { 
    my $href = shift;
    my $other = shift || '';

    "<a href=\"$href\" $other>" . join( '', @_ ) . "</a>";
}

# headings


sub par
{
    "\n\n<p>";
}

sub br { "<br>\n"; }
sub hr { "<hr>\n"; }



sub FormEncode #helper
{
    my $Text = $_[ 0 ];
    
    $Text =~ s/\"/&quot;/g;
    $Text =~ s/\'/&apos;/g;

    $Text;
}


sub HTMLPrintFrameset
{
    # sgml document type
#    print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n" .
#        "           \"http://www.w3.org/TR/html4/frameset.dtd\">\n";

    print "<html>";
    printframeset( @_ );
    print "</html>\n";
}

sub printframeset
{
    my $what = shift;
    print "<frameset $what>\n";
    while( $what = shift(@_) )
    {
        if( ref( $what ) ) { printframeset( @{$what} ); }
        else {
            print "<frame name='$what' src='" . shift(@_) . "'>\n";
        }
    }
    print "</frameset>\n";
}

# ==============================================================================

=item HTMLSelect

  $tx = HTMLSelect( \%opt, $key, \@vals, \@texts, $separator );
  $tx = HTMLSelect( $value, $key, \@vals, \@texts, $separator );

Constructs a set of radio-buttons for selecting one value for given C<$key>.
AS< >set of available choices is given in C<\@vals>, corresponding texts in
C<\@texts>. The C<$separator> is textually inserted between particular choices.
If C<$value> (or C<< $opt->{'key'} >>) equals to one of the choices,
corresponding radio-button is selected.  

Constructed HTML code C<$tx> is returned.

=cut






# ==============================================================================

=item HTMLSelectSet

  $tx = HTMLSelectSet( \%opt, $key, \@vals, \@texts, $separator );
  $tx = HTMLSelectSet( \@value, $key, \@vals, \@texts, $separator );

Constructs a set of checkboxes for selecting multiple values for given C<$key>.
AS< >set of available choices is given in C<\@vals>, corresponding texts in
C<\@texts>. The C<$separator> is textually inserted between particular choices.
If C<\@value> (or C<< $opt->{'key'} >>) contains one or more choices,
corresponding checkboxes are selected.  

Constructed HTML code C<$tx> is returned.

=cut

sub HTMLSelectSet
{
    my ($opt, $key, $vals, $texts, $separator ) = @_;
    my ($tx) = ('');

    # $opt should be hash or array corresponding to $key
    ref( $opt ) eq 'HASH' and do { $opt = $opt->{ $key }; $key = '@' . $key; };

    my %sel = ();
    $opt and @sel{@{$opt}} = @{$opt};

    for( my $i = 0; $i <= $#{$vals}; ++ $i )
    {
        $i and $tx .= $separator;       # insert separator
        $tx .= "<input type='checkbox' name='$key' " . "value='$vals->[$i]' " .
            ( $sel{$vals->[$i]} ? ' checked>' : '>' ) . $texts->[$i];
    }

    return $tx;
}



sub HTMLListSelect
{
    my ($opt, $key, $vals, $texts ) = @_;
    my ($tx) = ('');

    # $opt should be hash or value corresponding to $key
    ref( $opt ) eq 'HASH' and $opt = $opt->{ $key };
    
    $tx .= "<select name='$key' size=1>\n";

    for( my $i = 0; $i <= $#{$vals}; ++ $i )
    {
        $tx .= "<option value='$vals->[$i]' label='$texts->[$i]'";
        defined( $opt ) and $opt eq $vals->[$i] and $tx .= ' selected';
        $tx .= ">$texts->[$i]\n";
    }

    return $tx . "</select>";
}

sub html_button {
    my ($value, $key, $text,$t) = @_;

    $t = $t ? " $t" : '';

    ref( $value ) eq 'HASH' and $value = $value->{ $key };
    $value = defined( $value ) ? " value='" . FormEncode( $value ) . "'" : '';

    
    return "<button name='$key'$value$t>$text</button>";
}



sub html_checkbox {
    my ($value, $key, $checked_val) = @_;
    my ($tx) = ('');

    ref( $value ) eq 'HASH' and $value = $value->{ $key };

    return "<input type='checkbox' name='$key' value='$checked_val' " .
        ( ( $value and $value eq $checked_val ) ? ' checked>' : '>' );
}


sub textboxen
{
    my ($opt, $key, $key_en, $val_en, $separator, $size ) = @_;

    # $opt should be hash or value corresponding to $key
    ref( $opt ) eq 'HASH' and $opt = $opt->{ $key };
    $size = defined( $size ) ?" size='$size'" : '';
    defined( $separator ) or $separator = '';

    return "<input type='checkbox' name='$key_en' value='$val_en'" .
        ( defined( $opt ) ? ' checked' : '' ) . ">$separator" .
        "<input type='text' name=\'$key\'$size value='" .
        (defined($opt) ? FormEncode( $opt ) : '' ) . "'>\n";
}

sub span {
    my $tx = shift || '';
    my $t = shift || '';
    "<span $t>$tx</span>";
}

1;
