#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use autodie;

use FindBin '$Bin';

# Non-ancient perls have this in List::Util, but I want to support ancient ones too
use List::MoreUtils 'all';

use Vnlog::Util qw(parse_options read_and_preparse_input reconstruct_substituted_command get_key_index);




# This comes from the getopt_long() invocation in join.c in GNU coreutils
my @specs = ( # options with no args
             "ignore-case|i",
             "check-order",
             "nocheck-order",
             "zero-terminated|z",
             "header",

             # options that take an arg
             "a=s@", "e=s", "1=s", "2=s", "j=s", "o=s", "t=s", "v=s@",

             "help|h");

@specs = (@specs,
          "vnl-prefix1=s",
          "vnl-suffix1=s",
          "vnl-prefix2=s",
          "vnl-suffix2=s",

          "vnl-sort=s");

my %options_unsupported = ( 't' => <<'EOF',
vnlog is built on assuming a particular field separator
EOF
                            'e' => <<'EOF',
vnlog assumes - as an "undefined" field value. -e thus not allowed
EOF
                            'header' => <<'EOF',
vnlog already handles field headers; this is pointless
EOF

                            'zero-terminated' => <<'EOF'
vnlog is built on assuming a particular record separator
EOF
                          );

my ($filenames,$options) = parse_options(\@ARGV, \@specs, <<EOF);

  $0 [join options]
           [--vnl-sort -|[dfgiMhnRrV]+]
           [--vnl-[pre|suf]fix[1|2] xxx]
           logfile1 logfile2

The most common options are (from the GNU sort manpage)

  -j FIELD
         join on this FIELD. This is the vnlog field we're joining on

  -i, --ignore-case
         ignore differences in case when comparing fields

  -a FILENUM
         also print unpairable lines from file FILENUM, where FILENUM
         is 1 or 2, corresponding to FILE1 or FILE2

  -v FILENUM
         like -a FILENUM, but suppress joined output lines

There're also a few vnlog-specific options

  --vnl-prefix1 xxx
  --vnl-suffix1 xxx
  --vnl-prefix2 xxx
  --vnl-suffix2 xxx
         Add a suffix/prefix to the output column labels of the 1st/2nd data
         file. Very useful if we're joining datasets with identically-named
         fields

  --vnl-sort -|[dfgiMhnRrV]+]
         Pre-sort both input files lexicographically (join assumes this sort
         order). If the argument isn't -, then ALSO post-sort the output
         using the given sort order. This is both for convenience and to work
         around the hard-coded sort order that join assumes.
EOF

for my $key(keys %$options)
{
    if($options_unsupported{$key})
    {
        my $keyname = length($key) == 1 ? "-$key" : "--$key";
        die("I don't support $keyname: $options_unsupported{$key}");
    }
}

if( scalar(@$filenames) != 2 )
{
    die "Exactly two inputs should have been given";
}
if(defined $options->{j} &&
   (defined $options->{1} || defined $options->{2}))
{
    die "Either (both -1 and -2) or -j MUST be given, but not both. -j is recommended";
}
if(( defined $options->{1} && !defined $options->{2}) ||
   (!defined $options->{1} &&  defined $options->{2}))
{
    die "Either (both -1 and -2) or -j MUST be given, but not both. -j is recommended";
}
if( defined $options->{1})
{
    if($options->{1} ne $options->{2})
    {
        die "-1 and -2 should refer to the same field. Using -j is recommended";
    }

    $options->{j} = $options->{1};
    delete $options->{1};
    delete $options->{2};
}

if( !defined $options->{j} )
{
    die "Either (both -1 and -2) or -j MUST be given, but not both. -j is recommended";
}

if( defined $options->{a} )
{
    my $N = scalar @{$options->{a}};
    if( $N < 1 || $N > 2 )
    {
        die "-a should have been passed at most 2 times";
    }

    if( !all {/^[12]$/} @{$options->{a}} )
    {
        die "-a MUST be given either 1 or 2";
    }
}
if( defined $options->{v} )
{
    my $N = scalar @{$options->{v}};
    if( $N < 1 || $N > 2 )
    {
        die "-v should have been passed at most 2 times";
    }

    if( !all {/^[12]$/} @{$options->{v}} )
    {
        die "-v MUST be given either 1 or 2";
    }
}


