CGI-AppBuilder-HTML
view release on metacpan or search on metacpan
# print "PC: $x->{xx}<br>\n";
$ar->{page_def} = $x->{xx};
my $pd = eval $ar->{page_def};
$s->echo_msg("ERR: ($prg) $@",0) if $@;
# $s->disp_param($pd);
# 3. build HTML code
my $f_a = "<a href='%s', target='%s' title='%s'>%s</a>\n";
my $f_img = "<IMG src='%s' border=0 align=middle title='%s' width=60>\n";
my $f_ft = "<font size=%s>%s</font>\n";
my $t1 = ' <td align=left>';
$t1 .= sprintf $f_img, $ar->{logo}, 'Company Logo' if exists $ar->{logo};
$t1 .= sprintf $f_ft, "+1", $ar->{app_name} if exists $ar->{app_name};
$t1 .= sprintf $f_ft, "-2", " [V $ar->{app_version}]" if exists $ar->{app_version};
$t1 .= " </td>\n";
my $t2 = '';
for my $i (0..$#{$pd->{top}}) {
my $v = $pd->{top}[$i];
$t2 .= ($t2) ? '| ' : "[\n";
$t2 .= sprintf $f_a, @$v;
}
$t2 .= "]\n";
$t2 = " <td>$t2 </td>\n";
my $t = "<table align=center width=780>\n";
$t .= "<tr>\n$t1$t2</tr>\n";
$t .= "</table>\n";
print $t;
}
sub disp_header {
my ($s, $q, $ar, $prt, $add_ct) = @_;
my $ck = (exists $ar->{_cookie} && $ar->{_cookie}
&& ref($ar->{_cookie}) =~ /^ARRAY/ ) ? $ar->{_cookie} : [];
# for my $i (0..$#$ck) { my $c = $ck->[$i]; print "Set-Cookie: $c\n"; }
my $f_ma = " <meta name=\"%s\" content=\"%s\" />\n";
my $f_ss = " <link rel=\"stylesheet\" type=\"text/css\" href=\"%s\" />\n";
my $f_sc = "<script src=\"%s\" type=\"text/javascript\"></script>\n";
my $f_s2 = "<script type=\"text/javascript\">\n%s\n</script>\n";
my $f_bs = " <base href=\"%s\" target=\"%s\" />\n";
my $vs = 'cgi_script,home_url,HomeLoc';
my ($cgi,$home_url,$home_loc) = $s->get_params($vs, $ar);
$cgi = $home_url if ! $cgi;
$cgi = $home_loc if ! $cgi;
my $hr = (exists $ar->{html_header}) ? $ar->{html_header} : {};
my $tit = (exists $hr->{-title}) ? $hr->{-title} : "";
my $atr = (exists $hr->{-author}) ? $hr->{-author} : "";
my $tgt = (exists $hr->{-target}) ? $hr->{-target} : "";
my $t = "";
$t .= "Content-Type: text/html\n\n" if $add_ct;
# $t .= '<?xml version="1.0" encoding="iso-8859-1"?>' . "\n";
# $t .= '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"' . "\n";
# $t .= "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n";
# $t .= '<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">';
$t .= "<html>\n<head>\n";
$t .= " <title>$tit</title>\n" if $tit;
$t .= " <link rev=\"made\" href=\"mailto:$atr\" />\n" if $atr;
$t .= sprintf $f_bs, $cgi, $tgt if $tgt;
foreach my $k (keys %{$hr->{meta}}) {
my $v = $hr->{meta}{$k};
$t .= sprintf $f_ma, $k, $v;
}
my $hr1 = $hr->{-style};
$t .= (ref($hr1) =~ /^HASH/ && exists $hr1->{src}) ?
sprintf $f_ss, $hr1->{src} : $hr->{-style};
for my $i (0..$#{$hr->{-script}}) {
my $g = $hr->{-script}[$i]{-language};
if (exists $hr->{-script}[$i]{-src}) {
$t .= sprintf $f_sc, $hr->{-script}[$i]{-src};
} elsif (exists $hr->{-script}[$i]{-code}) {
$t .= sprintf $f_s2, $hr->{-script}[$i]{-code};
}
}
my $f_ot = " <sql_out>%s</sql_out>\n";
if (exists $ar->{_sql_output}) {
$t .= "<!-- SQL_OUTPUT: \n";
for my $i (0..$#{$ar->{_sql_output}}) {
# chomp ($v = $ar->{_sql_output}[$i]);
$t .= $ar->{_sql_output}[$i];
}
$t .= "-->\n";
}
$t .= "</head>\n";
my $ba = (exists $ar->{body_attr}) ? $ar->{body_attr} : {};
if (exists $ar->{body_attr}) {
$t .= "<body";
foreach my $k (keys %{$ar->{body_attr}}) {
$t .= " $k=$ar->{body_attr}{$k}";
}
$t .= ">\n";
}
# else {
# $t .= "<body>\n";
# }
print $t if $prt;
return $t;
}
sub disp_footer {
my ($s, $q, $ar, $prt) = @_;
my $t = "</body>\n</html>\n";
print $t if $prt;
return $t;
}
sub expand_idx {
my ($s, $rr, $vr) = @_;
return if ! @$rr;
my ($hh, $aa) = @$rr;
( run in 1.700 second using v1.01-cache-2.11-cpan-119454b85a5 )