no
warnings
'uninitialized'
;
our
$VERSION
=
'3.20'
;
sub
new {
my
$self
=
shift
;
my
$class
=
ref
(
$self
) ||
$self
;
my
%opt
=
@_
if
@_
> 1;
return
bless
\
%opt
,
$class
;
}
sub
prepare {
my
$self
=
shift
;
my
$form
=
shift
;
my
@html
= ();
my
$hd
=
$form
->header;
if
(
defined
$hd
) {
push
@html
,
$form
->dtd, htmltag(
'head'
);
push
@html
, htmltag(
'title'
) .
$form
->title . htmltag(
'/title'
)
if
$form
->title;
if
(
$form
->{stylesheet} &&
$form
->{stylesheet} ne 1) {
push
@html
, htmltag(
'link'
, {
rel
=>
'stylesheet'
,
type
=>
'text/css'
,
href
=>
$form
->{stylesheet} });
}
}
my
$js
=
$form
->script;
push
@html
,
$js
if
$js
;
my
$font
=
$form
->font;
my
$fcls
=
$font
? htmltag(
'/font'
) :
''
;
if
(
defined
$hd
) {
push
@html
, htmltag(
'/head'
),
$form
->body;
push
@html
,
$font
if
$font
;
push
@html
, htmltag(
'h3'
) .
$form
->title . htmltag(
'/h3'
)
if
$form
->title;
}
push
@html
,
$form
->noscript
if
$js
;
my
(
$stid
,
$keid
);
if
(
my
$fn
=
$form
->name) {
$stid
= tovar(
"${fn}$form->{statename}"
);
$keid
= tovar(
"${fn}$form->{extraname}"
);
}
my
$txt
=
$form
->text;
push
@html
,
$txt
if
$txt
;
push
@html
,
$form
->start;
if
(
my
$st
=
$form
->statetags) {
push
@html
,
$form
->div(
id
=>
$form
->idname(
$form
->statename),
class
=>
$form
->class(
$form
->statename)) .
$st
. htmltag(
'/div'
);
}
if
(
my
$ke
=
$form
->keepextras) {
push
@html
,
$form
->div(
id
=>
$form
->idname(
$form
->extraname),
class
=>
$form
->class(
$form
->extraname)) .
$ke
. htmltag(
'/div'
);
}
my
@unhidden
;
for
my
$field
(
$form
->fieldlist) {
push
(
@unhidden
,
$field
),
next
if
$field
->type ne
'hidden'
;
push
@html
,
$field
->tag;
}
my
$legend
=
$form
->fieldsets;
my
$table
=
$form
->table(
id
=>
$form
->idname(
$form
->bodyname),
class
=>
$form
->class);
my
$tabn
= 1;
push
@html
,
$table
if
$table
;
my
$lastset
;
for
my
$field
(
@unhidden
) {
if
(
my
$set
=
$field
->fieldset) {
if
(
$set
ne
$lastset
) {
if
(
$lastset
) {
push
@html
, htmltag(
'/table'
)
if
$table
;
push
@html
, htmltag(
'/fieldset'
);
push
@html
, htmltag(
'/div'
);
}
elsif
(
$table
) {
if
(
$html
[-1] =~ /^<table\b/) {
pop
@html
;
}
else
{
push
@html
, htmltag(
'/table'
);
}
}
push
@html
,
$form
->div(
id
=>
$form
->idname(
$form
->tabname.
$tabn
++),
class
=>
$form
->class(
$form
->tabname));
(
my
$sn
=
lc
$set
) =~ s/\W+/_/g;
push
@html
, htmltag(
'fieldset'
,
id
=>
$form
->idname(
"_$sn"
),
class
=>
$form
->class(
'_set'
));
push
@html
, htmltag(
'legend'
) . (
$legend
->{
$set
}||
$set
) . htmltag(
'/legend'
)
if
defined
$legend
->{
$set
};
push
@html
,
$form
->table
if
$table
;
$lastset
=
$set
;
}
}
elsif
(
$lastset
) {
push
@html
, htmltag(
'/table'
)
if
$table
;
push
@html
, htmltag(
'/fieldset'
);
push
@html
, htmltag(
'/div'
);
push
@html
,
$table
if
$table
;
undef
$lastset
;
}
debug 2,
"render: attacking normal field '$field'"
;
next
if
$field
->static > 1 && !
$field
->tag_value;
if
(
$table
) {
push
@html
,
$form
->
tr
(
id
=>
$form
->idname(
"_$field"
,
$form
->rowname));
my
$cl
=
$form
->class(
$form
->labelname);
my
$row
=
' '
.
$form
->td(
id
=>
$form
->idname(
"_$field"
,
$form
->labelname),
class
=>
$cl
) .
$font
;
if
(
$field
->invalid) {
$row
.=
$form
->invalid_tag(
$field
->label);
}
elsif
(
$field
->required && !
$field
->static) {
$row
.=
$form
->required_tag(
$field
->label);
}
else
{
$row
.=
$field
->label;
}
$row
.=
$fcls
. htmltag(
'/td'
);
push
@html
,
$row
;
$row
=
''
;
if
(
$field
->invalid) {
$row
.=
' '
.
$field
->message;
}
if
(
$field
->comment) {
$row
.=
' '
.
$field
->comment
unless
$field
->static;
}
$row
=
$field
->tag .
$row
;
$cl
=
$form
->class(
$form
->{fieldname});
push
@html
, (
' '
.
$form
->td(
id
=>
$form
->idname(
"_$field"
,
$form
->fieldname),
class
=>
$cl
) .
$font
.
$row
.
$fcls
. htmltag(
'/td'
));
push
@html
, htmltag(
'/tr'
);
}
else
{
my
$row
=
$font
;
if
(
$field
->invalid) {
$row
.=
$form
->invalid_tag(
$field
->label);
}
elsif
(
$field
->required && !
$field
->static) {
$row
.=
$form
->required_tag(
$field
->label);
}
else
{
$row
.=
$field
->label;
}
$row
.=
$fcls
;
push
@html
,
$row
;
push
@html
,
$field
->tag;
push
@html
,
$field
->message
if
$field
->invalid;
push
@html
,
$field
->comment
if
$field
->comment;
push
@html
,
'<br />'
if
$form
->linebreaks;
}
}
if
(
$lastset
) {
push
@html
, htmltag(
'/table'
)
if
$table
;
push
@html
, htmltag(
'/fieldset'
);
push
@html
, htmltag(
'/div'
);
undef
$table
;
}
my
$buttons
=
$form
->
reset
.
$form
->submit;
if
(
$buttons
) {
my
$row
=
''
;
if
(
$table
) {
my
$c
=
$form
->class(
$form
->{submitname});
my
%a
=
$c
? () : (
align
=>
'center'
);
$row
.=
$form
->
tr
(
id
=>
$form
->idname(
$form
->submitname,
$form
->rowname)) .
"\n "
.
$form
->td(
id
=>
$form
->idname(
$form
->submitname,
$form
->fieldname),
class
=>
$c
,
colspan
=> 2,
%a
) .
$font
;
}
else
{
$row
.=
$form
->div(
id
=>
$form
->idname(
'_controls'
),
class
=>
$form
->class(
'_controls'
));
}
$row
.=
$buttons
;
if
(
$table
) {
$row
.= htmltag(
'/font'
)
if
$font
;
$row
.= htmltag(
'/td'
) .
"\n"
. htmltag(
'/tr'
)
if
$table
;
}
else
{
$row
.= htmltag(
'/div'
);
}
push
@html
,
$row
;
}
push
@html
, htmltag(
'/table'
)
if
$table
;
push
@html
, htmltag(
'/form'
);
push
@html
, htmltag(
'/font'
)
if
$font
&&
defined
$hd
;
push
@html
, htmltag(
'/body'
),htmltag(
'/html'
)
if
defined
$hd
;
return
$self
->{output} =
join
(
"\n"
,
@html
) .
"\n"
}
sub
render {
my
$self
=
shift
;
return
$self
->{output};
}
1;