#! /usr/bin/perl
$RCS_ID = '$Id: dataent,v 2.8 1993/04/10 08:34:41 hobbs Exp $' ;
($pdir = $0) =~ s-[^/]+$-- ;	# pgm dir
$pdir = '.' unless $pdir ;
$0 =~ s-.*/-- ;
$LFSUF = ".LCK" ;	# lockfile suffix
$HelpInfo = <<EOH ;

	    RDB utility: $0

Usage:  $0  [options]  rdbtable
   or:  $0  [options]  -init  template

Options:
    -help    Print this help info.
    -init    Initiate a new rdbtable.
    -nbr     Do NOT remove leading and trailing blank space from data values.
    -prev    Use data values from previous row as defaults for current row.

This utility provides an interactive capability for entering data into an
rdbtable. The user is prompted by column name for data values.  Options may
be abbreviated.

In the first case of usage above, new rows of data are added to the end of an
existing rdbtable. In the second case, a template file is used to generate a
new rdbtable and add rows of data to it.

At each column name prompt the user may enter data followed by a <RET> or
just a <RET> to retain the current value, which is initially null.  Normally
leading and trailing blank space is removed from data values.  If it is desired
to prevent this enter a backslash (\\) as the first character (the backslash
will be removed) or use the '-nbr' option.  In order to replace an existing data
value with a null value enter a backslash (\\) and a <RET>.

At any column name prompt, if a single space character is entered, followed by
a <RET>, control is transferred to the end of row action prompt.  This is
useful if not all data values need to be entered on all rows.  If two space
characters followed by a <RET> is entered control is transferred to the
previous column name prompt. This is useful if an error was made entering data;
it can be corrected immediately.

After all the column name prompts for a row have been responded to, the user is
asked for the next action. The default is to save the current row of data to
the rdbtable and go on to enter data for the next row. Other options available
are to go back and check each value of the current row; to quit, saving or not
saving the current row; to list the data values for the entire row; to delete
the current row and start a new one; to jump back to a specified column name
prompt for the current row and continue from there; or to produce a help
listing.  Also the setting of the '-nbr' and '-prev' options may be toggled on
or off.

At any time an INTERRUPT signal (^C or DEL) may be entered to abort the
program.  In this case all rows of data except the current one will be saved.

Concurrency control to prevent silmultaneous wrting of an rdbtable by multiple
users is provided by the use of a lockfile "rdbtable$LFSUF".

Uses RDB operator: headchg.

$RCS_ID
EOH
$SIG{'INT'} = 'catch' ;				# in case of an INT
while ( $ARGV[0] =~ /^-/ ){				# Get args
    $_ = shift ;
    if( /^-h.*/ ){ print $HelpInfo ; exit 1 ; }
    if( /-i.*/ ){ $INIT++ ; next ; }
    if( /-n.*/ ){ $NBRM++ ; next ; }
    if( /-p.*/ ){ $PREV++ ; next ; }
    if( /-s.*/ ){ $SCRN++ ; next ; }
    if( /-x.*/ ){ $XBUG++ ; next ; }
    die "\nBad arg: $_\n", "For help type \"$0 -help\".\n" ; }
$file = shift ;
if( ! $file ){ die "\nNo file given.\n", "For help type \"$0 -help\".\n" ; }
if( $INIT ){					# init a new rdbtable
    @F = `headchg -gen -q $file` ;
    # chk error: $@, or $! ... then die if bad return .......................
    for $_ (@F){
	next if /^\s*#/ ;	# comment
	chop( $y = $_ ) ;	# col name line
	last ; }
    @H = split( "\t", $y ) ;
    if( $file =~ /\.[^.]*$/ && $& ne '.rdb' ){	# get new filename
	$new = "$`.rdb" ; }		# form:  xxx.rdb
    else{
	$new = "$file.rdb" ; }	# safety valve
    ($lockfile = $new) =~ s-$-$LFSUF- ;	# lock file name
    if( -f $new ){				# $new already exists 
	print STDERR "\nFile $new exists, Add new data to end? " ;
	$a = <STDIN> ;
	die "\nAborting\n" if $a !~ /^y/i ;
	&set_lock ;
	open( UT, ">>$new" ) || die "\nCan't open output: $new\n" ; }
    else{
	&set_lock ;
	open( UT, ">$new" ) || die "\nCan't open output: $new\n" ;
	print UT @F ; }		# header of new rdbtable 
}
else{						# add to existing rdbtable
    open( FI, $file ) || die "\nCan't open input: $file\n" ;
    while(<FI>){
	next if /^\s*#/ ;	# comment
	chop ;			# col name line of header
	last ; }
    @H = split( "\t", $_ ) ;
    close FI ;
    ($lockfile = $file) =~ s-$-$LFSUF- ;	# lock file name
    &set_lock ;
    open( UT, ">>$file" ) || die "\nCan't open output: $file\n" ;
}
$sel = select(UT) ; $|++ ; select($sel) ;      # so data is written immediately
for( $i=0 ; $i < @H ; $i++ ){ $dat[$i] = "" ; }	# clear array @dat
if( $SCRN ){
    &scrn_ent ; }
