#!/usr/bin/perl -w # # dbrowaccumulate # Copyright (C) 1991-1998 by John Heidemann # $Id: dbrowaccumulate,v 1.11 2005/03/01 01:48:56 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 STDERR <getopt) { $ch = $dbopts->opt; if ($ch eq 'C') { $inc_code = $dbopts->optarg; } elsif ($ch eq 'c') { $incc = $dbopts->optarg; } elsif ($ch eq 'd') { $debug = 1; } else { &usage; }; }; &usage if ($#ARGV > 0); &readprocess_header; if ($inc_code eq '') { # what col to inc with? die "$prog: neither -C nor -c specified.\n" if ($incc eq ''); die ("$prog: unknown column ``$incc''.\n") if (!defined($colnametonum{$incc})); $incc = $colnametonum{$incc}; $inc_code = '$f[' . $incc . ']'; }; my($accum) = 0; my($accum_f) = &col_create('accum'); my($code) = "\$accum += $inc_code;\n\$f[$accum_f] = \$accum;\n"; if ($debug) { print $code; exit 1; }; &write_header(); my($loop) = q[ while () { &pass_comments && next; &split_cols; ] . $code . q[ &write_cols; }; ]; eval $loop; $@ && die "$prog: interal eval error: $@.\n"; print "# | $prog " . join(" ", @orig_argv) . "\n"; exit 0; if (0) { my $x; $x = $accum = $code; }