diff options
author | yorhel <yorhel@1fe2e327-d9db-4752-bcf7-ef0cb4a1748b> | 2008-06-06 13:54:03 +0000 |
---|---|---|
committer | yorhel <yorhel@1fe2e327-d9db-4752-bcf7-ef0cb4a1748b> | 2008-06-06 13:54:03 +0000 |
commit | d667908bb47626b789344048537b3eb9e00d6828 (patch) | |
tree | 48efe9b68e82f0fa74e648db008ac277fda74d02 | |
parent | 225f58c043446d3519adc47d72dba582cb75c56f (diff) |
Got rid of GraphViz.pm (which is like using CGI.pm to generate HTML), and fixed some XHTML validation problems
git-svn-id: svn://vndb.org/vndb@21 1fe2e327-d9db-4752-bcf7-ef0cb4a1748b
-rw-r--r-- | data/tpl/vnpage | 2 | ||||
-rw-r--r-- | data/tpl/vnpage_rg | 2 | ||||
-rw-r--r-- | lib/Multi/Core.pm | 2 | ||||
-rw-r--r-- | lib/Multi/RG.pm | 135 |
4 files changed, 56 insertions, 85 deletions
diff --git a/data/tpl/vnpage b/data/tpl/vnpage index 6ccb8f91..d65de024 100644 --- a/data/tpl/vnpage +++ b/data/tpl/vnpage @@ -121,7 +121,7 @@ if($d{vn}{length} || $d{vn}{alias} || @links || $prod) { ]] if($_->{relation} != $lrel) { $lrel=$_->{relation}; if($i) { ]]</dd>[[ } ]]- <dt>[[: $VNDB::VREL->[$lrel] ]]</dt><dd><a href="/v[[= $_->{id} ]]">[[: $_->{title} ]]</a> [[ } else { ]]<br /><a href="/v[[= $_->{id} ]]" title="[[: $_->{title} ]]">[[: shorten $_->{title}, 40 ]]</a>[[ } - ++$i;} ]] + ++$i;} ]]</dd> </dl> [[ } ]]- diff --git a/data/tpl/vnpage_rg b/data/tpl/vnpage_rg index 2a14a4df..832c4617 100644 --- a/data/tpl/vnpage_rg +++ b/data/tpl/vnpage_rg @@ -6,6 +6,6 @@ [[ } else { ]] [[= $d{vn}{rmap} ]] <p id="relations"> - <img src="[[= sprintf "%s/rg/%02d/%d.gif", $p{st}, $d{vn}{rgraph}%100, $d{vn}{rgraph} ]]" usemap="#rgraph" /> + <img src="[[= sprintf "%s/rg/%02d/%d.gif", $p{st}, $d{vn}{rgraph}%100, $d{vn}{rgraph} ]]" usemap="#rgraph" alt="Relation graph for -[[: $d{vn}{title} ]]" /> </p> [[ } ]] diff --git a/lib/Multi/Core.pm b/lib/Multi/Core.pm index e9c67eb6..74706910 100644 --- a/lib/Multi/Core.pm +++ b/lib/Multi/Core.pm @@ -113,7 +113,7 @@ sub finish { # cmd sub log { # level, msg return if $_[ARG0] > $Multi::LOGLVL; - (my $p = $_[SENDER][2]{$_[CALLER_STATE]}[0]) =~ s/^Multi:://; # NOT PORTABLE + (my $p = eval { $_[SENDER][2]{$_[CALLER_STATE]}[0] } || '') =~ s/^Multi:://; my $msg = sprintf '(%s) %s::%s: %s', (qw|WRN ACT DBG|)[$_[ARG0]-1], $p, $_[CALLER_STATE], $_[ARG2] ? sprintf($_[ARG1], @_[ARG2..$#_]) : $_[ARG1]; diff --git a/lib/Multi/RG.pm b/lib/Multi/RG.pm index 51bddc32..8aace991 100644 --- a/lib/Multi/RG.pm +++ b/lib/Multi/RG.pm @@ -9,13 +9,6 @@ use strict; use warnings; use POE 'Wheel::Run', 'Filter::Stream'; use Encode 'encode_utf8'; -use Text::Unidecode; -use GraphViz; - - -# GraphViz.pm is only used to create the layout, the actual -# 'dot' command is manually run using POE::Wheel::Run -# TODO: Get rid of GraphViz.pm altogether? (it does suck...) sub spawn { @@ -24,7 +17,7 @@ sub spawn { package_states => [ $p => [qw| _start cmd_relgraph - creategraph getrel relscomplete buildgraph savegraph completegraph + creategraph getrel builddot buildgraph savegraph completegraph proc_stdin proc_stdout proc_stderr proc_closed proc_child |], ], @@ -70,22 +63,17 @@ sub cmd_relgraph { sub creategraph { # id # Function order: - # creategraph - # getrel (recursive) - # relscomplete + # creategraph (inits vars and initates getrel) + # getrel (recursive - fetches relation and vn data) # if !rels - # completegraph + # completegraph (checks for other vids in the queue, exits otherwise) # else - # buildgraph - # savegraph + # builddot (creates input for graphviz) + # buildgraph (fetches graph ID and calls grapviz) + # savegraph (writes cmap, chmods files, updates database entries) # completegraph $_[KERNEL]->call(core => log => 3, 'Processing graph for v%d', $_[ARG0]); - $_[HEAP]{gv} = GraphViz->new( - #width => 700/96, - height => 2000/96, - ratio => 'compress', - ); $_[HEAP]{rels} = {}; # relations (key=vid1-vid2, value=relation) $_[HEAP]{nodes} = {}; # nodes (key=vid, value=[ vid, title, date, lang, processed ]) @@ -95,7 +83,6 @@ sub creategraph { # id sub getrel { # vid - #return if $_[HEAP]{nodes}{$_[ARG0]} && $_[HEAP]{nodes}{$_[ARG0]}[4]; $_[KERNEL]->call(core => log => 3, 'Fetching relations for v%d', $_[ARG0]); my $s = $Multi::SQL->prepare(q| @@ -123,19 +110,28 @@ sub getrel { # vid $_[HEAP]{nodes}{$_[ARG0]}[4]++; } - $_[KERNEL]->yield('relscomplete') if !grep { !$_->[4] } values %{$_[HEAP]{nodes}}; + if(!grep !$_->[4], values %{$_[HEAP]{nodes}}) { + if(!keys %{$_[HEAP]{nodes}}) { + $_[KERNEL]->call(core => log => 3, 'No relation graph for v%d', $_[HEAP]{vid}); + $Multi::SQL->do('UPDATE vn SET rgraph = 0 WHERE id = ?', undef, $_[HEAP]{vid}); + $_[HEAP]{nodes}{$_[HEAP]{vid}} = []; + $_[KERNEL]->yield('completegraph'); + return; + } + $_[KERNEL]->call(core => log => 3, 'Fetched all relation data'); + $_[KERNEL]->yield('builddot') + } } -sub relscomplete { # heap->nodes and heap->rels are now assumed to contain all necessary data - if(!keys %{$_[HEAP]{nodes}}) { - $_[KERNEL]->call(core => log => 3, 'No relation graph for v%d', $_[HEAP]{vid}); - $Multi::SQL->do('UPDATE vn SET rgraph = 0 WHERE id = ?', undef, $_[HEAP]{vid}); - $_[HEAP]{nodes}{$_[HEAP]{vid}} = []; - $_[KERNEL]->yield('completegraph'); - return; - } - $_[KERNEL]->call(core => log => 3, 'Fetched all relation data'); +sub builddot { + my $gv = + qq|graph {\n|. + qq|\tratio = "compress"\n|. + qq|\tnode [ fontname = "$_[HEAP]{font}", shape = "plaintext",|. + qq| fontsize = $_[HEAP]{fsize}[0], style = "setlinewidth(0.5)" ]\n|. + qq|\tedge [ labeldistance = 2.5, labelangle = -20, labeljust = 1, minlen = 2, dir = "both",|. + qq| fontname = $_[HEAP]{font}, fontsize = $_[HEAP]{fsize}[1], arrowsize = 0.7, color = "#69a89a" ]\n|; # insert all nodes, ordered by release date for (sort { $a->[2] <=> $b->[2] } values %{$_[HEAP]{nodes}}) { @@ -145,22 +141,20 @@ sub relscomplete { # heap->nodes and heap->rels are now assumed to contain all n my $title = $_->[1]; $title = substr($title, 0, 27).'...' if length($title) > 30; $title =~ s/&/&/g; - - $_[HEAP]{gv}->add_node($_->[0], - fontname => $_[HEAP]{font}, - shape => 'plaintext', - fontsize => $_[HEAP]{fsize}[0], - style => 'setlinewidth(0.5)', - URL => '/v'.$_->[0], - tooltip => encode_utf8($_->[1]), - label => sprintf( - '<<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#f0f0f0"> - <TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="2"><FONT POINT-SIZE="%d"> %s </FONT></TD></TR> - <TR><TD> %s </TD><TD> %s </TD></TR> - </TABLE>>', - $_[HEAP]{fsize}[2], encode_utf8($title), $date, $_->[3]||'N/A' - ), - ); + $title =~ s/>/>/g; + $title =~ s/</</g; + + my $tooltip = $_->[1]; + $tooltip =~ s/\\/\\\\/g; + $tooltip =~ s/"/\\"/g; + + $gv .= sprintf + qq|\tv%d [ URL = "/v%d", tooltip = "%s" label=<|. + q|<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#f0f0f0">|. + q|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="2"><FONT POINT-SIZE="%d"> %s </FONT></TD></TR>|. + q|<TR><TD> %s </TD><TD> %s </TD></TR>|. + qq|</TABLE>> ]\n|, + $_->[0], $_->[0], encode_utf8($tooltip), $_[HEAP]{fsize}[2], encode_utf8($title), $date, $_->[3]||'N/A'; } # @rels = ([ vid1, vid2, relation, date1, date2 ], ..), for easier processing @@ -176,29 +170,18 @@ sub relscomplete { # heap->nodes and heap->rels are now assumed to contain all n ($_->[0], $_->[1]) = ($_->[1], $_->[0]); $_->[2] = reverserel($_->[2]); } - $_[HEAP]{gv}->add_edge( - $_->[1] => $_->[0], - labeldistance => 2.5, - labelangle => -20, - labeljust => 'l', - dir => 'both', - minlen => 2, - fontname => $_[HEAP]{font}, - fontsize => $_[HEAP]{fsize}[1], - arrowsize => 0.7, - color => '#69a89a', - $VNDB::VRELW->{$_->[2]} ? ( - headlabel => $VNDB::VREL->[$_->[2]], - taillabel => $VNDB::VREL->[$_->[2]-1], - ) : $VNDB::VRELW->{$_->[2]+1} ? ( - headlabel => $VNDB::VREL->[$_->[2]], - taillabel => $VNDB::VREL->[$_->[2]+1], - ) : ( - label => ' '.$VNDB::VREL->[$_->[2]], - ), - ); + + my $label = + $VNDB::VRELW->{$_->[2]} ? qq|headlabel = "$VNDB::VREL->[$_->[2]]", taillabel = "$VNDB::VREL->[$_->[2]-1]"| : + $VNDB::VRELW->{$_->[2]+1} ? qq|headlabel = "$VNDB::VREL->[$_->[2]]", taillabel = "$VNDB::VREL->[$_->[2]+1]"| + : qq|label = " $VNDB::VREL->[$_->[2]]"|; + + $gv .= qq|\tv$$_[1] -- v$$_[0] [ $label ]\n|; } - + + $gv .= "}\n"; + #print $gv; + $_[HEAP]{gv} = \$gv; $_[KERNEL]->yield('buildgraph'); } @@ -225,13 +208,14 @@ sub buildgraph { StderrEvent => 'proc_stderr', CloseEvent => 'proc_closed', ); - $_[HEAP]{proc}->put($_[HEAP]{gv}->as_debug); + $_[HEAP]{proc}->put(${$_[HEAP]{gv}}); $_[HEAP]{cmap} = ''; } sub savegraph { # save the image map + $_[HEAP]{cmap} =~ s{>\n}{ />\n}g; # make XML parsers happy open my $F, '>', $_[HEAP]{gid}[2] or die $!; print $F '<!-- V:'.join(',',keys %{$_[HEAP]{nodes}})." -->\n"; print $F '<map id="rgraph" name="rgraph">'."\n"; @@ -299,16 +283,3 @@ sub reverserel { # relation 1; -__END__ - - - # generate the graph - #$_[HEAP]{gv}->as_gif($gif); - #chmod 0666, $gif; - - #print $_[HEAP]{gv}->as_debug; - - # postscript output (experimental) - #$_[HEAP]{gv}->as_svg('/tmp/test.svg'); - # system('/usr/bin/inkscape --export-png '.$gif.' /tmp/test.svg'); - # chmod 0666, $gif; |