modmark/pl_proto.pl

#!/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;