[[!
use Time::CTime ();
use Algorithm::Diff 'sdiff';
use POSIX ('ceil', 'floor');
my %p; # $X->{page} global page data
my %d; # $X->{page}->{$p} local page data
# redefine _hchar - usually a bad idea, but who cares
sub _hchar {local$_=shift||return'';s/&/&/g;s/</g;s/>/>/g;s/"/"/g;s/\r?\n/
\n/g;return$_;}
sub formatdate {return _hchar(Time::CTime::strftime($_[0],gmtime($_[1]||0)))||'';}
sub txt {local$_=shift||return'';s/&/&/g;s/</g;s/>/>/g;return$_;}
sub art2str {my$r='';$r.=($r?' & ':'').$_->{name}foreach (@{$_[0]->{artists}});return $_[1]?$r:_hchar($r);}
sub calctime {my$r=shift;return'0:00:00'if!$r;my$x=sprintf'%d:%02d:%02d',int($r/3600),int(($r%3600)/60),($r%3600)%60;return $x;}
sub shorten {local$_=shift||return'';return length>$_[0]?substr($_,0,$_[0]-3).'...':$_};
# Date string format: yyyy-mm-dd
# y = 0 -> Unknown
# y = 9999 -> TBA (To Be Announced)
# m = 0 -> Month + day unknown, year known
# d = 0 -> Day unknown, month + year known
sub datestr {
my $d = $_[0]||'00000000';
my @d = map { int } $1, $2, $3 if $d =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/;
return 'unknown' if $d[0] == 0;
my $r = sprintf !$d[1] ? '%04d' : !$d[2] ? '%04d-%02d' : '%04d-%02d-%02d', @d;
my $b = $r gt Time::CTime::strftime("%Y-%m-%d", gmtime());
$r = 'TBA' if $d[0] == 9999;
return ($b?'':'').$r.($b?'':'');
}
sub mediastr {
return join(', ', map {
$_->{medium} =~ /^(cd|dvd|gdr|blr)$/
? sprintf('%d %s%s', $_->{qty}, $VNDB::MED->{$_->{medium}}, $_->{qty}>1?'s':'')
: $VNDB::MED->{$_->{medium}}
} @{$_[0]});
}
sub sortbut { # url, col
my $r=' '; my $u = _hchar($_[0]);
$u .= $u =~ /\?/ ? ';' : '?';
for ('a', 'd') {
my $chr = $_ eq 'd' ? "\x{25BE}" : "\x{25B4}";
$r .= $d{order}[0] eq $_[1] && $d{order}[1] eq $_ ? $chr :
sprintf '%s', $u, $_[1], $_, $chr;
}
return $r;
}
sub pagebut { # url
my @br; my $ng = $_[0] =~ /\?/ ? ';' : '?';
push @br, sprintf '<- previous', $_[0].($d{page}-2 ? $ng.'p='.($d{page}-1) : '') if $d{page} > 1;
push @br, sprintf 'next ->', $_[0].$ng.'p='.($d{page}+1) if $d{npage};
return $#br >= 0 ? ('
( '.join(' | ', @br).' )
') : ''; } sub wraplong { # text, margin local $_ = $_[0]; my $m = $_[1]/2; s/([^\s\r\n]{$m})([^\s\r\n])/$1 $2/g; return $_; } sub wordsplit { # split a string into an array of words, but make sure to not split HTML tags # return [ split //, $_[0] ]; my @a; my $in=''; for (split /\s+/, $_[0]) { my $gt = () = />/g; my $lt = () = / $lt) { push @a, $in.$_; $in=''; } elsif($lt > $gt || $in) { $in .= $_.' '; } else { push @a, $_; }; } push @a, $in if $in; return \@a; } sub cdiff { # obj1, obj2, @items->[ short, name, serialise, diff, [parsed_x, parsed_y] ] my($x, $y, @items, @c) = @_; # serialise = 0 -> integer, 1 -> string, CODEref -> code my $type = defined $$y{minage} ? 'r' : defined $$y{length} ? 'v' : 'p'; my $pre = '|; if(!$x) { # just show info about the revision if there is no previous edit return $pre.qq|'. qq| | Revision $$x{cid} (edit) By $$x{username} on |.formatdate('%Y-%m-%d at %R', $$x{added}).' | '.
qq|Revision $$y{cid} (edit) By $$y{username} on |.formatdate('%Y-%m-%d at %R', $$y{added}).' | '.
'
Edit summary of revision '.$$y{cid}.' '.summary($$y{comments}, 0, '[no summary]').' | ||
'.$_->[1].' | '.$_->[4].' | '.$_->[5].' |
< '.join(' - ', map { sprintf $_, $t.$$o{id} } @act).' >
'.( $t eq 'v' ? qq| | : $t eq 'r' ? qq| | : '' ); } my %pagetitles = ( faq => 'Frequently Asked Questions', userlogin => 'Login', userreg => 'Register a new account', userpass => 'Forgot your password?', home => 'Visual Novel Database', pbrowse => 'Browse producers', userlist => 'Browse users', myvotes => sub { return $p{myvotes}{user}{username} eq $p{AuthUsername} ? 'My votes' : ('Votes by '.$p{myvotes}{user}{username}); }, userpage => sub { return 'User: '.$p{userpage}{user}{username} }, vnlist => sub { return $p{vnlist}{user}{username} eq $p{AuthUsername} ? 'My visual novel list' : ($p{vnlist}{user}{username}.'\'s visual novel list'); }, useredit => sub { return !$p{useredit}{adm} ? 'My account' : 'Edit '.$p{useredit}{form}{username}.'\'s account'; }, ppage => sub { return $p{ppage}{prod}{name} }, pedit => sub { return $p{pedit}{id} ? sprintf('Edit %s', $p{pedit}{form}{name}) : 'Add a new producer'; }, vnedit => sub { return $p{vnedit}{id} ? sprintf('Edit %s', $p{vnedit}{form}{title}) : 'Add a new visual novel'; }, redit => sub { return $p{redit}{id} ? sprintf('Edit %s', $p{redit}{rel}{title}) : sprintf('Add release to %s', $p{redit}{vn}{title}); }, vnpage => sub { return $p{vnpage}{vn}{title}; }, vnrg => sub { return 'Relations for '.$p{vnrg}{vn}{title} }, vnstats => sub { return 'User statistics for '.$p{vnstats}{vn}{title} }, vnbrowse => sub { return $p{vnbrowse}{chr} eq 'search' ? sprintf 'Search results for "%s"', $p{searchquery} : $p{vnbrowse}{chr} eq 'cat' ? 'Browse categories' : $p{vnbrowse}{chr} eq 'mod' ? 'Visual Novels awaiting moderation' : $p{vnbrowse}{chr} eq 'all' ? 'Browse all visual novels' : $p{vnbrowse}{chr} eq '0' ? 'Browse by char: Other' : sprintf 'Browse by char: %s', uc $p{vnbrowse}{chr}; }, rpage => sub { return $p{rpage}{rel}{romaji} || $p{rpage}{rel}{title} }, hist => sub { return !$p{hist}{id} || !$p{hist}{type} ? 'Recent changes' : $p{hist}{type} eq 'u' ? 'Recent changes by '.$p{hist}{title} : 'Edit history of '.$p{hist}{title}; }, docs => sub { return ( 'Categories', 'Adding/editing a visual novel', 'Adding/editing a release', 'Adding/editing a producer', 'General guidelines', 'Error parsing form', )[$p{docs}{p}-1]||'' } ); sub gettitle{$p{$_}&&($p{PageTitle}=ref($pagetitles{$_}) eq 'CODE' ? &{$pagetitles{$_}} : $pagetitles{$_}) for (keys%pagetitles);} # # F O R M E R R O R H A N D L I N G # my %formerr_names = ( mail => 'Email', username => 'Username', userpass => 'Password', pass1 => 'Password', pass2 => 'Password (second)', title => 'Title', desc => 'Description', rel => 'Relation', romaji => 'Romanized title', lang => 'Language', web => 'Website', released => 'Release date', platforms => 'Platforms', media => 'Media', name => 'Name', vn => 'Visual novel relations', ); my @formerr_msgs = ( sub { return sprintf 'Field "%s" is required.', @_ }, sub { return sprintf '%s should have at least %d characters.', @_ }, sub { return sprintf '%s is too large! Only %d characters allowed.', @_ }, sub { return $_[1] eq 'mail' ? 'Invalid email address' : $_[1] eq 'url' ? 'Invalid URL' : $_[1] eq 'pname' ? sprintf('%s can only contain alfanumeric characters!', $_[0]) : $_[1] eq 'asciiprint' ? sprintf('Only ASCII characters are allowed at %s', $_[0]) : $_[1] eq 'int' ? sprintf('%s should be a number!', $_[0]) : ''; }, sub { return sprintf '%s: invalid item selected', @_ }, sub { return 'Invalid unicode, are you sure your browser works fine?' }, ); my %formerr_exeptions = ( loginerr => 'Invalid username or password', badpass => 'Passwords do not match', usrexists => 'Username already exists, please choose an other one', mailexists => 'There already is a user with that email address, please request a new password if you forgot it', nomail => 'No user found with that email address', nojpeg => 'Image is not in JPEG or PNG format!', toolarge => 'Image is too large (in filesize), try to compress it a little', ); sub formerr { my @err = ref $_[0] eq 'ARRAY' ? @{$_[0]} : (); return '' if $#err < 0; my @msgs; my $ret = ' Error:%s
\n