• R/O
  • SSH
  • HTTPS

make-flowchart: Commit


Commit MetaInfo

Revisão1 (tree)
Hora2009-02-22 06:41:59
Autortenmyo

Mensagem de Log

新規

Mudança Sumário

Diff

--- trunk/fcml2dot.pl (nonexistent)
+++ trunk/fcml2dot.pl (revision 1)
@@ -0,0 +1,176 @@
1+#!/usr/bin/perl -w
2+use strict;
3+use warnings;
4+
5+my $funcnum=0;
6+my @returnlist;
7+my @switchstack;
8+my @breakstack;
9+my @refIDs;
10+my @nodelist;
11+
12+print "digraph {\n\n";
13+while (<>) {
14+ my($command,$args) = /^\s*(\w+)\s*(.*?)\s*$/;
15+ next if not $command;
16+ SWITCH_COMMAND: {
17+ $_ = $command;
18+ next if /^#/;
19+ my $currentID = "${command}_$.";
20+ # case case
21+ /^case$/ && do {
22+ @refIDs=([$switchstack[-1], $args]);
23+ last;
24+ };
25+ # case break
26+ /^break$/ && do {
27+ push @breakstack, $refIDs[-1];
28+ last;
29+ };
30+ # case return
31+ /^return$/ && do {
32+ push @returnlist, [$currentID, $args];
33+ };
34+ # case endswitch
35+ /^endswitch$/ && do {
36+ @refIDs=@breakstack;
37+ last;
38+ };
39+
40+ # case sub
41+ /^sub$/ && do {
42+ $funcnum++;
43+ @returnlist = ();
44+ @switchstack = ();
45+ @refIDs = ();
46+ @nodelist = ();
47+ $command = "start_end";
48+ print qq/subgraph cluster_$funcnum { label="$args";\n/;
49+ };
50+ # case endsub
51+ /^endsub$/ && do {
52+ $args = "END";
53+ $command = "start_end";
54+ push @refIDs, @returnlist;
55+ };
56+ # case switch
57+ /^switch$/ && do {
58+ @breakstack = ();
59+ push @switchstack, $currentID;
60+ };
61+
62+ # default
63+ do {
64+ push @nodelist, {
65+ ID => $currentID,
66+ command => $command,
67+ args => $args,
68+ ref => [@refIDs],
69+ };
70+ @refIDs=([$currentID, ""]);
71+ };
72+ # case endsub
73+ /^endsub$/ && do {
74+ print @{nodedump(\@nodelist)};
75+ print "}\n\n";
76+ };
77+ }
78+}
79+
80+print "}\n";
81+
82+
83+
84+sub nodedump {
85+ my $nodelist = shift;
86+ my @ret;
87+
88+ # default node
89+ push @ret,
90+ qq/node[height=0.2, width=1];\n/;
91+ push @ret, "\n";
92+
93+ # switch
94+ push @ret,
95+ qq/node[shape="diamond", style=""];\n/;
96+ foreach my $i (grep {$_->{command} eq "switch"} @$nodelist) {
97+ push @ret,
98+ qq/$i->{ID}\[label="$i->{args}"\];\n/;
99+ }
100+ push @ret, "\n";
101+
102+ # do
103+ push @ret,
104+ qq/node[shape="rect", style=""];\n/;
105+ foreach my $i (grep {$_->{command} eq "do"} @$nodelist) {
106+ push @ret,
107+ qq/$i->{ID}\[label="$i->{args}"\];\n/;
108+ }
109+ push @ret, "\n";
110+
111+ # call
112+ push @ret,
113+ qq/node[shape="record", style=""];\n/;
114+ foreach my $i (grep {$_->{command} eq "call"} @$nodelist) {
115+ push @ret,
116+ qq/$i->{ID}\[label="\\ |$i->{args}|\\ "\];\n/;
117+ }
118+ push @ret, "\n";
119+
120+ # start_end
121+ push @ret,
122+ qq/node[shape="rect", style="rounded"];\n/;
123+ foreach my $i (grep {$_->{command} eq "start_end"} @$nodelist) {
124+ push @ret,
125+ qq/$i->{ID}\[label="$i->{args}"\];\n/;
126+ }
127+ push @ret, "\n";
128+
129+ # return
130+ push @ret,
131+ qq/node[shape="point", height=0, width=0];\n/;
132+ foreach my $i (grep {$_->{command} eq "return"} @$nodelist) {
133+ push @ret,
134+ qq/$i->{ID};\n/;
135+ }
136+ push @ret, "\n";
137+
138+ # edge
139+ foreach my $i (@$nodelist) {
140+ foreach my $ref (@{$i->{ref}}) {
141+ push @ret,
142+ qq/$ref->[0] -> $i->{ID}/;
143+
144+ push @ret,
145+ qq/[taillabel="$ref->[1]"]/
146+ if $ref->[1];
147+
148+ if ((@{$i->{ref}} == 1) && ($i->{command} eq "return")) {
149+ push @ret,
150+ qq/[arrowhead="none"]/;
151+ }
152+
153+ push @ret, ";\n";
154+ }
155+ }
156+
157+
158+ return \@ret;
159+}
160+
161+
162+__DATA__
163+sub main2
164+ do init
165+ switch OK?
166+ #return a
167+ case 1
168+ call error_func
169+ return a
170+ case 2
171+ break
172+ case 4
173+ do foo
174+ break
175+ endswitch
176+endsub
Show on old repository browser