From 800cf807fa6ccfb232094eabfb374b5b20cd8b3b Mon Sep 17 00:00:00 2001 From: zimoch Date: Fri, 19 Feb 2016 12:31:15 +0000 Subject: [PATCH] better line based diagnostics possible --- dbLoadTemplate | 144 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 109 insertions(+), 35 deletions(-) diff --git a/dbLoadTemplate b/dbLoadTemplate index 7a8a68c..5a10ca7 100755 --- a/dbLoadTemplate +++ b/dbLoadTemplate @@ -1,8 +1,16 @@ #!/usr/bin/env perl -# $Header: /cvs/G/EPICS/App/scripts/dbLoadTemplate,v 1.10 2014/07/23 09:15:57 zimoch Exp $ +# $Header: /cvs/G/EPICS/App/scripts/dbLoadTemplate,v 1.11 2016/02/19 12:31:15 zimoch Exp $ use strict; +use Getopt::Long; +use Data::Dumper; + +my $show_lines; +my @include_dirs; +GetOptions ("L" => \$show_lines, + "I=s" => \@include_dirs) +or die("Error in command line arguments\n"); my $QUOTECHAR = '"'; my $NOWORDCHAR = ",(){}="; @@ -23,27 +31,42 @@ sub nextToken { $input = ; if (!defined $input) { return if index ($flags, "e") >= $[; - die "unexpected end of file in $ARGV\n"; + die "$ARGV:$.: unexpected end of file\n"; } } $input =~ s/^\s*($STRING|$SUBST|$WORD|$NOWORD)\s*(#.*\n?)?//; - $1 ne $QUOTECHAR or die "unterminated string in $ARGV line $.\n"; - #print STDERR "nextToken from $ARGV line $. is $1\n"; + $1 ne $QUOTECHAR or die "$ARGV:$.: unterminated string\n"; + #print STDERR "nextToken from $ARGV:$. is $1\n"; $1; } sub peekToken { - my $token = nextToken; + my $token; + $token = nextToken; $input = "$token $input"; $token; } our %subst; +our %global; + +sub expand; sub replace { my $macro = shift; - defined $subst{$macro} or die "macro \$($macro) undefined in $ARGV line $.\n"; - $subst{$macro}; + my $default = shift; + if (defined $subst{$macro}) { return $subst{$macro}; } + if (defined $default) { + print "$ARGV:$.:$macro default $default\n"; + return $default; + } + die "$ARGV:$.: macro \$($macro) undefined\n"; +} + +sub expand { + m/\$\(([^)]*)$/ and die "$ARGV:$.: unterminated macro \$($1\n"; + %subst and s/\$\(([^=)]*)?(=([^)]*))?\)/replace $1,$3/ge; # replace macros + $_; } sub expect { @@ -58,12 +81,20 @@ sub expect { $desc = "'$expr'" if $desc eq ""; $success = /^$expr$/; } - $success or die "parse error in $ARGV line $.: found '$_' instead of $desc\n"; + $success or die "$ARGV:$.: parse error: found '$_' instead of $desc\n"; } s/^$QUOTECHAR(.*)$QUOTECHAR$/$1/; # remove quotes around strings - m/\$\(([^)]*)$/ and die "unterminated macro \$($1 in $ARGV line $.\n"; - %subst and s/\$\((.*?)\)/replace($1)/ge; # replace macros - $_; + expand; +} + +sub findFile { + my $filename = shift; + if (-e $filename) { return $filename; } + foreach my $dir (@include_dirs) { + my $path = "$dir/$filename"; + if (-e $path) { return $path; } + } + return 0; } sub handleRecord; @@ -71,22 +102,30 @@ sub handleAlias; sub parseRecord { eval { expect "g?record|alias 'record' or 'grecord' or 'alias'" }; - # print STDERR "parseRecord $ARGV line $.\n"; + # print STDERR "parseRecord $ARGV:$.\n"; if ($@) { $@ =~ /end of file/ or die $@; return 0; } + if ($_ eq "alias") { my $name = expect "(", "$STRING quoted record name"; my $alias = expect ",", "$STRING quoted alias name"; expect ")"; - handleAlias $name, $alias; + handleAlias $name, $alias, $.; return 1; } - + my $rtype = expect "(", "$WORD record type"; my $name = expect ",", "$STRING quoted record name"; - expect ")", "{"; + my $line = $.; + expect ")"; + eval {expect "{";}; + if ($@) { + $@ =~ /end of file/ or die $@; + handleRecord $rtype,$name,$line; + return 0; + } my @fields; my @aliases; while (1) { @@ -103,9 +142,10 @@ sub parseRecord { last if $_ eq "}"; push @fields, expect "(", "$WORD field name"; push @fields, expect ",", "$STRING|$SUBST quoted field value"; + push @fields, $.; expect ")"; - } - handleRecord $rtype,$name,@fields; + } + handleRecord $rtype,$name,$line,@fields; while (@aliases) { handleAlias $name, shift @aliases; } @@ -118,6 +158,7 @@ sub parseTemplate { local *ARGV; local $input; @ARGV = @_; + if ($show_lines) { print "# file @_\n";} while (parseRecord) {}; } else { while (parseRecord) {}; @@ -126,20 +167,33 @@ sub parseTemplate { } sub parseSubst { - # print STDERR "parseSubst $ARGV line $.\n"; - my $filename; - eval { $filename = expect "file","$STRING|$WORD file name" }; + # print STDERR "parseSubst $ARGV:$.\n"; + eval { expect "file|global" }; if ($@) { $@ =~ /end of file/ or die $@; return 0; } - die "template file $filename not found in $ARGV line $.\n" unless -e $filename; - die "template file $filename not readable in $ARGV line $.\n" unless -r $filename; + if ($_ eq "global") { + expect "{"; + while (1) { + my $macro; + $macro = expect "$WORD|,|} macro name"; + # one comma allowed + if ($_ eq ",") {$macro = expect "$WORD|} macro name";} + last if $_ eq '}'; + expect "=", "$STRING|$SUBST value for $macro"; + $global{$macro} = $_; + } + return 1; + } + + my $filename = expect "$STRING|$WORD file name"; + $filename = findFile $filename or die "$ARGV:$.: template file $filename not found\n"; eval { expect "{","pattern|{ 'pattern' or '{'" }; if ($_ eq "{") { # old style substitution do { - local %subst; + local %subst = %global; while (1) { my $macro; $macro = expect "$WORD|,|} macro name"; @@ -152,9 +206,9 @@ sub parseSubst { my $n; $n = scalar (keys %subst); if ($n > 100) { - print STDERR "Warning: more than 100 marcos ($n in your case) is not supported\n"; + print STDERR "Warning: more than 100 marcos ($n in your case): Don't forget to adjust var dbTemplateMaxVars\n"; } - eval {parseTemplate $filename} or die "$@called from $ARGV line $.\n"; + eval {parseTemplate $filename} or die "$@$ARGV:$.: called from here\n"; expect "{|} '{' or '}'"; } while $_ eq "{"; } else { @@ -171,10 +225,10 @@ sub parseSubst { my $n; $n = scalar (@macros); if ($n > 100) { - print STDERR "Warning: more than 100 marcos ($n in your case) is not supported\n"; + print STDERR "Warning: more than 100 marcos ($n in your case): Don't forget to adjust var dbTemplateMaxVars\n"; } while (1) { - local %subst; + local %subst = %global; expect "{|} '{' or '}'"; last if $_ eq "}"; foreach my $macro (@macros) { @@ -183,22 +237,20 @@ sub parseSubst { $subst{$macro} = $_; } expect "}"; - eval {parseTemplate $filename} or die "$@called from $ARGV line $.\n"; + eval {parseTemplate $filename} or die "$@called from $ARGV:$.\n"; }; } return 1; } sub parseFiles { - foreach (@_) { - die "file $_ not found.\n" unless -e $_; - die "file $_ not readable.\n" unless -r $_; - } foreach (@_) { local *ARGV; + local %global; local %subst; - @ARGV = $_; - if (peekToken eq "file") { + my $filename = findFile $_ or die "file $_ not found\n"; + @ARGV = $filename; + if (peekToken =~ "file|global") { while (parseSubst) {}; } else { parseTemplate; @@ -206,14 +258,34 @@ sub parseFiles { } } +sub printline { + if (!$show_lines) { return; } + my $line = shift; + our $oldline; + if ($line != $oldline+1) { + my $d = $line - $oldline - 1; + if ($d > 0 && $d < 3) { + print substr("\n\n\n",1,$d); + } else { + print "# line $line\n"; + } + } + $oldline = $line; +} + sub handleRecord { my $rtype = shift; my $rname = shift; + my $line = shift; + printline $line; print "record($rtype,\"$rname\") {"; while (@_) { my $fieldname = shift; my $value = shift; - print "\n\t\tfield($fieldname, \"$value\")"; + my $line = shift; + print "\n"; + printline $line; + print "\t\tfield($fieldname, \"$value\")"; } print "}\n"; } @@ -221,6 +293,8 @@ sub handleRecord { sub handleAlias { my $rname = shift; my $alias = shift; + my $line = shift; + printline $line; print "alias(\"$rname\",\"$alias\")\n"; }