forked from ruanjue/wtdbg2
/
dbm_index_dot.pl
executable file
·70 lines (59 loc) · 1.38 KB
/
dbm_index_dot.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
#!/usr/bin/perl -w
#
#Author: Ruan Jue
#
use strict;
use DB_File;
my $dot_file = shift or die("Usage: $0 <dot_file>\n");
die("$dot_file.dbm already exists!!!") if(-e "$dot_file.dbm");
open(IN, "<", $dot_file) or die;
my %hash;
tie %hash, 'DB_File', "$dot_file.dbm", O_RDWR | O_CREAT, 0644, $DB_HASH or die "Cannot open $dot_file.dbm: $!";
my %nodes = ();
my %link = ();
while(<IN>){
s/^\s+//;
s/\s+$//;
if(/^rankdir\s*=\s*(\S+)/){
$hash{"rankdir"} = $1;
next;
}
my $desc = '';
while(1){
if(/\s*(\[[^]]+\]);?$/){
$_ = substr($_, 0, length($_) - length($1));
$desc .= $1;
s/\s+$//;
} else {
last;
}
}
my @ts = split;
if(@ts == 1 and length $desc){
$nodes{$ts[0]} = $desc;
} elsif(@ts >= 3 and ($ts[1] eq '->' or $ts[1] eq '-')){
my ($lnk1, $lnk2) = ("", "");
if($ts[0]=~/^(\S+?):(\S+)$/){ $ts[0] = $1; $lnk1 = $2; }
if($ts[2]=~/^(\S+?):(\S+)$/){ $ts[2] = $1; $lnk2 = $2; }
push(@{$link{$ts[0]}{$ts[2]}}, [$desc, $lnk1, $lnk2]);
$link{$ts[2]}{$ts[0]} = [] unless(defined $link{$ts[2]}{$ts[0]});
}
}
close IN;
foreach my $n1 (keys %nodes){
$hash{$n1} = $nodes{$n1};
}
foreach my $n1 (keys %link){
my $hx = $link{$n1};
my $str = (defined $hash{$n1})? $hash{$n1} : "";
foreach my $n2 (keys %{$hx}){
my $ls = $hx->{$n2};
$str .= "\nN\t$n2";
foreach my $lk (@{$ls}){
$str .= "\n" . join("\t", "L", @{$lk});
}
}
$hash{$n1} = $str;
}
untie %hash;
1;