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
|
#!/usr/bin/perl
package VNDB;
use strict;
use warnings;
use Cwd 'abs_path';
our $ROOT;
BEGIN { ($ROOT = abs_path $0) =~ s{/util/vndb\.pl$}{}; }
use lib $ROOT.'/yawf/lib';
use lib $ROOT.'/lib';
use YAWF ':html';
our(%O, %S);
# load and (if required) regenerate the skins
# NOTE: $S{skins} can be modified in data/config.pl, allowing deletion of skins or forcing only one skin
$S{skins} = readskins();
# load settings from global.pl
require $ROOT.'/data/global.pl';
YAWF::init(
%O,
namespace => 'VNDB',
object_data => \%S,
pre_request_handler => \&reqinit,
error_404_handler => \&handle404,
);
sub reqinit {
my $self = shift;
$self->authInit;
# check for IE6
if($self->reqHeader('User-Agent') && $self->reqHeader('User-Agent') =~ /MSIE 6/
&& !$self->reqCookie('ie-sucks') && $self->reqPath ne 'we-dont-like-ie6') {
# act as if we're opening /we-dont-like-ie6 (ugly hack, until YAWF supports preventing URL handlers from firing)
$ENV{HTTP_REFERER} = $ENV{REQUEST_URI};
$ENV{REQUEST_URI} = '/we-dont-like-ie6';
}
# load some stats (used for about all pageviews, anyway)
$self->{stats} = $self->dbStats;
}
sub handle404 {
my $self = shift;
$self->resStatus(404);
$self->htmlHeader(title => 'Page Not Found');
div class => 'mainbox';
h1 'Page not found';
div class => 'warning';
h2 'Oops!';
p "It seems the page you were looking for does not exist,\n".
"you may want to try using the menu on your left to find what you are looking for.";
end;
end;
$self->htmlFooter;
}
sub readskins {
my %skins; # dirname => skin name
my @regen;
my $lasttemplate = [stat "$ROOT/data/style.css"]->[9];
for my $f (glob "$ROOT/static/s/*") {
next if !-e "$f/conf";
my $n = $1 if $f =~ m{([^/]+)$};
open my $F, '<', "$f/conf" or die $!;
while(<$F>) {
chomp;
s/\r//;
s{[\t\s]*//.*$}{};
next if !/^name[\t\s]+(.+)$/;
$skins{$n} = $1;
last;
}
close $F;
next if !$skins{$n};
my $css = -f "$f/style.css" && [stat "$f/style.css"]->[9] || 0;
my $boxbg = -f "$f/boxbg.png" && [stat "$f/boxbg.png"]->[9] || 0;
my $lastgen = $css < $boxbg ? $css : $boxbg;
push @regen, $n if (!$lastgen && -x $f && (!$css && !$boxbg || $css && -w "$f/style.css" || $boxbg && -w "$f/boxbg.png"))
|| ([stat "$f/conf"]->[9] > $lastgen || $lasttemplate > $lastgen) && -w "$f/style.css" && -w "$f/boxbg.png";
}
system "$ROOT/util/skingen.pl", @regen if @regen;
return \%skins;
}
|