summaryrefslogtreecommitdiff
path: root/lib/VNDB/VN.pm
diff options
context:
space:
mode:
authoryorhel <yorhel@1fe2e327-d9db-4752-bcf7-ef0cb4a1748b>2008-04-13 13:45:20 +0000
committeryorhel <yorhel@1fe2e327-d9db-4752-bcf7-ef0cb4a1748b>2008-04-13 13:45:20 +0000
commitd7046f5d38004ff20739798c18f5796c31676546 (patch)
tree1639e6a8c3b74588bff7be6aaf6cf5e04e3bc63f /lib/VNDB/VN.pm
W00t, VNDB on SVN!
git-svn-id: svn://vndb.org/vndb@1 1fe2e327-d9db-4752-bcf7-ef0cb4a1748b
Diffstat (limited to 'lib/VNDB/VN.pm')
-rw-r--r--lib/VNDB/VN.pm380
1 files changed, 380 insertions, 0 deletions
diff --git a/lib/VNDB/VN.pm b/lib/VNDB/VN.pm
new file mode 100644
index 00000000..f2340037
--- /dev/null
+++ b/lib/VNDB/VN.pm
@@ -0,0 +1,380 @@
+
+package VNDB::VN;
+
+use strict;
+use warnings;
+use Exporter 'import';
+use Digest::MD5;
+require bytes;
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| VNPage VNEdit VNLock VNDel VNHide VNBrowse VNXML VNUpdReverse VNRecreateRel |;
+
+
+sub VNPage {
+ my $self = shift;
+ my $id = shift;
+ my $page = shift || '';
+
+ my $r = $self->FormCheck(
+ { name => 'rev', required => 0, default => 0, template => 'int' },
+ { name => 'diff', required => 0, default => 0, template => 'int' },
+ );
+
+ my $v = $self->DBGetVN(
+ id => $id,
+ what => 'extended relations categories'.($r->{rev} ? ' changes' : ''),
+ $r->{rev} ? ( rev => $r->{rev} ) : ()
+ )->[0];
+ return $self->ResNotFound if !$v->{id};
+
+ $r->{diff} ||= $v->{prev} if $r->{rev};
+ my $c = $r->{diff} && $self->DBGetVN(id => $id, rev => $r->{diff}, what => 'extended changes relations categories')->[0];
+ $v->{next} = $self->DBGetHist(type => 'v', id => $id, next => $v->{cid}, showhid => 1)->[0]{id} if $r->{rev};
+
+ if($page eq 'rg' && $v->{rgraph}) {
+ open(my $F, '<', sprintf '%s/%02d/%d.cmap', $self->{mappath}, $v->{rgraph}%50, $v->{rgraph}) || die $!;
+ $v->{rmap} = join('', (<$F>));
+ close($F);
+ }
+
+ $self->ResAddTpl(vnpage => {
+ vote => $self->AuthInfo->{id} ? $self->DBGetVotes(uid => $self->AuthInfo->{id}, vid => $id)->[0] : {},
+ list => $self->AuthInfo->{id} ? $self->DBGetVNList(uid => $self->AuthInfo->{id}, vid => $id)->[0] : {},
+ rel => scalar $self->DBGetRelease(vid => $id, what => 'producers platforms'),
+ vn => $v,
+ prev => $c,
+ page => $page,
+ change => $r->{diff}||$r->{rev},
+ $page eq 'stats' ? (
+ lists => {
+ latest => scalar $self->DBGetVNList(vid => $id, results => 7),
+ graph => $self->DBVNListStats(vid => $id),
+ },
+ votes => {
+ latest => scalar $self->DBGetVotes(vid => $id, results => 10),
+ graph => $self->DBVoteStats(vid => $id),
+ },
+ ) : (),
+ });
+}
+
+
+sub VNEdit {
+ my $self = shift;
+ my $id = shift; # 0 = new
+
+ my $rev = $self->FormCheck({ name => 'rev', required => 0, default => 0, template => 'int' })->{rev};
+
+ my $v = $self->DBGetVN(id => $id, what => 'extended changes relations categories', $rev ? ( rev => $rev ) : ())->[0] if $id;
+ return $self->ResNotFound() if $id && !$v;
+
+ return $self->ResDenied if !$self->AuthCan('edit') || ($v->{locked} && !$self->AuthCan('lock'));
+
+ my %b4 = $id ? (
+ ( map { $_ => $v->{$_} } qw| title desc alias img_nsfw length l_wp l_cisv l_vnn | ),
+ relations => join('|||', map { $_->{relation}.','.$_->{id}.','.$_->{title} } @{$v->{relations}}),
+ categories => join(',', map { $_->[0].$_->[1] } sort { $a->[0] cmp $b->[0] } @{$v->{categories}}),
+ ) : ();
+
+ my $frm = {};
+ if($self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck(
+ { name => 'title', required => 1, maxlength => 250 },
+ { name => 'alias', required => 0, maxlength => 500, default => '' },
+ { name => 'desc', required => 1, maxlength => 10240 },
+ { name => 'length', required => 0, enum => [ 0..($#$VNDB::VNLEN+1) ], default => 0 },
+ { name => 'l_wp', required => 0, default => '', maxlength => 150 },
+ { name => 'l_cisv', required => 0, default => 0, template => 'int' },
+ { name => 'l_vnn', required => 0, default => 0, template => 'int' },
+ { name => 'img_nsfw', required => 0 },
+ { name => 'categories', required => 0, default => '' },
+ { name => 'relations', required => 0, default => 0 },
+ { name => 'comm', required => 0, default => '' },
+ );
+ $frm->{img_nsfw} = $frm->{img_nsfw} ? 1 : 0;
+
+ return $self->ResRedirect('/v'.$id, 'post')
+ if $id && !$self->ReqParam('img') && 10 == scalar grep { $b4{$_} eq $frm->{$_} } keys %b4;
+
+ my $relations = [ map { /^([0-9]+),([0-9]+)/ && $2 != $id ? ( [ $1, $2 ] ) : () } split /\|\|\|/, $frm->{relations} ];
+ my $cat = [ map { [ substr($_,0,3), substr($_,3,1) ] } split /,/, $frm->{categories} ];
+
+ # upload image
+ my $imgid = '';
+ if($self->ReqParam('img')) {
+ my $tmp = sprintf '%s/00/tmp.%d.jpg', $self->{imgpath}, $$*int(rand(1000)+1);
+ $self->ReqSaveUpload('img', $tmp);
+
+ my $l;
+ open(my $T, '<:raw:bytes', $tmp) || die $1;
+ read $T, $l, 2;
+ seek $T, 0, 0;
+ my($x, $y) = jpegsize($T);
+ close($T);
+
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'nojpeg' ] : [ 'nojpeg' ]
+ if $l ne pack('H*', 'ffd8');
+ if(!$frm->{_err}) {
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'toolarge' ] : [ 'toolarge' ]
+ if -s $tmp > 51200; # 50 KB max.
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'imgsize' ] : [ 'imgsize' ]
+ if $x > 256 || $y > 400; # 256x400 max
+ }
+
+ if($frm->{_err}) {
+ unlink $tmp;
+ } else {
+ $imgid = $self->DBIncId('covers_seq');
+ my $new = sprintf '%s/%02d/%d.jpg', $self->{imgpath}, $imgid%50, $imgid;
+ rename $tmp, $new or die $!;
+ chmod 0666, $new;
+ }
+ } elsif($id) {
+ $imgid = $v->{image};
+ }
+
+ my %args = (
+ ( map { $_ => $frm->{$_} } qw| title desc alias comm length l_wp l_cisv l_vnn img_nsfw| ),
+ image => $imgid,
+ relations => $relations,
+ categories => $cat,
+ );
+
+ if(!$frm->{_err}) {
+ my($oid, $cid) = ($id, 0);
+ $cid = $self->DBEditVN($id, %args) if $id; # edit
+ ($id, $cid) = $self->DBAddVN(%args) if !$id; # add
+
+ # update reverse relations and relation graph
+ if((!$oid && $#$relations >= 0) || ($oid && $frm->{relations} ne $b4{relations})) {
+ my %old = $oid ? (map { $_->{id} => $_->{relation} } @{$v->{relations}}) : ();
+ my %new = map { $_->[1] => $_->[0] } @$relations;
+ $self->VNRecreateRel($id, $self->VNUpdReverse(\%old, \%new, $id, $cid));
+ }
+
+ return $self->ResRedirect('/v'.$id.'?rev='.$cid, 'post');
+ }
+ }
+
+ if($id) {
+ $frm->{$_} ||= $b4{$_} for (keys %b4);
+ $frm->{comm} = sprintf 'Reverted to revision %d by %s.', $v->{cid}, $v->{username} if $v->{cid} != $v->{latest};
+ } else {
+ $frm->{categories} = 0;
+ }
+
+ $self->AddHid($frm);
+ $frm->{_hid} = {map{$_=>1} qw| info cat img |}
+ if !$frm->{_hid} && !$id;
+ $self->ResAddTpl(vnedit => {
+ form => $frm,
+ id => $id,
+ vn => $v,
+ });
+}
+
+
+sub VNDel {
+ my $self = shift;
+ my $id = shift;
+
+ my $v = $self->DBGetVN(id => $id)->[0];
+ return $self->ResNotFound if !$v;
+ return $self->ResDenied if !$self->AuthCan('del');
+ $self->DBDelVN($id);
+ return $self->ResRedirect('/v', 'perm');
+}
+
+
+sub VNLock {
+ my $self = shift;
+ my $id = shift;
+
+ my $v = $self->DBGetVN(id => $id)->[0];
+ return $self->ResNotFound() if !$v;
+ return $self->ResDenied if !$self->AuthCan('lock');
+ $self->DBLockItem('vn', $id, $v->{locked}?0:1);
+ $self->DBLockItem('releases', $_->{id}, $v->{locked}?0:1)
+ for (@{$self->DBGetRelease(vid => $id)});
+ return $self->ResRedirect('/v'.$id, 'perm');
+}
+
+
+sub VNHide {
+ my $self = shift;
+ my $id = shift;
+
+ my $v = $self->DBGetVN(id => $id, what => 'relations')->[0];
+ return $self->ResNotFound() if !$v;
+ return $self->ResDenied if !$self->AuthCan('del');
+ $self->DBHideVN($id, $v->{hidden}?0:1);
+ $self->VNRecreateRel($id, $self->VNUpdReverse({ map { $_->{id} => $_->{relation} } @{$v->{relations}} }, {}, $id, 0))
+ if @{$v->{relations}};
+ return $self->ResRedirect('/v'.$id, 'perm');
+}
+
+
+sub VNBrowse {
+ my $self = shift;
+ my $chr = shift;
+ $chr = 'all' if !defined $chr;
+
+ my $f = $self->FormCheck(
+ { name => 's', required => 0, default => 'title', enum => [ qw|title released votes| ] },
+ { name => 'o', required => 0, default => 'a', enum => [ 'a','d' ] },
+ { name => 'i', required => 0, default => '' },
+ { name => 'e', required => 0, default => '' },
+ { name => 'l', required => 0, default => '' },
+ { name => 'q', required => 0},
+ { name => 'p', required => 0, template => 'int', default => 1},
+ );
+
+ my($r, $np) = $chr ne 'cat' || $f->{e} || $f->{i} || $f->{l} ? ($self->DBGetVN(
+ $chr =~ /^[a-z0]$/ ? (
+ char => $chr ) : (),
+ $chr eq 'search' && $f->{q} ? (
+ search => $f->{q} ) : (),
+ page => $f->{p},
+ $chr eq 'cat' ? (
+ cati => [ split /,/, $f->{i} ],
+ cate => [ split /,/, $f->{e} ],
+ lang => [ grep { $VNDB::LANG->{$_} } split /,/, $f->{l} ],
+ ) : (),
+ results => 50,
+ order => {title => 'vr.title', released => 'v.c_released', votes => 'v.c_votes'
+ }->{$f->{s}}.{a=>' ASC',d=>' DESC'}->{$f->{o}},
+ )) : ([], 0);
+
+ $self->ResRedirect('/v'.$r->[0]{id}, 'temp')
+ if $chr eq 'search' && $#$r == 0;
+
+ $self->ResAddTpl(vnbrowse => {
+ vn => $r,
+ npage => $np,
+ page => $f->{p},
+ chr => $chr,
+ $chr eq 'cat' ? (
+ incl => $f->{i},
+ excl => $f->{e},
+ cat => $self->DBCategoryCount,
+ lang => $self->DBLanguageCount,
+ slang => $f->{l},
+ ) : (),
+ order => [ $f->{s}, $f->{o} ],
+ },
+ searchquery => $f->{q});
+}
+
+
+sub VNXML {
+ my $self = shift;
+
+ my $q = $self->FormCheck(
+ { name => 'q', required => 0, maxlength => 100 }
+ )->{q};
+
+ my $r = [];
+ if($q) {
+ ($r,undef) = $self->DBGetVN(results => 10,
+ $q =~ /^v([0-9]+)$/ ? (id => $1) : (search => $q));
+ }
+
+ my $x = $self->ResStartXML;
+ $x->startTag('vn', results => $#$r+1, query => $q);
+ for (@$r) {
+ $x->startTag('item');
+ $x->dataElement(id => $_->{id});
+ $x->dataElement(title => $_->{title});
+ $x->endTag('item');
+ }
+ $x->endTag('vn');
+}
+
+
+
+sub jpegsize {
+ my $stream = shift;
+
+ my $MARKER = "\xFF"; # Section marker.
+
+ my $SIZE_FIRST = 0xC0; # Range of segment identifier codes
+ my $SIZE_LAST = 0xC3; # that hold size info.
+
+ my ($x, $y, $id) = (undef, undef, "could not determine JPEG size");
+
+ my ($marker, $code, $length, $data);
+ my $segheader;
+
+ seek $stream, 2, 0;
+ while (1) {
+ $length = 4;
+ read $stream, $segheader, $length;
+
+ ($marker, $code, $length) = unpack("a a n", $segheader);
+
+ if ($marker ne $MARKER) {
+ $id = "JPEG marker not found";
+ last;
+ } elsif((ord($code) >= $SIZE_FIRST) && (ord($code) <= $SIZE_LAST)) {
+ $length = 5;
+ read $stream, $data, $length;
+ ($y, $x) = unpack("xnn", $data);
+ $id = 'JPG';
+ last;
+ } else {
+ seek $stream, ($length - 2), 1;
+ }
+ }
+ return ($x, $y, $id);
+}
+
+
+# Update reverse relations
+sub VNUpdReverse { # old, new, id, cid
+ my($self, $old, $new, $id, $cid) = @_;
+ my %upd;
+ for (keys %$old, keys %$new) {
+ if(exists $$old{$_} and !exists $$new{$_}) {
+ $upd{$_} = -1;
+ } elsif((!exists $$old{$_} and exists $$new{$_}) || ($$old{$_} != $$new{$_})) {
+ $upd{$_} = $$new{$_};
+ if($VNDB::VRELW->{$upd{$_}}) { $upd{$_}-- }
+ elsif($VNDB::VRELW->{$upd{$_}+1}) { $upd{$_}++ }
+ }
+ }
+
+ for my $i (keys %upd) {
+ my $r = $self->DBGetVN(id => $i, what => 'extended relations categories')->[0];
+ my @newrel;
+ $_->{id} != $id && push @newrel, [ $_->{relation}, $_->{id} ]
+ for (@{$r->{relations}});
+ push @newrel, [ $upd{$i}, $id ] if $upd{$i} != -1;
+ $self->DBEditVN($i,
+ relations => \@newrel,
+ comm => 'Reverse relation update caused by revision '.$cid.' of v'.$id,
+ causedby => $cid,
+ uid => 1, # Multi - hardcoded
+ ( map { $_ => $r->{$_} } qw| title desc alias categories img_nsfw length l_wp l_cisv l_vnn image | )
+ );
+ }
+
+ return keys %upd;
+}
+
+
+sub VNRecreateRel { # @ids
+ my($s, @id) = @_;
+ $s->DBCommit; # creates deadlock otherwise
+ my $c = sprintf "%s %s", $s->{grapher}, join(' ', @id);
+ my $o = `$c`;
+ chomp $o;
+ warn "$$s{grapher}: $o\n" if $o;
+}
+
+
+
+1;
+
+