view release on metacpan or  search on metacpan

bin/join  view on Meta::CPAN

#######################
# OPTIONS STUFF BELOW #
#######################
sub get_arg {
  # $_ contains VAL in -oVAL
  my $arg = shift;
  my $opt;
  if    (length) { $opt = $_ }
  elsif (@ARGV)  { $opt = shift @ARGV }
  else {
    warn "option requires an argument -- '$arg'\n";
    help();
  }
  return $opt;
}

sub get_numeric_arg {
  my ($argname, $desc) = @_;
  my $opt = get_arg($argname);
  if ($opt !~ m/\A[0-9]+\Z/) {
    warn "invalid number of $desc: `$opt'\n";
    help();
  }
  return $opt;
}

sub get_file_number {
  my $argname = shift;
  my $f = get_numeric_arg($argname);
  if ($f != 1 && $f != 2) {
    warn "argument $argname expects 1 or 2\n";
    help();
  }
  return --$f;
}

sub get_field_specs {
  do {
    my $text = get_arg('o');
    my @specs = split /\s+|,/, $text;
    foreach my $spec (@specs) {
      if ($spec !~ m/^(0)$|^([12])\.(\d+)$/) {
        warn "$Program: invalid field spec `$spec'\n";
        exit EX_FAILURE;
      }
      if (defined $1) { push @fields, [0, -1] }
      else {
        if ($3 == 0) {
          warn "$Program: fields start at 1\n";
          exit EX_FAILURE;
        }
        push @fields, [$2, $3 - 1];
      }
    }
  } while (length || (@ARGV && $ARGV[0] =~ m!^0$|^[12]\.\d+$!));
}

sub get_options {
  my ($aflag, $vflag);
  while (@ARGV && $ARGV[0] =~ /^-(.)/) {
    local $_ = shift @ARGV;
    return if $_ eq '--';
    if (s/^-a//) {
      help() if $vflag;
      $aflag = 1;
      my $f = get_file_number('a');
      $unpairables[$f] = 1;
    }
    elsif (s/^-v//) {
      help() if $aflag;
      $vflag = 1;
      $print_pairables = 0;
      my $f = get_file_number('v');
      $unpairables[$f] = 1;
    }
    elsif (s/^-e//)    { $e_string = get_arg('e') }
    elsif (s/^-(?:j?([12])|j)//) {
      my $field = get_numeric_arg('j');
      if ($field == 0) {
        warn "fields start at 1\n";
        help();
      }
      if ($1) { ($1 == 1 ? $j1 : $j2) = $field}
      else    { $j1 = $j2 = $field }
    }
    elsif (s/^-o//)    { get_field_specs() }
    elsif (s/^-t//)    { $delimiter = get_arg('t') }
    else {
      warn "invalid option '$_'\n";
      help();
    }
  }
}

__END__

=head1 NAME

join - relational database operator

=head1 SYNOPSIS

join [B<-a> I<file_number> | B<-v> I<file_number>] [B<-e> I<string>]
     [B<-o> I<list>] [B<-t> I<char>]
     [B<-1> I<field>] [B<-2> I<field>] I<file1> I<file2>

=head1 DESCRIPTION

The B<join> utility performs an ``equality join'' on the specified
files and writes the result to the standard output.  The ``join
field'' is the field in each file by which the files are compared.
The first field in each line is used by default.  There is one line in
the output for each pair of lines in I<file1> and I<file2> which have
identical join fields.  Each output line consists of the join field,
the remaining fields from I<file1> and then the remaining fields from
I<file2>.

The defaults are: the join field is the first field in each line;
fields in the input are separated by one or more blanks, with leading
blanks on the line ignored; fields in the output are separated by a
space; each output line consists of the join field, the remaining