1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use Data::Dumper;
6 use lib "/home/swatson/perl5/lib/perl5";
7 use GraphViz2;
8
9 my $SOURCE_FILE = $ARGV[0];
10
11 sub read_to_var($) {
12 my $file_path = shift;
13 my $content;
14 open(my $fh, '<', $file_path) or die "cannot open file $file_path";
15 {
16 local $/;
17 $content = <$fh>;
18 }
19 close($fh);
20
21 return $content;
22 }
23
24 my $src_content = read_to_var($SOURCE_FILE);
25
26 sub trim($) {
27 my $str = shift;
28 $str =~ s/^\s+|\s+$//g;
29 return $str;
30 }
31
32 my @module_library_paths = (
33 ".",
34 );
35 my %modules;
36
37 sub parse_module_file {
38 my $src = shift;
39
40 my %module;
41
42
43 my $last_proc_type = "null";
44 my $last_input = "null";
45 my $last_output = "null";
46 foreach my $line ( split("\n", $src) ) {
47 chomp $line;
48 if ( $line =~ m/^#/ ) {
49 next;
50 }
51
52 if ( $line =~ m/^Manufacturer:(.*)/ ) {
53 my $manu = $1;
54 $manu = trim($manu);
55 $module{'Manufacturer'} = $manu;
56 }
57
58 if ( $line =~ m/^Module:(.*)/ ) {
59 my $mod = $1;
60 $mod = trim($mod);
61 $module{'Module'} = $mod;
62 }
63
64 if ( $line =~ m/^Revision:(.*)/ ) {
65 my $rev = $1;
66 $rev = trim($rev);
67 $module{'Rev'} = $rev;
68 }
69
70 if ( $line =~ m/^-\ / ) {
71 if ( $line =~ m/^-\ Input:(.*)/ ) {
72 my $input = $1;
73 $input = trim($input);
74 my %input_chars;
75 $last_input = $input;
76 $last_proc_type = "input";
77 $module{'Inputs'}->{$input} = \%input_chars;
78 }
79
80 if ( $line =~ m/^-\ Knob:(.*)/ ) {
81 my $knob = $1;
82 $knob = trim($knob);
83 my %knob_chars;
84 $last_input = $knob;
85 $last_proc_type = "input";
86 $module{'Inputs'}->{$knob} = \%knob_chars;
87 }
88
89 if ( $line =~ m/^-\ Output:(.*)/ ) {
90 my $output = $1;
91 $output = trim($output);
92 my %output_chars;
93 $last_output = $output;
94 $last_proc_type = "output";
95 $module{'Outputs'}->{$output} = \%output_chars;
96 }
97
98 if ( $line =~ m/^-\ Button:(.*)/ ) {
99 my $button = $1;
100 $button = trim($button);
101 my %button_chars;
102 $last_input = $button;
103 $last_proc_type = "input";
104 $module{'Inputs'}->{$button} = \%button_chars;
105 }
106
107 }
108
109 if ( $line =~ m/^--\ / ) {
110 if ( $line =~ m/^--\ Position:(.*)/ ) {
111 my $pos_args = $1;
112 $pos_args = trim($pos_args);
113 if ( $last_proc_type eq "input" ) {
114 $module{'Inputs'}->{$last_input}->{'pos'} = $pos_args;
115 } elsif ( $last_proc_type eq "output" ) {
116 $module{'Outputs'}->{$last_output}->{'pos'} = $pos_args;
117 }
118 }
119 }
120
121 }
122
123 return \%module;
124 }
125
126 my %AST;
127
128 my %PARSE_TABLE = (
129 'comment' => '^#.*$',
130 'title' => '^Title: (.*)$',
131 'mod_path' => '^ModuleDir\ "(.*)"$',
132 'import' => '^import (Module)::([a-zA-Z0-9]{1,})::([a-zA-Z0-9]{1,})(.*$)',
133 'set' => '^set\ (.*)$',
134 'connect' => '^connect(.*)$',
135 );
136
137 my %PARSE_RULES = (
138 'comment' => sub {
139 # Do nothing, throw this line out
140 },
141 'title' => sub {
142 my $title = shift;
143 $AST{'Title'} = $title;
144 },
145 'mod_path' => sub {
146 my $file_path = shift;
147 if ( ! -d $file_path ) {
148 die "Path: $file_path doesn't look like a directory, exiting";
149 }
150
151 push(@module_library_paths, $file_path);
152 },
153 'import' => sub {
154 my $module_import = shift;
155 my $import_manu = shift;
156 my $import_mod = shift;
157 my $import_as = shift;
158 my @module_files = sub {
159 my @files;
160 foreach my $path ( @module_library_paths ) {
161 my @f = split("\n", `find $path`);
162 foreach my $file ( @f ) {
163 if ( $file =~ m/.module$/ ) {
164 my $f_bn = `basename $file`;
165 chomp $f_bn;
166 if ( ! grep(/$f_bn/, @files) ) {
167 push(@files, $file);
168 }
169 }
170 }
171 }
172 return @files;
173 }->();
174 foreach my $mod_file ( @module_files ) {
175 my $mod_file_content = read_to_var($mod_file);
176 my $mod_ref = parse_module_file($mod_file_content);
177
178 if ( $import_mod eq $$mod_ref{'Module'} ) {
179
180 if ( defined $AST{'Modules'} ) {
181 my $r = grep { $import_mod eq $_->{'Module'} } @{$AST{'Modules'}};
182 if ( $r == 0 ) {
183 push(@{$AST{'Modules'}}, $mod_ref);
184 }
185 } else {
186 push(@{$AST{'Modules'}}, $mod_ref);
187 }
188 } else {
189 next;
190 }
191 }
192 },
193 'set' => sub {
194 my $set_line = shift;
195 my $mod_to_set;
196 my $attr_to_set;
197 my $attr_param;
198 my $value;
199 my $setter = sub {
200 my $mod_to_set = shift;
201 my $attr_to_set = shift;
202 my $attr_param = shift;
203 if ( $attr_param eq "position" ) {
204 $attr_param = "pos";
205 }
206 my $value = shift;
207
208 my %set_params = (
209 'Param' => $attr_param,
210 'Value' => $value,
211 );
212
213 # Check values against mod definition
214 # Pull mod ref out of AST for straight forward checking
215 my $mod_ref;
216 # Check we have module in AST
217 my $r = grep { $mod_to_set eq $_->{'Module'} } @{$AST{'Modules'}};
218 if ( $r eq 0 ) {
219 die "Can't set value on module that is not imported: $mod_to_set\n";
220 } else {
221 foreach my $module_ref ( @{$AST{'Modules'}} ) {
222 if ( $mod_to_set eq $$module_ref{'Module'} ) {
223 $mod_ref = $module_ref;
224 last;
225 }
226 }
227 }
228
229 # Check that module has param we want to set
230 if ( ! $attr_to_set eq $$mod_ref{'Inputs'}->{$attr_to_set} ) {
231 die "Can't set a param that doesn't existing in the module spec: $attr_to_set";
232 }
233
234 # If the set has an attr param, check that it's in the allowed range on the attr
235 if ( $attr_param ne "null" ) {
236 my $attr_range = $$mod_ref{'Inputs'}->{$attr_to_set}->{'pos'};
237 if ( $attr_range =~ m/([0-9]{1,2})\-([0-9]{1,2})/ ) {
238 my $r_begin = $1;
239 my $r_end = $2;
240 if ( $value > $r_end || $value < $r_begin ) {
241 die "Parse error: attr_param value: $value for $attr_to_set : $attr_param is outside of range: $r_begin $r_end";
242 }
243 } else {
244 die "Somehow encountered parse error in setter for module file $$mod_ref{'Module'}\n";
245 }
246 }
247
248 $AST{'Sets'}->{$mod_to_set}->{$attr_to_set} = \%set_params;
249 };
250
251 if ( $set_line =~ m/(^[A-Z]{1}[A-Za-z0-9]{1,})\.{1}([A-Za-z0-9]{1,})\ \=\ (.*)$/ ) {
252 $mod_to_set = $1;
253 $attr_to_set = $2;
254 $value = $3;
255 } elsif ( $set_line =~ m/(^[A-Z]{1}[A-Za-z]{1,})\.{1}([A-Za-z0-9]{1,})\.([A-Za-z0-9]{1,})\ \=\ (.*)$/ ) {
256 $mod_to_set = $1;
257 $attr_to_set = $2;
258 $attr_param = $3;
259 $value = $4;
260 } else {
261 die "Parse error at $set_line";
262 }
263
264 if ( ! defined $attr_param || $attr_param eq "" ) {
265 $attr_param = "null",
266 };
267
268 $setter->($mod_to_set,$attr_to_set,$attr_param,$value);
269 },
270 'connect' => sub {
271 my $connect_line = shift;
272 $connect_line = trim($connect_line);
273 if ( $connect_line =~ m/([A-Z]{1}[A-Za-z0-9]{1,})\.([A-Za-z0-9]{1,})\ ([A-Z]{1}[A-Za-z0-9]{1,})\.([A-Za-z0-9]{1,})/ ) {
274 my $output_mod = $1;
275 my $output_mod_port = $2;
276 my $input_mod = $3;
277 my $input_mod_dst = $4;
278
279 # Check we have modules defined
280 if ( ! defined $AST{'Modules'} ) {
281 die "Parse error: Encountered connection but no modules are imported: $connect_line"
282 } else {
283 # Check that connect references imported modules and get module refs
284 my $output_mod_ref;
285 my $input_mod_ref;
286 foreach my $mod_ref ( @{$AST{'Modules'}} ) {
287 if ( $$mod_ref{'Module'} eq $output_mod ) {
288 $output_mod_ref = $mod_ref;
289 } elsif ( $$mod_ref{'Module'} eq $input_mod ) {
290 $input_mod_ref = $mod_ref;
291 }
292 }
293 # If we reach the end of the loop and input/output refs are not set
294 # we didn't find the module, and it's a parse error
295 if ( ! defined $output_mod_ref ||
296 $output_mod_ref eq "" ||
297 ! defined $input_mod_ref ||
298 $input_mod_ref eq "" ) {
299 die "Parse error, couldn't find $output_mod or $input_mod in AST"
300 }
301
302 # Check src/dst ports
303 if ( ! defined $$output_mod_ref{'Outputs'}->{$output_mod_port} ) {
304 die "Parse error: $output_mod_port is not defined in module $output_mod"
305 } elsif ( ! defined $$input_mod_ref{'Inputs'}->{$input_mod_dst} ) {
306 die "Parse error: $input_mod_dst is not defined in module $input_mod"
307 }
308
309 # Everything looks good, make connection
310 my $get_conn_id = sub {
311 if ( ! defined $AST{'Connections'} ) {
312 return 0;
313 } else {
314 my $c = 0;
315 foreach my $conn_id ( keys %{$AST{'Connections'}} ) {
316 $c++;
317 }
318 return $c;
319 }
320 };
321 my $conn_id = $get_conn_id->();
322 my %conn_map = (
323 'Output_Module' => $output_mod,
324 'Output_Port' => $output_mod_port,
325 'Input_Module' => $input_mod,
326 'Input_Mod_Dst' => $input_mod_dst,
327 );
328 $AST{'Connections'}->{$conn_id} = \%conn_map;
329
330 }
331 } else {
332 die "Parse error at $connect_line";
333 }
334 },
335
336 );
337
338 # Basic line parser
339 sub line_parse($) {
340 my $line = shift;
341 my $line_type = "null";
342 my @line_caps;
343 foreach my $key ( keys %PARSE_TABLE ) {
344 if ( $line =~ m/$PARSE_TABLE{$key}/ ) {
345 $line_type = $key;
346 }
347 }
348
349 if ( $line_type ne "null" && $line =~ m/$PARSE_TABLE{$line_type}/) {
350 if ( defined $1 && ! defined $2 ) {
351 $PARSE_RULES{$line_type}->($1);
352 } elsif ( defined $1 && defined $2 && defined $3 && defined $4 ) {
353 # This is for `import`
354 $PARSE_RULES{$line_type}->($1,$2,$3,$4);
355 } else {
356 $PARSE_RULES{$line_type}->();
357 }
358 } else {
359 print("$line\n");
360 }
361 }
362
363 # For testing module definitions
364 if ( defined $ARGV[1] && $ARGV[1] eq "--import-test" ) {
365 my $mod_ref = parse_module_file($src_content);
366 print Dumper $mod_ref;
367 exit 0;
368 }
369
370 # MAIN starts here - split the input and parse it
371 foreach my $line ( split("\n", $src_content) ) {
372 chomp $line;
373 if ( $line eq "" ) {
374 next;
375 }
376 line_parse($line);
377 }
378
379 # Dump the AST for now. This is where we'd render the output
380 print Dumper %AST;
381
382 my $graph = GraphViz2->new(
383 edge => {color => 'grey'},
384 global => {directed => 1},
385 graph => {label => $AST{'Title'}, rankdir => 'TB'},
386 node => {shape => 'square'},
387 );
388
389 # Given a mod_ref, construct a graph object
390 # that represents a module
391 sub module_node_constructor($$) {
392 my $graph = shift;
393 my $mod_ref = shift;
394 $graph->push_subgraph(
395 name => "cluster_$$mod_ref{'Module'}",
396 graph => {label => "$$mod_ref{'Module'}"},
397 node => {color => 'black', shape => 'circle'},
398 );
399
400 # $graph->push_subgraph(
401 # name => "cluster_mod_info",
402 # graph => {label => "mod_info"},
403 # node => {color => 'grey', shape => 'square'},
404 # );
405 # foreach my $node_name ( keys %{$mod_ref} ) {
406 # if ( $node_name =~ m/Module|Manufacturer|Rev/ ) {
407 # $graph->add_node(name => "$node_name\n: $$mod_ref{$node_name}", shape => 'square');
408 # }
409 # }
410
411 # $graph->pop_subgraph;
412
413 if ( defined $AST{'Sets'}->{$$mod_ref{'Module'}} ) {
414 my $sets_ref = $AST{'Sets'}->{$$mod_ref{'Module'}};
415 foreach my $set ( keys %{$sets_ref} ) {
416 my $name = "cluster" . "_" . "$set";
417 my $label = "$set" . "_" . "settings";
418 $graph->push_subgraph(
419 name => $name,
420 graph => {label => $label},
421 node => {color => "green", shape => 'square'},
422 );
423 $graph->add_node(name => "$set : $$sets_ref{$set}->{'Param'} : $$sets_ref{$set}->{'Value'}");
424 $graph->pop_subgraph;
425 }
426 }
427
428 # Handle connections
429 if ( defined $AST{'Connections'} ) {
430 my $conn_ref = $AST{'Connections'};
431 foreach my $conn ( keys %{$conn_ref} ) {
432 if ($$mod_ref{'Module'} eq $$conn_ref{$conn}->{'Output_Module'} ) {
433 my $name = "cluster" . "_" . "$$conn_ref{$conn}->{'Output_Port'}_$conn";
434 my $label = "$$conn_ref{$conn}->{'Output_Port'}_$conn";
435 $graph->push_subgraph(
436 name => $name,
437 graph => {label => $label},
438 node => {color => "blue"},
439 );
440 $graph->add_node(name => "$$conn_ref{$conn}->{'Output_Port'}");
441 $graph->pop_subgraph;
442 } elsif ($$mod_ref{'Module'} eq $$conn_ref{$conn}->{'Input_Module'} ) {
443 my $name = "cluster" . "_" . "$$conn_ref{$conn}->{'Input_Mod_Dst'}_$conn";
444 my $label = "$$conn_ref{$conn}->{'Input_Mod_Dst'}_$conn";
445 $graph->push_subgraph(
446 name => $name,
447 graph => {label => $label},
448 node => {color => 'purple'},
449 );
450 $graph->add_node(name => "$$conn_ref{$conn}->{'Input_Mod_Dst'}");
451 $graph->pop_subgraph;
452 }
453
454 }
455 }
456
457 $graph->pop_subgraph;
458 }
459
460 # Draw modules
461 foreach my $mod_ref ( @{$AST{'Modules'}} ) {
462 module_node_constructor($graph,$mod_ref);
463 }
464
465 # Draw connections
466 foreach my $conn_ref ( keys %{$AST{'Connections'}} ) {
467 my $from = $AST{'Connections'}->{$conn_ref}->{'Output_Port'};
468 my $to = $AST{'Connections'}->{$conn_ref}->{'Input_Mod_Dst'};
469 $graph->add_edge(color => 'red', from => $from, to => $to);
470 }
471
472 my $format = 'svg';
473 $graph->run(format => $format, output_file => "test.svg");