epics/utilities
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

better line based diagnostics possible

Browse Source
This commit is contained in:
zimoch
2016-02-19 12:31:15 +00:00
parent 5961408c25
commit 800cf807fa
1 changed files with 109 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

144
dbLoadTemplate
View File

@@ -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 = <ARGV>;
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";
}