#! /local/bin/perl

# jinx.shell -- Copyright (c) 1990, Henk P. Penning.
# You may distribute under the terms of the GNU General Public License
# as specified in the README file that comes with the Jinx 2.0 kit.

do 'jinx.pl' || die "can't include jinx.pl\n" ;

sub mapFieldNames
  { local(*fNames,*args) = @_ ;
    local($res,$_,@res,@errors) ;

    &mkInvert(*fNames) ;

    for ( @args )
      { if ( defined($fNames{$_}) )
	  { push(@res,$fNames{$_}+0) ; }
	else
	  { push(@errors,"$_ is not a valid name") ; }
      }
    if ( $#errors >= 0 )
      { return 0, @errors ; }
    else
      { return 1, @res ; }
  }

sub JsortSh
  { if ( $#_ < 0 )
      { return 0, "Usage: Jsort <jinx-db> [ field ... ]\n" ; }

    local($db,@args) = @_ ;
    local($res,@res,@errors) ;

    if ( -e "$db.dat" && ! -w "$db.dat" )
      { return 0, "Jsort: cannot write $db.dat\n" ; }

    ($res,@errors) = &openDb($db,*descr,*data,*name,*pat) ;
    if ( $res != 0 ) { return 0, @errors ; }

    ($res,@errors) = &mapFieldNames(*name,*args) ;
    if ( $res == 0 ) { return 0, @errors ; } else { @args = @errors ; } 

    ($res,@errors) = &doSort(*data,*args) ;
    if ( $res == 0 ) { return 0, @errors ; }

    return &putInfo(*data,$db,'dat') ;
  }

sub Jsort
  { if ( $#_ < 0 )
      { die "Usage: Jsort <jinx-db> [ field ... ]\n" ; }
    local($res,@errors) = &JsortSh ;
    local($_) ;
    for ( @errors ) { print STDERR "Jsort: $_\n" ; }
    die "fatal error in Jsort\n" if $res == 0 ;
  }

sub JprojectSh
  { return 0, "Usage: Jproject <new> <old> field ...\n" if $#_ < 2 ; 

    local($new,$old,@args) = @_ ;
    local($res,@res,@errors,@errors1,@errors2) ;

    local(@descr1,@data1,@name1,@pat1) ;

    ($res,@errors) = &openDb($old,*descr1,*data1,*name1,*pat1) ;
    if ( $res != 0 ) { return 0, @errors ; }

    ($res,@errors) = &mapFieldNames(*name1,*args) ;
    if ( $res == 0 ) { return 0, @errors ; } else { @args = @errors ; } 

    ($res,@errors) = &doProject(*descr1,*name1,*pat1,*data1,*args) ;
    if ( $res == 0 ) { return 0, @errors ; }

    ($res,@errors1) = &putInfo(*descr1,$new,'des') ;
    if ( $res == 0 ) { return 0, @errors1 ; }
    ($res,@errors2) = &putInfo(*data1,$new,'dat') ;
    if ( $res == 0 ) { return 0, @errors2 ; }
    return 1, @errors1, @errors2 ;
  }

sub Jproject
  { die "Usage: Jproject <new> <old> field ...\n" if $#_ < 2 ; 
    local(@args) = @_ ;
    local($res,@errors,$_) ;

    ($res,@errors) = &JprojectSh(@args) ;
    for ( @errors ) { print STDERR "Jproject: $_\n" ; }
    die "fatal error in Jproject\n" if $res == 0 ;
  }

sub JjoinSh
  { return 0, "Usage: Jjoin <new> <old1> <old2>\n" if $#_ != 2 ; 

    local($new,$old1,$old2) = @_ ;

    local(@descr1,@data1,@name1,@pat1,@descr2,@data2,@name2,@pat2) ;
    local(@errors,@errors1,@errors2) ;

    ($res,@errors) = &openDb($old1,*descr1,*data1,*name1,*pat1) ;
    if ( $res != 0 ) { return 0, @errors ; }
    ($res,@errors) = &openDb($old2,*descr2,*data2,*name2,*pat2) ;
    if ( $res != 0 ) { return 0, @errors ; }

    ($res,@errors) = &doJoin(*descr1,*data1,*descr2,*data2,'A','A') ;
    if ( $res == 0 ) { return 0, @errors ; }

    ($res,@errors1) = &putInfo(*descr1,$new,'des') ;
    if ( $res == 0 ) { return 0, @errors1 ; }
    ($res,@errors2) = &putInfo(*data1,$new,'dat') ;
    if ( $res == 0 ) { return 0, @errors2 ; }
    return 1, @errors1, @errors2 ;
  }

sub Jjoin
  { die "Usage: Jjoin <new> <old1> <old2>\n" if $#_ != 2 ; 
    local(@args) = @_ ;
    local($res,@errors,$_) ;

    ($res,@errors) = &JjoinSh(@args) ;
    for ( @errors ) { print STDERR "Jjoin: $_\n" ; }
    die "fatal error in Jjoin\n" if $res == 0 ;
  }

sub JreportSh
  { return 0, "Usage: Jreport <template> <db> [ OUT ]\n" if $#_ < 1 ; 

    local($template,$db,$outName) = @_ ;

    local(@descr,%name,@name,@pat,@data,$data,@errors,@template) ;
    local($i,$splitpat,@tempres,@temp,$OUTFILE) ;

    return 0, "can't open $template" if ! open(TEMP,$template) ;
    @template = <TEMP> ;
    $template = join('',@template) ;

    ($res,@errors) = &openDb($db,*descr,*data,*name,*pat) ;
    if ( $res != 0 ) { return 0, @errors ; }
    &mkInvert(*name) ;

    if ( $outName )
      { open(OUT,">$outName") || return 0, "can't write $outName" ;
	$OUTFILE= 'OUT' ;
      }
    else
      { $outName = 'STDOUT' ; 
        $OUTFILE = 'STDOUT' ;
      }

    $splitpat = '(:' . join(':|:',@name) . ':)' ;
    $* = 1 ; @temp = split(/$splitpat/,$template) ; $* = 0 ;
    @tempres = () ;
    $i = '0' ;
    for $temp ( @temp )
      { if ( $temp =~ /$splitpat/ )
	  { $temp =~ /^:(.*):$/ ;
	    push(@tempres,'$record[' . $name{$1} . ']') ;
	  }
	else
	  { push(@tempres,'$temp' . "[$i]") ; }
	$i++ ;
      }
    eval 'sub tempres { return ' . join(' . ',@tempres) . ' ; }' ; 

    for $data ( @data )
      { @record = split(/$;/,$data,$#name+1) ;
	$record = &tempres ;
	print $OUTFILE $record ; 
      }

    close(OUT) if $outName ne 'STDOUT';
    return 1, "report written to $outName" ;
  }

sub Jreport
  { die "Usage: Jreport <template> <db> [ OUT ]\n" if $#_ < 1 ; 
    local(@args) = @_ ;
    local($res,@errors,$_) ;

    ($res,@errors) = &JreportSh(@args) ;
    for ( @errors ) { print STDERR "Jreport: $_\n" ; }
    die "fatal error in Jreport\n" if $res == 0 ;
  }

sub JlistSh
  { local($header,$break,$width,$OPT,@errors,$curWidth) ;
    while ( $#_ >= 0 && $_[0] =~ /^-/ )
      { $OPT = shift ;
	if ( $OPT eq '-h' )
	  { $header = 1 ; }
	elsif ( $OPT =~ /^-w(\d*)/ )
	  { $break = 1  ;
	    $width = ($1) ? $1 : 80 ;
	  }
	else
	  { push(@errors,"$0: Unknown option '$OPT'") ; }
      }

    if ( $#errors >= 0 || $#_ < 0 )
      { return 0, @errors, "Usage: Jlist [-w[width]] [-h] <db> [ OUT ]" ; }

    local($db,$outName) = @_ ;

    local(@descr,%name,@name,@pat,@data,$data,@errors) ;
    local($i,@notNum,@maxlen,$formatH,$formatD,$OUTFILE) ;

    ($res,@errors) = &openDb($db,*descr,*data,*name,*pat) ;
    if ( $res != 0 ) { return 0, @errors ; }
    &mkInvert(*name) ;

    if ( $outName)
      { open(OUT,">$outName") || return 0, "can't write $outName" ;
	$OUTFILE = 'OUT' ;
      }
    else
      { $outName = 'STDOUT' ;
        $OUTFILE = 'STDOUT' ;
      }

    for $data ( @data )
      { @record = split(/$;/,$data,$#name+1) ;
	$i = 0 ; 
	for ( @record )
	  { $maxlen[$i] = length($_) if length($_) > $maxlen[$i] ;
	    $notNum[$i] |= /\D/ if ! $notNum[$i] ;
	    $i++ ;
	  }
      }

    if ( $header )
      { $i = 0 ;
	for ( @name )
	  { $maxlen[$i] = length($_) if length($_) > $maxlen[$i] ; $i++ ; }
      }

    $i = 0 ; $curWidth = 0 ;
    for ( @maxlen )
      { if ( $break && $curWidth+$_ > $width )
	  { $formatH .= "\n" ;
	    $formatD .= "\n" ;
	    $curWidth = 0 ;
	  }
	$formatH .= '%-' . ($_+0) . 's ' ;
	$formatD .= '%'  . ( $notNum[$i] ? '-' : '' ) . ($_+0) . 's ' ;
	$curWidth += $_+1 ;
	$i++ ;
      }
    chop $formatH ; $formatH .= "\n" ;
    chop $formatD ; $formatD .= "\n" ;

    if ( $header )
      { printf $OUTFILE $formatH, @name ;
	print $OUTFILE "\n" ;
      }

    for $data ( @data )
      { @record = split(/$;/,$data,$#name+1) ;
	printf $OUTFILE $formatD, @record ;
      }

    close(OUT) if $outName ne 'STDOUT' ;
    return 1, "list written to $outName" ;
  }

sub Jlist
  { local(@args) = @_ ;
    local($res,@errors,$_) ;

    ($res,@errors) = &JlistSh(@args) ;
    for ( @errors ) { print STDERR "Jlist: $_\n" ; }
    die "fatal error in Jlist\n" if $res == 0 ;
  }

1 ;