#!/usr/bin/perl -w

=pod

=head1 lookup-append.pl

Loads the lookup table into memory. Appends fields from it to the
source.

=head2 Copyright

Copyright (c) 2005 by Fred Morris, 6739 3rd NW Seattle WA USA 98117
e-mail: m3047 (funny sign) inwa-dot-net telephone 206.297.6344

Licensed under the same terms as Perl itself, with no warranty or claims of fitness
for any particular use.

=head3 Author

Fred Morris

=head3 Shameless Self-Promotion

B<Fred Morris Consulting> would love to learn about your data services,
content management, or other information technology needs.

C<http://www.inwa.net/~m3047/contact.html>

C<http://www.inwa.net/~m3047/data-services.html>

=head3 Revision History

=over 4

=item version

1.0

=item Creation Date

16-Oct-2005

=item Modification History

=back

=head2 Command Line Syntax

C<lookup-append -l <lookup-file> [-d] [-k] -f <field-number> [-t <separator>] [<input-file>]>

Loads I<lookup-file> into memory.

Reads I<input-file>, or I<STDIN> if not supplied. The default
field separator is white space.

Uses the field identified by I<field-number> to look up a record in
I<lookup-file>, which it appends (sans the key) to the line.

=over 4

=item -l <lookup-file>

This is a file which will be used for lookup. It is assumed to
have the same field separator as the input file.

=item -d

Indicates that the lookup file (and the input file) have a header record,
and causes the first line of the lookup file to be appended to the first
line of the input file. (appends headers)

=item -k

Causes input lines which do not have a corresponding lookup to be
suppressed. (kill unmatched lines)

=item -t <separator>

Allows the use of a different field separator. The default
separator is white space.

=back

=head2 Files

=head3 lookup file

=head4 field separator

The lookup file is presumed to have the same field separator as the
input.

=head4 lookup field

The first field is presumed to be the lookup field which will match
the specified field in the input file.

=head4 all other fields

All other fields will be appended to the input file.

=cut

use strict;

use Getopt::Std;

# -=-=-=- PRIVATE METHODS AND SUBROUTINES -=-=-=-

# -=-=-=- MAIN PROCESSING -=-=-=-

my $Separator = '\s+';
my $Header;
my $Lookup;
my $Field;
my $Kill;

{   # Check for options.

    my %Options;

    getopts( "hl:dkf:t:", \%Options );

    if (exists( $Options{h} )) {

        print "lookup-append -l <lookup-file> [-d] [-k] -f <field-number> [-t <separator>] [<input-file>]\n";
        exit(0);
    }

    defined($Lookup = $Options{l})	or die "Lookup file not specified";

    $Header = $Options{d};

    defined($Field = $Options{f})	or die "Field number not specified";
    ($Field =~ m/^\d+$/)		or die "-f must be numeric";

    $Separator = $Options{t}    if defined( $Options{t} );

    $Kill = $Options{k};
}

my %Lookups;

{   # Read the lookups.

    open LUP, "< $Lookup"		or die "Failed opening $Lookup: $!";

    my $first_line = 1;
    my $line;
    my @fields;

    while (defined($line = <LUP>)) {

        chomp $line;

        # Split it on the separator.

        (my $first, my $rest) = $line =~ m/^(.+?)($Separator.*)$/o;

	# Header line? Save it, sans the first field.

	if ($first_line) {

	    $first_line = 0;
	    $Header = $rest	if ($Header);

	    next;
	}

	# Add a hash entry.

	$Lookups{$first} = $rest;
    }

    close LUP				or die "Failed closing $Lookup: $!";
}

{   # Process the input file.

    my $line;
    my $counter = 0;

    while (defined($line = <>)) {

        chomp $line;

	$counter += 1;

	if (($counter == 1) && $Header) {

	    print $line, $Header, "\n";
	    next;
	}

        # Split it on the separator.

        my @fields = split /$Separator/, $line;

        # Write something back out.

	my $stuff = undef;

	if ($Field < @fields) {

	    my $lookup = $fields[$Field - 1];

	    defined( $stuff = $Lookups{$lookup} )
	    	or print STDERR "Line $counter: no lookup for $lookup\n";
	}
	else {

	    print STDERR "Line $counter: no field $Field\n";
	}

	next	if (! defined($stuff) && $Kill);

	print $line, (defined($stuff) ? $stuff : ''), "\n";
    }

}

# We are done.

exit(0);