The basic model of development that’s been my hobby for the past year has been to use a custom scripting language to configure an object model which is then consumed by a GUI or something– eliminating large amounts of maintenance and opening up a form of tool-oriented development that allows for an order of magnitude increase in code reuse. That was my big thing after getting halfway through SICP– and the trojan horse by which I could sneak in some of the benefits of Lisp into a more Blubby environment. Doing that sort of thing got me into some serious parsing, which made me realize I really needed to bone up on regular expressions. I messed around with sed and awk enough that I finally broke down and decided to learn Perl. Now I’m working through O’Reilly’s Intermediate Perl book so I can understand and use more stuff from Dominus’s book Higher Order Perl.

The code below was mainly done so that I could get a better handle on references in Perl. I’m having a hard time getting up to speed with it, but hopefully after a few more projects like this I’ll get the hang of it. I also wanted to try to improve on the parser design that I thrashed out for Blub a while back. Finally, I wanted to play around with the concept of a dispatch table before rereading Dominus’s chapter on the subject.

Anyways… what I’ve done is constructed my first complex data structure in Perl: a set of nested hash tables and arrays that describe a table of data. We’re loading up the tables by parsing a text file. I’m tired of parsing beginning and ending brackets, so I’m trying maybe a more Python style approach of just using whitespace to indicate the end of a section. Here’s an example table.

Table Stuff: Key/[A-Z]/, Description A, Fooie B, Barrie

The dispatch table (and Perl’s core features) allow us to treat code as data. With just a few language features built in to our parser, we can allow the users of our scripting language to extend and redefine the parser from within their scripts. Pretty cool…. (Dominus goes much further into this than I do, of course. And I’m crazy, so don’t judge his book by my bad code– I’m just learning, here, with my lame “3rd grade” level of Perl fluency.)

As I go further into the book Intermediate Perl, I can maybe come back and revisit this by turning it into an object. Also, I’m not using the regex’s I’ve tacked onto the table columns, so maybe I could write a validation routine that checks that the column data matches the expression. Another change might be to have a second dispatch table to handle the different state changes… but that may be overcomplicating it. [Actually, after refactoring a bit, it seems okay.] I’m sure I might come up with a different architecture if I read some chapters on compiler-like code….

#/bin/perl use strict; use warnings; my %tables; my $read_type = 0; my $current_table = "None"; my $show_debug = 0; sub cell { my ($table, $key, $column) = @_; my $rs = rows($table); my $r = $rs->{$key}; return $r->{$column}; } ### returns an array of column names sub columns { my ($table) = @_; my $t = $tables{$table}; return $t->{"Columns"}; } ### returns a hash of row hashes sub rows { my ($table) = @_; my $t = $tables{$table}; return $t->{"Rows"} } ### returns an array of column regex's for validating cells sub column_regexes { my ($table) = @_; my $t = $tables{$table}; return $t->{"ColumnRegexes"} } sub add_table { my ($key, $table) = @_; $tables{$key} = $table; } sub add_row { my ($table, $key, $row) = @_; rows($table)->{$key} = $row; } ### pass an array of columns and an array of column regex's ### and get a table hash back sub initialize_table { my ($columns, $regexes) = @_; my %table; $table{"Columns"} = $columns; $table{"ColumnRegexes"} = $regexes; my %empty_rows; $table{"Rows"} = \%empty_rows; return \%table; } ### pass a comma delimited header line from a table definition ### and get two array references describing the table structure sub parse_column_header { my ($line) = @_; my @fields = split /,/, $line; my $column_number = 0; my @columns; my @regexes; print "reading columns to table $current_table: $line

" if $show_debug; foreach(@fields){ my $field = $_; $field =~ s/^\s+|\s+$//g; # trim field if($field =~ /^([^\/]*)\/([^\/]*)\//){ $field = $1; $regexes[$column_number] = $2; } $columns[$column_number] = $field; $column_number++; } return (\@columns, \@regexes); } ### pass a table name and a comma delimited header line from a table definition ### and get the row's key and a hash of detail data sub parse_row_detail { my ($table, $line) = @_; my @fields = split /,/, $line; print "reading rows to table $current_table: $line

" if $show_debug; my %row; my $column_number = 0; my $rowkey; foreach(@fields){ my $field = $_; $field =~ s/^\s+|\s+$//g; # trim field if ($rowkey){ $row{columns($current_table)->[$column_number]} = $field; } else { $rowkey = $field; } $column_number++; } return ($rowkey, \%row); } sub reading_table_header { my ($line) = @_; my ($columns, $regexes) = parse_column_header($line); add_table($current_table, initialize_table($columns,$regexes)); $read_type = 2; } sub reading_table_detail { my ($line) = @_; my ($rowkey, $row) = parse_row_detail($current_table, $line); add_row($current_table, $rowkey, $row); } my $dispatch_table = { '^Table ([A-Za-z]+):' => sub { $current_table = $1; $read_type = 1; print "(reading table $1)

" if $show_debug; }, '^\#(.*)' => sub { print "found a comment: $1

" if $show_debug; }, '^[\w]*$' => sub { print "(Whitespace line)

" if $show_debug; $read_type = 0; } }; my $alternate_dispatch_table = { 1 => \&reading_table_header, 2 => \&reading_table_detail }; while(<>){ my $line = $_; my $success = 0; my $key; foreach $key (sort keys %{$dispatch_table}) { if ($line =~ /$key/){ $dispatch_table->{$key}->(); $success = 1; last; } } if ($success == 0 and $read_type > 0) { chomp($line); my $altcode = $alternate_dispatch_table->{$read_type}; $altcode->($line); } } my $a = cell("Stuff", "B", "Description"); print "a is $a

"; my $cols = columns("Junk"); print "Look at this: $cols->[0], $cols->[1], $cols->[2]

";

Share this: Twitter

Facebook

Like this: Like Loading... Related