# vnlog uses - to represent empty fields
$options->{e} = '-';

if( !defined $options->{o} )
{
    # Some format MUST be given. Otherwise join doesn't respect -e
    $options->{o} = 'auto';
}

$options->{'vnl-prefix1'} //= '';
$options->{'vnl-suffix1'} //= '';
$options->{'vnl-prefix2'} //= '';
$options->{'vnl-suffix2'} //= '';

my $join_key = $options->{j};


my $input_filter = undef;
if(defined $options->{'vnl-sort'})
{
    if($options->{'vnl-sort'} !~ /^(?: [dfgiMhnRrV]+ | -)$/x)
    {
        die("--vnl-sort must be followed by '-' or one or more of the ordering options that 'sort' takes: dfgiMhnRrV");
    }

    # We sort with the default order (lexicographical) since that's what join
    # wants. We'll re-sort the output by the desired order again
    my $key = $options->{j};
    $input_filter = ["$Bin/vnl-sort", "-k", "$key"];
    if($options->{'ignore-case'})
    {
        push @$input_filter, '-f';
    }
}


my $inputs = read_and_preparse_input($filenames, $input_filter);
my $keys_output = substitute_field_keys($options, $inputs);
my $ARGV_new = reconstruct_substituted_command($inputs, $options, \@specs);

my $legend = '# ' . join(' ', @$keys_output) . "\n";

# Simple case used 99% of the time: we're not post-filtering anything. Just
# invoke the join, and we're done
if(!defined $options->{'vnl-sort'} || $options->{'vnl-sort'} eq '-')
{
    syswrite(*STDOUT, $legend);
    exec 'join', @$ARGV_new;
}


# Complicated case. We're post-filtering our output. I set up the pipes, fork
# and exec
use POSIX;
my ($fdread,$fdwrite) = POSIX::pipe();

my $childpid_sort = fork();
if ( $childpid_sort == 0 )
{
    # Child. This is the re-sorting end. In this side of the fork vnl-sort reads
    # data from the join
    POSIX::close($fdwrite);
    POSIX::close(0);
    POSIX::dup2($fdread, 0);

    my $order = $options->{'vnl-sort'};
    exec "$Bin/vnl-sort", "-k", $join_key, "-$order";
}

my $childpid_join = fork();
if ( $childpid_join == 0 )
{
    # Child. This is the 'join' end. join will write to the pipe, not to stdout.
    POSIX::close($fdread);
    POSIX::close(1);
    POSIX::dup2($fdwrite, 1);

    POSIX::write(1, $legend, length($legend));

    exec 'join', @$ARGV_new;
}

POSIX::close($fdread);
POSIX::close($fdwrite);

# parent of both. All it does is wait for both to finish so that whoever called
# vnl-join knows when the whole thing is done.
waitpid $childpid_join, 0;
waitpid $childpid_sort, 0;





