#!/local/bin/perl

#  Routine to add PDS delimiters to an ASCII table and update the corresponding
#  label file.
#
#  Format:  % tbldelimit <label file>
#
#  The data file name is taken from the appropriate field in the label
#  file.  The file name for the output files is formed by adding a "_dlm"
#  suffix to the stem (i.e., "input.lbl" becomes "input_dlm.lbl").  The 
#  data file must be present.
#
#  Delimiters
#  ----------
#  
#  A comma (,) is inserted after all fields.  Any fields which are not of
#  type "INTEGER", "REAL", or "FLOAT", are enclosed within double quotes.
#  All delimiters are added and will increase the size of the file by the
#  appropriate number of bytes.
#
#
#  Modifications:
#  -------------
#
#  19 Jun 1995, acr: Fixed dumb filename case bug in data file open
#  20 Mar 1996, acr: Fixed another dumb typo which prevented ^*_TABLE pointers
#                    from being recognized
#  03 Jun 1996, acr: Fixed an even dumber bug that prevented the ^*_TABLE OBJECT
#                    definition from being recognized.  Also changed 
#                    'pdsdelimit' to 'tbldelimit' throughout program.
#
#
#==============================================================================
#
# Method
# ------
#
#  Read in the entire input label file to an array.
#  Find the following keywords:
#     ^TABLE              save file name
#     OBJECT=TABLE        must be present
#     INTERCHANGE_FORMAT  must be ASCII
#     COLUMNS             to use as a counter
#  For each column, find start byte, total bytes, size and type.
#  Make sure each column:
#     o  Comes later than the previous column
#     o  Does not overlap the previous column
#     o  Does not contain ITEMS
#  Write the new label, changing:
#     o  ROW_BYTES
#     o  RECORD_BYTES
#     o  START_BYTE for each COLUMN (but do not include delimiters in BYTES)
#  Write the new data file, inserting delimiters.
#
#==============================================================================
#
# Read the input label into an array and remove all trailing whitespace while
# scanning for required keywords:
#

@label = <>;

$tbl_ptr = 0;
$ptr_cnt = 0;
$obj_def = 0;
$int_frm = 0;
$columns = 0;
$col_chk = -1;
$add_bytes = 0;   # Total number of bytes to be added to the record.

for ($i=0; $i<@label; $i++)
  { $label[$i] =~ s/\s*$//;      # Clip trailing whitespace from input 
    $line = $label[$i];
    $line =~ s/\s+//g;           # Remove whitespace from buffer

    # General File parameters to check for:

    if ($line =~ /^\^[A-Z-\_]*TABLE/)
      { $tbl_ptr++; 
        ($junk,$datafile) = split(/=/,$line);
      }
    elsif ($line =~ /^\^/)
      { $ptr_cnt++; }
    elsif ($line =~ /^OBJECT=[A-Z-\_]*TABLE/)
      { $obj_def++; }
    elsif ($line =~ /^INTERCHANGE_FORMAT=ASCII/)
      { $int_frm++; }

    # Column parameters to be gathered.  These are stored in a series of arrays:
    #
    #    @start_byte   The START_BYTE values
    #    @size         The BYTES values
    #    @type         A simplified DATA_TYPE value: 0=number; 1=string

    elsif ($line =~ /^OBJECT=COLUMN/)
      { $columns++; }
    elsif ($line =~ /^DATA_TYPE/)
      { if ($line =~ /REAL/  ||  $line =~ /FLOAT/  ||  $line =~ /INTEGER/)
          { $type[$columns] = 0; 
            $add_bytes += 1;
          }
        else
          { $type[$columns] = 1; 
            $add_bytes += 3;
          }
      }
    elsif ($line =~ /^START_BYTE/)
      { ($junk,$start_byte[$columns]) = split(/=/,$line); }
    elsif ($line =~ /^BYTES/)
      { ($junk,$size[$columns]) = split(/=/,$line); }

    # This program can't handle ITEMS or BIT_COLUMNS.  If they are found, stop:

    elsif ($line =~ /^ITEMS/)
      { die "tbldelimit: Can't handle ITEMS in column $columns.\n"; }
    elsif ($line =~/^OBJECT=BIT_COLUMN/)
      { die "tbldelimit: Can't handle BIT_COLUMN in column $columns.\n"; }

    # Error-checking to be done when the end of a new column definition is
    # reached:

    elsif ($line =~ /END_OBJECT/)
      { $col_chk++;
        if ($col_chk > 1  &&  $col_chk < $columns)
          { 
            # Columns must be in order of ascending START_BYTE:

            if ($start_byte[$columns] < $start_byte[$col_chk])
              { print "Column $columns (byte $start_byte[$columns]) precedes ";
                print "column $col_chk (byte $start_byte[$col_chk]).\n";
                die "tbldelimit: Can't go on.\n";
              }

            # Columns must not overlap:

            if ($start_byte[$col_chk] + $size[$col_chk] > $start_byte[$columns])
              { print "Columns $columns (byte $start_byte[$columns]) and ";
                print "$col_chk (byte $start_byte[$col_chk]) overlap.\n";
                die "tbldelimit: Can't go on.\n";
              }
          }
      }  # End of column error-checking.
  }

