# 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 mmHTMLGen;
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(HTMLPrintHead HTMLPrintFrameset HTMLSelect HTMLSelectSet
                 HTMLSelect_text HTMLSelectSetH HTMLSelectSetH_text
                 HTMLSelectOne HTMLListSelect textbox TextBox textboxen 
                 TextBoxEn submitbutton SubmitButton checkbox CheckBox
                 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)]);


}

#           our @EXPORT_OK;

sub _args
{
    my ($args) = @_;
    my $tx = '';
    $args->{'class'} and $tx .= " class=\"$args->{'class'}\"";
    $tx;
}

#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>";
}

sub AHref { print ahref( @_ ); }
# headings


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

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

sub Emi { print emi(@_); }
sub Emb { print emb(@_); }

sub Par { print par(@_); }
sub Br { print br(@_); }
sub Hr { print hr(@_); }



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

    $Text;
}


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

    defined( $Opt{ 'endtag' } ) or $Opt{ 'endtag' } = 1;

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

    print "<html";
    defined( $Opt{ 'lang' } ) and print " lang=\"$Opt{ 'lang' }\"";
    print ">\n<head>\n";

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

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

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

    $Opt{ 'icon' } and 
        print "  <link rel=\"shortcut icon\" href=\"$Opt{'icon'}\">\n";

    $Opt{ 'rawhead' } and print $Opt{'rawhead'};

    $Opt{ 'endtag' } and print "</head>\n";
}

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

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

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

    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 HTMLSelect_text {
    my ($opt, $key, $vals, $texts) = @_;

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

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

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

=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;
}

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

    # $opt should be hash or hash corresponding to $key
    ref( $opt ) eq 'HASH' or die;
    defined( $opt->{$key} ) and $opt = $opt->{ $key };

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

    return $tx;
}

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

    # $opt should be hash or hash corresponding to $key
    ref( $opt ) eq 'HASH' or die;
    defined( $opt->{$key} ) and $opt = $opt->{ $key };
    my $tx = '';

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


sub HTMLSelectOne
{
    my ($opt, $key, $val, $text ) = @_;
    my ($tx) = ('');

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

    $tx .= "<input type='checkbox' name='$key' value='$val' " .
        ( ( $opt and $opt eq $val ) ? ' checked>' : '>' ) . $text;
    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 submitbutton
{
    my ($value, $key, $t) = @_;
    $t = defined( $t ) ? " $t" : '';
    $key = defined( $key ) ?" name='$key'" : '';

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

sub SubmitButton { print submitbutton(@_); }

sub checkbox
{
    return HTMLSelectOne( @_ );
}

sub CheckBox { print checkbox(@_); }

sub textarea
{
    my ($opt, $key, $cols, $rows) = @_;

    # $opt should be hash or value corresponding to $key
    ref( $opt ) eq 'HASH' and $opt = $opt->{ $key };
    $opt = defined( $opt ) ? FormEncode( $opt ) : '';
    my $rrows = int( length( $opt ) / ( $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>$opt</textarea>"; 
}
sub TextArea { print textarea(@_); }


sub textbox
{
    my ($opt, $key, $size, $en ) = @_;

    # $opt should be hash or value corresponding to $key
    ref( $opt ) eq 'HASH' and $opt = $opt->{ $key };
    my $maxlen;
    defined( $size ) and ref( $size ) and ($size, $maxlen) = @{$size};
    $size = defined( $size ) ?" size='$size'" : '';
    $maxlen = defined( $maxlen ) ?" maxlength='$maxlen'" : '';
    $opt = defined( $opt ) ? FormEncode( $opt ) : '';
    defined( $en ) or $en = 1;
    $en = $en ? '' : ' readonly'; 

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

sub TextBox { print textbox(@_); }
sub TextBoxEn { print textboxen(@_); }


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>";
}

sub Span { print span( @_ ); }
1;
