|
@@ -0,0 +1,201 @@
|
|
|
+#!/usr/bin/perl
|
|
|
+
|
|
|
+use strict;
|
|
|
+use warnings;
|
|
|
+use Data::Dumper;
|
|
|
+
|
|
|
+my $SOURCE_FILE = $ARGV[0];
|
|
|
+
|
|
|
+sub read_to_var($) {
|
|
|
+ my $file_path = shift;
|
|
|
+ my $content;
|
|
|
+ open(my $fh, '<', $file_path) or die "cannot open file $file_path";
|
|
|
+ {
|
|
|
+ local $/;
|
|
|
+ $content = <$fh>;
|
|
|
+ }
|
|
|
+ close($fh);
|
|
|
+
|
|
|
+ return $content;
|
|
|
+}
|
|
|
+
|
|
|
+my $src_content = read_to_var($SOURCE_FILE);
|
|
|
+
|
|
|
+sub trim($) {
|
|
|
+ my $str = shift;
|
|
|
+ $str =~ s/^\s+|\s+$//g;
|
|
|
+ return $str;
|
|
|
+}
|
|
|
+
|
|
|
+my @module_library_paths = (
|
|
|
+ ".",
|
|
|
+);
|
|
|
+my %modules;
|
|
|
+
|
|
|
+sub parse_module_file {
|
|
|
+ my $src = shift;
|
|
|
+
|
|
|
+ my %module;
|
|
|
+
|
|
|
+
|
|
|
+ my $last_proc_type = "null";
|
|
|
+ my $last_input = "null";
|
|
|
+ my $last_output = "null";
|
|
|
+ foreach my $line ( split("\n", $src) ) {
|
|
|
+ chomp $line;
|
|
|
+ if ( $line =~ m/^#/ ) {
|
|
|
+ next;
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line =~ m/^Manufacturer:(.*)/ ) {
|
|
|
+ my $manu = $1;
|
|
|
+ $manu = trim($manu);
|
|
|
+ $module{'Manufacturer'} = $manu;
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line =~ m/^Module:(.*)/ ) {
|
|
|
+ my $mod = $1;
|
|
|
+ $mod = trim($mod);
|
|
|
+ $module{'Module'} = $mod;
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line =~ m/^Revision:(.*)/ ) {
|
|
|
+ my $rev = $1;
|
|
|
+ $rev = trim($rev);
|
|
|
+ $module{'Rev'} = $rev;
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line =~ m/^-\ / ) {
|
|
|
+ if ( $line =~ m/^-\ Input:(.*)/ ) {
|
|
|
+ my $input = $1;
|
|
|
+ $input = trim($input);
|
|
|
+ my %input_chars;
|
|
|
+ $last_input = $input;
|
|
|
+ $last_proc_type = "input";
|
|
|
+ $module{'Inputs'}->{$input} = \%input_chars;
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line =~ m/^-\ Knob:(.*)/ ) {
|
|
|
+ my $knob = $1;
|
|
|
+ $knob = trim($knob);
|
|
|
+ my %knob_chars;
|
|
|
+ $last_input = $knob;
|
|
|
+ $last_proc_type = "input";
|
|
|
+ $module{'Inputs'}->{$knob} = \%knob_chars;
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line =~ m/^-\ Output:(.*)/ ) {
|
|
|
+ my $output = $1;
|
|
|
+ $output = trim($output);
|
|
|
+ my %output_chars;
|
|
|
+ $last_output = $output;
|
|
|
+ $last_proc_type = "output";
|
|
|
+ $module{'Outputs'}->{$output} = \%output_chars;
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line =~ m/^--\ / ) {
|
|
|
+ if ( $line =~ m/^--\ Position:(.*)/ ) {
|
|
|
+ my $pos_args = $1;
|
|
|
+ $pos_args = trim($pos_args);
|
|
|
+ if ( $last_proc_type eq "input" ) {
|
|
|
+ $module{'Inputs'}->{$last_input}->{'pos'} = $pos_args;
|
|
|
+ } elsif ( $last_proc_type eq "output" ) {
|
|
|
+ $module{'Outputs'}->{$last_output}->{'pos'} = $pos_args;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ }
|
|
|
+
|
|
|
+ return \%module;
|
|
|
+}
|
|
|
+
|
|
|
+my %AST;
|
|
|
+
|
|
|
+my %PARSE_TABLE = (
|
|
|
+ 'comment' => '^#.*$',
|
|
|
+ 'title' => '^Title: (.*)$',
|
|
|
+ 'mod_path' => '^ModuleDir\ "(.*)"$',
|
|
|
+ 'import' => '^import (Module)::([a-zA-Z0-9]{1,})::([a-zA-Z0-9]{1,})(.*$)',
|
|
|
+ 'set' => '^set\ (.*)$',
|
|
|
+);
|
|
|
+
|
|
|
+my %PARSE_RULES = (
|
|
|
+ 'comment' => sub {},
|
|
|
+ 'title' => sub {
|
|
|
+ my $title = shift;
|
|
|
+ $AST{'Title'} = $title;
|
|
|
+ },
|
|
|
+ 'mod_path' => sub {
|
|
|
+ my $file_path = shift;
|
|
|
+ if ( ! -d $file_path ) {
|
|
|
+ die "Path: $file_path doesn't look like a directory, exiting";
|
|
|
+ }
|
|
|
+
|
|
|
+ push(@module_library_paths, $file_path);
|
|
|
+ },
|
|
|
+ 'import' => sub {
|
|
|
+ my $module_path = shift;
|
|
|
+ my @module_files = sub {
|
|
|
+ my @files;
|
|
|
+ foreach my $path ( @module_library_paths ) {
|
|
|
+ my @f = split("\n", `find $path`);
|
|
|
+ foreach my $file ( @f ) {
|
|
|
+ if ( $file =~ m/.module$/ ) {
|
|
|
+ push(@files, $file);
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ return @files;
|
|
|
+ }->();
|
|
|
+ foreach my $mod_file ( @module_files ) {
|
|
|
+ my $mod_file_content = read_to_var($mod_file);
|
|
|
+ my $mod_ref = parse_module_file($mod_file_content);
|
|
|
+
|
|
|
+ foreach my $ref ( @{$AST{'Modules'}} ) {
|
|
|
+ if ( $$mod_ref{'Manufacturer'} eq $$ref{'Manufacturer'} &&
|
|
|
+ $$mod_ref{'Rev'} eq $$ref{'Rev'} ) {
|
|
|
+ # We've already imported this module
|
|
|
+ next;
|
|
|
+ } else {
|
|
|
+ push(@{$AST{'Modules'}}, $mod_ref);
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ },
|
|
|
+ 'set' => sub { print("$_[0]\n"); },
|
|
|
+);
|
|
|
+
|
|
|
+# Basic line parser
|
|
|
+sub line_parse($) {
|
|
|
+ my $line = shift;
|
|
|
+ my $line_type = "null";
|
|
|
+ my @line_caps;
|
|
|
+ foreach my $key ( keys %PARSE_TABLE ) {
|
|
|
+ if ( $line =~ m/$PARSE_TABLE{$key}/ ) {
|
|
|
+ $line_type = $key;
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if ( $line_type ne "null" && $line =~ m/$PARSE_TABLE{$line_type}/) {
|
|
|
+ if ( defined $1 ) {
|
|
|
+ $PARSE_RULES{$line_type}->($1);
|
|
|
+ } else {
|
|
|
+ $PARSE_RULES{$line_type}->();
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ print("$line\n");
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+foreach my $line ( split("\n", $src_content) ) {
|
|
|
+ chomp $line;
|
|
|
+ if ( $line eq "" ) {
|
|
|
+ next;
|
|
|
+ }
|
|
|
+ line_parse($line);
|
|
|
+}
|
|
|
+
|
|
|
+
|
|
|
+print Dumper %AST;
|