config root man

package ADN::HTML;
#
# HTML.pm:
#

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// use Module
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

use strict;
use Exporter;
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Exporting
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

@ISA       = qw( Exporter );
$VERSION   = 1.00;

@EXPORT    = qw( );
@EXPORT_OK = qw( );

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Module
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

sub body {
    my ($conf, $mode) = @_;
    my $body = '';

    my @body = qw( BODY_BASE BODY_TEXT BODY_COLOR BODY_BACK
                   BODY_LINK BODY_VLINK BODY_ALINK );
    foreach (@body) {
        if ($mode && $mode == 1) { $_ = 'CUST_' . $_; }

        next unless ($conf->{$_});
        $body .= $conf->{$_} . " ";
    }

    $body =~ s/ $//;
    return $body;
}

    #// ----------------------------------------------------------
    #// CGI::FastTemplate 出力 (提供ツール仕様)
    #// ----------------------------------------------------------

sub write {
    my ($tml, $conf, $mode) = @_;

    my $prefix = ($mode && $mode == 1) ? 'CUST_' : '';
    my $meta   = $prefix . 'FILE_META';
    my $define = $prefix . 'FILE_DEFINE';
    my $header = $prefix . 'FILE_HEADER';
    my $footer = $prefix . 'FILE_FOOTER';

    $tml->define( meta   => $conf->{$meta},
                  #define => $conf->{$define},
                  header => $conf->{$header},
                  footer => $conf->{$footer}
                );

    ADN::Utility::http_header();

    $tml->parse(META   => "meta");
    $tml->parse(DEFINE => "define");
    $tml->parse(HEADER => "header");
    $tml->parse(FOOTER => "footer");
    $tml->parse(MAIN   => "main");
    $tml->print();
}

    #// ----------------------------------------------------------
    #// CGI::FastTemplate 出力 (汎用)
    #// ----------------------------------------------------------

sub redirect {
    my ($tml, $conf) = @_;

    $tml->define(main => 'redirect.html');
    $tml->assign($conf);

    ADN::Utility::http_header();

    $tml->parse(MAIN => "main");
    $tml->print();

    exit;
}

sub write_adn0 {
    my ($tml, $conf) = @_;

    ADN::Utility::http_header();

    $tml->parse(MAIN => "main");
    $tml->print();
}

sub write_adn {
    my ($tml, $conf) = @_;

    $tml->define( header => $conf->{FILE_HEADER},
                  footer => $conf->{FILE_FOOTER}
                );

    ADN::Utility::http_header();

    $tml->parse(HEADER => "header");
    $tml->parse(FOOTER => "footer");
    $tml->parse(MAIN   => "main");
    $tml->print();
}

    #// ----------------------------------------------------------
    #// HTML タグ生成 (\n は Model 側で付加)
    #// ----------------------------------------------------------

sub mkhtml_spacer {
    my ($space, $path, $alt, $width, $height) = @_;

    my $html = $space . '<img src="' . $path . 'spacer.gif" alt="' . $alt
                      . '" width="' . $width . '" height="' . $height . '" />';
    return $html;
}

sub mkhtml_bold {
    my ($str, $lf) = @_;
    my $line = ($lf) ? "\n" : '';

    my $html = "<b>$str</b>$line";
    return $html;
}

sub mkhtml_link {
    my ($space, $str, $label) = @_;

    my $html = $space . "<a href=\"$str\">$label</a>";
    return $html;
}

sub mkhtml_br {
    my ($space, $str, $lf) = @_;
    my $line = ($lf) ? "\n" : '';

    my $html = $space . "$str<br />$line";
    return $html;
}

sub mkhtml_li {
    my ($space, $str, $css, $lf) = @_;
    my $line = ($lf) ? "\n" : '';

    my $add = '';
    if ($css) { $add = $css; }

    my $html = $space . "<li$css>$str</li>$line";
    return $html;
}

sub mkhtml_td {
    my ($space, $str, $css) = @_;

    my $add = '';
    if ($css) { $add = $css; }

    my $html = $space . "<td$add>$str</td>";
    return $html;
}

sub mkhtml_tr0 {
    my $space = shift;

    my $html = $space . "<tr>";
    return $html;
}

sub mkhtml_tr1 {
    my $space = shift;

    my $html = $space . "</tr>";
    return $html;
}

sub mkhtml_select0 {
    my ($space, $name, $add) = @_;

    unless ($add) { $add = ''; }

    my $html = $space . "<select name=\"$name\"$add>";
    return $html;
}

sub mkhtml_select1 {
    my $space = shift;

    my $html = $space . "</select>";
    return $html;
}

sub mkhtml_option {
    my ($space, $value, $show, $on) = @_;

    my $add = '';
    if ($on == 1) { $add = ' selected="selected"'; }

    my $html = $space . "<option value=\"$value\"$add>$show</option>";
    return $html;
}

sub mkhtml_option0 {
    my ($space, $value, $show, $init) = @_;

    my $html = $space . "<option value=\"$value\"$init>$show</option>";
    return $html;
}

sub mkhtml_check {
    my ($space, $type, $name, $value, $show, $on) = @_;

    my $add = '';
    if ($on == 1) { $add = ' checked="checked"'; }

    my $html = $space . "<input type=\"$type\" name=\"$name\" value=\"$value\"$add /> $show";
    return $html;
}

sub mkhtml_check0 {
    my ($space, $type, $name, $value, $show, $init) = @_;

    my $html = $space . "<input type=\"$type\" name=\"$name\" value=\"$value\"$init /> $show";
    return $html;
}

sub mkhtml_input {
    my ($space, $type, $name, $value, $size) = @_;
    unless ($size) { $size = 20; }

    my $html = $space . "<input type=\"$type\" name=\"$name\" value=\"$value\" size=\"$size\" />";
    return $html;
}

sub mkhtml_tarea {
    my ($space, $cols, $rows, $option, $str, $name) = @_;

    unless ($option) { $option = ''; }
    if ($option ne '') { $option = ' ' . $option; }

    unless ($name) { $name = ''; }
    if ($name ne '') { $name = ' name="' . $name . '"'; }

    my $html = $space . '<textarea' . $name . " cols=\"$cols\" rows=\"$rows\"$option>$str</textarea>";
    return $html;
}

1;