#!/usr/bin/perl -w # irclinkmap by yanek & Liskni_si, GNU GPL # $Id$ # Synopsis: ./irc_mapper_graphviz.pl "comment" use strict; use Data::Dumper; my $VAR1; my $VAR2; my $VAR3; my $VAR4; my $VAR5; my $ev; open(TMP,'irc_mapper.last'); eval join('',); close TMP; my $edge = $VAR1; undef $VAR1; my $links = $VAR2; undef $VAR2; my $servers = $VAR3; undef $VAR3; my $date = $VAR4; undef $VAR4; my $admins = $VAR5; undef $VAR5; my $comment = shift || "some"; print "digraph ircmap {\n"; print " bgcolor=grey12;\n"; print " rankdir=LR;\n"; print " edge [ arrowsize = 1 ];\n"; print " node [ color = red, shape=triangle, label=\"Invalid\\nhost\", style=filled ];\n"; sub fnmatch($$) { my $a = shift; my $b = shift; $a = quotemeta $a; $a =~ s/\*/.*/; $a =~ s/\?/./; return ($b =~ /$a/); } sub hopcmp($$) { my $a = shift; my $b = shift; my $r = $servers->{$a} cmp $servers->{$b}; if ($r == 0) { return $a cmp $b; } else { return $r; } } #my %marks; foreach my $srv (sort hopcmp (keys %{$servers})) { my $color = (defined $edge->{$srv})?"gold":"red"; my $label = $srv; if (defined $admins->{$srv}) { $admins->{$srv} =~ s/\s*,\s*/\\n/g; $label .= '\n' . $admins->{$srv}; } print " \"$srv\" [ label = \"$label\", shape = \"ellipse\", color = $color ]\n"; #$marks{$srv}++; } my $mark; foreach my $a (sort hopcmp (keys %{$servers})) { foreach my $b (sort hopcmp (keys %{$edge->{$a}})) { $mark->{$a}->{$b}++; #if (! defined $marks{$b}) { # print " \"$b\" [ label = \"$b\", shape = \"ellipse\", color = red ]\n"; # $marks{$b}++; #} my $head = 'none'; my $tail = 'none'; if ($edge->{$a}->{$b} > 0 and defined $edge->{$b}->{$a}) { $head = 'normal'; $tail = 'normal'; } elsif ($edge->{$a}->{$b} > 0 and ! defined $edge->{$b}->{$a}) { $head = 'normal'; $tail = 'none'; } elsif ($edge->{$a}->{$b} == 0 and defined $edge->{$b}->{$a}) { $head = 'normal'; $tail = 'none'; ($a,$b) = ($b,$a); } else { print STDERR " // $a $b = $edge->{$a}->{$b}\n"; } my $color = 'white'; if (defined $links->{$a}->{$b}) { $color = 'green'; } if ($head ne $tail) { $color = 'orange'; } print "\"$a\" -> \"$b\" [ arrowhead = $head, arrowtail = $tail, color = $color ]\n" if ! defined $mark->{$b}->{$a}; } } print "label = \"$comment IRC structure\\nGenerated on $date\"; fontsize=20; fontcolor=yellow;\n"; print "}\n";