author | A.M. Thurnherr <athurnherr@yahoo.com> |
Wed, 30 Jul 2014 10:06:32 -0400 | |
changeset 12 | 58c5aa230550 |
parent 3 | 55a8c407d38e |
child 13 | bdd925186562 |
permissions | -rw-r--r-- |
0 | 1 |
#!/usr/bin/perl |
2 |
#====================================================================== |
|
3 |
# A N T S I O . P L |
|
4 |
# doc: Fri Jun 19 19:22:51 1998 |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
5 |
# dlm: Tue Jul 22 20:39:11 2014 |
0 | 6 |
# (c) 1998 A.M. Thurnherr |
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
7 |
# uE-Info: 497 0 NIL 0 0 70 2 2 4 NIL ofnI |
0 | 8 |
#====================================================================== |
9 |
||
10 |
# HISTORY: |
|
11 |
# Jun 19, 1998: - created |
|
12 |
# Dec 29, 1998: - added antsLineFlag and antsLinePrefix |
|
13 |
# Dec 30, 1998: - added -P)assthrough option handling, arg to &antsFlush() |
|
14 |
# Jan 02, 1999: - changed -P to -T and added -P)refix for [./fnr] |
|
15 |
# Feb 17, 1999: - added &antsReadFile() |
|
16 |
# Feb 25, 1999: - added &antsInfo() |
|
17 |
# Mar 11, 1999: - set undefined ret-vals of &antsBufOut() to NaN |
|
18 |
# Mar 12, 1999: - added FILE to &antsPrintHeaders() |
|
19 |
# Mar 14, 1999: - BUG ensured that $ants_[0] was defined when |
|
20 |
# typical &antsBufFull was called on empty buffer |
|
21 |
# - added &antsPostFlush() |
|
22 |
# - added &antsSetR_() |
|
23 |
# - BUG padding by &antsSet_() was broken |
|
24 |
# Mar 20, 1999: - added code to abort if file on cmdline does not exist |
|
25 |
# - removed &antsReadFile() |
|
26 |
# Oct 31, 1999: - BUG when using -I |
|
27 |
# Dec 06, 1999: - made &antsInfo() respect -Q |
|
28 |
# Mar 07, 2000: - adapted to -M |
|
29 |
# Jul 31, 2000: - removed buffer auto growth unless $antsPadOut |
|
30 |
# Aug 21, 2000: - allow for in-line comments on -T |
|
31 |
# Aug 28, 2000: - added opt_Z to remove leading zeroes on output |
|
32 |
# - added %P handling |
|
33 |
# Sep 03, 2000: - documentation |
|
34 |
# Sep 04, 2000: - ensure %PARAMS are not just whitespace strings |
|
35 |
# Oct 31, 2000: - added &antsReplaceParam() |
|
36 |
# Nov 07, 2000: - added &antsFileScanParam() |
|
37 |
# Nov 10, 2000: - made to ignore DOS EOF (BLOERKS!!!) |
|
38 |
# Nov 16, 2000: - added comment about antsIO() bypassing &antsBufOut() |
|
39 |
# Nov 17, 2000: - made -P override header PARAMs |
|
40 |
# Jan 16, 2001: - cosmetics |
|
41 |
# Feb 19, 2001: - added $antsNoHeaderCopy for [data] |
|
42 |
# Mar 8, 2001: - adapted to -G)range |
|
43 |
# Mar 18, 2001: - BUG: -G had selected NaNs |
|
44 |
# Mar 22, 2001: - added $antsNoEmbeddedHeaderCopy for [fields] [efields] |
|
45 |
# Mar 28, 2001: - mark header info of utils used in pipelines |
|
46 |
# Mar 31, 2001: - updated -G)range |
|
47 |
# - adapted to -F)ields |
|
48 |
# Apr 3, 2001: - added appendfields |
|
49 |
# Apr 5, 2001: - removed string interpolation from &antsOut() |
|
50 |
# - added prependfields |
|
51 |
# May 15, 2001: - output NaN on undefined -F vals |
|
52 |
# Jun 4, 2001: - allowd %PARAMs on -F |
|
53 |
# Jun 19, 2001: - added pseudo param %FILE |
|
54 |
# Jul 9, 2001: - added Active ANTS stuff |
|
55 |
# Jul 10, 2001: - continued, split off &antsParseHeader() |
|
56 |
# Jul 11, 2001: - continued |
|
57 |
# Jul 13, 2001: - replace -F fields names on 1st use |
|
58 |
# Jul 16, 2001: - moved fchmod call to &antsPrintHeaders(), c.f. [Split] |
|
59 |
# Jul 19, 2001: - embedded error messages in pipeline |
|
60 |
# - copy header on -ve -H |
|
61 |
# Jul 24, 2001: - BUG: set $antsNewLayout on -F |
|
62 |
# - BUG: remove % from -F layout |
|
63 |
# - moved fnr lookup for -G from [antsusage.pl] |
|
64 |
# Aug 1, 2001: - BUG: &antsIn() had not restored @ARGV on EOF |
|
65 |
# Aug 3, 2001: - added &antsFileScanLayout() |
|
66 |
# Aug 9, 2001: - BUG: $antsNewLayout was not set on prepend/append fields |
|
67 |
# Aug 10, 2001: - added $opt_G to &antsFileIn() |
|
68 |
# Aug 19, 2001: - BUG: &antsReplaceParam() re-written |
|
69 |
# Aug 29, 2001: - BUG: made -r into -f && -r |
|
70 |
# Oct 28, 2001: - BUG: handled antsLinePrefix on parseHeader |
|
71 |
# Nov 22, 2001: - added $antsParseHeader flag |
|
72 |
# Nov 28, 2001: - allowed %param in -G |
|
73 |
# Dec 30, 2001: - added &antsExit() |
|
74 |
# May 18, 2002: - added %BASENAME, %EXTN |
|
75 |
# May 20, 2002: - added $antsNewFile |
|
76 |
# Jun 22, 2002: - added $antsPadIn |
|
77 |
# Jan 6, 2003: - added $antsGrex (-G regex support) |
|
78 |
# Jan 8, 2003: - added &antsFileParams() |
|
79 |
# Mar 4, 2003: - added %RECNO |
|
80 |
# Apr 14, 2003: - BUG: antsReplaceParam() removed because in-stream |
|
81 |
# %PARAMs are not generally handled correctly |
|
82 |
# - BUG: antsFileScanParam() had returned the first |
|
83 |
# value encountered, NOT the valid (last) one!!! |
|
84 |
# Apr 24, 2003: - BUG: added default $antsPadIn = 1 (required for |
|
85 |
# [gamma_n]) |
|
86 |
# May 8, 2003: - made antsFileIn() respect -N (for [gshear]) |
|
87 |
# Jul 1, 2004: - BUG: $antsBufNFields was not set when an empty file |
|
88 |
# with valid #ANTS#FIELDS# was read |
|
89 |
# Jul 9, 2004: - BUG: test of incompatible in-file field definitions |
|
90 |
# did not work |
|
91 |
# Dec 5, 2004: - BUG: Jul 1 fix did not work correctly in cases where |
|
92 |
# subsequent #ANTS#FIELDS# lines would shrink the |
|
93 |
# number of fields; new fix was not debugged! |
|
94 |
# Jan 17, 2005: - removed path from active files and used perl -S |
|
95 |
# Feb 8, 2005: - made activation-status copy more portable (i.e. |
|
96 |
# independent of perl path) |
|
97 |
# Mar 7, 2005: - added %DIRNAME (& cleaned up %BASENAME %EXTN) |
|
98 |
# Nov 8, 2005: - changed -T to -P, -Z => -T, added -Z |
|
99 |
# Nov 17, 2005: - BUG: antsPreFlush() flushed one too few ([fmedian]) |
|
100 |
# - BUG: antsFlagged was not set correctly any more |
|
101 |
# Nov 18, 2005: - finally allowed %PARAMs bounds in -G |
|
102 |
# Nov 21, 2005: - BUG: %PARAM bounds in -G had broken regexp capability |
|
103 |
# Dec 7, 2005: - BUG: embedded layout overrode @antsFName if $antsNewLayout |
|
104 |
# - replaced @antsFName by @antsLayout{In,Out} |
|
105 |
# Dec 8, 2005: - Version 3.2 (see [HISTORY]) |
|
106 |
# Dec 12, 2005: - disable output padding in &antsOut() if new layout |
|
107 |
# Dec 14, 2005: - made &antsAddParams() set %P |
|
108 |
# - removed &antsReplaceParam() |
|
109 |
# Dec 20, 2005: - BUG: empty field names in Layout replaced by undef |
|
110 |
# - $# is buggy => implemented opt_M without $# |
|
111 |
# Dec 23, 2005: - replaced defined(@array) (c.f. perlfunc(1)) |
|
112 |
# - BUG: -F did not work ok when @antsNewLayout was set |
|
113 |
# Dec 29, 2005: - added $PARAMSonly to avoid output duplication on -F%param |
|
114 |
# Dec 30, 2005: - changed &antsFileIn() EOF return |
|
115 |
# Jan 3, 2006: - BUG: pseudo %PARAMs (e.g. BASENAME) were not set |
|
116 |
# on EOF when buffer is not full |
|
117 |
# - changed %FILE to %FILENAME |
|
118 |
# - added support for -S)elect |
|
119 |
# Jan 4, 2006: - BUG: empty strings were not output as NaN |
|
120 |
# Jan 9, 2006: - removed line flagging code |
|
121 |
# Jan 12, 2006: - replaced old -H)eader skip support with new -H)ead |
|
122 |
# Jan 13, 2006: - new [antsexprs.pl] |
|
123 |
# - removed -G handling (now done as -S) |
|
124 |
# - renamed -T)rim to -C)anonical |
|
125 |
# - removed -Z)ap handling |
|
126 |
# Jan 14, 2006: - continued removing -G |
|
127 |
# Jan 31, 2006: - BUG: selecting last field per record with -I produced |
|
128 |
# an extraneous empty line |
|
129 |
# May 18, 2006: - BUG: set pseudo-params before -S test, to allow e.g. |
|
130 |
# -S %RECNO==3 to work |
|
131 |
# - BUG: set %RECNO on partially full buffer |
|
132 |
# - added %LINENO pseudo param |
|
133 |
# Jun 27, 2006: - BUG: added formal param @ to allow antsOut(NaN) to be |
|
134 |
# used in list -w |
|
135 |
# - changed semantics of antsPadOut() |
|
136 |
# Jul 1, 2006: - Version 3.3 [HISTORY] |
|
137 |
# Jul 10, 2006: - removed fchmod (now in perl chmod) |
|
138 |
# Jul 21, 2006: - removed obsolete code |
|
139 |
# Jul 22, 2006: - shuffled &antsOut() to allow for -H0 |
|
140 |
# Jul 23, 2006: - BUG: -F%PARAM did not work any more |
|
141 |
# Jul 28, 2006: - BUG: pseudo-params were set during header parsing of |
|
142 |
# an empty file |
|
143 |
# Jul 31, 2006: - BUG: @antsLayout was not set on 0-record files |
|
144 |
# - code cleanup |
|
145 |
# Aug 24, 2006: - added $antsIgnoreInputParams |
|
146 |
# Aug 28, 2006: - made antsIgnoreInputParams into eva'ed expr for [bindata] |
|
147 |
# Oct 26, 2006: - allowed for empty lines in &antsFileScanParams() |
|
148 |
# Nov 10, 2006: - suppressed copying of layout even if embedded headers |
|
149 |
# are copied |
|
150 |
# Dec 17, 2007: - modified behavior of antsIgnoreInputParams (see NOTES below) |
|
151 |
# Jan 16, 2007: - re-implemented changes to -P mandated by Dec 14, 2006 |
|
152 |
# changes to [antsusage.pl] |
|
153 |
# May 31, 2007: - added support for -G)eographic coord format |
|
154 |
# Nov 14, 2007: - maded -G work with %PARAMS |
|
155 |
# - BUG: %FILENAME (& others) not set on %PARAMS-only files |
|
156 |
# Nov 15, 2007: - BUG: -G had never worked correctly when selecting fields |
|
157 |
# Feb 8, 2008: - moved number output formatting to fmtNum() [antsutils.pl] |
|
158 |
# Mar 26, 2008: - modified/extended -F behavior |
|
159 |
# Mar 28, 2008: - fiddled |
|
160 |
# Apr 15, 2008: - BUG: pseudo params were not set during header parsing |
|
161 |
# => e.g. %RECNO could not be used in ded addr-expr |
|
162 |
# May 1, 2008: - BUG: embedded header copy also copied embedded layout |
|
163 |
# re-definitions |
|
164 |
# May 22, 2008: - BUG: $antsPadOut = 0 did not suppress padding as intended |
|
165 |
# in presence of layout or new layout => add option of |
|
166 |
# setting it to -1 |
|
167 |
# Jul 11, 2008: - BUG: file-name-related pseudo %PARAMs did not work |
|
168 |
# correctly for input files without extensions |
|
169 |
# - added %FILENAME -> %PATHNAME |
|
170 |
# Jul 21, 2008: - fiddled with antsInfo() |
|
171 |
# Jul 23, 2008: - added code to allow deleting %PARAMs by setting them |
|
172 |
# to undef in [list] |
|
173 |
# Jul 29, 2008: - BUG: removed code to strip leading/trailing spaces from |
|
174 |
# %PARAMs (before, a %PARAM containing just spaces |
|
175 |
# was deleted on an NCode/listNC combo --- there is |
|
176 |
# an example in [ubtest/NCode.TF] |
|
177 |
# Jun 10, 2009: - added duplicate-output-field sanity check |
|
178 |
# Aug 1, 2009: - BUG: duplicate unnamed output files generated error |
|
179 |
# Aug 23, 2009: - V4.0: added &antsAddDeps |
|
180 |
# Aug 25, 2009: - BUG: '-' was added as a dep for STDIN |
|
181 |
# Aug 27, 2009: - added pseudo %PARAM %DEPS |
|
182 |
# Oct 3, 2009: - added $antsAllowEmbeddedLayoutChange |
|
183 |
# Oct 12, 2009: - changed antsAddDeps() to ignore empty dependencies |
|
184 |
# Oct 13, 2009: - removed antsAddDeps() defaults |
|
185 |
# Oct 15, 2009: - replaced \n by \\n in antsAddParams(); primarily for listNC |
|
186 |
# Nov 3, 2009: - BUG: <> dependencies were not set when $antsParseHeader was set to 0 |
|
187 |
# Nov 6, 2009: - BUG: stdin had sometimes produced empty dep |
|
188 |
# Aug 15, 2010: - turned error on duplicate output fields into warning |
|
189 |
# Aug 28, 2010: - moved dependency checks from [list] to here |
|
190 |
# Oct 18, 2010: - disabled dependency checks for files in other directories |
|
191 |
# Oct 19, 2010: - implemented &antsOut('EOF') to clear all static vars & other stuff to |
|
192 |
# allow a single utility to output different ANTS files (used in |
|
193 |
# LADCPproc) |
|
194 |
# Apr 28, 2011: - added code to make all nans lowercase to antsIn() |
|
195 |
# May 20, 2011: - BUG: %LINENO had not been reset between files any more |
|
196 |
# May 22, 2011: - adapted to new antsCompileEditExpr() |
|
197 |
# May 24: 2011: - BUG: forgot '$' in a variable (where???) |
|
198 |
# Jul 28, 2011: - disabled adding of new deps on -D |
|
199 |
# Apr 11, 2012: - improved layout-change error message |
|
200 |
# Apr 26, 2012: - BUG: antsFileScanParam() was not properly anchored (%start_date matched %BT.start_date) |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
201 |
# Jul 20, 2014: - adapted antsFileScanParam() to :: convention |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
202 |
# Jul 22, 2014: - BUG: antsPadIn was done after handling -S & -N |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
203 |
# - removed antsPadIn flag (made it always be true) |
0 | 204 |
|
205 |
# NOTES: |
|
206 |
# - %P was named without an ants-prefix because associative arrays |
|
207 |
# are rare (and perl supports multiple name spaces for the |
|
208 |
# different variable types) and to facilitate its use in |
|
209 |
# [list] |
|
210 |
# - copying of embedded (i.e. not appearing at start) headers is |
|
211 |
# required e.g. for subsample -i ... | list %some-param |
|
212 |
||
213 |
# $antsIngoreInputParams: |
|
214 |
# - is eval'ed first time antsIn() is called (usually while parsing header) |
|
215 |
# - if it evaluates to TRUE, all input %PARAMS are ignored (even if it would |
|
216 |
# later eval to FALSE) |
|
217 |
# - during header parsing, @ARGV only contains additional file arguments, |
|
218 |
# i.e. setting $antsIgnoreInputParams = '@ARGV>0' before antsUsage() is |
|
219 |
# called ignores all input %PARAMs if there is more than 1 file argument |
|
220 |
||
221 |
#====================================================================== |
|
222 |
# Default Behaviour |
|
223 |
#====================================================================== |
|
224 |
||
225 |
# Flags |
|
226 |
||
227 |
$antsFixedFormat = 0; # remove leading & trailing stuff |
|
228 |
$antsParseHeader = 1; # parse header on &antsUsage() |
|
229 |
$antsIgnoreInputParams = 0; # ignore %PARAMs |
|
230 |
$antsAllowEmbeddedLayoutChange = 0; # disallow layount changes |
|
231 |
||
232 |
# Standard Fixed Size Buffer |
|
233 |
||
234 |
sub antsBufFull() # default buffer full |
|
235 |
{return $#ants_+1 == $antsBufSize;} |
|
236 |
sub antsBufOut($) # default constructor |
|
237 |
{return $ants_[$ants_][$_[0]]; } |
|
238 |
||
239 |
# Setup Size 1 Buffer |
|
240 |
||
241 |
$antsBufSize = 1; # default |
|
242 |
$antsBufSkip = 1; |
|
243 |
||
244 |
#====================================================================== |
|
245 |
# Interface |
|
246 |
#====================================================================== |
|
247 |
||
248 |
sub antsInstallBufFull($) |
|
249 |
{ |
|
250 |
eval "sub antsBufFull() { $_[0] }"; |
|
251 |
croak($@) if ($@); |
|
252 |
&antsReCompile(); |
|
253 |
} |
|
254 |
||
255 |
sub antsInstallBufOut($) |
|
256 |
{ |
|
257 |
eval "sub antsBufOut(\$) { my(\$fnr)=\@_; $_[0] }"; |
|
258 |
croak($@) if ($@); |
|
259 |
&antsReCompile(); |
|
260 |
} |
|
261 |
||
262 |
sub antsActivateOut() |
|
263 |
{ |
|
264 |
$antsActiveHeader = "#!/usr/bin/perl -S list\n" unless ($opt_Q); |
|
265 |
} |
|
266 |
||
267 |
#---------------------------------------------------------------------- |
|
268 |
# antsCheckDeps([filename]): |
|
269 |
# - call only after header has been parsed |
|
270 |
# - by default, tests current <> file |
|
271 |
#---------------------------------------------------------------------- |
|
272 |
||
273 |
{ my($warned); |
|
274 |
||
275 |
sub antsCheckDeps() |
|
276 |
{ |
|
277 |
my($infile) = @_ ? $_[0] : $ARGV; # default: check current input |
|
278 |
my($indir) = ($infile =~ m{^(.*)/[^/]*$}); |
|
279 |
# print(STDERR "checking dependencies of file $infile (deps = @antsDeps)\n"); |
|
280 |
||
281 |
return if ($opt_D); # suppress |
|
282 |
return unless (@antsDeps); # no dependency info |
|
283 |
return if defined($indir) && $indir ne '.'; # not in current directory |
|
284 |
||
285 |
my(@stat) = stat($infile); # get time |
|
286 |
return unless (@stat); # happens on stdin? |
|
287 |
||
288 |
my($ctimef) = 10; my($ctime) = $stat[$ctimef]; |
|
289 |
for (my($d)=0; $d<=$#antsDeps; $d++) { |
|
290 |
@stat = stat($antsDeps[$d]); |
|
291 |
if (@stat) { |
|
292 |
croak("$0: <$infile> is stale with respect to <$antsDeps[$d]>\n") |
|
293 |
unless ($stat[$ctimef] <= $ctime); |
|
294 |
} elsif (!$warned) { |
|
295 |
&antsInfo("WARNING: dependency $antsDeps[$d] (&, possibly, others) not found"); |
|
296 |
$warned = 1; |
|
297 |
} |
|
298 |
} |
|
299 |
} |
|
300 |
} # static scope |
|
301 |
||
302 |
sub antsParseHeader() |
|
303 |
{ |
|
304 |
return if ($antsFixedFormat || !$antsParseHeader); |
|
305 |
$antsDoParseHeader = 1; # glorks! |
|
306 |
my($success) = &antsIn(); |
|
307 |
&antsCheckDeps(); |
|
308 |
return $success; |
|
309 |
} |
|
310 |
||
311 |
#---------------------------------------------------------------------- |
|
312 |
||
313 |
sub antsReCompile() # re-compile with funs |
|
314 |
{ eval ' |
|
315 |
||
316 |
sub antsIn() |
|
317 |
{ |
|
318 |
my(@Layout); |
|
319 |
undef(@Layout); # needed, but unclear why |
|
320 |
||
321 |
undef($antsNewFile); # assume no new file |
|
322 |
||
323 |
unless ($antsHeaderParsed || $antsDoParseHeader) { |
|
324 |
for (my($i)=0; $i<=$#ARGV; $i++) { # check file params |
|
325 |
open($ARGV[$i]),croak("$0: $ARGV[$i]: $!\n") |
|
326 |
unless (-f $ARGV[$i] && -r $ARGV[$i]); |
|
327 |
} |
|
328 |
&antsAddDeps($ARGV,@ARGV); # <> files |
|
329 |
$antsCurHeader =~ s/\]/\] |/ # mark as pipeline |
|
330 |
unless (-t 0); |
|
331 |
$antsHeaderParsed = 1; |
|
332 |
} |
|
333 |
||
334 |
my(@tempARGV); # temporily remove non-file args |
|
335 |
if ($antsDoParseHeader) { |
|
336 |
my($ai) = $#ARGV; |
|
337 |
while ($ai >= 0 && -f $ARGV[$ai]) { $ai-- } |
|
338 |
# print(STDERR "before: @ARGV\n"); |
|
339 |
push(@tempARGV,splice(@ARGV,0,$ai+1)); |
|
340 |
# print(STDERR "after: @ARGV\n"); |
|
341 |
if ($#ARGV < 0 && -t 0) { # donot wait on stdin |
|
342 |
push(@ARGV,@tempARGV); |
|
343 |
$antsDoParseHeader=0; |
|
344 |
return 0; |
|
345 |
} |
|
346 |
} |
|
347 |
||
348 |
splice(@ants_,0,$antsBufSkip); # shift buffers |
|
349 |
||
350 |
IN: until ($#ants_>=0 && &antsBufFull()) { # fill buffer; NEEDS RECOMPILE |
|
351 |
||
352 |
if (defined($antsPeekBuffer)) { # from header parsing |
|
353 |
$_ = $antsPeekBuffer; |
|
354 |
$antsPeekBuffer = undef; |
|
355 |
} else { |
|
356 |
unless ($_ = <>) { # get next record |
|
357 |
# EOF before buffer is full (can be partially filled) |
|
358 |
unshift(@ARGV,@tempARGV); # restore ARGV list |
|
359 |
||
360 |
@antsLayout = @Layout if (@Layout); # set last defined layout |
|
361 |
$antsBufNFields = @antsLayout # adjust buffer width |
|
362 |
if (@antsLayout > $antsBufNFields); |
|
363 |
||
364 |
my($lastFile) = $P{PATHNAME}; |
|
365 |
$P{PATHNAME} = $ARGV; # set pseudo %PARAMs |
|
366 |
($P{DIRNAME},$P{FILENAME}) = |
|
367 |
($ARGV =~ m{^(.*)/([^/]+)$}); |
|
368 |
unless (defined($P{DIRNAME})) { |
|
369 |
$P{DIRNAME} = "."; |
|
370 |
$P{FILENAME} = $P{PATHNAME}; |
|
371 |
} |
|
372 |
($P{BASENAME},$P{EXTN}) = |
|
373 |
($P{FILENAME} =~ m{^([^\.]+)\.(.+)$}); |
|
374 |
unless (defined($P{EXTN})) { |
|
375 |
$P{BASENAME} = $P{FILENAME}; |
|
376 |
$P{EXTN} = ""; |
|
377 |
} |
|
378 |
$P{DEPS} = "@antsDeps"; |
|
379 |
||
380 |
return 0 if ($antsDoParseHeader); # empty file!!! |
|
381 |
||
382 |
$P{RECNO} = -1 # set pseudo %PARAMs |
|
383 |
unless defined($P{RECNO}); |
|
384 |
$P{RECNO}++; |
|
385 |
$P{LINENO} = ($ARGV eq $lastFile) ? $P{LINENO}+1 : 0; |
|
386 |
||
387 |
return 0; # return EOF |
|
388 |
} |
|
389 |
} |
|
390 |
||
391 |
next IN if (length == 1 && ord == 26); # handle MS-DOG EOF |
|
392 |
||
393 |
&antsActivateOut(),next IN # copy activation status |
|
394 |
if (m{^#![^\s]*/perl\s.*list$}); |
|
395 |
||
396 |
exit(1) if (/^#ANTS#ERROR#/); # error in pipeline |
|
397 |
||
398 |
if (/^#ANTS#PARAMS# ([^\{]+)\{([^\}]*)\}/) { |
|
399 |
if (eval($antsIgnoreInputParams)) { # eval only 1st time |
|
400 |
$antsIgnoreInputParams = 1; |
|
401 |
next IN; |
|
402 |
} |
|
403 |
do { |
|
404 |
if ($2 eq "") { |
|
405 |
delete($P{$1}); |
|
406 |
} else { |
|
407 |
$P{$1} = $2; |
|
408 |
} |
|
409 |
} while ($\' =~ m/ ([^\{]+)\{([^\}]*)\}/); |
|
410 |
} elsif (/^#ANTS#DEPS# \{([^\}]*)\}/) { # handle dependencies |
|
411 |
do { push(@antsDeps,$1); } |
|
412 |
while ($\' =~ m/ \{([^\}]*)\}/); |
|
413 |
} elsif (/^#ANTS# \[[^\]]*\] [^|]/) { # pipe-head => restart dependencies |
|
414 |
undef(@antsDeps); |
|
415 |
} elsif (/^#ANTS#FIELDS# \{([^\}]*)\}/) { # handle layout |
|
416 |
undef(@Layout); |
|
417 |
do { |
|
418 |
push(@Layout,$1 eq "" ? undef : $1); |
|
419 |
} while ($\' =~ m/ \{([^\}]*)\}/); |
|
420 |
} |
|
421 |
||
422 |
if (!($opt_Q || $antsNoHeaderCopy) && /^#ANTS#/) { # handle headers |
|
423 |
if (defined($antsHeadersPrinted)) { # embedded headers |
|
424 |
# The following is somewhat subtle because it must prevent embedded |
|
425 |
# layout definitions to be copied 1) even if embedded headers are requested |
|
426 |
# (because otherwise there will be embedded-layout-change errors) 2) but not |
|
427 |
# if there has not been a layout defined already (ubtest common_opts); |
|
428 |
print unless ($antsNoEmbeddedHeaderCopy || |
|
429 |
(/^#ANTS#FIELDS#/ && @antsLayout)); |
|
430 |
} else { |
|
431 |
$antsOldHeaders .= $_; |
|
432 |
} |
|
433 |
next IN; |
|
434 |
} |
|
435 |
||
436 |
if (/^#/) { # handle non-header comments |
|
437 |
&antsPrintHeaders(STDOUT,@antsNewLayout),print if ($opt_P); |
|
438 |
next IN; |
|
439 |
} |
|
440 |
||
441 |
next IN if /^\s*$/; # skip empty lines |
|
442 |
unless ($antsFixedFormat) { |
|
443 |
s/^\s+//; # strip leading space |
|
444 |
s/#.*$// unless ($opt_P); # strip trailing comments |
|
445 |
s/\s+$//; # strip trailing space |
|
446 |
} |
|
447 |
||
448 |
# DONE WITH HEADER PARSING |
|
449 |
||
450 |
croak("$0: embedded layout change when reading file $ARGV <@antsLayout> -> <@Layout>") |
|
451 |
if (!$antsAllowEmbeddedLayoutChange && @Layout && @antsLayout && ("@Layout" ne "@antsLayout")); |
|
452 |
||
453 |
@antsLayout = @Layout unless (@antsLayout); |
|
454 |
||
455 |
$P{RECNO} = -1 unless defined($P{RECNO}); # set pseudo %PARAMs |
|
456 |
$P{LINENO} = -1 unless defined($P{LINENO}); |
|
457 |
$P{DEPS} = "@antsDeps"; |
|
458 |
||
459 |
my($lastFile) = $P{PATHNAME}; |
|
460 |
$P{PATHNAME} = $ARGV; |
|
461 |
($P{DIRNAME},$P{FILENAME}) = |
|
462 |
($ARGV =~ m{^(.*)/([^/]+)$}); |
|
463 |
unless (defined($P{DIRNAME})) { |
|
464 |
$P{DIRNAME} = "."; |
|
465 |
$P{FILENAME} = $P{PATHNAME}; |
|
466 |
} |
|
467 |
($P{BASENAME},$P{EXTN}) = |
|
468 |
($P{FILENAME} =~ m{^([^\.]+)\.(.+)$}); |
|
469 |
unless (defined($P{EXTN})) { |
|
470 |
$P{BASENAME} = $P{FILENAME}; |
|
471 |
$P{EXTN} = ""; |
|
472 |
} |
|
473 |
||
474 |
if ($antsDoParseHeader) { # done parsing |
|
475 |
unshift(@ARGV,@tempARGV); |
|
476 |
$antsDoParseHeader = undef; |
|
477 |
$antsPeekBuffer = $_; |
|
478 |
$antsPadOut = $antsBufNFields = split($opt_I,$antsPeekBuffer); |
|
479 |
return 1; |
|
480 |
} |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
481 |
|
0 | 482 |
$P{RECNO}++; # update pseudo %PARAMs |
483 |
$P{LINENO} = ($ARGV eq $lastFile) ? $P{LINENO}+1 : 0; |
|
484 |
||
485 |
s/[Nn][Aa][Nn]/nan/g; # make all nans lower case |
|
486 |
||
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
487 |
local(@in) = split($opt_I); # needs to be local for -S |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
488 |
if (@in > $antsBufNFields) { # increase # of fields to expect |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
489 |
$antsBufNFields = @in; |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
490 |
for ($i=0; $i<$#ants_; $i++) { # update recs already in buffer |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
491 |
push(@{$ants_[$i]},nan) |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
492 |
while ($#{$ants_[$i]}+1 < $antsBufNFields); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
493 |
} |
0 | 494 |
} |
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
495 |
push(@in,nan) # pad current record |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
496 |
while (@in<$antsBufNFields); |
0 | 497 |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
498 |
if (defined($opt_S)) { # -S)elect |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
499 |
$opt_S = &antsCompileAddrExpr($opt_S,\'$in\') |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
500 |
unless ref($opt_S); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
501 |
next IN unless (&$opt_S); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
502 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
503 |
|
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
504 |
if (@antsNFNames) { # -N)ums |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
505 |
for (my($i)=0; $i<=$#antsNFNames; $i++) { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
506 |
unless (defined($antsNfnr[$i])) { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
507 |
if ($antsNFNames[$i] =~ /^%/) { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
508 |
croak("$0: illegal -N option ($antsNFNames[$i] undefined)\n") |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
509 |
unless (defined($P{$\'})); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
510 |
next IN unless (numberp($P{$\'})); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
511 |
} else { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
512 |
$antsNfnr[$i] = &fnr($antsNFNames[$i]); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
513 |
next IN unless (numberp($in[$antsNfnr[$i]])); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
514 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
515 |
} else { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
516 |
next IN unless (numberp($in[$antsNfnr[$i]])); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
517 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
518 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
519 |
} |
0 | 520 |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
521 |
chomp; |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
522 |
$antsLineBuf = $_; # save |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
523 |
|
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
524 |
push(@ants_,[@in]); # add to buffer |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
525 |
|
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
526 |
### if ($#{$ants_[$#ants_]}+1 > $antsBufNFields) { # grow # of fields |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
527 |
### $antsBufNFields = $#{$ants_[$#ants_]} + 1; |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
528 |
#### print("antsBufNFields := $antsBufNFields --- $_"); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
529 |
### for ($i=0; $i<$#ants_; $i++) { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
530 |
### push(@{$ants_[$i]},nan) |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
531 |
### while ($#{$ants_[$i]}+1 < $antsBufNFields); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
532 |
### } |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
533 |
### } |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
534 |
### } |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
535 |
### push(@{$ants_[$#ants_]},nan) # pad this |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
536 |
### while ($#{$ants_[$#ants_]}+1 < $antsBufNFields); |
0 | 537 |
} |
538 |
||
539 |
$ants_ = ($#ants_ - $#ants_%2) / 2; # set current idx to centre |
|
540 |
# print(STDERR "reading done; $#ants_+1 recs in buf, $ants_ is cur\n"); |
|
541 |
||
542 |
if ($antsLastFileName ne $ARGV) { # signal new file |
|
543 |
$antsLastFileName = $ARGV; |
|
544 |
$antsNewFile = 1; |
|
545 |
} |
|
546 |
||
547 |
return $#ants_+1; # ok |
|
548 |
} |
|
549 |
||
550 |
#---------------------------------------------------------------------- |
|
551 |
||
552 |
{ my(@ofn); # output layout # STATIC SCOPE |
|
553 |
my(@OEparam); # -F %PARAMs |
|
554 |
my(@OEfield); # -F fields |
|
555 |
my(@OEexpr); # -F exprs (compiled) |
|
556 |
my($EOparamsOnly); # nothing but %PARAMs in -F |
|
557 |
||
558 |
sub antsOut(@) |
|
559 |
{ |
|
560 |
my(@out) = @_; |
|
561 |
if (@out == 1 && $out[0] eq "EOF") { |
|
562 |
undef(@ofn); undef(@OEparam); undef(@OEfield); undef(@OEexpr); undef($EOparamsOnly); |
|
563 |
undef($antsHeadersPrinted); undef(@antsOutExprs); |
|
564 |
$antsPadOut = $antsBufNFields = @antsNewLayout; # NB: MUST BE SET BEFORE &antsOut("EOF"); |
|
565 |
return; |
|
566 |
} |
|
567 |
||
568 |
# STEP 0: PREPARE STUFF |
|
569 |
||
570 |
@ofn = @antsNewLayout unless (@ofn); # output layout |
|
571 |
@ofn = @antsLayout unless (@ofn); |
|
572 |
||
573 |
# STEP 1: CONSTRUCT @out IF NEEDED |
|
574 |
||
575 |
unless (@out > 0) { |
|
576 |
for (my($fnr)=0; $fnr<$antsBufNFields; $fnr++) { |
|
577 |
$out[$fnr] = &antsBufOut($fnr); # calc; NEEDS RECOMPILE |
|
578 |
} |
|
579 |
} |
|
580 |
||
581 |
# STEP 2: HANDLE FIELD SELECTION (-F) |
|
582 |
||
583 |
if (@antsOutExprs) { |
|
584 |
||
585 |
unless ($antsOutExprsCompiled) { # parse/compile |
|
586 |
my(@ofn_buf) = @ofn; # save current output layout |
|
587 |
undef(@ofn); |
|
588 |
||
589 |
$OEparamsOnly = 1; |
|
590 |
for (my($if)=my($of)=0; $if<@antsOutExprs; $if++,$of++) { |
|
3 | 591 |
# if ($antsOutExprs[$if] =~ m{^%([\w\.]+)$}) { # %PARAM |
592 |
if ($antsOutExprs[$if] =~ m{^%([^=]+)$}) { # %PARAM |
|
0 | 593 |
$ofn[$of] = $1; |
594 |
$OEparam[$of] = 1; |
|
595 |
} elsif ($antsOutExprs[$if] eq \'$@\') { # all fields |
|
596 |
undef($OEparamsOnly); |
|
597 |
for (my($i)=0; $i<@ofn_buf; $i++,$of++) { |
|
598 |
$ofn[$of] = $ofn_buf[$i]; |
|
599 |
$OEfield[$of] = $i; |
|
600 |
} |
|
3 | 601 |
# } elsif ($antsOutExprs[$if] =~ m{^[\w\.]+$}) { # single field |
602 |
} elsif ($antsOutExprs[$if] =~ m{^[^=]+$}) { # single field |
|
603 |
undef($OEparamsOnly); |
|
604 |
$ofn[$of] = $antsOutExprs[$if]; |
|
605 |
$OEfield[$of] = &outFnr($antsOutExprs[$if]); |
|
0 | 606 |
} else { # expression |
607 |
undef($OEparamsOnly); |
|
608 |
my($expr); |
|
3 | 609 |
($ofn[$of],$expr) = ($antsOutExprs[$if] =~ m{^([^=]*)=(.*)$}); |
0 | 610 |
croak("$0: cannot parse -F $antsOutExprs[$if]\n") |
611 |
unless defined($expr); |
|
612 |
my(@tmp) = @antsLayout; |
|
613 |
@antsLayout = @ofn_buf; |
|
614 |
$OEexpr[$of] = &antsCompileEditExpr($expr,\'$out_buf\'); |
|
615 |
@antsLayout = @tmp; |
|
616 |
} |
|
617 |
} |
|
618 |
$antsOutExprsCompiled = 1; |
|
619 |
} |
|
620 |
||
621 |
local(@out_buf) = @out; # save current output data |
|
622 |
undef(@out); # accessible from within exprs |
|
623 |
||
624 |
for (my($f)=0; $f<@ofn; $f++) { # create @out according to -F |
|
625 |
if ($OEparam[$f]) { |
|
626 |
$out[$f] = $P{$ofn[$f]}; |
|
627 |
} elsif (defined($OEfield[$f])) { |
|
628 |
$out[$f] = $out_buf[$OEfield[$f]]; |
|
629 |
} else { |
|
630 |
$out[$f] = &{$OEexpr[$f]}; |
|
631 |
} |
|
632 |
} |
|
633 |
} |
|
634 |
||
635 |
# STEP 3: PRINT HEADERS |
|
636 |
||
637 |
if (@antsNewLayout || @antsOutExprs) { |
|
638 |
&antsPrintHeaders(STDOUT,@ofn); |
|
639 |
} else { |
|
640 |
&antsPrintHeaders(STDOUT); |
|
641 |
} |
|
642 |
||
643 |
||
644 |
# STEP 4: DONE, DUE TO -H RUNNING OUT |
|
645 |
||
646 |
&antsExit() if (defined($opt_H) && ($opt_H-- == 0)); |
|
647 |
||
648 |
||
649 |
# STEP 5: PRINT DATA |
|
650 |
||
651 |
$antsPadOut = @ofn if ($antsPadOut >= 0 && @ofn); |
|
652 |
push(@out,nan) while (@out < $antsPadOut); |
|
653 |
||
654 |
my($outStr); |
|
655 |
for (my($fnr)=0; $fnr<=$#out; $fnr++) { |
|
656 |
$out[$fnr] = |
|
657 |
fmtNum($out[$fnr], |
|
658 |
@antsNewLayout ? $antsNewLayout[$fnr] : $antsLayout[$fnr]); |
|
659 |
$outStr .= (defined($out[$fnr]) && $out[$fnr] ne "" ? $out[$fnr] : nan) |
|
660 |
. ($fnr == $#out ? $opt_R : $opt_O); |
|
661 |
} |
|
662 |
print($outStr); |
|
663 |
||
664 |
# STEP 6: DONE, DUE TO -F WITH PARAMS ONLY |
|
665 |
||
666 |
&antsExit() if ($OEparamsOnly); |
|
667 |
||
668 |
} # antsOut() |
|
669 |
} # STATIC SCOPE |
|
670 |
||
671 |
#---------------------------------------------------------------------- |
|
672 |
||
673 |
sub antsIO() # combine input and output |
|
674 |
{ # NB: BYPASSES &antsBufOut()! |
|
675 |
my($i); |
|
676 |
for ($i=0; $i<$antsBufSkip && $i<=$#ants_; $i++) { |
|
677 |
&antsOut(@{$ants_[$i]}); |
|
678 |
} |
|
679 |
return &antsIn(); # re-fill |
|
680 |
} |
|
681 |
||
682 |
sub antsPreFlush() # pre-flush buffer to cur |
|
683 |
{ |
|
684 |
my($i); |
|
685 |
for ($i=0; $i<=$ants_; $i++) { |
|
686 |
&antsOut(@{$ants_[$i]}); |
|
687 |
} |
|
688 |
} |
|
689 |
||
690 |
sub antsPostFlush() # post-flush buffer after cur |
|
691 |
{ |
|
692 |
my($i); |
|
693 |
for ($i=$ants_; $i<=$#ants_; $i++) { |
|
694 |
&antsOut(@{$ants_[$i]}); |
|
695 |
} |
|
696 |
} |
|
697 |
||
698 |
sub antsFlush() # flush buffer |
|
699 |
{ |
|
700 |
&antsOut(@{$ants_[0]}),shift(@ants_) |
|
701 |
while ($#ants_ >= 0); |
|
702 |
}'; die("antsReCompile: $@\n") if ($@); # re-compile functions |
|
703 |
||
704 |
} # of antsReCompile() |
|
705 |
||
706 |
&antsReCompile(); # compile |
|
707 |
||
708 |
#---------------------------------------------------------------------- |
|
709 |
||
710 |
sub antsSetR_($$$) # set field in any rec |
|
711 |
{ my($r,$f,$v) = @_; |
|
712 |
$antsBufNFields = $f+1 # auto extension |
|
713 |
if ($antsBufNFields-1 < $f); |
|
714 |
while ($#{$ants_[$r]} < $f-1) { |
|
715 |
push(@{$ants_[$r]},nan); |
|
716 |
} |
|
717 |
$ants_[$r][$f] = $v; |
|
718 |
} |
|
719 |
||
720 |
sub antsSet_($$) # set field in current rec |
|
721 |
{ &antsSetR_($ants_,$_[0],$_[1]); } |
|
722 |
||
723 |
#---------------------------------------------------------------------- |
|
724 |
||
725 |
{ my(%sExprs); # multiple layouts -> multiple compiled -S exprs |
|
726 |
||
727 |
sub antsFileIn() # read from a file |
|
728 |
{ my($f) = @_; |
|
729 |
||
730 |
REDO: |
|
731 |
return () unless ($_ = <$f>); # get next record (return EOF) |
|
732 |
||
733 |
goto REDO if /^#/; # skip comments |
|
734 |
goto REDO if /^\s*$/; # skip empty lines |
|
735 |
s/^\s+//; # remove leading spaces |
|
736 |
s/#.*$//; # remove trailing comments |
|
737 |
||
738 |
local(@in) = split($opt_I); # needs to be local for -S |
|
739 |
||
740 |
if (defined($opt_S)) { # -S)elect |
|
741 |
$sExprs{$f} = &antsCompileAddrExpr($opt_S,'$in') |
|
742 |
unless defined($sExprs{$f}); |
|
743 |
goto REDO unless (&{$sExprs{$f}}); |
|
744 |
} |
|
745 |
||
746 |
if (@antsNFNames) { # handle -N)ums |
|
747 |
for (my($i)=0; $i<=$#antsNFNames; $i++) { |
|
748 |
if ($antsNFNames[$i] =~ /^%/) { |
|
749 |
croak("$0: illegal -N option ($antsNFNames[$i] undefined)\n") |
|
750 |
unless (defined($P{$'})); |
|
751 |
goto REDO unless (numberp($P{$'})); |
|
752 |
} else { |
|
753 |
$antsNfnr[$i] = &fnr($antsNFNames[$i]); |
|
754 |
goto REDO unless (numberp($in[$antsNfnr[$i]])); |
|
755 |
} |
|
756 |
} |
|
757 |
} |
|
758 |
||
759 |
return @in; |
|
760 |
} |
|
761 |
||
762 |
} # static scope |
|
763 |
||
764 |
#====================================================================== |
|
765 |
# Utilities |
|
766 |
#====================================================================== |
|
767 |
||
768 |
sub antsPrintHeaders($@) # handle headers |
|
769 |
{ |
|
770 |
return if ($antsHeadersPrinted); # do only once |
|
771 |
$antsHeadersPrinted = 1; |
|
772 |
local(*fh,@newLayout) = @_; |
|
773 |
||
774 |
if (@newLayout) { # check for duplicate field names |
|
775 |
my(%fn); |
|
776 |
for (my($i)=0; $i<=$#newLayout; $i++) { |
|
777 |
next unless defined($newLayout[$i]) && $newLayout[$i] ne ''; |
|
778 |
if ($fn{$newLayout[$i]}) { |
|
779 |
&antsInfo("duplicate output field <$newLayout[$i]> changed to <$newLayout[$i]_>"); |
|
780 |
$newLayout[$i] .= '_'; |
|
781 |
again; |
|
782 |
} |
|
783 |
$fn{$newLayout[$i]} = 1; |
|
784 |
} |
|
785 |
} |
|
786 |
||
787 |
return if ($opt_Q); # suppress |
|
788 |
||
789 |
if (defined($antsActiveHeader)) { # activate file |
|
790 |
chmod(0777&~umask,*fh); |
|
791 |
print(fh $antsActiveHeader); |
|
792 |
} |
|
793 |
||
794 |
print(fh $antsOldHeaders); # old headers |
|
795 |
||
796 |
print(fh $antsCurHeader) unless ($opt_X); # new headers |
|
797 |
print(fh $antsCurParams); |
|
798 |
print(fh $antsCurDeps) unless ($opt_X); |
|
799 |
if (@newLayout) { |
|
800 |
print(fh "#ANTS#FIELDS# "); |
|
801 |
for (my($i)=0; $i<=$#newLayout; $i++) { |
|
802 |
print(fh "{$newLayout[$i]} "); |
|
803 |
} |
|
804 |
print(fh "\n"); |
|
805 |
} |
|
806 |
||
807 |
||
808 |
} |
|
809 |
||
810 |
sub antsExit() |
|
811 |
{ |
|
812 |
&antsPrintHeaders(STDOUT,@antsNewLayout); |
|
813 |
exit(0); |
|
814 |
} |
|
815 |
||
816 |
#---------------------------------------------------------------------- |
|
817 |
||
818 |
# NB: to use antsInfo in expressions, a return value of 1 |
|
819 |
# has been assumed!!! |
|
820 |
||
821 |
sub antsInfo(@) # add info to header & STDERR |
|
822 |
{ |
|
823 |
return 1 if ($opt_Q); |
|
824 |
my($fmt,@args) = @_; # can't do it directly!!! |
|
825 |
my($msg) = sprintf($fmt,@args); |
|
826 |
$antsCurHeader .= "#ANTS# $0: $msg\n"; |
|
827 |
print(STDERR "$0: $msg\n"); |
|
828 |
return 1; |
|
829 |
} |
|
830 |
||
831 |
#---------------------------------------------------------------------- |
|
832 |
# %PARAM-related stuff |
|
833 |
#---------------------------------------------------------------------- |
|
834 |
||
835 |
sub antsAddParams(@) # add params |
|
836 |
{ |
|
837 |
my($i); |
|
838 |
||
839 |
$antsCurParams .= "#ANTS#PARAMS#"; |
|
840 |
for ($i=0; $i<$#_; $i+=2) { |
|
841 |
my($v) = $_[$i+1]; |
|
842 |
$v =~ s/\n/\\n/g; |
|
843 |
$P{$_[$i]} = $v; |
|
844 |
$antsCurParams .= " $_[$i]\{$v\}"; |
|
845 |
} |
|
846 |
$antsCurParams .= "\n"; |
|
847 |
} |
|
848 |
||
849 |
sub antsFileParams() # get params from file |
|
850 |
{ |
|
851 |
my($f) = @_; |
|
852 |
my(%P); |
|
853 |
||
854 |
while ($_ = <$f>) { # get next record |
|
855 |
if (/^#ANTS#PARAMS# ([^\{]+)\{([^\}]*)\}/) { |
|
856 |
do { |
|
857 |
$P{$1} = $2; |
|
858 |
$P{$1} =~ s/^\s*//; # ensure non-null |
|
859 |
} while ($' =~ m/ ([^\{]+)\{([^\}]*)\}/); |
|
860 |
} |
|
861 |
} |
|
862 |
seek($f,0,0) || croak("$0: $@\n"); |
|
863 |
return %P; |
|
864 |
} |
|
865 |
||
866 |
# antsFileScanParam() only scans the 1st header!!!! |
|
867 |
# empty lines are ok, though |
|
868 |
||
869 |
sub antsFileScanParam() # find param in file |
|
870 |
{ |
|
871 |
my($f,$pn) = @_; |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
872 |
my($v1,$v2); |
0 | 873 |
|
874 |
while ($_ = <$f>) { # get next record |
|
875 |
last unless (/^#/ || /^\s*$/); |
|
876 |
next unless (/^#ANTS#PARAMS# /); |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
877 |
$v1 = $1 if (/ $pn\{([^\}]*)\}/); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
878 |
$v2 = $1 if (/::$pn\{([^\}]*)\}/); |
0 | 879 |
} |
880 |
seek($f,0,0) || croak("$0: $@\n"); |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
881 |
return defined($v1) ? $v1 : $v2; |
0 | 882 |
} |
883 |
||
884 |
#---------------------------------------------------------------------- |
|
885 |
# Layout-related stuff |
|
886 |
#---------------------------------------------------------------------- |
|
887 |
||
888 |
sub antsFileLayout($) # return layout |
|
889 |
{ my($f) = @_; |
|
890 |
my(@lo); |
|
891 |
||
892 |
while ($_ = <$f>) { # get next record |
|
893 |
next unless (/^#ANTS#FIELDS# /); |
|
894 |
@lo = split(' ',$'); |
|
895 |
} |
|
896 |
seek($f,0,0) || croak("$0: $@\n"); |
|
897 |
for (my($i)=0; $i<=$#lo; $i++) { |
|
898 |
$lo[$i] =~ s/^\{(.*)\}$/$1/; |
|
899 |
} |
|
900 |
return @lo; |
|
901 |
} |
|
902 |
||
903 |
sub antsFileScanFnr($$) # find fnr in file |
|
904 |
{ my($f,$fn) = @_; |
|
905 |
my(@lo) = &antsFileLayout($f); |
|
906 |
||
907 |
for (my($f)=0; $f<=$#lo; $f++) { |
|
908 |
return $f if ($fn eq $lo[$f]); |
|
909 |
} |
|
910 |
return undef; |
|
911 |
} |
|
912 |
||
913 |
#---------------------------------------------------------------------- |
|
914 |
# Deps-related stuff |
|
915 |
#---------------------------------------------------------------------- |
|
916 |
||
917 |
sub antsAddDeps(@) # add Deps |
|
918 |
{ |
|
919 |
my(@deps) = @_; |
|
920 |
return if $opt_D || (@deps==1 && ($deps[0] eq '-' || $deps[0] eq '')); # STDIN |
|
921 |
||
922 |
$antsCurDeps .= '#ANTS#DEPS#'; |
|
923 |
for (my($i)=0; $i<=$#deps; $i++) { |
|
924 |
next if (length($deps[$i]) == 0); |
|
925 |
$antsCurDeps .= " \{$deps[$i]\}"; |
|
926 |
} |
|
927 |
$antsCurDeps .= "\n"; |
|
928 |
} |
|
929 |
||
930 |
#====================================================================== |
|
931 |
||
932 |
1; |