perl_mlb
view release on metacpan or search on metacpan
} else {
$dtd = $XHTML ? XHTML_DTD : $DEFAULT_DTD;
}
$xml_dtd++ if ref($dtd) eq 'ARRAY' && $dtd->[0] =~ /\bXHTML\b/i;
$xml_dtd++ if ref($dtd) eq '' && $dtd =~ /\bXHTML\b/i;
push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd;
if (ref($dtd) && ref($dtd) eq 'ARRAY') {
push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t "$dtd->[1]">));
} else {
push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd">));
}
push(@result,$XHTML ? qq(<html xmlns="http://www.w3.org/1999/xhtml" lang="$lang" xml:lang="$lang"><head><title>$title</title>)
: ($lang ? qq(<html lang="$lang">) : "<html>")
. "<head><title>$title</title>");
if (defined $author) {
push(@result,$XHTML ? "<link rev=\"made\" href=\"mailto:$author\" />"
: "<link rev=\"made\" href=\"mailto:$author\">");
}
if ($base || $xbase || $target) {
my $href = $xbase || $self->url('-path'=>1);
my $t = $target ? qq/ target="$target"/ : '';
push(@result,$XHTML ? qq(<base href="$href"$t />) : qq(<base href="$href"$t>));
}
if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
foreach (keys %$meta) { push(@result,$XHTML ? qq(<meta name="$_" content="$meta->{$_}" />)
: qq(<meta name="$_" content="$meta->{$_}">)); }
}
push(@result,ref($head) ? @$head : $head) if $head;
# handle the infrequently-used -style and -script parameters
push(@result,$self->_style($style)) if defined $style;
push(@result,$self->_script($script)) if defined $script;
# handle -noscript parameter
push(@result,<<END) if $noscript;
<noscript>
$noscript
</noscript>
END
;
my($other) = @other ? " @other" : '';
push(@result,"</head><body$other>");
return join("\n",@result);
}
END_OF_FUNC
### Method: _style
# internal method for generating a CSS style section
####
'_style' => <<'END_OF_FUNC',
sub _style {
my ($self,$style) = @_;
my (@result);
my $type = 'text/css';
my $cdata_start = $XHTML ? "\n<!--/* <![CDATA[ */" : "\n<!-- ";
my $cdata_end = $XHTML ? "\n/* ]]> */-->\n" : " -->\n";
if (ref($style)) {
my($src,$code,$verbatim,$stype,$foo,@other) =
rearrange([SRC,CODE,VERBATIM,TYPE],
'-foo'=>'bar', # trick to allow dash to be omitted
ref($style) eq 'ARRAY' ? @$style : %$style);
$type = $stype if $stype;
my $other = @other ? join ' ',@other : '';
if (ref($src) eq "ARRAY") # Check to see if the $src variable is an array reference
{ # If it is, push a LINK tag for each one
foreach $src (@$src)
{
push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" $other/>)
: qq(<link rel="stylesheet" type="$type" href="$src"$other>)) if $src;
}
}
else
{ # Otherwise, push the single -src, if it exists.
push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" $other/>)
: qq(<link rel="stylesheet" type="$type" href="$src"$other>)
) if $src;
}
if ($verbatim) {
push(@result, "<style type=\"text/css\">\n$verbatim\n</style>");
}
push(@result,style({'type'=>$type},"$cdata_start\n$code\n$cdata_end")) if $code;
} else {
my $src = $style;
push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" $other/>)
: qq(<link rel="stylesheet" type="$type" href="$src"$other>));
}
@result;
}
END_OF_FUNC
'_script' => <<'END_OF_FUNC',
sub _script {
my ($self,$script) = @_;
my (@result);
my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
foreach $script (@scripts) {
my($src,$code,$language);
if (ref($script)) { # script is a hash
($src,$code,$language, $type) =
rearrange([SRC,CODE,LANGUAGE,TYPE],
'-foo'=>'bar', # a trick to allow the '-' to be omitted
ref($script) eq 'ARRAY' ? @$script : %$script);
# User may not have specified language
$language ||= 'JavaScript';
unless (defined $type) {
$type = lc $language;
# strip '1.2' from 'javascript1.2'
$type =~ s/^(\D+).*$/text\/$1/;
}
} else {
($src,$code,$language, $type) = ('',$script,'JavaScript', 'text/javascript');
}
my $comment = '//'; # javascript by default
$comment = '#' if $type=~/perl|tcl/i;
$comment = "'" if $type=~/vbscript/i;
my ($cdata_start,$cdata_end);
if ($XHTML) {
$cdata_start = "$comment<![CDATA[\n";
$cdata_end .= "\n$comment]]>";
} else {
$cdata_start = "\n<!-- Hide script\n";
$cdata_end = $comment;
$cdata_end .= " End script hiding -->\n";
}
my(@satts);
push(@satts,'src'=>$src) if $src;
push(@satts,'language'=>$language) unless defined $type;
push(@satts,'type'=>$type);
$code = "$cdata_start$code$cdata_end" if defined $code;
push(@result,script({@satts},$code || ''));
}
@result;
}
END_OF_FUNC
#### Method: end_html
# End an HTML document.
# Trivial method for completeness. Just returns "</body>"
####
'end_html' => <<'END_OF_FUNC',
sub end_html {
return "</body></html>";
}
END_OF_FUNC
################################
# METHODS USED IN BUILDING FORMS
################################
#### Method: isindex
# Just prints out the isindex tag.
# Parameters:
# $action -> optional URL of script to run
# Returns:
# A string containing a <isindex> tag
'isindex' => <<'END_OF_FUNC',
sub isindex {
my($self,@p) = self_or_default(@_);
my($action,@other) = rearrange([ACTION],@p);
$action = qq/ action="$action"/ if $action;
my($other) = @other ? " @other" : '';
return $XHTML ? "<isindex$action$other />" : "<isindex$action$other>";
}
END_OF_FUNC
#### Method: startform
# Start a form
# Parameters:
# $method -> optional submission method to use (GET or POST)
# $action -> optional URL of script to run
# $enctype ->encoding to use (URL_ENCODED or MULTIPART)
'startform' => <<'END_OF_FUNC',
sub startform {
my($self,@p) = self_or_default(@_);
my($method,$action,$enctype,@other) =
rearrange([METHOD,ACTION,ENCTYPE],@p);
$method = lc($method) || 'post';
$enctype = $enctype || &URL_ENCODED;
unless (defined $action) {
$action = $self->escapeHTML($self->url(-absolute=>1,-path=>1));
if (length($ENV{QUERY_STRING})>0) {
$action .= "?".$self->escapeHTML($ENV{QUERY_STRING},1);
}
}
$action = qq(action="$action");
( run in 3.386 seconds using v1.01-cache-2.11-cpan-bbb979687b5 )