#!/opt/perl/bin/perl
#
# Program to dump Db::Ctree ISAM flies
#
# ctdump filename {mode {start}}
#
#  mode = 0 (default) bar separated format
#  mode = 1           by record (shown padding)
#  mode = 2           hex dump
#
#  start = key 0 start field (default first record)
#
# Author:
#        Robert Eden - reden@strategiconlien.com
#

use Db::Ctree qw(:ALL);

my $filename = shift;
my $mode     = shift;
my $start    = shift;
die "ctdump <filename>\n" unless $filename;

#
# handle interrupts so we can clean up without Perl crashing
#
$QUIT=0;
$SIG{QUIT} = sub{$QUIT=1};
$SIG{TERM} = sub{$QUIT=2};
$SIG{INT}  = sub{$QUIT=3};

#
# the following statement is pretty much site specific... sorry
#
$filename .= ".dat" unless $filename =~ /\.dat$/;
$filename = "/appl/plexar/master/$filename" unless -e $filename;

die "$filename not found "     unless -e $filename;

#
# open database
#
InitISAM(10,2,4);
$dbptr = Db::Ctree -> new (0, $filename, &Db::Ctree::SHARED);

#
# schema available?
#
$dbptr -> build_schema();
$mode = 1 unless ($mode or $dbptr -> {FTYPE});

@fname = @{$dbptr -> {FNAME}};
@ftype = @{$dbptr -> {FTYPE}};
$fmask = $dbptr -> {FMASK};

print join("|",@fname) . "\n" unless $mode;
print join("|",@ftype) . "\n" unless $mode;

if ( $start )
{
   $record = $dbptr -> fetch_gte($start);
}  
else
{
   $record = $dbptr -> fetch_first();
}

while ($record)
{
   die "SIGNAL received! ($QUIT)" if $QUIT;

#
# Mode 0, process fields
#
   if ($mode == 0)
   {
      %rec = $dbptr ->unpack_record($record);
      foreach $col (@{$dbptr -> {FNAME}})
      {
         $_ = $rec{$col};
         tr [\000-\037][.];
         print $_,"|";
      }  
      print "\n";
   } # mode0

#
# Mode 1, line dump
#
   elsif ($mode == 1)
   {
         $record =~ tr [\000-\037][.];
         print "$record\n";
   }

#
# Mode 2, hex dump
#
   elsif ($mode == 2)
   {
     @c     = unpack('a' x $dbptr -> {RECLEN},$record);
     foreach (0...$#c)
     {
       die "SIGNAL received! ($QUIT)" if $QUIT;
       printf "[%03d] %s = %3d\n",$_,
                                  ord($c[$_])<32 ? '.' : $c[$_],
                                  ord($c[$_]);
     }

     last; # only display first record in hex
   }

   $record = $dbptr -> fetch_next;
   last if ( $start and $record !~ /$start/);
} # record loop

die &isam_err." Error on Read" if (&isam_err and
                                   &isam_err != &Db::Ctree::INOT_ERR);

