#!/usr/bin/perl

#
# dbroweval
# Copyright (C) 1991-1998 by John Heidemann <johnh@isi.edu>
# $Id: dbroweval,v 1.26 2003/05/23 04:17:49 johnh Exp $
#
# This program is distributed under terms of the GNU general
# public license, version 2.  See the file COPYING
# in $dblibdir for details.
#
sub usage {
    print <<END;
usage: $0 [-f CodeFile] code [code...]
	Evaluate code for each row of the data.

	Typical actions are things like reformatting
	and other data transformations.

Options:
    -b CODE	Run CODE before reading any data (like awk BEGIN blocks).
    -e CODE	Run CODE at the end of all data (like awk END blocks).
    -f FILE	Read code from the FILE.
    -d		enable debugging
    -n		no output except for comments
    -N		no output (not currently implemented)

Code can include embedded column names preceeded by underscores;
these result in the value of that column for the current row.

The values of the last row's columns are retreieved with _last_foo
where foo is the column name.

Even more perverse, _columname(N) is the value of the
Nth column after columnname [so _columnname(0) is the also
the column's value.

Sample input:
#h      size    mean    stddev  pct_rsd
1024    1.4962e+06      2.8497e+05      19.047
10240   5.0286e+06      6.0103e+05      11.952
102400  4.9216e+06      3.0939e+05      6.2863
#  | dbsetheader size bw
#  | /home/johnh/BIN/DB/dbmultistats size bw
#  | /home/johnh/BIN/DB/dbcol size mean stddev pct_rsd

Command:
cat data.jdb | dbroweval '_mean = sprintf("%8.0f", _mean); _stddev = sprintf("%8.0f", _stddev);'

Sample output:
#h      size    mean    stddev  pct_rsd
1024     1496200          284970        19.047
10240    5028600          601030        11.952
102400   4921600          309390        6.2863
#  | dbsetheader size bw
#  | /home/johnh/BIN/DB/dbmultistats size bw
#  | /home/johnh/BIN/DB/dbcol size mean stddev pct_rsd
#  | /home/johnh/BIN/DB/dbroweval   { _mean = sprintf("%8.0f", _mean); _stddev = sprintf("%8.0f", _stddev); }

Bugs:
Handling of code in files isn't very elegant.

END
# '
    exit 0;
}

require 5.000;
BEGIN {
    $dblibdir = "/home/johnh/BIN/DB";
    push(@INC, $dblibdir);
}
require "$dblibdir/dblib.pl";
use DbGetopt;


my(@orig_argv) = @ARGV;
my($prog) = &progname;

@beg_code = @end_code = @code_files = ();
$debug = 0;
my($no_output) = 0;
my($dbopts) = new DbGetopt("b:de:f:nN?", \@ARGV);
my($ch);
while ($dbopts->getopt) {
    $ch = $dbopts->opt;
    if ($ch eq 'b') {
	push (@beg_code, $dbopts->optarg);
    } elsif ($ch eq 'd') {
	$debug++;
    } elsif ($ch eq 'e') {
	push (@end_code, $dbopts->optarg);
    } elsif ($ch eq 'f') {
	push(@code_files, $dbopts->optarg);
    } elsif ($ch eq 'n') {
	$no_output = 1;
    } elsif ($ch eq 'N') {
	$no_output = 2;  die "$0: -N not yet implemented\n";
    } else {
	&usage;
    };
};


#
# handle files
#
foreach (@code_files) {
    open(INF, "<$_") || die "$prog: cannot open ``$_''.\n";
    push(@ARGV, join('', <INF>));
    close INF;
};

&readprocess_header;

($perl_code_f, $db_code_a_f, $title_f, $command_f) = (0..20);

$pretty_args = "";
foreach $iref ([\$beg_code, \@beg_code, "BEGIN CODE:", "-b"],
		[\$code, \@ARGV, "CODE:", ""],
		[\$end_code, \@end_code, "END_CODE:", "-e"]) {
    next if ($#{$iref->[$db_code_a_f]} == -1);
    $c = ${$iref->[$perl_code_f]} = &codify(@{$iref->[$db_code_a_f]});
    $pretty_args .= " $iref->[$command_f] { " .
			&code_prettify(@{$iref->[$db_code_a_f]}) . " }";
    print STDERR "$iref->[$title_f]:\n$c\n" if ($debug);
}
exit 1 if ($debug);

&write_header() if (!$no_output);

eval $beg_code;  $@ && die "$prog: error in eval of begin block: $@\n";
my($loop) = q[
    row:
    while (<STDIN>) {
	&pass_comments && next;
	&split_cols;
{] . $code . q[;}
	&write_cols if (!$no_output);
    };
];
eval $loop;  $@ && die "$prog: error in eval of code: $@\n";

eval $end_code;  $@ && die "$prog: error in eval of end block: $@\n";

$code =~ s/\n/ /g;   # otherwise comments break
print "#  | $prog $pretty_args\n";
exit 0;