#!/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\ (.*)$', 'connect' => '^connect(.*)$', ); my %PARSE_RULES = ( 'comment' => sub { # Do nothing, throw this line out }, '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_import = shift; my $import_manu = shift; my $import_mod = shift; my $import_as = 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$/ ) { my $f_bn = `basename $file`; chomp $f_bn; if ( ! grep(/$f_bn/, @files) ) { 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); if ( $import_mod eq $$mod_ref{'Module'} ) { if ( defined $AST{'Modules'} ) { my $r = grep { $import_mod eq $_->{'Module'} } @{$AST{'Modules'}}; if ( $r == 0 ) { push(@{$AST{'Modules'}}, $mod_ref); } } else { push(@{$AST{'Modules'}}, $mod_ref); } } else { next; } } }, 'set' => sub { my $set_line = shift; my $mod_to_set; my $attr_to_set; my $attr_param; my $value; my $setter = sub { my $mod_to_set = shift; my $attr_to_set = shift; my $attr_param = shift; if ( $attr_param eq "position" ) { $attr_param = "pos"; } my $value = shift; my %set_params = ( 'Param' => $attr_param, 'Value' => $value, ); # Check values against mod definition # Pull mod ref out of AST for straight forward checking my $mod_ref; # Check we have module in AST my $r = grep { $mod_to_set eq $_->{'Module'} } @{$AST{'Modules'}}; if ( $r eq 0 ) { die "Can't set value on module that is not imported: $mod_to_set\n"; } else { foreach my $module_ref ( @{$AST{'Modules'}} ) { if ( $mod_to_set eq $$module_ref{'Module'} ) { $mod_ref = $module_ref; last; } } } # Check that module has param we want to set if ( ! $attr_to_set eq $$mod_ref{'Inputs'}->{$attr_to_set} ) { die "Can't set a param that doesn't existing in the module spec: $attr_to_set"; } # If the set has an attr param, check that it's in the allowed range on the attr if ( $attr_param ne "null" ) { my $attr_range = $$mod_ref{'Inputs'}->{$attr_to_set}->{'pos'}; if ( $attr_range =~ m/([0-9]{1,2})\-([0-9]{1,2})/ ) { my $r_begin = $1; my $r_end = $2; if ( $value > $r_end || $value < $r_begin ) { die "Parse error: attr_param value: $value for $attr_to_set : $attr_param is outside of range: $r_begin $r_end"; } } else { die "Somehow encountered parse error in setter for module file $$mod_ref{'Module'}\n"; } } $AST{'Sets'}->{$mod_to_set}->{$attr_to_set} = \%set_params; }; if ( $set_line =~ m/(^[A-Z]{1}[a-z]{1,})\.{1}([A-Za-z0-9]{1,})\ \=\ (.*)$/ ) { $mod_to_set = $1; $attr_to_set = $2; $value = $3; } elsif ( $set_line =~ m/(^[A-Z]{1}[a-z]{1,})\.{1}([A-Za-z0-9]{1,})\.([A-Za-z0-9]{1,})\ \=\ (.*)$/ ) { $mod_to_set = $1; $attr_to_set = $2; $attr_param = $3; $value = $4; } else { die "Parse error at $set_line"; } if ( ! defined $attr_param || $attr_param eq "" ) { $attr_param = "null", }; $setter->($mod_to_set,$attr_to_set,$attr_param,$value); }, 'connect' => sub { my $connect_line = shift; $connect_line = trim($connect_line); }, ); # 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 && ! defined $2 ) { $PARSE_RULES{$line_type}->($1); } elsif ( defined $1 && defined $2 && defined $3 && defined $4 ) { # This is for `import` $PARSE_RULES{$line_type}->($1,$2,$3,$4); } 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;