1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
# Importing this module is equivalent to:
#
# use v5.26;
# use warnings;
# use utf8;
#
# use TUWF ':html5_', 'mkclass';
# use Exporter 'import';
# use Time::HiRes 'time';
# use List::Util 'min', 'max', 'sum';
# use POSIX 'ceil';
#
# use VNDBUtil;
# use VNDB::BBCode;
# use VNDB::Types;
# use VNDB::Config;
# use VNDB::Func 'fmtdate', 'fmtage', 'fmtvote', 'query_encode';
# use VNDB::ExtLinks;
# use VNWeb::Auth;
# use VNWeb::HTML;
# use VNWeb::DB;
# use VNWeb::Validation;
# use VNWeb::Elm;
#
# + A few other handy tools.
#
# WARNING: This should not be used from the above modules.
package VNWeb::Prelude;
use strict;
use warnings;
use feature ':5.26';
use utf8;
use VNWeb::Elm;
use VNWeb::Auth;
use TUWF;
use JSON::XS;
sub import {
my $c = caller;
strict->import;
warnings->import;
feature->import(':5.26');
utf8->import;
die $@ if !eval <<" EOM;";
package $c;
use TUWF ':html5_', 'mkclass';
use Exporter 'import';
use Time::HiRes 'time';
use List::Util 'min', 'max', 'sum';
use POSIX 'ceil';
use VNDBUtil;
use VNDB::BBCode;
use VNDB::Types;
use VNDB::Config;
use VNDB::Func 'fmtdate', 'fmtage', 'fmtvote', 'query_encode';
use VNDB::ExtLinks;
use VNWeb::Auth;
use VNWeb::HTML;
use VNWeb::DB;
use VNWeb::Validation;
use VNWeb::Elm;
1;
EOM;
no strict 'refs';
*{$c.'::RE'} = *RE;
*{$c.'::json_api'} = \&json_api;
*{$c.'::in'} = \∈
}
# Regular expressions for use in path registration
my $num = qr{[1-9][0-9]{0,8}};
my $id = qr{(?<id>$num)};
my $rev = qr{(?:\.(?<rev>$num))};
our %RE = (
num => qr{(?<num>$num)},
uid => qr{u$id},
vid => qr{v$id},
rid => qr{r$id},
sid => qr{s$id},
cid => qr{c$id},
pid => qr{p$id},
iid => qr{i$id},
did => qr{d$id},
tid => qr{t$id},
vrev => qr{v$id$rev?},
rrev => qr{r$id$rev?},
prev => qr{p$id$rev?},
srev => qr{s$id$rev?},
crev => qr{c$id$rev?},
drev => qr{d$id$rev?},
postid => qr{t$id\.(?<num>$num)},
);
# Easy wrapper to create a simple API that accepts JSON data on POST requests.
# The CSRF token and the input data are validated before the subroutine is
# called.
#
# Usage:
#
# json_api '/some/url', {
# username => { maxlength => 10 },
# }, sub {
# my $validated_data = shift;
# };
sub json_api {
my($path, $keys, $sub) = @_;
my $schema = ref $keys eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $keys }) : $keys;
TUWF::post $path => sub {
if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
warn "Invalid CSRF token in request\n";
return elm_CSRF;
}
my $data = tuwf->validate(json => $schema);
if(!$data) {
warn "JSON validation failed\ninput: " . JSON::XS->new->allow_nonref->pretty->canonical->encode(tuwf->reqJSON) . "\nerror: " . JSON::XS->new->encode($data->err) . "\n";
return elm_Invalid;
}
$sub->($data->data);
warn "Non-JSON response to a json_api request, is this intended?\n" if tuwf->resHeader('Content-Type') !~ /^application\/json/;
};
}
# Simple "is this element in the array?" function, using 'eq' to test equality.
# Supports both an @array and \@array.
# Usage:
#
# my $contains_hi = in 'hi', qw/ a b hi c /; # true
#
sub in {
my($q, @a) = @_;
$_ eq $q && return 1 for map ref $_ eq 'ARRAY' ? @$_ : ($_), @a;
0
}
1;
|