#  More error-checking:

if ($tbl_ptr < 1)
  { die "tbldelimit: Could not find ^TABLE poiner.\n"; }

if ($tbl_ptr > 1)
  { die "tbldelimit: More than one TABLE pointer.\n"; }

if ($ptr_cnt > 0)
  { die "tbldelimit: More than one pointer found.\n"; }

if ($obj_def < 1)
  { die "tbldelimit: No TABLE object definition found. \n"; }

if ($obj_def > 1)
  { die "tbldelimit: More than one TABLE definition found.\n"; }

if ($int_frm != 1)
  { die "tbldelimit: INTERCHANGE_FORMAT ambiguous or inappropriate.\n"; }

#..............................................................................
# end of label scan
#..............................................................................

# Next, take the data file name and derive the output file names:

$datafile =~ s/"//g;        # Remove any double-quotes
$datafile =~ tr/A-Z/a-z/;   # Translate to lower case
$fileroot = $datafile;
$fileroot =~ s/^(.*)\..*$/\1/;
$fileext  = $datafile;
$fileext  =~ s/^.*\.(.*)$/\1/;
$outlabel = $fileroot . "_dlm.lbl";
$outdata  = $fileroot . "_dlm." . $fileext;

# Find and open the datafile.  If it's not found in lower case, try upper
# case.  (The output file names should match the case convention of the
# existing data file.)

$DATAFILE = $datafile;
$DATAFILE =~ tr/a-z/A-Z/;

if (-e $datafile)
  { open (INDATA,$datafile) ||
      die "tbldelimit: Could not open data file ($datafile).\n"; }
elsif (-e $DATAFILE)
  { open (INDATA,$DATAFILE) ||
      die "tbldelimit: Could not open data file ($DATAFILE).\n";
    $outlabel =~ tr/a-z/A-Z/;
    $outdata  =~ tr/a-z/A-Z/;
  }
else
  { die "tbldelimit: Could not find the data file ($datafile).\n"; }

# And open the output data file:

open (OUTDATA,"> $outdata");

#............................................................................

#  Now loop through the data records.  For each record, loop through the
#  columns, adding delimiters as needed:

