#!/bin/ash
# *********************************************************************
#  Written by and copyright Carlo Strozzi <carlos@linux.it>.
#
#  prtable: NoSQL table formatting for character displays.
#  Copyright (C) 2001 Carlo Strozzi <carlos@linux.it>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#  2001-03-23 Alpha code
#  2001-04-20 Added inline help
#  2001-06-25 Signed-float width detection error
#  2001-07-09 Simplified datatype detection logic.
#  2001-08-17 Added stdio portability
#
#  $Id$
# *********************************************************************

#
# Main program.
#

trunc=9999
debug=0
perl_args=""
step=3

# Screen size auto-detection.
if [ "$LINES" != "" ]
then
   perl_args="-p$LINES"
fi

if [ "$COLUMNS" != "" ]
then
   perl_args="$perl_args -l$COLUMNS"
fi

while [ $# -ge 1 ]
do
  case $1 in
    -T|--trunc)	shift; trunc=$1; perl_args="$perl_args -t$1" ;;
    -x|--debug)	shift; debug=$1; perl_args="$perl_args -x" ;;
    -S|--step)	shift; step=$1 ;;
    -h|--help)
       cat @DOCPATH@/prtable.txt
       exit 1
    ;;
    *)		perl_args="$perl_args $1" ;;
  esac
  shift
done

# Create the necessary temporary files.
[ "$TMPDIR" = "" ] && TMPDIR=/tmp
awk_tmp1=`mktemp $TMPDIR/nosql.XXXXXX` || exit $?
trap_list=$awk_tmp1

awk_tmp2=`mktemp $TMPDIR/nosql.XXXXXX` || exit $?
trap_list="$trap_list $awk_tmp2"

perl_tmp=`mktemp $TMPDIR/nosql.XXXXXX` || exit $?
trap_list="$trap_list $perl_tmp"

table_tmp=`mktemp $TMPDIR/nosql.XXXXXX` || exit $?
trap_list="$trap_list $table_tmp"

trap "rm -f $trap_list; trap 0; exit 0" 0 1 2 3 15

cat <<'_EOF1_' > $awk_tmp1
#
# Replace the table dashline with column type/length information.
#

BEGIN { NULL = ""; FS = OFS = "\t" }

NR == 1 { print; next }
NR == 2 { next }

{
  if (trunc) {
     out_rec = substr($1, 1, trunc)
     for (i = 2; i <= NF; i++) out_rec = out_rec OFS substr($i, 1, trunc)
     print out_rec > table_tmp
  }
  else print > table_tmp

  for (i = 1; i <= NF; i++) {
    # NULL fields do not modify the datatype.
    if ($i == NULL) continue
    
    field_width = length($i)
    if (field_width > col_w[i]) col_w[i] = field_width
    if (trunc) {
      if (col_w[i] > trunc) { 
         col_w[i] = trunc
         $i = substr($i, 1, trunc)
      }
    }

    # Note: order is important in the following sequence of
    # fall-through tests on data types.

    # If not already String.
    if (col_t[i] != "S")
    {
      # Float
      if (col_t[i] ~ /^[FI]/ || !tested[i])
      {
        # if ($i ~ /^[-+]?[0-9]+[.,][0-9]+$/) # .08 is a valid float.
        if ($i ~ /^[-+]?[0-9]*[.,][0-9]+$/)
        {
          split($i, a, /[.,]/)
          new_precision = length(a[2])

          if (new_precision > precision[i]) precision[i] = new_precision

          # In floats sx_w[i] is the length of the integer part only.
          new_width = length(a[1])
          if (new_width > sx_w[i]) sx_w[i] = new_width

          col_t[i] = "F." precision[i]
          if (i == debug)
          {
            print "prtable> NR: " NR \
              " , value: " $i " , type: F." precision[i] > "@STDERR@"
          }
          tested[i] = 1 ; continue
        }
      }
  
      # Integer
      if (col_t[i] ~ /^[FI]/ || !tested[i])
      {
        if ($i ~ /^[-+]?[0-9]+$/)
        {
	  if ($i ~ /^[-+]/) add_one[i] = 1

          # Integer is compatible with Float.
          if (col_t[i] ~ /^F/)
          {
            # In floats sx_w[i] is the length of the integer part only.
            new_width = length($i)
            if (new_width > sx_w[i]) sx_w[i] = new_width
          }
          else col_t[i] = "I"
          if (i == debug)
          {
            print "prtable> NR: " NR \
              " , value: " $i " , type: I" > "@STDERR@"
          }
          tested[i] = 1 ; continue
        }
      }
  
      # Default is String.
      col_t[i] = "S"
      if (i == debug)
      {
        print "prtable> NR: " NR \
          " , value: " $i " , type: S" > "@STDERR@"
      }
      tested[i] = 1

    } # END If not already String.
  }
}