sub push_nonjoin_keys
{
    my ($keys_output, $keys, $key_join, $prefix, $suffix) = @_;
    for my $i (0..$#$keys)
    {
        if ( $keys->[$i] ne $key_join)
        {
            push @$keys_output, $prefix . $keys->[$i] . $suffix;
        }
    }
}

sub substitute_field_keys
{
    # I handle -j and -o. Prior to this I converted -1 and -2 into -j
    my ($options, $inputs) = @_;

    # I convert -j into -1 and -2 because the two files might
    # have a given named field in a different position
    my $join_field_name = $options->{j};
    delete $options->{j};
    $options->{1} = get_key_index($inputs->[0], $join_field_name);
    $options->{2} = get_key_index($inputs->[1], $join_field_name);




    my @keys_out;
    if( defined $options->{o} and $options->{o} ne 'auto')
    {
        my @format_in  = split(/[ ,]/, $options->{o});
        my @format_out;
        for my $format_element(@format_in)
        {
            if( $format_element eq '0')
            {
                push @format_out, '0';
                push @keys_out, $join_field_name;
            }
            else
            {
                $format_element =~ /(.*)\.(.*)/ or die "-o given '$format_element', but each field must be either 'FILE.FIELD' or '0'";
                my ($file,$field) = ($1,$2);
                if($file ne '1' && $file ne '2')
                {
                    die "-o given '$format_element', where a field parsed to 'FILE.FIELD', but FILE must be either '1' or '2'";
                }

                my $index = get_key_index($inputs->[$file-1],$field);
                push @format_out, "$file.$index";
                push @keys_out, $field;
            }
        }

        $options->{o} = join(',', @format_out);
    }
    else
    {
        # automatic field ordering. I.e
        #   join field
        #   all non-join fields from file1, in order
        #   all non-join fields from file2, in order
        push @keys_out, $join_field_name;

        push_nonjoin_keys(\@keys_out, $inputs->[0]{keys}, $join_field_name, $options->{'vnl-prefix1'}, $options->{'vnl-suffix1'});
        push_nonjoin_keys(\@keys_out, $inputs->[1]{keys}, $join_field_name, $options->{'vnl-prefix2'}, $options->{'vnl-suffix2'});
    }

    return \@keys_out;
}




__END__

=head1 NAME

vnl-join - joins two log files on a particular field

=head1 SYNOPSIS


 $ cat a.vnl
 # a b
 AA 11
 bb 12
 CC 13
 dd 14
 dd 123

 $ cat b.vnl
 # a c
 aa 1
 cc 3
 bb 4
 ee 5
 - 23

 Try to join unsorted data on field 'a':
 $ vnl-join -j a a.vnl b.vnl
 # a b c
 join: /dev/fd/5:3: is not sorted: CC 13
 join: /dev/fd/6:3: is not sorted: bb 4

 Sort the data, and join on 'a':
 $ vnl-join --vnl-sort - -j a a.vnl b.vnl | vnl-align
 # a  b c
 bb  12 4

 Sort the data, and join on 'a', ignoring case:
 $ vnl-join -i --vnl-sort - -j a a.vnl b.vnl | vnl-align
 # a b c
 AA 11 1
 bb 12 4
 CC 13 3

 Sort the data, and join on 'a'. Also print the unmatched lines from both files:
 $ vnl-join -a1 -a2 --vnl-sort - -j a a.vnl b.vnl | vnl-align
 # a  b   c
 -   -   23
 AA   11 -
 CC   13 -
 aa  -    1
 bb   12  4
 cc  -    3
 dd  123 -
 dd   14 -
 ee  -    5

 Sort the data, and join on 'a'. Print the unmatched lines from both files, Output ONLY column 'c' from the 2nd input:
 $ vnl-join -a1 -a2 -o 2.c --vnl-sort - -j a a.vnl b.vnl | vnl-align
 # c
 23
 -
 -
  1
  4
  3
 -
 -
  5

=head1 DESCRIPTION

  Usage: vnl-join [join options]
                  [--vnl-sort -|[dfgiMhnRrV]+]
                  [--vnl-[pre|suf]fix[1|2] xxx]
                  logfile1 logfile2

This tool joins two vnlog files on a given field. C<vnl-join> is a
wrapper around the GNU coreutils C<join> tool. Since this is a wrapper, most
commandline options and behaviors of the C<join> tool are present; consult the
L<join(1)> manpage for detail. The differences from GNU coreutils C<join> are

=over

=item *

The input and output to this tool are vnlog files, complete with a legend

=item *

The columns are referenced by name, not index. So instead of saying

  join -j1

to join on the first column, you say

  join -j time

to join on column "time".

=item *

C<-1> and C<-2> are supported, but I<must> refer to the same field. Since
vnlog knows the identify of each field, it makes no sense for C<-1> and C<-2>
to be different. So pass C<-j> instead, it makes more sense in this context.

=item *

C<vnl-join>-specific options are available to adjust the field-naming in the
output: C<--vnl-prefix1>, C<--vnl-prefix2>, C<--vnl-suffix1>, C<--vnl-suffix2>.
See below for details.

=item *

A C<vnl-join>-specific option C<--vnl-sort> is available to sort the input
and/or output. See below for details.

=item *

If no C<-o> is given, we pass C<-o auto> to make sure that missing data is shown
as C<->.

=item *

C<-e> is not supported because vnlog uses C<-> to represent undefined fields.

=item *

C<--header> is not supported because vnlog assumes a specific header
structure, and C<vnl-join> makes sure that this header is handled properly

=item *

C<-t> is not supported because vnlog assumes whitespace-separated fields

=item *

C<--zero-terminated> is not supported because vnlog assumes newline-separated
records

=back

Past that, everything C<join> does is supported, so see that man page for
detailed documentation. Note that all non-legend comments are stripped out,
since it's not obvious where they should end up.

=head2 Field names in the output

By default, the field names in the output match those in the input. This is what
you want most of the time. It is possible, however that a column name adjustment
is needed. One common use case for this is if the files being joined have
identically-named columns, which would produce duplicate columns in the output.
Example: we fixed a bug in a program, and want to compare the results before and
after the fix. The program produces an x-y trajectory as a function of time, so
both the bugged and the bug-fixed programs produce a vnlog with a legend

 # time x y

Joining this on C<time> will produce a vnlog with a legend

 # time x y x y

which is confusing, and I<not> what you want. Instead, we invoke C<vnl-join> as

 vnl-join --vnl-suffix1 _bugged --vnl-suffix2 _fixed -j time bugged.vnl fixed.vnl

And in the output we get a legend

 # time x_bugged y_bugged x_fixed y_fixed

Much better.

=head2 Sorting of input and output

The GNU coreutils C<join> tool expects sorted columns because it can then take
only a single pass through the data. If the input isn't sorted, then we can use
normal shell substitutions to sort it:

 $ vnl-join -j key <(vnl-sort -k key a.vnl) <(vnl-sort -k key b.vnl)

For convenience C<vnl-join> provides a C<--vnl-sort> option. This allows the
above to be equivalently expressed as

 $ vnl-join -j key --vnl-sort - a.vnl b.vnl

The C<-> after the C<--vnl-sort> indicates that we want to sort the I<input>
only. If we also want to sort the output, pass the short codes C<sort> accepts
instead of the C<->. For instance, to sort the input for C<join> and to sort the
output numerically, in reverse, do this:

 $ vnl-join -j key --vnl-sort rg a.vnl b.vnl

The reason this shorthand exists is to work around a quirk of C<join>. The sort
order is I<assumed> by C<join> to be lexicographical, without any way to change
this. For C<sort>, this is the default sort order, but C<sort> has many options
to change the sort order, options which are sorely missing from C<join>. A
real-world example affected by this is the joining of numerical data. If you
have C<a.vnl>:

 # time a
 8 a
 9 b
 10 c

and C<b.vnl>:

 # time b
 9  d
 10 e

Then you cannot use C<vnl-join> directly to join the data on time:

 $ vnl-join -j time a.vnl b.vnl
 # time a b
 join: /dev/fd/4:3: is not sorted: 10 c
 join: /dev/fd/5:2: is not sorted: 10 e
 9 b d
 10 c e

Instead you must re-sort both files lexicographically, I<and> then (because you
almost certainly want to) sort it back into numerical order:

 $ vnl-join -j time <(vnl-sort -k time a.vnl) <(vnl-sort -k time b.vnl) |
   vnl-sort -n -k time
 # time a b
 9 b d
 10 c e

Yuck. The shorthand described earlier makes the interface part of this
palatable:

 $ vnl-join -j time --vnl-sort n a.vnl b.vnl
 # time a b
 9 b d
 10 c e

=head1 BUGS

This and the other C<vnl-xxx> tools that wrap coreutils are written specifically
to work with the Linux kernel and the GNU coreutils. None of these have been
tested with BSD tools or with non-Linux kernels, and I'm sure things don't just
work. It's probably not too effortful to get that running, but somebody needs to
at least bug me for that. Or better yet, send me nice patches :)

=head1 SEE ALSO

L<join(1)>

=head1 REPOSITORY

https://github.com/dkogan/vnlog/

=head1 AUTHOR

Dima Kogan C<< <dima@secretsauce.net> >>

=head1 LICENSE AND COPYRIGHT

Copyright 2018 Dima Kogan C<< <dima@secretsauce.net> >>

This library is free software; you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation; either version 2.1 of the License, or (at your option) any
later version.

=cut
