package VNDB::Util::CommonHTML; use strict; use warnings; use YAWF ':html', 'xml_escape'; use Exporter 'import'; use Algorithm::Diff::XS 'compact_diff'; use VNDB::Func; use Encode 'encode_utf8', 'decode_utf8'; use POSIX 'ceil'; our @EXPORT = qw| htmlMainTabs htmlDenied htmlHiddenMessage htmlBrowse htmlBrowseNavigate htmlRevision htmlEditMessage htmlItemMessage htmlVoteStats htmlHistory htmlSearchBox |; # generates the "main tabs". These are the commonly used tabs for # 'objects', i.e. VN/producer/release entries and users # Arguments: u/v/r/p/g, object, currently selected item (empty=main) sub htmlMainTabs { my($self, $type, $obj, $sel) = @_; $sel ||= ''; my $id = $type.$obj->{id}; return if $type eq 'g' && !$self->authCan('tagmod'); ul class => 'maintabs'; if($type =~ /[uvrp]/) { li $sel eq 'hist' ? (class => 'tabselected') : (); a href => "/$id/hist", 'history'; end; } if($type =~ /[uvp]/) { my $cnt = $self->dbThreadCount($type, $obj->{id}); li $sel eq 'disc' ? (class => 'tabselected') : (); a href => "/t/$id", "discussions ($cnt)"; end; } if($type eq 'u') { li $sel eq 'posts' ? (class => 'tabselected') : (); a href => "/$id/posts", 'posts'; end; } if($type eq 'u' && ($obj->{show_list} || $self->authCan('usermod'))) { li $sel eq 'wish' ? (class => 'tabselected') : (); a href => "/$id/wish", 'wishlist'; end; li $sel eq 'list' ? (class => 'tabselected') : (); a href => "/$id/list", 'list'; end; } if($type eq 'u') { li $sel eq 'tags' ? (class => 'tabselected') : (); a href => "/$id/tags", 'tags'; end; } if($type eq 'v' && $self->authCan('tag') && !$obj->{hidden}) { li $sel eq 'tagmod' ? (class => 'tabselected') : (); a href => "/$id/tagmod", 'modify tags'; end; } if($type eq 'r' && $self->authCan('edit')) { li $sel eq 'copy' ? (class => 'tabselected') : (); a href => "/$id/copy", 'copy'; end; } if( $type eq 'u' && ($self->authInfo->{id} && $obj->{id} == $self->authInfo->{id} || $self->authCan('usermod')) || $type =~ /[vrp]/ && $self->authCan('edit') && (!$obj->{locked} || $self->authCan('lock')) && (!$obj->{hidden} || $self->authCan('del')) || $type eq 'g' && $self->authCan('tagmod') ) { li $sel eq 'edit' ? (class => 'tabselected') : (); a href => "/$id/edit", 'edit'; end; } if($type =~ /[vrp]/ && $self->authCan('del')) { li; a href => "/$id/hide", $obj->{hidden} ? 'unhide' : 'hide'; end; } if($type =~ /[vrp]/ && $self->authCan('lock')) { li; a href => "/$id/lock", $obj->{locked} ? 'unlock' : 'lock'; end; } if($type eq 'u' && $self->authCan('usermod')) { li $sel eq 'del' ? (class => 'tabselected') : (); a href => "/$id/del", 'del'; end; } if($type eq 'v' && $obj->{rgraph}) { li $sel eq 'rg' ? (class => 'tabselected') : (); a href => "/$id/rg", 'relations'; end; } li !$sel ? (class => 'tabselected') : (); a href => "/$id", $id; end; end; } # generates a full error page, including header and footer sub htmlDenied { my $self = shift; $self->htmlHeader(title => 'Access Denied'); div class => 'mainbox'; h1 'Access Denied'; div class => 'warning'; if(!$self->authInfo->{id}) { h2 'You need to be logged in to perform this action.'; p; lit 'Please login, or create an account ' .'if you don\'t have one yet.'; end; } else { h2 "You are not allowed to perform this action."; p 'It seems you don\'t have the proper rights to perform the action you wanted to perform...'; } end; end; $self->htmlFooter; } # Generates message saying that the current item has been deleted, # Arguments: [pvr], obj # Returns 1 if the use doesn't have access to the page, 0 otherwise sub htmlHiddenMessage { my($self, $type, $obj) = @_; return 0 if !$obj->{hidden}; my $board = $type eq 'r' ? 'v'.$obj->{vn}[0]{vid} : $type.$obj->{id}; div class => 'mainbox'; h1 $obj->{title}||$obj->{name}; div class => 'warning'; h2 'Item deleted'; p; lit qq|This item has been deleted from the database, File a request on the| .qq| discussion board to undelete this page.|; end; end; end; return $self->htmlFooter() || 1 if !$self->authCan('del'); return 0; } # generates a browse box, arguments: # items => arrayref with the list items # options => hashref containing at least the keys s (sort key), o (order) and p (page) # nextpage => whether there's a next page or not # sorturl => base URL to append the sort options to (if there are any sortable columns) # pageurl => base URL to append the page option to # class => classname of the mainbox # header => # can be either an arrayref or subroutine reference, # in the case of a subroutine, it will be called when the header should be written, # in the case of an arrayref, the array should contain the header items. Each item # can again be either an arrayref or subroutine ref. The arrayref would consist of # two elements: the name of the header, and the name of the sorting column if it can # be sorted # row => subroutine ref, which is called for each item in $list, arguments will be # $self, $item_number (starting from 0), $item_value # footer => subroutine ref, called after all rows have been processed sub htmlBrowse { my($self, %opt) = @_; $opt{sorturl} .= $opt{sorturl} =~ /\?/ ? ';' : '?' if $opt{sorturl}; # top navigation $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 't'); div class => 'mainbox browse'.($opt{class} ? ' '.$opt{class} : ''); table; # header thead; Tr; if(ref $opt{header} eq 'CODE') { $opt{header}->($self); } else { for(0..$#{$opt{header}}) { if(ref $opt{header}[$_] eq 'CODE') { $opt{header}[$_]->($self, $_+1); } else { td class => $opt{header}[$_][3]||'tc'.($_+1), $opt{header}[$_][2] ? (colspan => $opt{header}[$_][2]) : (); lit $opt{header}[$_][0]; if($opt{header}[$_][1]) { lit ' '; lit $opt{options}{s} eq $opt{header}[$_][1] && $opt{options}{o} eq 'a' ? "\x{25B4}" : qq|\x{25B4}|; lit $opt{options}{s} eq $opt{header}[$_][1] && $opt{options}{o} eq 'd' ? "\x{25BE}" : qq|\x{25BE}|; } end; } } } end; end; # footer if($opt{footer}) { tfoot; $opt{footer}->($self); end; } # rows $opt{row}->($self, $_+1, $opt{items}[$_]) for 0..$#{$opt{items}}; end; end; # bottom navigation $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 'b'); } # creates next/previous buttons (tabs), if needed # Arguments: page url, current page (1..n), nextpage (0/1), alignment (t/b), noappend (0/1) sub htmlBrowseNavigate { my($self, $url, $p, $np, $al, $na) = @_; return if $p == 1 && !$np; $url .= $url =~ /\?/ ? ';p=' : '?p=' unless $na; ul class => 'maintabs ' . ($al eq 't' ? 'notfirst' : 'bottom'); if($p > 1) { li class => 'left'; a href => $url.($p-1), '<- previous'; end; } if($np) { li; a href => $url.($p+1), 'next ->'; end; } end; } # Shows a revision, including diff if there is a previous revision. # Arguments: v|p|r, old revision, new revision, @fields # Where @fields is a list of fields as arrayrefs with: # [ shortname, displayname, %options ], # Where %options: # diff => 1/0, whether do show a diff on this field # serialize => coderef, should convert the field into a readable string, no HTML allowed # htmlize => same as serialize, but HTML is allowed and this can't be diff'ed # split => coderef, should return an array of HTML strings that can be diff'ed. (implies diff => 1) # join => used in combination with split, specifies the string used for joining the HTML strings sub htmlRevision { my($self, $type, $old, $new, @fields) = @_; div class => 'mainbox revision'; h1 'Revision '.$new->{rev}; # previous/next revision links a class => 'prev', href => sprintf('/%s%d.%d', $type, $new->{id}, $new->{rev}-1), '<- earlier revision' if $new->{rev} > 1; a class => 'next', href => sprintf('/%s%d.%d', $type, $new->{id}, $new->{rev}+1), 'later revision ->' if $new->{cid} != $new->{latest}; p class => 'center'; a href => "/$type$new->{id}", "$type$new->{id}"; end; # no previous revision, just show info about the revision itself if(!$old) { div; revheader($type, $new); br; b 'Edit summary:'; br; br; lit bb2html($new->{comments})||'[no summary]'; end; } # otherwise, compare the two revisions else { table; thead; Tr; td; lit ' '; end; td; revheader($type, $old); end; td; revheader($type, $new); end; end; Tr; td; lit ' '; end; td colspan => 2; b 'Edit summary of revision '.$new->{rev}.':'; br; br; lit bb2html($new->{comments})||'[no summary]'; end; end; end; my $i = 1; revdiff(\$i, $old, $new, @$_) for (@fields); end; } end; } sub revheader { # type, obj my($type, $obj) = @_; b 'Revision '.$obj->{rev}; txt ' ('; a href => "/$type$obj->{id}.$obj->{rev}/edit", 'edit'; txt ')'; br; txt 'By '; lit userstr($obj); txt ' on '; lit date $obj->{added}, 'full'; } sub revdiff { my($i, $old, $new, $short, $name, %o) = @_; $o{serialize} ||= $o{htmlize}; $o{diff}++ if $o{split}; $o{join} ||= ''; my $ser1 = $o{serialize} ? $o{serialize}->($old->{$short}, $old) : $old->{$short}; my $ser2 = $o{serialize} ? $o{serialize}->($new->{$short}, $new) : $new->{$short}; return if $ser1 eq $ser2; if($o{diff} && $ser1 && $ser2) { # compact_diff doesn't like utf8 encoded strings, so encode input, decode output my @ser1 = map encode_utf8($_), $o{split} ? $o{split}->($ser1) : map xml_escape($_), split //, $ser1; my @ser2 = map encode_utf8($_), $o{split} ? $o{split}->($ser2) : map xml_escape($_), split //, $ser2; return if $o{split} && $#ser1 == $#ser2 && !grep $ser1[$_] ne $ser2[$_], 0..$#ser1; $ser1 = $ser2 = ''; my @d = compact_diff(\@ser1, \@ser2); for my $i (0..($#d-2)/2) { # $i % 2 == 0 -> equal, otherwise it's different my $a = join($o{join}, @ser1[ $d[$i*2] .. $d[$i*2+2]-1 ]); my $b = join($o{join}, @ser2[ $d[$i*2+1] .. $d[$i*2+3]-1 ]); $ser1 .= ($ser1?$o{join}:'').($i % 2 ? qq|$a| : $a) if $a; $ser2 .= ($ser2?$o{join}:'').($i % 2 ? qq|$b| : $b) if $b; } $ser1 = decode_utf8($ser1); $ser2 = decode_utf8($ser2); } elsif(!$o{htmlize}) { $ser1 = xml_escape $ser1; $ser2 = xml_escape $ser2; } $ser1 = '[empty]' if !$ser1 && $ser1 ne '0'; $ser2 = '[empty]' if !$ser2 && $ser2 ne '0'; Tr $$i++ % 2 ? (class => 'odd') : (); td $name; td class => 'tcval'; lit $ser1; end; td class => 'tcval'; lit $ser2; end; end; } # Generates a generic message to show as the header of the edit forms # Arguments: v/r/p, obj sub htmlEditMessage { my($self, $type, $obj, $copy) = @_; my $full = {v => 'visual novel', r => 'release', p => 'producer'}->{$type}; my $guidelines = {v => 2, r => 3, p => 4}->{$type}; div class => 'mainbox'; h1 $obj ? ''.($copy ? 'Copy ':'Edit ').($obj->{name}||$obj->{title}) : "Add new $full"; if($copy) { div class => 'warning'; h2 "You're not editing a release!"; p; txt "You're about to insert a new release into the database with information based on "; a href => "/$type$obj->{id}", $obj->{title}; txt ". Hit the 'edit' tab on the right-top if you intended to edit the release instead of creating a new one."; end; end; } div class => 'notice'; h2 'Before editing:'; ul; li; lit qq|Read the guidelines!|; end; if($obj) { li; lit qq|Check for any existing discussions on the discussion board|; end; li; lit qq|Browse the edit history for any recent changes related to what you want to change.|; end; } elsif($type ne 'r') { li; lit qq|Search the database to see if we already have information about this $full|; end; } end; end; if($obj && $obj->{latest} != $obj->{cid}) { div class => 'warning'; h2 'Reverting'; p qq|You are editing an old revision of this $full. If you save it, all changes made after this revision will be reverted!|; end; } end; } # Generates a small message when the user can't edit the item, # or the item is locked. # Arguments: v/r/p, obj sub htmlItemMessage { my($self, $type, $obj) = @_; if($obj->{locked}) { p class => 'locked', 'Locked for editing' } elsif(!$self->authInfo->{id}) { p class => 'locked'; lit 'You need to be logged in to edit this page'; end; } elsif(!$self->authCan('edit')) { p class => 'locked', "You're not allowed to edit this page"; } } # generates two tables, one with a vote graph, other with recent votes sub htmlVoteStats { my($self, $type, $obj, $stats) = @_; my($max, $count, $total) = (0, 0); for (0..$#$stats) { $max = $stats->[$_] if $stats->[$_] > $max; $count += $stats->[$_]; $total += $stats->[$_]*($_+1); } div class => 'votestats'; table class => 'votegraph'; thead; Tr; td colspan => 2, 'Vote graph'; end; end; tfoot; Tr; td colspan => 2, sprintf '%d vote%s total, average %.2f%s', $count, $count != 1 ? 's' : '', $total/$count, $type eq 'v' ? ' ('.$self->{votes}[ceil($total/$count-1)].')' : ''; end; end; for (reverse 0..$#$stats) { Tr; td class => 'number', $_+1; td class => 'graph'; div style => 'width: '.($stats->[$_] ? $stats->[$_]/$max*250 : 0).'px', ' '; txt $stats->[$_]; end; end; } end; my $recent = $self->dbVoteGet( $type.'id' => $obj->{id}, results => 8, order => 'date DESC', what => $type eq 'v' ? 'user' : 'vn', hide => $type eq 'v', hide_ign => $type eq 'v', ); if(@$recent) { table class => 'recentvotes'; thead; Tr; td colspan => 3, 'Recent votes'; end; end; for (0..$#$recent) { Tr $_ % 2 == 0 ? (class => 'odd') : (); td; if($type eq 'u') { a href => "/v$recent->[$_]{vid}", title => $recent->[$_]{original}||$recent->[$_]{title}, shorten $recent->[$_]{title}, 40; } else { a href => "/u$recent->[$_]{uid}", $recent->[$_]{username}; } end; td $recent->[$_]{vote}; td date $recent->[$_]{date}; end; } end; } clearfloat; if($type eq 'v') { div; h3 'Popularity'; p sprintf 'Ranked #%d out of %d with a score of %.2f.', $obj->{ranking}, $self->{stats}{vn}, $obj->{c_popularity}*100; end; } end; } sub htmlHistory { my($self, $list, $f, $np, $url) = @_; $self->htmlBrowse( items => $list, options => $f, nextpage => $np, pageurl => $url, class => 'history', header => [ sub { td colspan => 2, class => 'tc1', mt '_hist_col_rev' }, [ mt '_hist_col_date' ], [ mt '_hist_col_user' ], sub { td; a href => '#', id => 'history_comments', 'expand'; txt mt '_hist_col_page'; end; } ], row => sub { my($s, $n, $i) = @_; my $tc = [qw|v r p|]->[$i->{type}]; my $revurl = "/$tc$i->{iid}.$i->{rev}"; Tr $n % 2 ? ( class => 'odd' ) : (); td class => 'tc1_1'; a href => $revurl, "$tc$i->{iid}"; end; td class => 'tc1_2'; a href => $revurl, ".$i->{rev}"; end; td class => 'tc2', date $i->{added}; td class => 'tc3'; lit userstr($i); end; td; a href => $revurl, title => $i->{ioriginal}, shorten $i->{ititle}, 80; end; end; if($i->{comments}) { Tr class => $n % 2 ? 'editsum odd hidden' : 'editsum hidden'; td colspan => 5; lit bb2html $i->{comments}, 150; end; end; } }, ); } sub htmlSearchBox { my($self, $sel, $v) = @_; fieldset class => 'search'; p class => 'searchtabs'; a href => '/v/all', $sel eq 'v' ? (class => 'sel') : (), 'Visual novels'; a href => '/r', $sel eq 'r' ? (class => 'sel') : (), 'Releases'; a href => '/p/all', $sel eq 'p' ? (class => 'sel') : (), 'Producers'; a href => '/g', $sel eq 'g' ? (class => 'sel') : (), 'Tags'; a href => '/u/all', $sel eq 'u' ? (class => 'sel') : (), 'Users'; end; input type => 'text', name => 'q', id => 'q', class => 'text', value => $v; input type => 'submit', class => 'submit', value => 'Search!'; end; } 1;