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
|
package VNDB::Func;
use strict;
use warnings;
use TUWF ':html';
use Exporter 'import';
use POSIX 'strftime', 'ceil', 'floor';
use VNDBUtil;
our @EXPORT = (@VNDBUtil::EXPORT, qw| clearfloat cssicon tagscore mt minage fil_parse fil_serialize |);
# three ways to represent the same information
our $fil_escape = '_ !"#$%&\'()*+,-./:;<=>?@[\]^`{}~';
our @fil_escape = split //, $fil_escape;
our %fil_escape = map +($fil_escape[$_], sprintf '%02d', $_), 0..$#fil_escape;
# Clears a float, to make sure boxes always have the correct height
sub clearfloat {
div class => 'clearfloat', '';
}
# Draws a CSS icon, arguments: class, title
sub cssicon {
acronym class => "icons $_[0]", title => $_[1];
lit ' ';
end;
}
# Tag score in html tags, argument: score, users
sub tagscore {
my $s = shift;
div class => 'taglvl', style => sprintf('width: %.0fpx', ($s-floor($s))*10), ' ' if $s < 0 && $s-floor($s) > 0;
for(-3..3) {
div(class => "taglvl taglvl0", sprintf '%.1f', $s), next if !$_;
if($_ < 0) {
if($s > 0 || floor($s) > $_) {
div class => "taglvl taglvl$_", ' ';
} elsif(floor($s) != $_) {
div class => "taglvl taglvl$_ taglvlsel", ' ';
} else {
div class => "taglvl taglvl$_ taglvlsel", style => sprintf('width: %.0fpx', 10-($s-$_)*10), ' ';
}
} else {
if($s < 0 || ceil($s) < $_) {
div class => "taglvl taglvl$_", ' ';
} elsif(ceil($s) != $_) {
div class => "taglvl taglvl$_ taglvlsel", ' ';
} else {
div class => "taglvl taglvl$_ taglvlsel", style => sprintf('width: %.0fpx', 10-($_-$s)*10), ' ';
}
}
}
div class => 'taglvl', style => sprintf('width: %.0fpx', (ceil($s)-$s)*10), ' ' if $s > 0 && ceil($s)-$s > 0;
}
# short wrapper around maketext()
sub mt {
return $TUWF::OBJ->{l10n}->maketext(@_);
}
sub minage {
my($a, $ex) = @_;
my $str = $a == -1 ? mt '_minage_null' : !$a ? mt '_minage_all' : mt '_minage_age', $a;
$ex = !defined($a) ? '' : {
0 => 'CERO A',
12 => 'CERO B',
15 => 'CERO C',
17 => 'CERO D',
18 => 'CERO Z',
}->{$a} if $ex;
return $str if !$ex;
return $str.' '.mt('_minage_example', $ex);
}
# arguments: $filter_string, @allowed_keys
sub fil_parse {
my $str = shift;
my %keys = map +($_,1), @_;
my %r;
for (split /\./, $str) {
next if !/^([a-z0-9_]+)-([a-zA-Z0-9_~]+)$/ || !$keys{$1};
my($f, $v) = ($1, $2);
my @v = split /~/, $v;
s/_([0-9]{2})/$1 > $#fil_escape ? '' : $fil_escape[$1]/eg for(@v);
$r{$f} = @v > 1 ? \@v : $v[0]
}
return \%r;
}
sub fil_serialize {
my $fil = shift;
my $e = qr/([\Q$fil_escape\E])/;
return join '.', map {
my @v = ref $fil->{$_} ? @{$fil->{$_}} : ($fil->{$_});
s/$e/_$fil_escape{$1}/g for(@v);
$_.'-'.join '~', @v
} grep defined($fil->{$_}), keys %$fil;
}
1;
|