END {
  if (NR < 3)
  {
    # The table comprises only the header.

    for (i = 1; i <= NF; i++) { col_w[i] = length($i); col_t[i] = "S" }
  }

  # Compute actual length if Float.
  if (sx_w[1])
  {
    new_width = sx_w[1] + precision[1] + 1 + add_one[1]
    if (new_width > col_w[1]) col_w[1] = new_width
  }

  # Set first field: defaults to "0S" if yet unassigned.
  if (col_t[1] == NULL) { col_w[1] = 0 ; col_t[1] = "S" }

  # Special case for first field.
  if (debug == 1)
  {
    print "prtable> NR: " NR \
    " , value: " $1 " , type: S" > "@STDERR@"
  }

  out_rec = col_w[1] col_t[1]

  # Set remaining fields.
  for (i = 2; i <= NF; i++)
  {
    # Compute actual length if Float.
    if (sx_w[i])
    {
      new_width = sx_w[i] + precision[i] + 1 + add_one[i]
      if ( new_width > col_w[i] ) col_w[i] = new_width
    }

    # Yet unassigned fields default to "0S".
    if (col_t[i] == NULL) { col_w[i] = 0 ; col_t[i] = "S" }
    out_rec = out_rec OFS col_w[i] col_t[i]
  }

  # Print column definiton line.
  print out_rec
}
_EOF1_

cat <<'_EOF2_' > $awk_tmp2
# *********************************************************************
#
#  Pre-processes a table in a way similar to 'justify', but no blanks are
#  added around fields and the column definition line is not turned into
#  dashes. This is used to pre-process a table that is to be fed into the
#  'print' operator.
#
#  Warning: if the input list contains duplicated entries, i.e. multiple
#  rows with the same label (column name), the resulting table may
#  be broken.
#
# *********************************************************************

BEGIN { NULL = ""; FS = OFS = "\t"; }

NR == 1 {
  for (i = 1; i <= NF; i++)
  {
	# Set default column widths and types.
	col_w[i] = length($i)
	col_t[i] = "S"
  }
  split($0, c_names) ; next
}

NR == 2 {
  # Handle widths and column names.
  for (i = 1; i <= NF; i++)
  {
	tmp = $i ; sub(/[A-Za-z].*$/, NULL, tmp)
	# Make tmp a number. This is mandatory.
	tmp += 0
	if (tmp > col_w[i]) col_w[i] = tmp
	tmp = $i ; gsub(/[^A-Za-z]+/, NULL, tmp)
	precision[i] = $i; float[i] = sub(/^.*\./, NULL, precision[i])
	precision[i] += 0
	if (tmp != "S") col_t[i] = "N"
	if (i == 1) printf("%s", c_names[i])
	else { printf(OFS); printf("%s", c_names[i]) }
  }
  printf("\n")

  # Handle column definiton line..
  for (i = 1; i <= NF; i++)
  {
	if (i == 1) printf("%s", col_w[i] col_t[i])
	else { printf(OFS); printf("%s", col_w[i] col_t[i]) }
  }
  printf("\n")
}

