utilities/dbLoadTemplate

#!/usr/bin/env perl

#$Author: zimoch $
#$Date: 2008/09/19 11:13:04 $
#$Revision: 1.1 $
#$Id: dbLoadTemplate,v 1.1 2008/09/19 11:13:04 zimoch Exp $

use strict;

my $QUOTECHAR = '"';
my $NOWORDCHAR = ",(){}=";

my $NOWORD=qr/[${NOWORDCHAR}${QUOTECHAR}]/;
my $WORD=qr/[^\s${NOWORDCHAR}${QUOTECHAR}]+/;
my $STRING=qr/(?:$QUOTECHAR([^$QUOTECHAR]*)$QUOTECHAR)/;

# nextToken returns the next input word, string, or char
# It skips comments and whitespace
# it dies at end of file or on unterminated string
our $input = "";

sub nextToken {
    my $flags = shift;
    while ($input =~ /^\s*(#|$)/) {
        $input = <ARGV>;
        if (!defined $input) {
            return if index ($flags, "e") >= $[;
            die "unexpected end of file in $ARGV\n";
        }
    }
    $input =~ s/^\s*($WORD|$STRING|$NOWORD)\s*(#.*\n?)?//;
    $1 ne $QUOTECHAR or die "unterminated string in $ARGV line $.\n";
    # print STDERR "nextToken from $ARGV line $. is $1\n";
    $1;
}

sub peekToken {
    my $token = nextToken;
    $input = "$token $input";
    $token;
}

our %subst;

sub replace {
    my $macro = shift;
    defined $subst{$macro} or die "macro \$($macro) undefined in $ARGV line $.\n";
    $subst{$macro};
}

sub expect {
    my ($desc, $success, $token);
    foreach my $want (@_) {
        $_ = nextToken;
        if (length $want == 1) { # single character
            $desc = "'$want'";
            $success = $_ eq $want;
        } else {
            (my $expr, $desc) = split / /, $want, 2;
            $desc = "'$expr'" if $desc eq "";
            $success = /^$expr$/;
        }
        $success or die "parse error in $ARGV line $.: found '$_' instead of $desc\n";
    }
    if (s/^"(.*)"$/$1/) {
        %subst and s/\$\(([^\)]*)\)/replace($1)/ge;
    }
    $_;
}

sub handleRecord;

sub parseRecord {
    eval { expect "g?record 'record' or 'grecord'" };
    # print STDERR "parseRecord $ARGV line $.\n";
    if ($@) {
        $@ =~ /end of file/ or die $@;
        return 0;
    }
    my $rtype = expect "(", "$WORD record type";
    my $name = expect ",", "$STRING quoted record name";
    expect ")", "{";
    my @fields;
    while (1) {
        expect "field|} 'field'";
        last if $_ eq "}";
        push @fields, expect "(", "$WORD field name";
        push @fields, expect ",", "$STRING quoted field value";
        expect ")";
    } 
    handleRecord $rtype,$name,@fields;
    return 1;
}

sub parseTemplate {
    # print STDERR "parseTemplate @_\n";
    if (@_) {
        local *ARGV;
        local $input;
        @ARGV = @_;
        while (parseRecord) {};
    } else {
        while (parseRecord) {};
    }
}

sub parseSubst {
    # print STDERR "parseSubst $ARGV line $.\n";
    my $filename;
    eval { $filename = expect "file","$WORD file name" };
    if ($@) {
        $@ =~ /end of file/ or die $@;
        return 0;
    }
    eval { expect "{","pattern|{ 'pattern' or '{'" };
    if ($_ eq "{") {
        # old style substitution
        do {
            while (1) {
                my $macro;
                do {
                    $macro = expect "$WORD|,|} macro name";
                } while $_ eq ",";   # ignore commas
                last if $_ eq '}';
                expect "=", "$WORD|$STRING value for $macro";
                $subst{$macro} = $_;
            }
            parseTemplate $filename;
            expect "{|} '{' or '}'";
        } while $_ eq "{";
    } else {
        # pattern substitution
        expect "{";
        my @macros;
        while (1) {
            do {
                expect "$WORD|,|} macro name";
            } while $_ eq ",";  # ignore commas
            last if $_ eq '}';
            push @macros, $_;
        };
        while (1) {
            local %subst;
            expect "{|} '{' or '}'";
            last if $_ eq "}";
            foreach my $macro (@macros) {
                do {
                    expect "$WORD|$STRING|, value for $macro";
                } while $_ eq ",";  # ignore commas
                $subst{$macro} = $_;
            }
            expect "}";
            parseTemplate $filename;
        };
    }
    return 1;
}

sub parseFiles {
    foreach (@_) {
        local *ARGV;
        local %subst;
        @ARGV = $_;
        if (peekToken eq "file") {
            while (parseSubst) {};
        } else {
            parseTemplate;
        }
    }
}

sub handleRecord {
    my $rtype = shift;
    my $rname = shift;
    print "record($rtype,\"$rname\") {";
    while (@_) {
        my $fieldname = shift;
        my $value = shift;
        print "\n\t\tfield($fieldname, \"$value\")";
    }
    print "}\n";
}

parseFiles @ARGV