diff options
Diffstat (limited to 'lib/VNDB/Util')
-rw-r--r-- | lib/VNDB/Util/FormHTML.pm | 282 | ||||
-rw-r--r-- | lib/VNDB/Util/Misc.pm | 9 | ||||
-rw-r--r-- | lib/VNDB/Util/ValidateTemplates.pm | 96 |
3 files changed, 2 insertions, 385 deletions
diff --git a/lib/VNDB/Util/FormHTML.pm b/lib/VNDB/Util/FormHTML.pm deleted file mode 100644 index 85b7fab9..00000000 --- a/lib/VNDB/Util/FormHTML.pm +++ /dev/null @@ -1,282 +0,0 @@ - -package VNDB::Util::FormHTML; - -use strict; -use warnings; -use TUWF ':html'; -use Exporter 'import'; -use POSIX 'strftime'; -use VNDB::Func; - -our @EXPORT = qw| htmlFormError htmlFormPart htmlForm |; - - -# 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 $e; - next; - } - if(ref $e eq 'SCALAR') { - li; lit $$e; end; - next; - } - my($field, $type, $rule) = @$e; - ($type, $rule) = ('template', 'editsum') if $type eq 'required' && $field eq 'editsum'; - - li "$field is a required field" if $type eq 'required';; - li "$field: minimum number of values is $rule" if $type eq 'mincount'; - li "$field: maximum number of values is $rule" if $type eq 'maxcount'; - li "$field: should have at least $rule characters" if $type eq 'minlength'; - li "$field: only $rule characters allowed" if $type eq 'maxlength'; - li "$field must be one of the following: ".join(', ', @$rule) if $type eq 'enum'; - li $rule->[1] if $type eq 'func' || $type eq 'regex'; - if($type eq 'template') { - li "$field: Invalid number" if $rule eq 'int' || $rule eq 'num' || $rule eq 'uint' || $rule eq 'page' || $rule eq 'id'; - li "$field: Invalid URL" if $rule eq 'weburl'; - li "$field: only ASCII characters allowed" if $rule eq 'ascii'; - li "Invalid email address" if $rule eq 'email'; - li "$field may only contain lowercase alphanumeric characters and a hyphen" if $rule eq 'uname'; - li 'Invalid JAN/UPC/EAN' if $rule eq 'gtin'; - li "$field: Malformed data or invalid input" if $rule eq 'json'; - li 'Invalid release date' if $rule eq 'rdate'; - li 'Invalid Wikidata ID' if $rule eq 'wikidata'; - if($rule eq 'editsum') { - li; lit 'Please read <a href="/d5#4">the guidelines</a> on how to use the edit summary.'; end; - } - } - } - end; - end 'div'; - 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) -# json short, (value) # Same as hidden, but value is passed through json_encode() -# input short, name, (value, allow0, 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 -sub htmlFormPart { - my($self, $frm, $fp) = @_; - my($type, %o) = @$fp; - local $_ = $type; - - if(/hidden/ || /json/) { - Tr class => 'hidden'; - td colspan => 2; - my $val = $o{value}||$frm->{$o{short}}; - input type => 'hidden', id => $o{short}, name => $o{short}, value => /json/ ? json_encode($val||[]) : $val||''; - 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}, tabindex => 10, - value => $o{value}||1, ($frm->{$o{short}}||0) eq ($o{value}||1) ? ( 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}, tabindex => 10, - value => $o{value} // ($o{allow0} ? $frm->{$o{short}}//'' : $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}, tabindex => 10, - 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}, tabindex => 10, - $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], tabindex => 10, - 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/) { - textarea name => $o{short}, id => $o{short}, rows => $o{rows}||5, cols => $o{cols}||60, tabindex => 10, $frm->{$o{short}}||''; - } - end; - end 'tr'; -} - - -# 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 (also used as form id) -# method => post/get -# upload => 1/0, adds an enctype. -# nosubmit => 1/0, hides the submit button -# editsum => 1/0, adds an edit summary field before the submit button -# continue => 2/1/0, replace submit button with continue buttons -# preview => 1/0, add preview button -# noformcode=> 1/0, remove the formcode field -# 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 and adds a 'formcode' field. -sub htmlForm { - my($self, $options, @subs) = @_; - form action => '/nospam?'.$options->{action}, method => $options->{method}||'post', 'accept-charset' => 'utf-8', - $options->{upload} ? (enctype => 'multipart/form-data') : (); - - if(!$options->{noformcode}) { - div class => 'hidden'; - input type => 'hidden', name => 'formcode', value => $self->authGetCode($options->{action}); - end; - } - - $self->htmlFormError($options->{frm}, 1); - - # tabs - if(@subs > 2) { - div class => 'maintabs left'; - ul id => 'jt_select'; - for (0..$#subs/2) { - li class => 'left'; - a href => "#$subs[$_*2]", id => "jt_sel_$subs[$_*2]", $subs[$_*2+1][0]; - end; - } - li class => 'left'; - a href => '#all', id => 'jt_sel_all', 'All items'; - end; - end 'ul'; - end 'div'; - } - - # form subs - while(my($short, $parts) = (shift(@subs), shift(@subs))) { - last if !$short || !$parts; - my $name = shift @$parts; - div class => 'mainbox', id => 'jt_box_'.$short; - h1 $name; - fieldset; - legend $name; - table class => 'formtable'; - $self->htmlFormPart($options->{frm}, $_) for @$parts; - end; - end; - end 'div'; - } - - # db mod / edit summary / submit button - if(!$options->{nosubmit}) { - div class => 'mainbox'; - fieldset class => 'submit'; - if($options->{editsum}) { - # hidden / locked checkbox - if($self->authCan('dbmod')) { - input type => 'checkbox', name => 'ihid', id => 'ihid', value => 1, - tabindex => 10, $options->{frm}{ihid} ? (checked => 'checked') : (); - label for => 'ihid', 'Deleted'; - input type => 'checkbox', name => 'ilock', id => 'ilock', value => 1, - tabindex => 10, $options->{frm}{ilock} ? (checked => 'checked') : (); - label for => 'ilock', 'Locked'; - br; txt 'Note: edit summary of the last edit should indicate the reason for the deletion.'; br; - } - - # edit summary - h2; - txt 'Edit summary'; - b class => 'standout', ' (English please!)'; - end; - textarea name => 'editsum', id => 'editsum', rows => 4, cols => 50, tabindex => 10, $options->{frm}{editsum}||''; - br; - } - if(!$options->{continue}) { - input type => 'submit', value => 'Submit', class => 'submit', tabindex => 10; - } else { - input type => 'submit', value => 'Continue', class => 'submit', tabindex => 10; - input type => 'submit', name => 'continue_ign', value => 'Continue and ignore duplicates', - class => 'submit', style => 'width: auto', tabindex => 10 if $options->{continue} == 2; - } - input type => 'submit', value => 'Preview', id => 'preview', name => 'preview', class => 'submit', tabindex => 10 if $options->{preview}; - end; - end 'div'; - } - - end 'form'; -} - - -1; - diff --git a/lib/VNDB/Util/Misc.pm b/lib/VNDB/Util/Misc.pm index 0423e35b..6342c0c5 100644 --- a/lib/VNDB/Util/Misc.pm +++ b/lib/VNDB/Util/Misc.pm @@ -7,9 +7,8 @@ use Exporter 'import'; use TUWF ':html'; use VNDB::Func; use VNDB::Types; -use VNDB::BBCode; -our @EXPORT = qw|filFetchDB filCompat bbSubstLinks|; +our @EXPORT = qw|filFetchDB filCompat|; our %filfields = ( @@ -90,11 +89,5 @@ sub filCompat { } - -sub bbSubstLinks { - shift; bb_subst_links @_; -} - - 1; diff --git a/lib/VNDB/Util/ValidateTemplates.pm b/lib/VNDB/Util/ValidateTemplates.pm index 7966b319..e28abcb2 100644 --- a/lib/VNDB/Util/ValidateTemplates.pm +++ b/lib/VNDB/Util/ValidateTemplates.pm @@ -4,107 +4,13 @@ package VNDB::Util::ValidateTemplates; use strict; use warnings; -use TUWF 'kv_validate'; -use VNDB::Func 'json_decode'; -use VNDBUtil 'gtintype'; -use Time::Local 'timegm'; TUWF::set( validate_templates => { id => { template => 'uint', max => 1<<40 }, page => { template => 'uint', max => 1000 }, - uname => { regex => qr/^[a-z0-9-]*$/, func => sub { $_[0] !~ /^-*[a-z][0-9]+-*$/ }, minlength => 2, maxlength => 15 }, - gtin => { func => \>intype }, - editsum => { maxlength => 5000, minlength => 2 }, - json => { func => \&json_validate, inherit => ['json_fields','json_maxitems','json_unique','json_sort'], default => [] }, - rdate => { template => 'uint', min => 0, max => 99999999, func => \&rdate_validate, default => 0 }, - wikidata => { func => \&wikidata_id, default => undef }, } ); - -sub wikidata_id { - $_[0] =~ s/^Q//; - $_[0] =~ /^([0-9]{1,9})$/ -} - - -# Figure out if a field is treated as a number in kv_validate(). -sub json_validate_is_num { - my $opts = shift; - return 0 if !$opts->{template}; - return 1 if $opts->{template} eq 'num' || $opts->{template} eq 'int' || $opts->{template} eq 'uint'; - my $t = TUWF::set('validate_templates')->{$opts->{template}}; - return $t && json_validate_is_num($t); -} - - -sub json_validate_sort { - my($sort, $fields, $data) = @_; - - # Figure out which fields need to use number comparison - my %nums; - for my $k (@$sort) { - my $f = (grep $_->{field} eq $k, @$fields)[0]; - $nums{$k}++ if json_validate_is_num($f); - } - - # Sort - return [sort { - for(@$sort) { - my $r = $nums{$_} ? $a->{$_} <=> $b->{$_} : $a->{$_} cmp $b->{$_}; - return $r if $r; - } - 0 - } @$data]; -} - -# Special validation function for simple JSON structures as form fields. It can -# only validate arrays of key-value objects. The key-value objects are then -# validated using kv_validate. -# TODO: json_unique implies json_sort on the same fields? These options tend to be the same. -sub json_validate { - my($val, $opts) = @_; - my $fields = $opts->{json_fields}; - my $maxitems = $opts->{json_maxitems}; - my $unique = $opts->{json_unique}; - my $sort = $opts->{json_sort}; - $unique = [$unique] if $unique && !ref $unique; - $sort = [$sort] if $sort && !ref $sort; - - my $data = eval { json_decode $val }; - $_[0] = $@ ? [] : $data; - return 0 if $@ || ref $data ne 'ARRAY'; - return 0 if defined($maxitems) && @$data > $maxitems; - - my %known_fields = map +($_->{field},1), @$fields; - my %unique; - - for my $i (0..$#$data) { - return 0 if ref $data->[$i] ne 'HASH'; - # Require that all keys are known and have a scalar value. - return 0 if grep !$known_fields{$_} || ref($data->[$i]{$_}), keys %{$data->[$i]}; - $data->[$i] = kv_validate({ field => sub { $data->[$i]{shift()} } }, $TUWF::OBJ->{_TUWF}{validate_templates}, $fields); - return 0 if $data->[$i]{_err}; - return 0 if $unique && $unique{ join '|||', map $data->[$i]{$_}, @$unique }++; - } - - $_[0] = json_validate_sort($sort, $fields, $data) if $sort; - return 1; -} - - -sub rdate_validate { - return 0 if $_[0] ne 0 && $_[0] !~ /^(\d{4})(\d{2})(\d{2})$/; - my($y, $m, $d) = defined $1 ? ($1, $2, $3) : (0,0,0); - - # Normalization ought to be done in JS, but do it here again because we can't trust browsers - ($m, $d) = (0, 0) if $y == 0; - $m = 99 if $y == 9999; - $d = 99 if $m == 99; - $_[0] = $y*10000 + $m*100 + $d; - - return 0 if $y && $d != 99 && !eval { timegm(0, 0, 0, $d, $m-1, $y) }; - return 1; -} +1; |