NR > 2 {
  # Handle table body.
  for (i = 1; i <= NF; i++)
  {
	if (float[i]) j_mode = "%." precision[i] "f"
	else j_mode = "%s"
	if (i == 1) printf(j_mode, $i)
	else { printf(OFS); printf(j_mode, $i) }
  }
  printf("\n")
}
_EOF2_

cat <<'_EOF3_' > $perl_tmp
# *********************************************************************
# Original code: ptbl,v 2.7 1993/03/29 13:34:46 hobbs
# *********************************************************************

$0 =~ s-.*/-- ;
$BIGLIM = 1000 ;	# data field limit for normal listing
$sep = "  " ;	# default spacing between columns
$ind = 4 ;	# default indent amount for 2nd and later lines
$BEST = 9999 ;
$UNAME=`uname -s`;
$tty_size = 'echo $LINES $COLUMNS' ;

$= = 0 ;	# default page size set later
while ( $ARGV[0] =~ /^-/ ){				# Get args
    $_ = shift ;
    if( /^-b(\d*)/ || /^--best=?(\d*)/ ){
	$BEST = -1 ; $BEST = $1 if $1 ne "" ; next ; }
    if( /^-B.*/ || /^--big-fields$/  ){ $BIGF++ ; next ; }
    if( /^-e.*/ || /^--edit$/ ){ $EDT++ ; $BEST = 0 ; $LEN = 9999 ;
	$NOPAG++ ; $sep = ' | ' ; next ; }
    if( /^-f.*/ || /^--fold$/ ){ $FLD++ ; next ; }
    if( /^-i(\d+)/ || /^--indent=(\d+)/ ){ $ind = $1 ; next ; }
    if( /^-l(\d+)/ || /^--line-width=(\d+)/ ){ $LEN = $1 ; next ; }
    if( /^-p(\d+)/ || /^--page-size=(\d+)/ ){
	if( $1 ){ $= = $1 ; } else{ $NOPAG++ ; }
	next ; }
    if( /^-P(\w)(.*)/ || /^--print=(\w)(.*)/ ){
	$PRT++ ;
	chop( $DATE = `date` ) ;
	$PSTG = $2 ;
	if( $1 eq 'P' ){ $= = 60; $LEN =  80; }
	if( $1 eq 'R' ){ $= = 47; $LEN = 116; }
	if( $1 eq 'A' ){ $= = 51; $LEN = 125; }
	if( $1 eq '8' ){ $= = 63; $LEN = 144; }
	if( $1 eq '6' ){ $= = 82; $LEN = 192; }
	next ; }
    if( /^-s(.+)/ || /^--separator=(.+)/ ){ $sep = $1 ; next ; }
    if( /^-t(\d*)$/ || /^--trunc=?(\d*)$/ ){
	$TRUN = 9999 ; $TRUN = $1 if $1 ; next ; }
    if( /^-w.*/ || /^--window$/ ){ $WIN++ ; $sep = ' ' ; next ; }
    if( /^-x.*/ || /^--debug$/ ){ $XBUG++ ; next ; }
    die "\n$0: unknown option: $_\n" ; 
}
$sepl = length($sep) ;
if( ! $LEN || (! $= && ! $NOPAG) ){
    chop($_ = `$tty_size`) =~ /^(\d+)\s+(\d+)/ ;
    if( ! $= && ! $NOPAG ){
	$= = $1 ;
	$= = 60 unless $= ; }	# safety valve
    $LEN = $2 if ! $LEN ;
    $LEN = 80 unless $LEN ;	# safety valve
}
$=-- if ! $PRT && ! $NOPAG ;	# for paging in window
while(<STDIN>){
    if( $EDT && /^\.\.>>>/ ){ print $_ ; next ; } # bypass control line if EDT
    if( /^\s*#/ ){				# comment 
	push( @savcom, $_ ) if $EDT ;
	next ; }
    $lln++ ;	# logical line nr (not control lines or comments)
    chop ;
    @F = split( /\t/, $_ );
    if( $lln <= 2 ){
	if( $lln == 1 ){
	    @hdrs = @F ;				# col names
	    next ; }
	if( $lln == 2 ){
	    $i = 0 ;
	    for $_ (@F){				# col definitions
		if( /(\d+)/ ){			# column width
		    push( @wdth, $1 ) ; }
		else{
		    push( @wdth, length($_) ) ; }
		if( /(\S+)/ && $1 =~ /</ ){	# justification
		    push( @just, "L" ) ; } # left
		elsif( /(\S+)/ && $1 =~ />/ ){
		    push( @just, "R" ) ; } # right
		else{
		    if( /(\S+)/ && $1 =~ /N/i ){ # numeric type
			push( @just, "R" ) ; } # right
		    else {
			push( @just, "L" ) ; } } # left
		if( $wdth[$#wdth] > ($LEN - $ind ) ){	# safety valve
		    $wdth[$#wdth] = $LEN - $ind ; }
		if( $TRUN && $wdth[$#wdth] > $TRUN ){
		    $wdth[$#wdth] = $TRUN ; }
		$_ = '-' x $wdth[$#wdth]  if ! $EDT ;
		$len = length( $hdrs[$i] ) ;	# adjust @hdrs
		if( $TRUN && $len > $TRUN ){
		    $hdrs[$i] = substr( $hdrs[$i], 0, $TRUN ) ;
		    $len = $TRUN ; }
		$ldf = length( $_ ) if $EDT ;	# adjust defines
		$w = $wdth[$#wdth] ;
		if( $just[$#just] eq "R" ){
		    $_ = " " x ($w-$ldf) . $_ if $EDT ;
		    $hdrs[$i] = " " x ($w-$len) . $hdrs[$i] ; }
		else{
		    $_ = $_ . " " x ($w-$ldf) if $EDT ;
		    $hdrs[$i] = $hdrs[$i] . " " x ($w-$len) ; }
		$i++ ;
	    }
	    @dsh = @F ;
	    &best_fit ;
	    if( $FLD || $TRUN ){
		if( $= ){
		    $tophdr = sprintf( "Page @>>   %s   %s\n\$%%\n\n",
			$DATE, $PSTG ) . $tophdr if $PRT ;
		    eval <<EOF ;
		    format top =
$tophdr
.
EOF
		}
		else{  &pr_top ; }
		if( $FLD ){ &do_fold ; exit ; }
		else{ &do_trun ; exit ; }
	    }
	    &gen_println ;
	    if( $= == 0 ){ $reclns = 0 ; }	# no paging
	    elsif( $= < $hdrlns + $reclns ){
		$= = $hdrlns + $reclns ; }	# safety valve
	    print @savcom if $EDT ;	# comment lines, for edit opt
	    &pr_top;
	    next ;
	}
    }
    &println ;
}
sub pr_top {					# print header
    $%++ ;
    $- = $= - $hdrlns if $= ;
    if( $PRT ){
	$- -= 2 ;
	printf( "Page %3d   %s   %s\n\n",
	$%, $DATE, $PSTG ) ; }
    print $tophdr, "\n" ;
}
sub gen_println {			# gen sub to print data line
    $pcode = <<EOF ;
sub println {
	# Even after commenting this out, a ^L is printed on the left
	# of the column names on all pages but the 1st one if '-t' option
	# is specified. So I leave this in place and do a post-filtering
	# with tr(1) in nosqlmain. Carlo
    if( \$- < \$reclns ){ print "\\f" ; &pr_top ; }
    if( \$- < \$reclns ){ &pr_top ; }
EOF
    $k = $lnl = $x = 0 ;
    for (@I){
	$i = $I[$k] ;
	$w = $wdth[$i] ;
	$aa = 0 ;
	$aa = $sepl if $x != 0 ;
	$aa += $w ;			# additional length
	if( ($lnl + $aa) > $LEN ){  # too long, new line
	    $pf[$i] .= "\\n" ;
	    $pf[$i] .= " " x $ind ;
	    $kk = $k ;
	    $lnl = $ind + $w ;
	    $x = 0 ; }
	else{ $lnl += $aa ; }
	$pf[$i] .= $sep if $x++ > 0 ;
	$pf[$i] .= "%" ;
	if( $just[$i] eq "L" ){
	    $pf[$i] .= "-" ; }
	$pf[$i] .= "$w" . "s" ;
	$pstg1 .= $pf[$i] ;		# print fields
	$pstg2 .= ", \$F[$i]" ;		# data values
	$k++ ;
    }
    $pstg1 .= "\\n" if ! $EDT ;
    $x = "\"$pstg1\"" . $pstg2 ;
    if( $BIGF ){ $pcode .=
	"    if( ! \$BIGF || ! &chk_big ){ printf( $x ) ; }\n" ; }
    else{
	$pcode .= "    printf( $x ) ;\n" ; }
    if( $EDT ){
	$pcode .= <<EOM ;
    for( \$m = \@hdrs; \$m < \@F ; \$m++ ){
	print \"$sep\", \$F[\$m] ;
	warn \"DATA-ERROR at line \$.\\n" ; }
    print "\\n" ;
EOM
    }
    $pcode .= "    \$- -= \$reclns ; \n}\n" ;
    print $pcode if $XBUG ;	# debug
    eval $pcode ;
    print $@ if $@ ;
}
sub best_fit {			# chk best fit and build @I & $tophdr
    $lnl = $LEN ;	# curr line length
    for( $i=0; $i <= $#hdrs; $i++ ){ push(@c,$i) ; } # temp ary
    $word = $k = 0 ;
    loop: while( 1 ){
	for( $j=0; $j <= $#c; ){
	    if( $BEST && $BEST <= $k++ ){
	        &chk_any ; }
	    $i = $c[$j] ;
	    $w = $wdth[$i] ;
	    if( $word++ > 0 ){
		if( $sepl <= $lnl ){
		    $lnl -= $sepl ;
		    $tophdr .= $sep ;
		    $toptmp .= $sep ; }
		else{
		    &bf_newl ;  	# new line ...
		    return if $FLD ;	# limit to one line
		    last loop if $WIN ;	# limit to one line
		    next loop ; } }
	    if( $w <= $lnl ){
		push(@I,$i) ;			# add to @I
		splice(@c,$j,1) ;		# rm from @c
		$lnl -= $w ;
		$tophdr .= $hdrs[$i] ;		# build $tophdr
		$toptmp .= $dsh[$i] ;
		next loop ; }
	    if( $BEST && &chk_any ){ $word = 0 ; redo ; }
	    &bf_newl ;
	    return if $FLD ;			# linit to one line
	    last loop if $WIN ;			# linit to one line
	    next loop ;
	}
	last ;
    }
    if( ! $WIN ){
	$tophdr =~ s/\s+$// ;
	$tophdr .= "\n" . $toptmp ;
	$hdrlns = $tophdr =~ s/\n/\n/g +1 ;
	$reclns = $hdrlns/2 ; }
    else{
	$tophdr =~ s/\s+$// ;
	# $tophdr .= "\n" . $toptmp ;
	$tophdr .= "\n" . $toptmp if $toptmp ;
	$hdrlns = 2 ;
	$reclns = 1 ; }
}
sub bf_newl {				# new line ...
    $lnl = $LEN - $ind ;
    $word = 0 ;
    $tophdr =~ s/\s*$// ;
    $tophdr .= "\n" . $toptmp ;
    $toptmp = "" ;
    return if $FLD || $WIN ;		# linit to one line
    $tophdr .= "\n" . " " x $ind ;
    $toptmp = " " x $ind ;
}
sub chk_any { # find biggest field that will fit in $lnl; Ret 1 if any
	      # found, and $j will hold index in @c corr. to biggest field.
    $any = $v = 0 ;
    for( $jj=0; $jj <= $#c; $jj++ ){
	$i = $c[$jj] ;
	$w = $wdth[$i] ;
	if( $w <= $lnl ){
	    $any++ ;
	    if( $w > $v ){
		$v = $w ;
		$j = $jj ; }
	}
    }
    $any ;
}
sub do_trun {				# process truncated data fields
    &rdy_pic ;
    for( $j=0; $j <=$#I ; $j++ ){
        $i= $I[$j] ;
	if( $j != 0 ){
	    $f_val .= ", " ; }
	$f_val .= "\$F[$i]" ;
    }
    $fcode = <<EOF ;
    format f_rec =
$f_pic
$f_val
.
    \$~ = f_rec ;
    while(<STDIN>){
	\$anydata++ ;
	chop ;
	\@F = split( /\\t/, \$_ );
	write ;
    }
    write if ! \$anydata ;
EOF
    print $tophdr, $fcode, "\n" if $XBUG ; # debug
    eval $fcode ;
    print $@ if $@ ;
}
sub do_fold {				# process folded data fields
    &rdy_pic ;
    for( $j=0; $j <=$#I ; $j++ ){
        $i= $I[$j] ;
	if( $j != 0 ){
	    $f_val .= ", " ;
	    $f_exp .= " || " ; }
	$f_val .= "\$tex$i" ;
	$f_exp .= "\$tex$i" ;
	$f_mov .= "\$tex$i = \$F[$i] ; " ;
    }
    $fcode = <<EOF ;
    format f_rec =
$f_pic
$f_val
.
    \$~ = f_rec ;
    while(<STDIN>){
	\$anydata++ ;
	chop ;
	\@F = split( /\\t/, \$_ );
	$f_mov
	while( $f_exp ){ write ; }
    }
    write if ! \$anydata ;
EOF
    print $fcode, "\n" if $XBUG ; # debug
    eval $fcode ;
    print $@ if $@ ;
}
sub rdy_pic {		# build $f_pic ...
    $k = $x = 0 ;
    for (@I){
	$i = $I[$k++] ;
	$w = $wdth[$i] -1 ;
	$f_pic .= $sep if $x++ > 0 ;
	if( $FLD ){
	    $f_pic .= '^' ; }
	else{
	    $f_pic .= '@' ; }
	if( $just[$i] eq 'R' ){
	    $f_pic .= '>' x $w ; }
	else{
	    $f_pic .= '<' x $w ; }
    }
}
sub chk_big {			# chk for data fields that are too big
    for $i (@I){
	if( length($F[$i]) > $BIGLIM ){
	    &print_big ;
	    return 1 ; } }
    0 ;
}
sub print_big {			# print line containing big data field(s)
    for $i (@I){
	if( length($F[$i]) > $BIGLIM ){
	    $x = $pf[$i] ;
	    if( $x =~ s-\\n-- ){ print "\n" ; }
	    if( $x =~ /[ |]+/ ){ print $& ; }
	    print $F[$i] ; }
	else{
	    printf( "$pf[$i]", $F[$i] ) ; } }
    print "\n" ;
}
_EOF3_

# Now run the just created programs.

case $step in
  1)
    mawk -f $awk_tmp1 -v debug=$debug \
	-v trunc=$trunc -v table_tmp=$table_tmp
	test -s $table_tmp && cat $table_tmp
  ;;
  2)
     { mawk -f $awk_tmp1 -v debug=$debug \
	 -v 'trunc='$trunc -v table_tmp=$table_tmp
	 test -s $table_tmp && cat $table_tmp
     } | mawk -f $awk_tmp2
  ;;
  *)
     { mawk -f $awk_tmp1 -v debug=$debug \
	 -v 'trunc='$trunc -v table_tmp=$table_tmp
	 test -s $table_tmp && cat $table_tmp
     } | mawk -f $awk_tmp2 | perl $perl_tmp $perl_args | tr -d '\f'
  ;;
esac

#
# End of program.
#