else{
    &line_ent ; }
&unlock ;

sub catch {			# catch INTs, save data to rdbtable
    close UT ;
    &unlock ;
    if( $SCRN ){
	&endwin ;
	&finishCterm ; }
    exit ;
}
sub set_lock {			# chk write perm, setup lock (uses $lockfile)
    ($dbdir = $lockfile) =~ s-[^/]+$-- ;	# db dir
    $dbdir = "." unless $dbdir ;
    $dbdir =~ s-/$-- ;
    unless( -w $dbdir ){
	die "No write permission in dir: $dbdir\n" ; }
    unless( &lock ){			# request lock
	die "File busy: $file, try later.\n" ; }
}
sub lock {	# chk, set lock on the file. ret 1 if lock set; else 0.
    $umask = umask( 0777 ) ;
    unless( open( LF, ">$lockfile" )){ return 0 ; }
    umask( $umask ) ;
    1 ;
}
sub unlock {					# remove lock on the file.
    unlink $lockfile ;
}
sub line_ent {					# line oriented data entry
    main: while( 1 ){					# main loop
	unless( $do_over ){			# clear row
	    print "New Row ...\n" ;
	    if( ! $PREV ){
		for( $i=0 ; $i < @H ; $i++ ){ $dat[$i] = "" ; } }
	    $#dat = $#H ; }
	for( $i=$ii ; $i < @H ; $i++ ){	# print values, if any, prompts
	    if( $dat[$i] ){
		printf( "%12s: (%s) ", $H[$i], $dat[$i] ) ; }
	    else{
		printf( "%12s: ", $H[$i] ) ; }
	    chop( $v = <STDIN> ) ;
	    if( $v eq ' ' ){		# go to (end of row) action prompt
		last ; }
	    if( $v eq '  ' ){		# back up a column
		$i--  if $i > 0 ;
		print "\n" ;
		redo ; }
	    if( $v ){			# save data value
		unless( ($v =~ s/^\\// ) || $NBRM ){
		    $v =~ s/^\s+// ;
		    $v =~ s/\s+$// ;
		}
		if( $v =~ s/\t/ /g ){
		    warn "TAB chars removed\n" ; }
		$dat[$i] = $v ;
	    }
	}
	while( 1 ){						# ACTION prompt
	    $do_over = $ii = 0 ;
	    print
	    "ACTION? (save, check, quit, list, del, jump NAME, help) [save] ";
	    chop( $a = <STDIN> ) ;
	    if( $a =~ /^s/ || $a eq "" ){		# new row in rdbtable
		print UT join( "\t", @dat ), "\n" ;
		last ; }
	    elsif( $a =~ /^c/ || $a =~ /^ / ){		# check row again
		print "\n" ;
		$do_over++ ;
		last ; }
	    elsif( $a =~ /^l/ ){			# list entire row
		print "\n" ;
		for( $i=0 ; $i < @H ; $i++ ){
		    if( $dat[$i] ){
			printf( "%12s: (%s)\n", $H[$i], $dat[$i] ) ; }
		    else{
			printf( "%12s:\n", $H[$i] ) ; } } }
	    elsif( $a =~ /^q/ ){			# quit
		if( $a =~ /^q\S*\s+\S/ ){			# del row
		    last main ; }
		print UT join( "\t", @dat ), "\n" ;		# save row
		last main ; }
	    elsif( $a =~ /^d/ ){			# del this row, continue
		last ; }
	    elsif( $a =~ /^j\S*\s+(\S+)/ ){		# jump to col, do over
		$x = $1 ;
		for( $i=0 ; $i < @H ; $i++ ){
		    if( $H[$i] =~ /^$x/ ){
			$ii = $i ;
			last ; }
		}
		$do_over++ ;
		last ; }
	    elsif( $a =~ /^-/ ){			# toggle option
		if( $a =~ /^-p/ ){
		    if( $PREV ){ $PREV = 0 ; print "\n\t>>> -prev OFF\n\n" ; }
		    else{ $PREV++ ; print "\n\t>>> -prev ON\n\n" ; } }
		if( $a =~ /^-n/ ){
		    if( $NBRM ){ $NBRM = 0 ; print "\n\t>>> -nbr OFF\n\n" ; }
		    else{ $NBRM++ ; print "\n\t>>> -nbr ON\n\n" ; } }
	    }
	    elsif( $a =~ /^h/ ){			# help listing
		print <<EOP ;

save    - save row, continue.
check   - check each data value for this row again.
quit    - save row, quit program.
quit no - do NOT save row, quit program.
list    - List data values for entire row.
del     - delete this row, start new row.
jump NAME - jump back to column NAME, check rest of row.
INTERRUPT (^C or <DEL>) - abort the program, discarding the current row.

At any column name prompt:
a space char & <RET>    - jump to the end of row action prompt.
two space chars & <RET> - jump back to the previous column name prompt.

Options and column names may be abbreviated.

EOP
	    } # help listing
	    else{ print "What ?\n" ; }
	} # action prompt
    } # main
}
sub scrn_ent {					# screen oriented data entry
    unshift( INC, $pdir ) ;
    do 'cterm.pl' || die "$0 can't include cterm.pl\n" ;
    &startCterm(@ARGV) ;
    &initscr ; &nonl ; &cbreak ; &noecho ;
    &leaveok($stdscr,0) ; &refresh ;
    &keypad($stdscr,1) if defined $curfun{'keypad'} ;

    &editl($curcon{'KEY_LEFT'}) if defined $curcon{'KEY_LEFT'} ;
    &editr($curcon{'KEY_RIGHT'}) if defined $curcon{'KEY_RIGHT'} ;
    &editq($curcon{'KEY_UP'}) if defined $curcon{'KEY_UP'} ;
    &editq($curcon{'KEY_DOWN'}) if defined $curcon{'KEY_DOWN'} ;
    &editq($curcon{'KEY_RET'}) ;
    &editq($curcon{'KEY_TAB'}) ;
    &editq(10) ;	# ^J (for down)
    &editq(11) ;	# ^K (for up)
    &editq(27) ;	# <ESC> 

    $lmin = 2 ;			# top line ndx
    $lmax = $LINES-2 ;		# bot line ndx
    $xtra = @H - ($lmax - $lmin +1) ; # excess of data lines over screen lines
    $lact = $LINES-1 ;		# action prompt line ndx
    $col = 15 ;			# col for editing
    $new_ent++ ;		# new entry
    if( $xtra > 0 ){ $k = @H ;				# temp safety valve
	&mvaddstr( 12, 0, "Can't do yet: rows: $k, screen lines $LINES" ) ;
	&refresh ; &catch ; }
    while( 1 ){
	if( $new_ent ){
	    &clear ;				# clear screen
	    $k = ( $xtra > 0 ? $lmax : $#H ) ;
	    for( $i=0, $j=$lmin ; $i <= $k ; $i++, $j++ ){
		&mvaddstr( $j, 0, sprintf( "%14s", $H[$i] )) ;	# col prompt
		&mvaddstr( $j, $col+1, $dat[$i] ) ; }		# data
	    $new_ent = 0 ; }
	else{
	    &clrreg( $lact, $lact ) ; }		# clear action line
	&mvaddstr( $lact, 0, "$msg" ) ;		# message on action line
	linin: while( 1 ){		# get data for each column, curr row
	    for( $i=0 ; $i < @H ; $i++, &clrreg($lact, $lact), $msg = "" ){
		$lin = $i+2 ;
		( $dat[$i], $quitKey ) =		# edit the field
		    &edit( $dat[$i], 0, $lin, $col, 60, ' <> ') ;
		if( &ch2str($quitKey) eq 'KEY_UP' || $quitKey == 11 ){ # or ^K
		    if( $i > 0 ){
			$i -= 2 ; }
		    else{
			$i = $#H -1 ; }
		    next ; }
		if( $quitKey == 13 || $quitKey == 27 ){ # <RET>, <ESC>
		    last linin ; }
	    }
	}				    # next action prompt, bot of screen
	&mvaddstr( $lact, 0,
	    "Save(or<RET>), Continue, Quit(save), Exit(nosave), Help " ) ;
	$cha = &ch2str( &getchR ) ;
	last if $cha eq 'e' ;				# exit no save
	if( $cha eq 'h' ){				# help
	    &clrreg( $lact, $lact ) ;
	    &mvaddstr( $lact, 0, "What do you want to know? " ) ;
	    &getchR ;
	    &clrreg( $lact, $lact ) ;
	    next ; }
	if( $cha eq 'KEY_RET' || $cha eq 's' || $cha eq 'q' ){
	    $msg = "Data saved to file" ;
	    print UT join( "\t", @dat ), "\n" ;		# save row of data
	    last if $cha eq 'q' ;			# quit
	    $new_ent++ ;
	    unless( $PREV ){
		for( $i=0 ; $i < @H ; $i++ ){ $dat[$i] = "" ; } } # clear @dat
	    next ; }
	if( $cha eq '-' ){				# option chg
	    $cha = &ch2str( &getchR ) ;
	    if( $cha eq 'p' ){		# prev
		if( $PREV ){ $PREV = 0 ; $msg = "PREV OFF" ; }
		else{ $PREV++ ; $msg = "PREV ON" ; }
	    }
	    next ; }
    }
    &clear; &refresh ; &endwin ; &finishCterm ;
}