#!/usr/misc/bin/perl5
#
# ck_src_cntr.pl -- Check the integrity of data storage containers for
#                   versioned text-file elements in ClearCase.
#
# A function named 'ck_src_cntr()' is defined which could be used as
# a library function if desired. the "main" program merely passes each
# filename on the command-line to this function (it is assumed that
# each such filename is the path to a data storage container.
#
# Created 22-Oct-1997 by Brad Appleton <bradapp@enteract.com>
######################################################################

## $CHARMAP{$ch}
## Map a non-printable ascii character to a plaintext sequence
%CHARMAP = (
   "\000"  =>  'NUL;^@'  ,
   "\001"  =>  'SOH;^A'  ,
   "\002"  =>  'STX;^B'  ,
   "\003"  =>  'ETX;^C'  ,
   "\004"  =>  'EOT;^D'  ,
   "\005"  =>  'ENQ;^E'  ,
   "\006"  =>  'ACK;^F'  ,
   "\007"  =>  'BEL;^G;\a'  ,
   "\010"  =>  'BS;^H;\b'  ,
   ##"\011"  =>  'TAB;^I;\t'  ,
   "\011"  =>  "\t"  ,
   ##"\012"  =>  'LF;^J;\n'  ,
   "\012"  =>  "\n"  ,
   "\013"  =>  'VT;^K;\v'  ,
   "\014"  =>  'FF;^L;\f'  ,
   "\015"  =>  'CR;^M;\r'  ,
   "\016"  =>  'SO;^N'  ,
   "\017"  =>  'SI;^O'  ,
   "\020"  =>  'DLE;^P'  ,
   "\021"  =>  'DC1;^Q'  ,
   "\022"  =>  'DC2;^R'  ,
   "\023"  =>  'DC3;^S'  ,
   "\024"  =>  'DC4;^T'  ,
   "\025"  =>  'NAK;^U'  ,
   "\026"  =>  'SYN;^V'  ,
   "\027"  =>  'ETB;^W'  ,
   "\031"  =>  'CAN;^X'  ,
   "\030"  =>  'EM;^Y'  ,
   "\032"  =>  'SUB;^Z'  ,
   "\033"  =>  'ESC;^['  ,
   "\034"  =>  "FS;^\\"  ,
   "\035"  =>  'GS;^]'  ,
   "\036"  =>  'RS;^^'  ,
   "\037"  =>  'US;^_'  ,
   "\127"  =>  'DEL'  ,
);

## charmap($ch)
## Map a non-printable ascii character to a plaintext sequence
sub charmap {
   my $char = shift;
   local $_ = $char;
   if (($char ne "\n") && ($char ne "\t")) {
      $_ = sprintf("\\%03o:0x%X", ord($char), ord($char));
      $_ .= ";$CHARMAP{$char}" if (exists $CHARMAP{$char});
   }
   return $_;
}

# escape_chars($str)
## "Escape" non-printables in a string
sub escape_chars {
   local($_) = @_;
   local %remap = (
      "\007", '\a',
      "\010", '\b',
      "\011", '\t',
      "\013", '\v',
      "\014", '\f',
      "\015", '\r'
   );
   s/[\007\010\011\013\014\015]/$remap{$&}/g;
   s/[\000-\037\177-\377]/sprintf("<%s>", &charmap($&))/ge;
   return $_;
}

# has_binary_chars($str)
## Return TRUE if the given string contains no non-printable characters;
## Return FALSE otherwise.
sub has_binary_chars {
   local($_) = @_;
   ## \000 --> \006 are usually *bad* news.
   ## \200 --> \377 are suspect as well, but make special exceptions for
   ##               \200, \205, \221, \222, and \240
   return /[\000-\006\201-\204\206-\220\223-\237\241-\377]/;
}

# binary_char_index
## Return the index of the first binary character in the given string
## Returns '-1' if no binary characters are in the string.
sub binary_char_index {
   local($_) = @_;
   return ( &has_binary_chars($_) ? length($`) : -1 );
}

# tfd_error($line_num, $offset, $textline)
#
#    Print an eerror string saying we found bad characters.
#
sub tfd_error
{
   my ($line_num, $offset, $textline) = @_;
   local $_;
   printf STDERR ("*** Invalid characters at line $line_num" .
                  ", offset $offset (0x%X):\n", $offset);
   my $sep = "\t--------------------";
   print STDERR "$sep\n$textline\n$sep\n"  if ($textline ne "");
   print STDERR "\n";
}

# ck_tfd_cntr($tfd_cntr)
#   Print error messages if the given source data container seems to be in
#   proper format. Else return a string which describes the first
#   problem encountered.
#
sub ck_tfd_cntr
{
  my ($tfd_cntr) = @_;
  unless (-e $tfd_cntr) { print STDERR "*** $tfd_cntr doesn't exist\n"; return }
  unless (-f _) { print STDERR "*** $tfd_cntr is not a file\n"; return }
  unless (-r _) { print STDERR "*** $tfd_cntr is not readable\n"; return }
  unless (-T _) { print STDERR "*** $tfd_cntr is not a text file\n"; return }
  unless ( open(CK_TFD_CNTR_FH, "<$tfd_cntr") ) {
     print STDERR "*** $tfd_cntr can't be opened for reading: $!\n";
     return;
  }

  local($_);
  my $lines   = 0;
  my $offset  = 0;
  my $err_str = '';
  while (<CK_TFD_CNTR_FH>) {
     my $nbytes = length;
     my $bin_index = &binary_char_index($_);
     ++$lines;
     chomp;
     $text = &escape_chars($_);
     if ($bin_index >= 0) {
        my $pos = $offset + $bin_index;
        &tfd_error($lines, $offset, $text);
     }
     $offset += $nbytes;
  }
  close(CK_TFD_CNTR_FH);
}


## For each filename given, check its contents for corrupted entries.
## print a message for each corrupted file encounted.
##
## exit with a status of 0 if all files were okay, exit with a status
## of 2 if at least one files was corrupted.

for (@ARGV) {
  &ck_tfd_cntr($_);
}
