author | A.M. Thurnherr <athurnherr@yahoo.com> |
Thu, 05 Mar 2015 12:58:39 -0500 | |
changeset 15 | ebd8a4ddd7f2 |
parent 13 | bdd925186562 |
parent 8 | 248fef05e79d |
child 23 | a4fef65fd959 |
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 |
|
15 | 5 |
# dlm: Thu Mar 5 12:57:33 2015 |
0 | 6 |
# (c) 1998 A.M. Thurnherr |
15 | 7 |
# uE-Info: 206 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) |
13 | 204 |
# Aug 7, 2014: - allow optional % in param name in &antsFileScanParam() |
8 | 205 |
# Oct 29, 2014: - implemented abbreviated Layout and %PARAM definitions |
0 | 206 |
|
8 | 207 |
# GENERAL NOTES: |
0 | 208 |
# - %P was named without an ants-prefix because associative arrays |
209 |
# are rare (and perl supports multiple name spaces for the |
|
210 |
# different variable types) and to facilitate its use in |
|
211 |
# [list] |
|
212 |
# - copying of embedded (i.e. not appearing at start) headers is |
|
213 |
# required e.g. for subsample -i ... | list %some-param |
|
214 |
||
8 | 215 |
# ABBREVIATED LAYOUT & PARAM DEFINITIONS |
216 |
# - # definition [definition [...]] |
|
217 |
# - definition := field_name | %PARAM_def |
|
218 |
# - field_name := {string} |
|
219 |
# - %PARAM_def := string{string|num} |
|
220 |
# - implemented in October 2014 in order to make ANTS format easier to use for others |
|
221 |
# - abbreviated and full headers must not be used together |
|
222 |
# - abbreviated field definitions are additive (rather than replacing, as in the full headers) |
|
223 |
||
0 | 224 |
# $antsIngoreInputParams: |
225 |
# - is eval'ed first time antsIn() is called (usually while parsing header) |
|
226 |
# - if it evaluates to TRUE, all input %PARAMS are ignored (even if it would |
|
227 |
# later eval to FALSE) |
|
228 |
# - during header parsing, @ARGV only contains additional file arguments, |
|
229 |
# i.e. setting $antsIgnoreInputParams = '@ARGV>0' before antsUsage() is |
|
230 |
# called ignores all input %PARAMs if there is more than 1 file argument |
|
231 |
||
232 |
#====================================================================== |
|
233 |
# Default Behaviour |
|
234 |
#====================================================================== |
|
235 |
||
236 |
# Flags |
|
237 |
||
238 |
$antsFixedFormat = 0; # remove leading & trailing stuff |
|
239 |
$antsParseHeader = 1; # parse header on &antsUsage() |
|
240 |
$antsIgnoreInputParams = 0; # ignore %PARAMs |
|
241 |
$antsAllowEmbeddedLayoutChange = 0; # disallow layount changes |
|
242 |
||
243 |
# Standard Fixed Size Buffer |
|
244 |
||
245 |
sub antsBufFull() # default buffer full |
|
246 |
{return $#ants_+1 == $antsBufSize;} |
|
247 |
sub antsBufOut($) # default constructor |
|
248 |
{return $ants_[$ants_][$_[0]]; } |
|
249 |
||
250 |
# Setup Size 1 Buffer |
|
251 |
||
252 |
$antsBufSize = 1; # default |
|
253 |
$antsBufSkip = 1; |
|
254 |
||
255 |
#====================================================================== |
|
256 |
# Interface |
|
257 |
#====================================================================== |
|
258 |
||
259 |
sub antsInstallBufFull($) |
|
260 |
{ |
|
261 |
eval "sub antsBufFull() { $_[0] }"; |
|
262 |
croak($@) if ($@); |
|
263 |
&antsReCompile(); |
|
264 |
} |
|
265 |
||
266 |
sub antsInstallBufOut($) |
|
267 |
{ |
|
268 |
eval "sub antsBufOut(\$) { my(\$fnr)=\@_; $_[0] }"; |
|
269 |
croak($@) if ($@); |
|
270 |
&antsReCompile(); |
|
271 |
} |
|
272 |
||
273 |
sub antsActivateOut() |
|
274 |
{ |
|
275 |
$antsActiveHeader = "#!/usr/bin/perl -S list\n" unless ($opt_Q); |
|
276 |
} |
|
277 |
||
278 |
#---------------------------------------------------------------------- |
|
279 |
# antsCheckDeps([filename]): |
|
280 |
# - call only after header has been parsed |
|
281 |
# - by default, tests current <> file |
|
282 |
#---------------------------------------------------------------------- |
|
283 |
||
284 |
{ my($warned); |
|
285 |
||
286 |
sub antsCheckDeps() |
|
287 |
{ |
|
288 |
my($infile) = @_ ? $_[0] : $ARGV; # default: check current input |
|
289 |
my($indir) = ($infile =~ m{^(.*)/[^/]*$}); |
|
290 |
# print(STDERR "checking dependencies of file $infile (deps = @antsDeps)\n"); |
|
291 |
||
292 |
return if ($opt_D); # suppress |
|
293 |
return unless (@antsDeps); # no dependency info |
|
294 |
return if defined($indir) && $indir ne '.'; # not in current directory |
|
295 |
||
296 |
my(@stat) = stat($infile); # get time |
|
297 |
return unless (@stat); # happens on stdin? |
|
298 |
||
299 |
my($ctimef) = 10; my($ctime) = $stat[$ctimef]; |
|
300 |
for (my($d)=0; $d<=$#antsDeps; $d++) { |
|
301 |
@stat = stat($antsDeps[$d]); |
|
302 |
if (@stat) { |
|
303 |
croak("$0: <$infile> is stale with respect to <$antsDeps[$d]>\n") |
|
304 |
unless ($stat[$ctimef] <= $ctime); |
|
305 |
} elsif (!$warned) { |
|
306 |
&antsInfo("WARNING: dependency $antsDeps[$d] (&, possibly, others) not found"); |
|
307 |
$warned = 1; |
|
308 |
} |
|
309 |
} |
|
310 |
} |
|
311 |
} # static scope |
|
312 |
||
313 |
sub antsParseHeader() |
|
314 |
{ |
|
315 |
return if ($antsFixedFormat || !$antsParseHeader); |
|
316 |
$antsDoParseHeader = 1; # glorks! |
|
317 |
my($success) = &antsIn(); |
|
318 |
&antsCheckDeps(); |
|
319 |
return $success; |
|
320 |
} |
|
321 |
||
322 |
#---------------------------------------------------------------------- |
|
323 |
||
8 | 324 |
sub def_abbrev($) |
325 |
{ |
|
326 |
my($def) = @_; |
|
327 |
if ($def =~ /^\{(\w+)\}$/) { |
|
328 |
push(@Layout,$1); |
|
329 |
} else { |
|
330 |
my($name,$val) = ($def =~ /(\w+)\{([^\}]+)\}/); |
|
331 |
$P{$name} = $val; |
|
332 |
} |
|
333 |
} |
|
334 |
||
0 | 335 |
sub antsReCompile() # re-compile with funs |
336 |
{ eval ' |
|
337 |
||
338 |
sub antsIn() |
|
339 |
{ |
|
8 | 340 |
local(@Layout); |
0 | 341 |
undef(@Layout); # needed, but unclear why |
342 |
||
343 |
undef($antsNewFile); # assume no new file |
|
344 |
||
345 |
unless ($antsHeaderParsed || $antsDoParseHeader) { |
|
346 |
for (my($i)=0; $i<=$#ARGV; $i++) { # check file params |
|
347 |
open($ARGV[$i]),croak("$0: $ARGV[$i]: $!\n") |
|
348 |
unless (-f $ARGV[$i] && -r $ARGV[$i]); |
|
349 |
} |
|
350 |
&antsAddDeps($ARGV,@ARGV); # <> files |
|
351 |
$antsCurHeader =~ s/\]/\] |/ # mark as pipeline |
|
352 |
unless (-t 0); |
|
353 |
$antsHeaderParsed = 1; |
|
354 |
} |
|
355 |
||
356 |
my(@tempARGV); # temporily remove non-file args |
|
357 |
if ($antsDoParseHeader) { |
|
358 |
my($ai) = $#ARGV; |
|
359 |
while ($ai >= 0 && -f $ARGV[$ai]) { $ai-- } |
|
360 |
# print(STDERR "before: @ARGV\n"); |
|
361 |
push(@tempARGV,splice(@ARGV,0,$ai+1)); |
|
362 |
# print(STDERR "after: @ARGV\n"); |
|
363 |
if ($#ARGV < 0 && -t 0) { # donot wait on stdin |
|
364 |
push(@ARGV,@tempARGV); |
|
365 |
$antsDoParseHeader=0; |
|
366 |
return 0; |
|
367 |
} |
|
368 |
} |
|
369 |
||
370 |
splice(@ants_,0,$antsBufSkip); # shift buffers |
|
371 |
||
372 |
IN: until ($#ants_>=0 && &antsBufFull()) { # fill buffer; NEEDS RECOMPILE |
|
373 |
||
374 |
if (defined($antsPeekBuffer)) { # from header parsing |
|
375 |
$_ = $antsPeekBuffer; |
|
376 |
$antsPeekBuffer = undef; |
|
377 |
} else { |
|
378 |
unless ($_ = <>) { # get next record |
|
379 |
# EOF before buffer is full (can be partially filled) |
|
380 |
unshift(@ARGV,@tempARGV); # restore ARGV list |
|
381 |
||
382 |
@antsLayout = @Layout if (@Layout); # set last defined layout |
|
383 |
$antsBufNFields = @antsLayout # adjust buffer width |
|
384 |
if (@antsLayout > $antsBufNFields); |
|
385 |
||
386 |
my($lastFile) = $P{PATHNAME}; |
|
387 |
$P{PATHNAME} = $ARGV; # set pseudo %PARAMs |
|
388 |
($P{DIRNAME},$P{FILENAME}) = |
|
389 |
($ARGV =~ m{^(.*)/([^/]+)$}); |
|
390 |
unless (defined($P{DIRNAME})) { |
|
391 |
$P{DIRNAME} = "."; |
|
392 |
$P{FILENAME} = $P{PATHNAME}; |
|
393 |
} |
|
394 |
($P{BASENAME},$P{EXTN}) = |
|
395 |
($P{FILENAME} =~ m{^([^\.]+)\.(.+)$}); |
|
396 |
unless (defined($P{EXTN})) { |
|
397 |
$P{BASENAME} = $P{FILENAME}; |
|
398 |
$P{EXTN} = ""; |
|
399 |
} |
|
400 |
$P{DEPS} = "@antsDeps"; |
|
401 |
||
402 |
return 0 if ($antsDoParseHeader); # empty file!!! |
|
403 |
||
404 |
$P{RECNO} = -1 # set pseudo %PARAMs |
|
405 |
unless defined($P{RECNO}); |
|
406 |
$P{RECNO}++; |
|
407 |
$P{LINENO} = ($ARGV eq $lastFile) ? $P{LINENO}+1 : 0; |
|
408 |
||
409 |
return 0; # return EOF |
|
410 |
} |
|
411 |
} |
|
412 |
||
413 |
next IN if (length == 1 && ord == 26); # handle MS-DOG EOF |
|
414 |
||
415 |
&antsActivateOut(),next IN # copy activation status |
|
416 |
if (m{^#![^\s]*/perl\s.*list$}); |
|
417 |
||
418 |
exit(1) if (/^#ANTS#ERROR#/); # error in pipeline |
|
419 |
||
420 |
if (/^#ANTS#PARAMS# ([^\{]+)\{([^\}]*)\}/) { |
|
421 |
if (eval($antsIgnoreInputParams)) { # eval only 1st time |
|
422 |
$antsIgnoreInputParams = 1; |
|
423 |
next IN; |
|
424 |
} |
|
425 |
do { |
|
426 |
if ($2 eq "") { |
|
427 |
delete($P{$1}); |
|
428 |
} else { |
|
429 |
$P{$1} = $2; |
|
430 |
} |
|
431 |
} while ($\' =~ m/ ([^\{]+)\{([^\}]*)\}/); |
|
432 |
} elsif (/^#ANTS#DEPS# \{([^\}]*)\}/) { # handle dependencies |
|
433 |
do { push(@antsDeps,$1); } |
|
434 |
while ($\' =~ m/ \{([^\}]*)\}/); |
|
435 |
} elsif (/^#ANTS# \[[^\]]*\] [^|]/) { # pipe-head => restart dependencies |
|
436 |
undef(@antsDeps); |
|
437 |
} elsif (/^#ANTS#FIELDS# \{([^\}]*)\}/) { # handle layout |
|
438 |
undef(@Layout); |
|
439 |
do { |
|
440 |
push(@Layout,$1 eq "" ? undef : $1); |
|
441 |
} while ($\' =~ m/ \{([^\}]*)\}/); |
|
8 | 442 |
} elsif (/^# (\{\w+\}|\w+\{[^\}]+\})+/) { # ABBREVIATED DEFINITIONS |
443 |
my($match) = $1; my($rem) = $\'; |
|
444 |
do { |
|
445 |
def_abbrev($match); |
|
446 |
($match,$rem) = ($rem =~ /(\{\w+\}|\w+\{[^\}]+\})(.*)/); |
|
447 |
} while ($match); |
|
0 | 448 |
} |
8 | 449 |
|
0 | 450 |
if (!($opt_Q || $antsNoHeaderCopy) && /^#ANTS#/) { # handle headers |
451 |
if (defined($antsHeadersPrinted)) { # embedded headers |
|
452 |
# The following is somewhat subtle because it must prevent embedded |
|
453 |
# layout definitions to be copied 1) even if embedded headers are requested |
|
454 |
# (because otherwise there will be embedded-layout-change errors) 2) but not |
|
455 |
# if there has not been a layout defined already (ubtest common_opts); |
|
456 |
print unless ($antsNoEmbeddedHeaderCopy || |
|
457 |
(/^#ANTS#FIELDS#/ && @antsLayout)); |
|
458 |
} else { |
|
459 |
$antsOldHeaders .= $_; |
|
460 |
} |
|
461 |
next IN; |
|
462 |
} |
|
463 |
||
464 |
if (/^#/) { # handle non-header comments |
|
465 |
&antsPrintHeaders(STDOUT,@antsNewLayout),print if ($opt_P); |
|
466 |
next IN; |
|
467 |
} |
|
468 |
||
469 |
next IN if /^\s*$/; # skip empty lines |
|
470 |
unless ($antsFixedFormat) { |
|
471 |
s/^\s+//; # strip leading space |
|
472 |
s/#.*$// unless ($opt_P); # strip trailing comments |
|
473 |
s/\s+$//; # strip trailing space |
|
474 |
} |
|
475 |
||
476 |
# DONE WITH HEADER PARSING |
|
477 |
||
478 |
croak("$0: embedded layout change when reading file $ARGV <@antsLayout> -> <@Layout>") |
|
479 |
if (!$antsAllowEmbeddedLayoutChange && @Layout && @antsLayout && ("@Layout" ne "@antsLayout")); |
|
480 |
||
481 |
@antsLayout = @Layout unless (@antsLayout); |
|
482 |
||
483 |
$P{RECNO} = -1 unless defined($P{RECNO}); # set pseudo %PARAMs |
|
484 |
$P{LINENO} = -1 unless defined($P{LINENO}); |
|
485 |
$P{DEPS} = "@antsDeps"; |
|
486 |
||
487 |
my($lastFile) = $P{PATHNAME}; |
|
488 |
$P{PATHNAME} = $ARGV; |
|
489 |
($P{DIRNAME},$P{FILENAME}) = |
|
490 |
($ARGV =~ m{^(.*)/([^/]+)$}); |
|
491 |
unless (defined($P{DIRNAME})) { |
|
492 |
$P{DIRNAME} = "."; |
|
493 |
$P{FILENAME} = $P{PATHNAME}; |
|
494 |
} |
|
495 |
($P{BASENAME},$P{EXTN}) = |
|
496 |
($P{FILENAME} =~ m{^([^\.]+)\.(.+)$}); |
|
497 |
unless (defined($P{EXTN})) { |
|
498 |
$P{BASENAME} = $P{FILENAME}; |
|
499 |
$P{EXTN} = ""; |
|
500 |
} |
|
501 |
||
502 |
if ($antsDoParseHeader) { # done parsing |
|
503 |
unshift(@ARGV,@tempARGV); |
|
504 |
$antsDoParseHeader = undef; |
|
505 |
$antsPeekBuffer = $_; |
|
506 |
$antsPadOut = $antsBufNFields = split($opt_I,$antsPeekBuffer); |
|
507 |
return 1; |
|
508 |
} |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
509 |
|
0 | 510 |
$P{RECNO}++; # update pseudo %PARAMs |
511 |
$P{LINENO} = ($ARGV eq $lastFile) ? $P{LINENO}+1 : 0; |
|
512 |
||
513 |
s/[Nn][Aa][Nn]/nan/g; # make all nans lower case |
|
514 |
||
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
515 |
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
|
516 |
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
|
517 |
$antsBufNFields = @in; |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
518 |
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
|
519 |
push(@{$ants_[$i]},nan) |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
520 |
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
|
521 |
} |
0 | 522 |
} |
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
523 |
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
|
524 |
while (@in<$antsBufNFields); |
0 | 525 |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
526 |
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
|
527 |
$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
|
528 |
unless ref($opt_S); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
529 |
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
|
530 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
531 |
|
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
532 |
if (@antsNFNames) { # -N)ums |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
533 |
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
|
534 |
unless (defined($antsNfnr[$i])) { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
535 |
if ($antsNFNames[$i] =~ /^%/) { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
536 |
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
|
537 |
unless (defined($P{$\'})); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
538 |
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
|
539 |
} else { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
540 |
$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
|
541 |
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
|
542 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
543 |
} else { |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
544 |
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
|
545 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
546 |
} |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
547 |
} |
0 | 548 |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
549 |
chomp; |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
550 |
$antsLineBuf = $_; # save |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
551 |
|
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
552 |
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
|
553 |
|
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
554 |
### 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
|
555 |
### $antsBufNFields = $#{$ants_[$#ants_]} + 1; |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
556 |
#### print("antsBufNFields := $antsBufNFields --- $_"); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
557 |
### 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
|
558 |
### push(@{$ants_[$i]},nan) |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
559 |
### 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
|
560 |
### } |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
561 |
### } |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
562 |
### } |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
563 |
### 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
|
564 |
### while ($#{$ants_[$#ants_]}+1 < $antsBufNFields); |
0 | 565 |
} |
566 |
||
567 |
$ants_ = ($#ants_ - $#ants_%2) / 2; # set current idx to centre |
|
568 |
# print(STDERR "reading done; $#ants_+1 recs in buf, $ants_ is cur\n"); |
|
569 |
||
570 |
if ($antsLastFileName ne $ARGV) { # signal new file |
|
571 |
$antsLastFileName = $ARGV; |
|
572 |
$antsNewFile = 1; |
|
573 |
} |
|
574 |
||
575 |
return $#ants_+1; # ok |
|
576 |
} |
|
577 |
||
578 |
#---------------------------------------------------------------------- |
|
579 |
||
580 |
{ my(@ofn); # output layout # STATIC SCOPE |
|
581 |
my(@OEparam); # -F %PARAMs |
|
582 |
my(@OEfield); # -F fields |
|
583 |
my(@OEexpr); # -F exprs (compiled) |
|
584 |
my($EOparamsOnly); # nothing but %PARAMs in -F |
|
585 |
||
586 |
sub antsOut(@) |
|
587 |
{ |
|
588 |
my(@out) = @_; |
|
589 |
if (@out == 1 && $out[0] eq "EOF") { |
|
590 |
undef(@ofn); undef(@OEparam); undef(@OEfield); undef(@OEexpr); undef($EOparamsOnly); |
|
591 |
undef($antsHeadersPrinted); undef(@antsOutExprs); |
|
592 |
$antsPadOut = $antsBufNFields = @antsNewLayout; # NB: MUST BE SET BEFORE &antsOut("EOF"); |
|
593 |
return; |
|
594 |
} |
|
595 |
||
596 |
# STEP 0: PREPARE STUFF |
|
597 |
||
598 |
@ofn = @antsNewLayout unless (@ofn); # output layout |
|
599 |
@ofn = @antsLayout unless (@ofn); |
|
600 |
||
601 |
# STEP 1: CONSTRUCT @out IF NEEDED |
|
602 |
||
603 |
unless (@out > 0) { |
|
604 |
for (my($fnr)=0; $fnr<$antsBufNFields; $fnr++) { |
|
605 |
$out[$fnr] = &antsBufOut($fnr); # calc; NEEDS RECOMPILE |
|
606 |
} |
|
607 |
} |
|
608 |
||
609 |
# STEP 2: HANDLE FIELD SELECTION (-F) |
|
610 |
||
611 |
if (@antsOutExprs) { |
|
612 |
||
613 |
unless ($antsOutExprsCompiled) { # parse/compile |
|
614 |
my(@ofn_buf) = @ofn; # save current output layout |
|
615 |
undef(@ofn); |
|
616 |
||
617 |
$OEparamsOnly = 1; |
|
618 |
for (my($if)=my($of)=0; $if<@antsOutExprs; $if++,$of++) { |
|
3 | 619 |
# if ($antsOutExprs[$if] =~ m{^%([\w\.]+)$}) { # %PARAM |
620 |
if ($antsOutExprs[$if] =~ m{^%([^=]+)$}) { # %PARAM |
|
0 | 621 |
$ofn[$of] = $1; |
622 |
$OEparam[$of] = 1; |
|
623 |
} elsif ($antsOutExprs[$if] eq \'$@\') { # all fields |
|
624 |
undef($OEparamsOnly); |
|
625 |
for (my($i)=0; $i<@ofn_buf; $i++,$of++) { |
|
626 |
$ofn[$of] = $ofn_buf[$i]; |
|
627 |
$OEfield[$of] = $i; |
|
628 |
} |
|
3 | 629 |
# } elsif ($antsOutExprs[$if] =~ m{^[\w\.]+$}) { # single field |
630 |
} elsif ($antsOutExprs[$if] =~ m{^[^=]+$}) { # single field |
|
631 |
undef($OEparamsOnly); |
|
632 |
$ofn[$of] = $antsOutExprs[$if]; |
|
633 |
$OEfield[$of] = &outFnr($antsOutExprs[$if]); |
|
0 | 634 |
} else { # expression |
635 |
undef($OEparamsOnly); |
|
636 |
my($expr); |
|
3 | 637 |
($ofn[$of],$expr) = ($antsOutExprs[$if] =~ m{^([^=]*)=(.*)$}); |
0 | 638 |
croak("$0: cannot parse -F $antsOutExprs[$if]\n") |
639 |
unless defined($expr); |
|
640 |
my(@tmp) = @antsLayout; |
|
641 |
@antsLayout = @ofn_buf; |
|
642 |
$OEexpr[$of] = &antsCompileEditExpr($expr,\'$out_buf\'); |
|
643 |
@antsLayout = @tmp; |
|
644 |
} |
|
645 |
} |
|
646 |
$antsOutExprsCompiled = 1; |
|
647 |
} |
|
648 |
||
649 |
local(@out_buf) = @out; # save current output data |
|
650 |
undef(@out); # accessible from within exprs |
|
651 |
||
652 |
for (my($f)=0; $f<@ofn; $f++) { # create @out according to -F |
|
653 |
if ($OEparam[$f]) { |
|
654 |
$out[$f] = $P{$ofn[$f]}; |
|
655 |
} elsif (defined($OEfield[$f])) { |
|
656 |
$out[$f] = $out_buf[$OEfield[$f]]; |
|
657 |
} else { |
|
658 |
$out[$f] = &{$OEexpr[$f]}; |
|
659 |
} |
|
660 |
} |
|
661 |
} |
|
662 |
||
663 |
# STEP 3: PRINT HEADERS |
|
664 |
||
665 |
if (@antsNewLayout || @antsOutExprs) { |
|
666 |
&antsPrintHeaders(STDOUT,@ofn); |
|
667 |
} else { |
|
668 |
&antsPrintHeaders(STDOUT); |
|
669 |
} |
|
670 |
||
671 |
||
672 |
# STEP 4: DONE, DUE TO -H RUNNING OUT |
|
673 |
||
674 |
&antsExit() if (defined($opt_H) && ($opt_H-- == 0)); |
|
675 |
||
676 |
||
677 |
# STEP 5: PRINT DATA |
|
678 |
||
679 |
$antsPadOut = @ofn if ($antsPadOut >= 0 && @ofn); |
|
680 |
push(@out,nan) while (@out < $antsPadOut); |
|
681 |
||
682 |
my($outStr); |
|
683 |
for (my($fnr)=0; $fnr<=$#out; $fnr++) { |
|
684 |
$out[$fnr] = |
|
685 |
fmtNum($out[$fnr], |
|
686 |
@antsNewLayout ? $antsNewLayout[$fnr] : $antsLayout[$fnr]); |
|
687 |
$outStr .= (defined($out[$fnr]) && $out[$fnr] ne "" ? $out[$fnr] : nan) |
|
688 |
. ($fnr == $#out ? $opt_R : $opt_O); |
|
689 |
} |
|
690 |
print($outStr); |
|
691 |
||
692 |
# STEP 6: DONE, DUE TO -F WITH PARAMS ONLY |
|
693 |
||
694 |
&antsExit() if ($OEparamsOnly); |
|
695 |
||
696 |
} # antsOut() |
|
697 |
} # STATIC SCOPE |
|
698 |
||
699 |
#---------------------------------------------------------------------- |
|
700 |
||
701 |
sub antsIO() # combine input and output |
|
702 |
{ # NB: BYPASSES &antsBufOut()! |
|
703 |
my($i); |
|
704 |
for ($i=0; $i<$antsBufSkip && $i<=$#ants_; $i++) { |
|
705 |
&antsOut(@{$ants_[$i]}); |
|
706 |
} |
|
707 |
return &antsIn(); # re-fill |
|
708 |
} |
|
709 |
||
710 |
sub antsPreFlush() # pre-flush buffer to cur |
|
711 |
{ |
|
712 |
my($i); |
|
713 |
for ($i=0; $i<=$ants_; $i++) { |
|
714 |
&antsOut(@{$ants_[$i]}); |
|
715 |
} |
|
716 |
} |
|
717 |
||
718 |
sub antsPostFlush() # post-flush buffer after cur |
|
719 |
{ |
|
720 |
my($i); |
|
721 |
for ($i=$ants_; $i<=$#ants_; $i++) { |
|
722 |
&antsOut(@{$ants_[$i]}); |
|
723 |
} |
|
724 |
} |
|
725 |
||
726 |
sub antsFlush() # flush buffer |
|
727 |
{ |
|
728 |
&antsOut(@{$ants_[0]}),shift(@ants_) |
|
729 |
while ($#ants_ >= 0); |
|
730 |
}'; die("antsReCompile: $@\n") if ($@); # re-compile functions |
|
731 |
||
732 |
} # of antsReCompile() |
|
733 |
||
734 |
&antsReCompile(); # compile |
|
735 |
||
736 |
#---------------------------------------------------------------------- |
|
737 |
||
738 |
sub antsSetR_($$$) # set field in any rec |
|
739 |
{ my($r,$f,$v) = @_; |
|
740 |
$antsBufNFields = $f+1 # auto extension |
|
741 |
if ($antsBufNFields-1 < $f); |
|
742 |
while ($#{$ants_[$r]} < $f-1) { |
|
743 |
push(@{$ants_[$r]},nan); |
|
744 |
} |
|
745 |
$ants_[$r][$f] = $v; |
|
746 |
} |
|
747 |
||
748 |
sub antsSet_($$) # set field in current rec |
|
749 |
{ &antsSetR_($ants_,$_[0],$_[1]); } |
|
750 |
||
751 |
#---------------------------------------------------------------------- |
|
752 |
||
753 |
{ my(%sExprs); # multiple layouts -> multiple compiled -S exprs |
|
754 |
||
755 |
sub antsFileIn() # read from a file |
|
756 |
{ my($f) = @_; |
|
757 |
||
758 |
REDO: |
|
759 |
return () unless ($_ = <$f>); # get next record (return EOF) |
|
760 |
||
761 |
goto REDO if /^#/; # skip comments |
|
762 |
goto REDO if /^\s*$/; # skip empty lines |
|
763 |
s/^\s+//; # remove leading spaces |
|
764 |
s/#.*$//; # remove trailing comments |
|
765 |
||
766 |
local(@in) = split($opt_I); # needs to be local for -S |
|
767 |
||
768 |
if (defined($opt_S)) { # -S)elect |
|
769 |
$sExprs{$f} = &antsCompileAddrExpr($opt_S,'$in') |
|
770 |
unless defined($sExprs{$f}); |
|
771 |
goto REDO unless (&{$sExprs{$f}}); |
|
772 |
} |
|
773 |
||
774 |
if (@antsNFNames) { # handle -N)ums |
|
775 |
for (my($i)=0; $i<=$#antsNFNames; $i++) { |
|
776 |
if ($antsNFNames[$i] =~ /^%/) { |
|
777 |
croak("$0: illegal -N option ($antsNFNames[$i] undefined)\n") |
|
778 |
unless (defined($P{$'})); |
|
779 |
goto REDO unless (numberp($P{$'})); |
|
780 |
} else { |
|
781 |
$antsNfnr[$i] = &fnr($antsNFNames[$i]); |
|
782 |
goto REDO unless (numberp($in[$antsNfnr[$i]])); |
|
783 |
} |
|
784 |
} |
|
785 |
} |
|
786 |
||
787 |
return @in; |
|
788 |
} |
|
789 |
||
790 |
} # static scope |
|
791 |
||
792 |
#====================================================================== |
|
793 |
# Utilities |
|
794 |
#====================================================================== |
|
795 |
||
796 |
sub antsPrintHeaders($@) # handle headers |
|
797 |
{ |
|
798 |
return if ($antsHeadersPrinted); # do only once |
|
799 |
$antsHeadersPrinted = 1; |
|
800 |
local(*fh,@newLayout) = @_; |
|
801 |
||
802 |
if (@newLayout) { # check for duplicate field names |
|
803 |
my(%fn); |
|
804 |
for (my($i)=0; $i<=$#newLayout; $i++) { |
|
805 |
next unless defined($newLayout[$i]) && $newLayout[$i] ne ''; |
|
806 |
if ($fn{$newLayout[$i]}) { |
|
807 |
&antsInfo("duplicate output field <$newLayout[$i]> changed to <$newLayout[$i]_>"); |
|
808 |
$newLayout[$i] .= '_'; |
|
809 |
again; |
|
810 |
} |
|
811 |
$fn{$newLayout[$i]} = 1; |
|
812 |
} |
|
813 |
} |
|
814 |
||
815 |
return if ($opt_Q); # suppress |
|
816 |
||
817 |
if (defined($antsActiveHeader)) { # activate file |
|
818 |
chmod(0777&~umask,*fh); |
|
819 |
print(fh $antsActiveHeader); |
|
820 |
} |
|
821 |
||
822 |
print(fh $antsOldHeaders); # old headers |
|
823 |
||
824 |
print(fh $antsCurHeader) unless ($opt_X); # new headers |
|
825 |
print(fh $antsCurParams); |
|
826 |
print(fh $antsCurDeps) unless ($opt_X); |
|
827 |
if (@newLayout) { |
|
828 |
print(fh "#ANTS#FIELDS# "); |
|
829 |
for (my($i)=0; $i<=$#newLayout; $i++) { |
|
830 |
print(fh "{$newLayout[$i]} "); |
|
831 |
} |
|
832 |
print(fh "\n"); |
|
833 |
} |
|
834 |
||
835 |
||
836 |
} |
|
837 |
||
838 |
sub antsExit() |
|
839 |
{ |
|
840 |
&antsPrintHeaders(STDOUT,@antsNewLayout); |
|
841 |
exit(0); |
|
842 |
} |
|
843 |
||
844 |
#---------------------------------------------------------------------- |
|
845 |
||
846 |
# NB: to use antsInfo in expressions, a return value of 1 |
|
847 |
# has been assumed!!! |
|
848 |
||
849 |
sub antsInfo(@) # add info to header & STDERR |
|
850 |
{ |
|
851 |
return 1 if ($opt_Q); |
|
852 |
my($fmt,@args) = @_; # can't do it directly!!! |
|
853 |
my($msg) = sprintf($fmt,@args); |
|
854 |
$antsCurHeader .= "#ANTS# $0: $msg\n"; |
|
855 |
print(STDERR "$0: $msg\n"); |
|
856 |
return 1; |
|
857 |
} |
|
858 |
||
859 |
#---------------------------------------------------------------------- |
|
860 |
# %PARAM-related stuff |
|
861 |
#---------------------------------------------------------------------- |
|
862 |
||
863 |
sub antsAddParams(@) # add params |
|
864 |
{ |
|
865 |
my($i); |
|
866 |
||
867 |
$antsCurParams .= "#ANTS#PARAMS#"; |
|
868 |
for ($i=0; $i<$#_; $i+=2) { |
|
869 |
my($v) = $_[$i+1]; |
|
870 |
$v =~ s/\n/\\n/g; |
|
871 |
$P{$_[$i]} = $v; |
|
872 |
$antsCurParams .= " $_[$i]\{$v\}"; |
|
873 |
} |
|
874 |
$antsCurParams .= "\n"; |
|
875 |
} |
|
876 |
||
877 |
sub antsFileParams() # get params from file |
|
878 |
{ |
|
879 |
my($f) = @_; |
|
880 |
my(%P); |
|
881 |
||
882 |
while ($_ = <$f>) { # get next record |
|
883 |
if (/^#ANTS#PARAMS# ([^\{]+)\{([^\}]*)\}/) { |
|
884 |
do { |
|
885 |
$P{$1} = $2; |
|
886 |
$P{$1} =~ s/^\s*//; # ensure non-null |
|
887 |
} while ($' =~ m/ ([^\{]+)\{([^\}]*)\}/); |
|
888 |
} |
|
889 |
} |
|
890 |
seek($f,0,0) || croak("$0: $@\n"); |
|
891 |
return %P; |
|
892 |
} |
|
893 |
||
894 |
# antsFileScanParam() only scans the 1st header!!!! |
|
895 |
# empty lines are ok, though |
|
896 |
||
897 |
sub antsFileScanParam() # find param in file |
|
898 |
{ |
|
899 |
my($f,$pn) = @_; |
|
12
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
900 |
my($v1,$v2); |
0 | 901 |
|
13 | 902 |
$pn = $' if ($pn =~ /^%/); # strip optional leading % |
0 | 903 |
|
904 |
while ($_ = <$f>) { # get next record |
|
905 |
last unless (/^#/ || /^\s*$/); |
|
906 |
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
|
907 |
$v1 = $1 if (/ $pn\{([^\}]*)\}/); |
58c5aa230550
just before adding new special arg 'prefix(file)suffix'
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
3
diff
changeset
|
908 |
$v2 = $1 if (/::$pn\{([^\}]*)\}/); |
0 | 909 |
} |
910 |
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
|
911 |
return defined($v1) ? $v1 : $v2; |
0 | 912 |
} |
913 |
||
914 |
#---------------------------------------------------------------------- |
|
915 |
# Layout-related stuff |
|
916 |
#---------------------------------------------------------------------- |
|
917 |
||
918 |
sub antsFileLayout($) # return layout |
|
919 |
{ my($f) = @_; |
|
920 |
my(@lo); |
|
921 |
||
922 |
while ($_ = <$f>) { # get next record |
|
923 |
next unless (/^#ANTS#FIELDS# /); |
|
924 |
@lo = split(' ',$'); |
|
925 |
} |
|
926 |
seek($f,0,0) || croak("$0: $@\n"); |
|
927 |
for (my($i)=0; $i<=$#lo; $i++) { |
|
928 |
$lo[$i] =~ s/^\{(.*)\}$/$1/; |
|
929 |
} |
|
930 |
return @lo; |
|
931 |
} |
|
932 |
||
933 |
sub antsFileScanFnr($$) # find fnr in file |
|
934 |
{ my($f,$fn) = @_; |
|
935 |
my(@lo) = &antsFileLayout($f); |
|
936 |
||
937 |
for (my($f)=0; $f<=$#lo; $f++) { |
|
938 |
return $f if ($fn eq $lo[$f]); |
|
939 |
} |
|
940 |
return undef; |
|
941 |
} |
|
942 |
||
943 |
#---------------------------------------------------------------------- |
|
944 |
# Deps-related stuff |
|
945 |
#---------------------------------------------------------------------- |
|
946 |
||
947 |
sub antsAddDeps(@) # add Deps |
|
948 |
{ |
|
949 |
my(@deps) = @_; |
|
950 |
return if $opt_D || (@deps==1 && ($deps[0] eq '-' || $deps[0] eq '')); # STDIN |
|
951 |
||
952 |
$antsCurDeps .= '#ANTS#DEPS#'; |
|
953 |
for (my($i)=0; $i<=$#deps; $i++) { |
|
954 |
next if (length($deps[$i]) == 0); |
|
955 |
$antsCurDeps .= " \{$deps[$i]\}"; |
|
956 |
} |
|
957 |
$antsCurDeps .= "\n"; |
|
958 |
} |
|
959 |
||
960 |
#====================================================================== |
|
961 |
||
962 |
1; |