Replacement for missing dbLoadTemplate in EPICS 3.14.8

New feature: can be used to re-format templates
2008-09-19 11:13:04 +00:00
parent 81a5fea6a1
commit edd0f61301
1 changed files with 184 additions and 0 deletions
--- a/184
+++ b/184
@@ -0,0 +1,184 @@
+#!/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