package VNDB::Util::FormHTML;
use strict;
use warnings;
use YAWF ':html';
use Exporter 'import';
use POSIX 'strftime';
our @EXPORT = qw| htmlFormError htmlFormPart htmlForm |;
# form error messages
my %formerr_names = (
alias => 'Aliases',
anime => 'Anime',
desc => 'Description',
description => 'Description',
editsum => 'Edit summary',
gtin => 'JAN/EAN/UPC',
lang => 'Language',
language => 'Language',
length => 'Length',
l_wp => 'Wikipedia link',
l_encubed => 'Novelnews link',
l_renai => 'Renai.us link',
l_vnn => 'V-N.net link',
mail => 'Email',
media => 'Media',
minage => 'Age rating',
msg => 'Message',
name => 'Name',
notes => 'Notes',
original => 'Original',
platforms => 'Platforms',
producers => 'Producers',
released => 'Release date',
boards => 'Boards',
title => 'Title',
type => 'Type',
usrname => 'Username',
usrpass => 'Password',
usrpass2 => 'Password (confirm)',
vn => 'Visual novels',
website => 'Website',
);
my %formerr_exeptions = (
login_failed => 'Invalid username or password',
nomail => 'No user found with that email address',
passmatch => 'Passwords do not match',
usrexists => 'Someone already has this username, please choose something else',
mailexists => 'Someone already registered with that email address',
noimage => 'Image must be in JPEG or PNG format',
toolarge => 'Image is too large, only 500kB allowed',
oneaday => 'You can only register one account from the same IP within 24 hours',
nochanges => 'No changes, please don\'t create an entry that is fully -identical- to another',
doublepost => 'Please wait 30 seconds before making another post',
);
# Displays friendly error message when form validation failed
# Argument is the return value of formValidate, and an optional
# argument indicating whether we should create a special mainbox
# for the errors.
sub htmlFormError {
my($self, $frm, $mainbox) = @_;
return if !$frm->{_err};
if($mainbox) {
div class => 'mainbox';
h1 'Error';
}
div class => 'warning';
h2 'Form could not be sent:';
ul;
for my $e (@{$frm->{_err}}) {
if(!ref $e) {
li $formerr_exeptions{$e};
next;
}
my($field, $type, $rule) = @$e;
$field = $formerr_names{$field}||$field;
li sprintf '%s is a required field!', $field if $type eq 'required';
li sprintf '%s should have at least %d characters', $field, $rule if $type eq 'minlength';
li sprintf '%s: only %d characters allowed', $field, $rule if $type eq 'maxlength';
li sprintf '%s must be one of the following: %s', $field, join ', ', @$rule if $type eq 'enum';
li sprintf 'Wrong board: %s', $rule if $type eq 'wrongboard';
if($type eq 'tagexists') {
li;
lit $rule->{state} != 1 ? qq|Tag $rule->{name} already exists!|
: qq|A tag with the same name has been deleted in the past,|
.qq| please use the discussion board if you want it to be re-added.|;
end;
}
li $rule->[1] if $type eq 'func' || $type eq 'regex';
if($type eq 'template') {
li sprintf
$rule eq 'mail' ? 'Invalid email address' :
$rule eq 'url' ? '%s: Invalid URL' :
$rule eq 'asciiprint' ? '%s may only contain ASCII characters' :
$rule eq 'int' ? '%s: Not a valid number' :
$rule eq 'pname' ? '%s can only contain lowercase alphanumberic characters and a hyphen, and must start with a character' : '',
$field;
}
}
end;
end;
end if $mainbox;
}
# Generates a form part.
# A form part is a arrayref, with the first element being the type of the part,
# and all other elements forming a hash with options specific to that type.
# Type Options
# hidden short, (value)
# input short, name, (width, pre, post)
# passwd short, name
# static content, (label, nolabel)
# check name, short, (value)
# select name, short, options, (width, multi, size)
# radio name, short, options
# text name, short, (rows, cols)
# date name, short
# part title
# TODO: Find a way to write this function in a readable way...
sub htmlFormPart {
my($self, $frm, $fp) = @_;
my($type, %o) = @$fp;
local $_ = $type;
if(/hidden/) {
Tr class => 'hidden';
td colspan => 2;
input type => 'hidden', id => $o{short}, name => $o{short}, value => $o{value}||$frm->{$o{short}}||'';
end;
end;
return
}
if(/part/) {
Tr class => 'newpart';
td colspan => 2, $o{title};
end;
return;
}
if(/check/) {
Tr class => 'newfield';
td class => 'label';
lit ' ';
end;
td class => 'field';
input type => 'checkbox', name => $o{short}, id => $o{short},
value => $o{value}||'true', $frm->{$o{short}} ? ( checked => 'checked' ) : ();
label for => $o{short};
lit $o{name};
end;
end;
end;
return;
}
Tr $o{name}||$o{label} ? (class => 'newfield') : ();
if(!$o{nolabel}) {
td class => 'label';
if($o{short} && $o{name}) {
label for => $o{short};
lit $o{name};
end;
} elsif($o{label}) {
txt $o{label};
} else {
lit ' ';
}
end;
}
td class => 'field', $o{nolabel} ? (colspan => 2) : ();
if(/input/) {
lit $o{pre} if $o{pre};
input type => 'text', class => 'text', name => $o{short}, id => $o{short},
value => $frm->{$o{short}}||'', $o{width} ? (style => "width: $o{width}px") : ();
lit $o{post} if $o{post};
}
if(/passwd/) {
input type => 'password', class => 'text', name => $o{short}, id => $o{short},
value => $frm->{$o{short}}||'';
}
if(/static/) {
lit ref $o{content} eq 'CODE' ? $o{content}->($self, \%o) : $o{content};
}
if(/select/) {
my $l='';
Select name => $o{short}, id => $o{short}, $o{width} ? (style => "width: $o{width}px") : (), $o{multi} ? (multiple => 'multiple', size => $o{size}||5) : ();
for my $p (@{$o{options}}) {
if($p->[2] && $l ne $p->[2]) {
end if $l;
$l = $p->[2];
optgroup label => $l;
}
my $sel = defined $frm->{$o{short}} && ($frm->{$o{short}} eq $p->[0] || ref($frm->{$o{short}}) eq 'ARRAY' && grep $_ eq $p->[0], @{$frm->{$o{short}}});
option value => $p->[0], $sel ? (selected => 'selected') : (), $p->[1];
}
end if $l;
end;
}
if(/radio/) {
for my $p (@{$o{options}}) {
input type => 'radio', id => "$o{short}_$p->[0]", name => $o{short}, value => $p->[0],
defined $frm->{$o{short}} && $frm->{$o{short}} eq $p->[0] ? (checked => 'checked') : ();
label for => "$o{short}_$p->[0]", $p->[1];
}
}
if(/date/) {
input type => 'hidden', id => $o{short}, name => $o{short}, value => $frm->{$o{short}}||'', class => 'dateinput';
}
if(/text/) {
(my $txt = $frm->{$o{short}}||'') =~ s/&/&/;
$txt =~ s/</;
$txt =~ s/>/>/;
textarea name => $o{short}, id => $o{short}, rows => $o{rows}||5, cols => $o{cols}||60;
lit $txt;
end;
}
end;
end;
}
# Generates a form, first argument is a hashref with global options, keys:
# frm => the $frm as returned by formValidate,
# action => The location the form should POST to
# upload => 1/0, adds an enctype.
# editsum => 1/0, adds an edit summary field before the submit button
# The other arguments are a list of subforms in the form
# of (subform-name => [form parts]). Each subform is shown as a
# (JavaScript-powered) tab, and has it's own 'mainbox'. This function
# automatically calls htmlFormError
sub htmlForm {
my($self, $options, @subs) = @_;
form action => '/nospam?'.$options->{action}, method => 'post', 'accept-charset' => 'utf-8',
$options->{upload} ? (enctype => 'multipart/form-data') : ();
$self->htmlFormError($options->{frm}, 1);
# tabs
if(@subs > 2) {
ul class => 'maintabs notfirst', id => 'jt_select';
for (0..$#subs/2) {
(my $short = lc $subs[$_*2]) =~ s/[^\w\d]+/_/g;
li class => 'left';
a href => "#$short", id => "jt_sel_$short", $subs[$_*2];
end;
}
li class => 'left';
a href => '#all', id => 'jt_sel_all', 'All items';
end;
end;
}
# form subs
while(my($name, $parts) = (shift(@subs), shift(@subs))) {
last if !$name || !$parts;
(my $short = lc $name) =~ s/[^\w\d]+/_/g;
div class => 'mainbox', id => 'jt_box_'.$short;
h1 $name;
fieldset;
legend $name;
table class => 'formtable';
$self->htmlFormPart($options->{frm}, $_) for @$parts;
end;
end;
end;
}
# edit summary / submit button
div class => 'mainbox';
fieldset class => 'submit';
if($options->{editsum}) {
(my $txt = $options->{frm}{editsum}||'') =~ s/&/&/;
$txt =~ s/</;
$txt =~ s/>/>/;
h2 'Edit summary';
textarea name => 'editsum', id => 'editsum', rows => 4, cols => 50;
lit $txt;
end;
br;
}
b "Don't forget! -> " if $options->{hitsubmit};
input type => 'submit', value => 'Submit', class => 'submit';
b ' <-' if $options->{hitsubmit};
end;
end;
end;
}
1;