#!/usr/pkg/bin/perl -w

#  Copyright 2008 Google Inc.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

use strict;
use Getopt::Long;

my ($help, $header, $value, $location, $delim, $copy_field, $copy_label,
    $show_version, $label_before, $label_after);

$value = '';
$delim = $ENV{"DELIMITER"} || chr(0xfe);
Getopt::Long::Configure("no_ignore_case");
&GetOptions("help" => \$help,
            "label=s" => \$header,
            "value=s" => \$value,
            "field=n" => \$location,
            "Before=s" => \$label_before,
            "After=s" => \$label_after,
            "delim=s" => \$delim,
            "copy=n" => \$copy_field,
            "Copy-label=s" => \$copy_label,
            "Version" => \$show_version);

if ($help) {
  usage();
  exit(1);
}
if ($show_version) {
  crush_version();
  exit(0);
}
$delim = expand_chars($delim);

my ($input_field_count, $header_line);
if (! defined $location) {
  if ($label_before || $label_after) {
    $header_line = <>;
    $header_line =~ s/[\r\n]//g;
    $input_field_count = fields_in_line($header_line, $delim);

    my $find_label = $label_before ? $label_before : $label_after;
    $location = field_str($find_label, $header_line, $delim);
    if (! defined($location)) {
      warn "$0: unable to find the field labelled \"$find_label\"\n";
      exit 1;
    }
    $location++;
    $location++ if ($label_after);
  } else {
    $location = 1;
  }
}

if ($copy_field) {
  $copy_field--;
} elsif ($copy_label) {
  if (! defined $header_line) {
    $header_line = <>;
    $header_line =~ s/[\r\n]//g;
    $input_field_count = fields_in_line($header_line, $delim);
    if ($location < 0) {
      $location = $input_field_count + $location + 2;
    }
  }
  $copy_field = field_str($copy_label, $header_line, $delim);
  if (! defined $copy_field) {
    warn "$0: unable to find the field labelled \"$copy_label\"\n";
    exit 1;
  }
}


if ($header_line) {
  print add_field($header_line, defined($header) ? $header : $value,
                  $location, $delim, defined($header) ? undef : $copy_field),
        qq(\n);
}

while (my $line = <>) {
  $line =~ s/[\r\n]//g;
  if (! defined($input_field_count)) {
    $input_field_count = fields_in_line($line, $delim);
    if ($location < 0) {
      $location = $input_field_count + $location + 2;
    }
  }
  if ($header && $. == 1) {
    # don't specify the copy field if processing the header line
    print add_field($line, $header, $location, $delim), qq(\n);
  } else {
    print add_field($line, $value, $location, $delim, $copy_field), qq(\n);
  }
}

exit(0);

# (line, value, position, delimiter, [copy])
sub add_field {
  my ($l, $v, $p, $d, $c) = @_;

  my @a;
  if (defined($c)) {
    @a = split(/\Q$d\E/o, $l, -1);
    $v = $a[$c];
  }

  # simple case: prepending the field
  if ($p <= 1) {
    return $v . $d . $l;
  }

  # simple case: appending the field
  if ($input_field_count < $p) {
    return $l . $d . $v;
  }

  if (! @a) {
    @a = split(/\Q$d\E/o, $l, -1);
  }

  # put the field somewhere in the middle
  return join($d, splice(@a, 0, $p - 1)) . $d .
         $v . $d . join($d, @a);
}

sub usage {
  print STDERR <<ENDUSAGE;

adds a field to a flat-file.

usage: $0 [hdflv] [file(s)]

  -h, --help  print this message and exit
  -d, --delim <S>        the field delimiter string (default: 0xfe)
  -f, --field <N>        the 1-based index for the new field (default: 1)
  -B, --Before <S>       place the new field before the field with the specified
                           label.
  -A, --After <S>        place the new field after the field with the specified
                           label.
  -l, --label <S>        label the new field as S on the first line
  -v, --value <S>        the value to place in the new field (default: emtpy)
  -c, --copy <N>         copy the value from field N into the new field
  -C, --Copy-label <S>   copy the new value from field labelled S

 * if no "label" is provided, the "value" will be used.
 * for -f, a field of either 0 or 1 may be used to indicate the first
   position.
 * if a field value of -1 indicates that the field should be appended to
   each line.
 * if both -v and -c are specified, -c takes precedence.

ENDUSAGE
}

=item * expand_chars

expand escape sequences like '\t' in a string to their expansions.

=cut
sub expand_chars {
  my $d = shift || return;
  eval("sprintf(\"$d\")");
}

=item * field_str()

returns the 0-based index of the first field in a delimited string equal to
the specified value, or undef if not found.

=cut
sub field_str {
  my $value = shift;
  my $string = shift;
  my $delim = shift;
  $string =~ s/[\r\n]//g;
  my @a = split(/\Q$delim\E/, $string);
  my $i;
  for $i (0 .. $#a) {
    if ($a[$i] eq $value) {
      return $i;
    }
  }
  return undef;
}

=item * fields_in_line()

Counts the number of fields in a delimited string.

=cut
sub fields_in_line {
  my $str = shift;
  my $delim = shift;
  my $n = 1;
  my $i = 0;
  while (($i = index($str, $delim, $i)) > 0) {
    $n++;
    $i += length($delim);
  }
  return $n;
}

=item * get_line_field($line, $field_index, $delim)

Get the data at position field from the delim deliminated string line.

$field_index is 0 based

=cut
sub get_line_field {
  my $pos = 0;
  for (my $i = 0; $i < $_[1]; $i++) {
    $pos = index($_[0], $_[2], $pos);
    $pos++;
  }
  my $end_pos = index($_[0], $_[2], $pos) - $pos;
  $end_pos = length($_[0]) - $pos if $end_pos <= 0;
  return substr($_[0], $pos, $end_pos);
}

=item * expand_nums($arg [, $adjust])

Turn a string of comma-separated numbers and number ranges into an array of
numbers. If specified, $adjust is added to each value after expansion. E.g.,
If turning 1-based field indexes into array indexes, pass -1 as the adjust
value.

=cut
sub expand_nums {
  my $arg = shift;
  my $adjust = shift || 0;
  my @fields = split(',', $arg);
  my @idxs = ();
  foreach my $f (@fields) {
    if ($f =~ /(\d+)-(\d+)/) {
      push(@idxs, $1 .. $2);
    } elsif ($f =~ /\d+/) {
      push(@idxs, $f);
    } else {
      use Carp;
      croak "Invalid value in numeric list: $f";
    }
  }
  if ($adjust) {
    foreach my $i (0 .. $#idxs) {
      $idxs[$i] += $adjust;
    }
  }
  return @idxs;
}


1;


sub crush_version {
  print STDERR "CRUSH tools release 2013-04 compiled at 2025-10-03-13:58:39\n";
}

1;