while ($line = <INDATA>)
  { 
    # Procedure:
    #
    #   Split the input line into separate characters; set buffer to null.
    #   For each field (column):
    #     Copy characters until the start of the next field
    #     if the field is a string, insert a quote
    #     Copy characters until the end of the field
    #     if the field is a string, insert a quote
    #     Insert a comma
    #   Copy characters until the end of the input buffer
    #   Write the output string.

    # Split the input line and setup the output line array:

    @in = split(//,$line);
    $i = $o = 0;                    # subscripts for input and output line
    $inlen  = @in;                  # input record length
    $outlen = $inlen + $add_bytes;  # output record length

    for ($col=1; $col<=$columns; $col++)
      {
        # Copy characters to start of column:

        while ($i < $start_byte[$col]-1)
          { $out[$o] = $in[$i];
            $o++;
            $i++;
          }

        # If this is a non-numeric column, add a quote:

        if ($type[$col] == 1)
          { $out[$o] = "\"";
            $o++;
          }

        # Copy characters until the end of the field:

        for ($j=0; $j<$size[$col]; $j++)
          { $out[$o] = $in[$i];
            $o++;
            $i++;
          }

        # If this is a non-numeric columns, add a quote:

        if ($type[$col] == 1)
          { $out[$o] = "\"";
            $o++;
          }

        # Add the delimiter, if this is not the last field:

        if ($col < $columns)
          { $out[$o] = ",";
            $o++;
          }
      }

    # Copy characters to end of input string:

    while ($i < $inlen)
      { $out[$o] = $in[$i];
        $o++;
        $i++;
      }

    # Make and write the output line:

    $outline = join('',@out);
    print OUTDATA $outline;
  }

# Close the input and output data files:

close(INDATA);
close(OUTDATA);

#..............................................................................

#  Finally, the values in the label must be adjusted.

#  Procedure:
#
#   Loop through the columns, calculating new START_BYTES as needed.
#   Pass through the label records, replacing the following values:
#       ROW_BYTES
#       RECORD_BYTES
#       START_BYTE (for COLUMNs)
#   Write the label records as they are finished.
#
#for ($i=1; $i<=$columns; $i++)
#  { printf "Column %2d:  START_BYTE %3d  BYTES %2d  type = %1d\n", 
#             $i, $start_byte[$i], $size[$i], $type[$i]; }
#printf "\n\n";

$offset = 0;                    # Cumulative offset for START_BYTE
for ($i=1; $i<=$columns; $i++)
  { if ($type[$i] == 1)         # Check for opening quote
      { $offset++; }
    $start_byte[$i] += $offset;
    if ($type[$i] == 1)         # Check for closing quote
      { $offset++; }
    $offset++;                  # Comma delimiter
  }
$offset--;                      # Remove the count for a delimiter after the
                                # last column, as there isn't one.

# Output the label records:

open (OUTLBL,"> $outlabel") || 
  die "tbldelimit: Could not open output label file ($outlabel).\n";

$col = 0;                       # Column counter

for ($i=0; $i<@label; $i++)
  { $line = $label[$i];

    # Check for fields that must be changed:

    if ($line =~ /RECORD_BYTES/  ||  $line =~ /ROW_BYTES/  ||
          ($line =~ /START_BYTE/  &&  $col > 0))
      { ($first,$last) = split(/=/,$line);
        $n = $last;                    # retrieve the value
        $n =~ s/\s+//g;
        $n =~ s/([0-9]+).*$/$1/;
        if ($line =~ /START_BYTE/)
          { $n = $start_byte[$col]; }  # write in the new START_BYTE
        else
          { $n += $offset; }           # add appropriate offset
        $last =~ s/(\s+)[0-9]+/$1$n/;
        $line = $first . "=" . $last;  # write it into the record
      }

    elsif ($line =~ /^\s*OBJECT\s*=\s*COLUMN/)
      { $col++; }

    elsif ($line =~ /\s*\^[A-Z_\-]*TABLE/)
      { ($first,$last) = split(/=/,$line);
        $outdata =~ tr/a-z/A-Z/;                  # Force filename to capitals
        $last =~ s/"[A-Z0-9\._\-]+"/"$outdata"/;  # Write in new data file name
        $line = $first . "=" . $last;
      }

    # Write the line, padding out to 80 characters and adding PDS record
    # delimiters:

    printf OUTLBL "%-78.78s\r\n", $line;
  }

# Close the label file and we're done:

close(OUTLBL);