From 186a9f53298c9495e337bd7b0eaccd4484be0816 Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Fri, 22 Sep 2017 14:21:36 -0500 Subject: [PATCH] Move maclib.pm to libcom --- src/tools/EPICS/macLib.pm | 250 -------------------------------------- src/tools/Makefile | 1 - 2 files changed, 251 deletions(-) delete mode 100644 src/tools/EPICS/macLib.pm diff --git a/src/tools/EPICS/macLib.pm b/src/tools/EPICS/macLib.pm deleted file mode 100644 index 412c6d709..000000000 --- a/src/tools/EPICS/macLib.pm +++ /dev/null @@ -1,250 +0,0 @@ -#************************************************************************* -# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne -# National Laboratory. -# EPICS BASE is distributed subject to a Software License Agreement found -# in file LICENSE that is included with this distribution. -#************************************************************************* - -package EPICS::macLib::entry; - -sub new ($$) { - my $class = shift; - my $this = { - name => shift, - type => shift, - raw => '', - val => '', - visited => 0, - error => 0, - }; - bless $this, $class; - return $this; -} - -sub report ($) { - my ($this) = @_; - return unless defined $this->{raw}; - printf "%1s %-16s %-16s %s\n", - ($this->{error} ? '*' : ' '), $this->{name}, $this->{raw}, $this->{val}; -} - - -package EPICS::macLib; - -use Carp; - -sub new ($@) { - my $proto = shift; - my $class = ref($proto) || $proto; - my $this = { - dirty => 0, - noWarn => 0, - macros => [{}], # [0] is current scope, [1] is parent etc. - }; - bless $this, $class; - $this->installList(@_); - return $this; -} - -sub installList ($@) { - # Argument is a list of strings which are arguments to installMacros - my $this = shift; - while (@_) { - $this->installMacros(shift); - } -} - -sub installMacros ($$) { - # Argument is a string: a=1,b="2",c,d='hello' - my $this = shift; - $_ = shift; - until (defined pos($_) and pos($_) == length($_)) { - m/\G \s* /xgc; # Skip whitespace - if (m/\G ( [A-Za-z0-9_-]+ ) \s* /xgc) { - my ($name, $val) = ($1); - if (m/\G = \s* /xgc) { - # The value follows, handle quotes and escapes - until (pos($_) == length($_)) { - if (m/\G , /xgc) { last; } - elsif (m/\G ' ( ( [^'] | \\ ' )* ) ' /xgc) { $val .= $1; } - elsif (m/\G " ( ( [^"] | \\ " )* ) " /xgc) { $val .= $1; } - elsif (m/\G \\ ( . ) /xgc) { $val .= $1; } - elsif (m/\G ( . ) /xgc) { $val .= $1; } - else { die "How did I get here?"; } - } - $this->putValue($name, $val); - } elsif (m/\G , /xgc or (pos($_) == length($_))) { - $this->putValue($name, undef); - } else { - warn "How did I get here?"; - } - } elsif (m/\G ( .* )/xgc) { - croak "Can't find a macro definition in '$1'"; - } else { - last; - } - } -} - -sub putValue ($$$) { - my ($this, $name, $raw) = @_; - if (exists $this->{macros}[0]{$name}) { - if (!defined $raw) { - delete $this->{macros}[0]{$name}; - } else { - $this->{macros}[0]{$name}{raw} = $raw; - } - } else { - my $entry = EPICS::macLib::entry->new($name, 'macro'); - $entry->{raw} = $raw; - $this->{macros}[0]{$name} = $entry; - } - $this->{dirty} = 1; -} - -sub pushScope ($) { - my ($this) = @_; - unshift @{$this->{macros}}, {}; -} - -sub popScope ($) { - my ($this) = @_; - shift @{$this->{macros}}; -} - -sub suppressWarning($$) { - my ($this, $suppress) = @_; - $this->{noWarn} = $suppress; -} - -sub expandString($$) { - my ($this, $src) = @_; - $this->_expand; - (my $name = $src) =~ s/^ (.{20}) .* $/$1.../xs; - my $entry = EPICS::macLib::entry->new($name, 'string'); - my $result = $this->_translate($entry, 0, $src); - return $result unless $entry->{error}; - return $this->{noWarn} ? $result : undef; -} - -sub reportMacros ($) { - my ($this) = @_; - $this->_expand; - print "Macro report\n============\n"; - foreach my $scope (@{$this->{macros}}) { - foreach my $name (keys %{$scope}) { - my $entry = $scope->{$name}; - $entry->report; - } - } continue { - print " -- scope ends --\n"; - } -} - - -# Private routines, not intended for public use - -sub _expand ($) { - my ($this) = @_; - return unless $this->{dirty}; - foreach my $scope (@{$this->{macros}}) { - foreach my $name (keys %{$scope}) { - my $entry = $scope->{$name}; - $entry->{val} = $this->_translate($entry, 1, $entry->{raw}); - } - } - $this->{dirty} = 0; -} - -sub _lookup ($$$$$) { - my ($this, $name) = @_; - foreach my $scope (@{$this->{macros}}) { - if (exists $scope->{$name}) { - return undef # Macro marked as deleted - unless defined $scope->{$name}{raw}; - return $scope->{$name}; - } - } - return undef; -} - -sub _translate ($$$$) { - my ($this, $entry, $level, $str) = @_; - return $this->_trans($entry, $level, '', \$str); -} - -sub _trans ($$$$$) { - my ($this, $entry, $level, $term, $R) = @_; - return $$R - if (!defined $$R or - $$R =~ m/\A [^\$]* \Z/x); # Short-circuit if no macros - my $quote = 0; - my $val; - until (defined pos($$R) and pos($$R) == length($$R)) { - if ($term and ($$R =~ m/\G (?= [$term] ) /xgc)) { - last; - } - if ($$R =~ m/\G \$ ( [({] ) /xgc) { - my $macEnd = $1; - $macEnd =~ tr/({/)}/; - my $name2 = $this->_trans($entry, $level+1, "=$macEnd", $R); - my $entry2 = $this->_lookup($name2); - if (!defined $entry2) { # Macro not found - if ($$R =~ m/\G = /xgc) { # Use default value given - $val .= $this->_trans($entry, $level+1, $macEnd, $R); - } else { - unless ($this->{noWarn}) { - $entry->{error} = 1; - printf STDERR "macLib: macro '%s' is undefined (expanding %s '%s')\n", - $name2, $entry->{type}, $entry->{name}; - } - $val .= "\$($name2)"; - } - $$R =~ m/\G [$macEnd] /xgc; # Discard close bracket - } else { # Macro found - if ($entry2->{visited}) { - $entry->{error} = 1; - printf STDERR "macLib: %s '%s' is recursive (expanding %s '%s')\n", - $entry->{type}, $entry->{name}, $entry2->{type}, $entry2->{name}; - $val .= "\$($name)"; - } else { - if ($$R =~ m/\G = /xgc) { # Discard default value - local $this->{noWarn} = 1; # Temporarily kill warnings - $this->_trans($entry, $level+1, $macEnd, $R); - } - $$R =~ m/\G [$macEnd] /xgc; # Discard close bracket - if ($this->{dirty}) { # Translate raw value - $entry2->{visited} = 1; - $val .= $this->_trans($entry, $level+1, '', \$entry2->{raw}); - $entry2->{visited} = 0; - } else { - $val .= $entry2->{val}; # Here's one I made earlier... - } - } - } - } elsif ($level > 0) { # Discard quotes and escapes - if ($quote and $$R =~ m/\G $quote /xgc) { - $quote = 0; - } elsif ($$R =~ m/\G ( ['"] ) /xgc) { - $quote = $1; - } elsif ($$R =~ m/\G \\? ( . ) /xgc) { - $val .= $1; - } else { - warn "How did I get here? level=$level"; - } - } else { # Level 0 - if ($$R =~ m/\G \\ ( . ) /xgc) { - $val .= "\\$1"; - } elsif ($$R =~ m/\G ( [^\\\$'")}]* ) /xgc) { - $val .= $1; - } elsif ($$R =~ m/\G ( . ) /xgc) { - $val .= $1; - } else { - warn "How did I get here? level=$level"; - } - } - } - return $val; -} - -1; diff --git a/src/tools/Makefile b/src/tools/Makefile index 7247fb0da..cef1127bf 100644 --- a/src/tools/Makefile +++ b/src/tools/Makefile @@ -16,7 +16,6 @@ PERL_MODULES += EPICS/Path.pm PERL_MODULES += EPICS/Release.pm PERL_MODULES += EPICS/Readfile.pm PERL_MODULES += EPICS/Getopts.pm -PERL_MODULES += EPICS/macLib.pm PERL_SCRIPTS += assembleSnippets.pl PERL_SCRIPTS += convertRelease.pl