#!/usr/bin/env perl
#
# $Id$
#
# append - append files to other files, then remove the originals

use strict;
use warnings;

use Getopt::Std;
use File::Basename;

#--- command line parsing for options --#
#
my %opt;
getopts( 'fkh?', \%opt );

if ( $opt{'h'} || $opt{'?'} )
{
  print STDERR <<ZZ;

Usage: $0 [-k] source1 [source2 [...]] target

to append the contents of source1, ..., to target.

If a source is a directory, all files in the directory are used.
If the target is a directory, appending happens to (the) file(s)
in the directory with the same name as the source(s).

If a target file doesn't exist, it is created.

Options:

  -k  keep: do not remove the original source files
  -f  fold: omit the maximum initial number of lines in the next file
      that the previous file ends with

ZZ
  exit(0);
}

#--- two auxiliary functions ---#
#

sub thesamefile
# whether the two filenames supplied as arguments point to the very same file
{
  my ( $f1, $f2 ) = @_;

  if ( !-e $f1 || !-e $f2 )
  {
    return 0;
  }

  my ( $dev1, $ino1 ) = stat($f1);
  my ( $dev2, $ino2 ) = stat($f2);

  return ( $dev1 eq $dev2 ) && ( $ino1 eq $ino2 );
}

sub append
{
  my ( $src, $tgt ) = @_;

  if ( !-e $src )
  {
    warn("$src does not exist, skipping it\n");
  }
  elsif ( thesamefile( $src, $tgt ) )
  {
    warn("$src and $tgt are the same, skipping them\n");
  }
  elsif ( -d $src && -d $tgt )
  {
    # append every member of $src to the equally-named member of $tgt
    # leaving the unmatched members of $src alone
    foreach my $srcf ( glob("$src/*") )
    {
      append( $srcf, $tgt );

      #if $src !~ /^\./;  # to exclude . and ..
    }
  }
  elsif ( -d $tgt )
  {
    # append $src to the equally-named member of $tgt
    # leaving it alone if no matching mmber exists
    foreach my $tgtf ( glob("$tgt/*") )
    {
      if ( basename($src) eq basename($tgtf) )
      {
        append( $src, $tgtf );
      }
    }
  }
  elsif ( -d $src )
  {
    # don't do anything! - too risky
  }
  else
  {
    # append the non-directory $src to the non-directory $tgt
    warn("appending $src to $tgt\n");

    if ( $opt{'f'} )
    {
      # append only the lines after the largest part that the target ends with

      # read the lines in the target
      open( my $tgt_fh, '<', $tgt )
       or die("cannot read '$tgt': $!\n");

      my @tgt = <$tgt_fh>;

      close($tgt_fh);

      if (@tgt)
      {
        # there is something to append

        # read the lines in the source
        open( my $src_fh, '<', $src )
         or die("cannot read '$src': $!\n");

        my @src = <$src_fh>;

        close($src_fh)
         or warn("cannot close file after reading from '$src': $!\n");

        # determine the number of lines to skip
        # (how many initial lines in @src are equal to final lines in @tgt)
        my $nr_lines_to_skip = 0;

        for ( my $s = $#src ; $s >= 0 ; --$s )
        {
          #warn("examining slice up to $src:$s\n");

          my $still_equal = 1;
          my $nr_equal    = 0;

          for ( my $t = $#tgt ; $t >= 0 && $s - $nr_equal >= 0 ; --$t )
          {
            #warn(sprintf("comparing: %s[%s] (%s) and %s[%s] (%s)\n",  $tgt, $t, $tgt[$t] =~ s#\s+$##r, $src, $s - $nr_equal, $src[ $s - $nr_equal ] =~ s#\s+$##r));

            if ( $tgt[$t] eq $src[ $s - $nr_equal ] )
            {
              ++$nr_equal;
              #warn("$nr_equal equal lines found\n");
            }
            else
            {
              #warn("not equal\n");
              $still_equal = 0;    # we can't skip from the start
              last;
            }
          }

          if ( $still_equal && $nr_equal > 0 )
          {
            # $src[$s .. $#src] is identical to $tgt[0 .. $nr_equal_lines - 1]
            $nr_lines_to_skip = $nr_equal;
            warn("$nr_equal lines will be skipped\n");
            last;
          }
        }

        if ( $nr_lines_to_skip != $#src + 1 )
        {
          # not all lines are being skipped
          open( my $tgt_fh, '>>', $tgt )
           or die("cannot append to '$tgt': $!\n");

          foreach my $s ( $nr_lines_to_skip .. $#src )
          {
            print $tgt_fh $src[$s];
          }

          close($tgt_fh)
           or warn("cannot close file after appending to '$tgt': $!\n");
        }
      }
    }
    else
    {
      # append the whole content, no matter what it is
      open( my $tgt_fh, '>>', $tgt )
       or die("cannot append to '$tgt'\n");
      open( my $src_fh, '<', $src )
       or warn("cannot open input from '$src': $!\n");
      local $/ = undef;
      my $appendage = <$src_fh>;
      print $tgt_fh $appendage;
      close($src_fh)
       or warn("cannot close file after reading from '$src': $!\n");
      close($tgt_fh)
       or warn("cannot close file after appending to '$tgt': $!\n");
    }

    ( $src eq '-' )
     or $opt{'k'}
     or unlink($src)
     or warn("cannot remove input file '$src': $!\n");
  }
}

#--- go go go! ---#
#

my $target = pop(@ARGV) || '-';

if ( $opt{'f'} && $target eq '-' )
{
  die("cannot use option -f when appending to standard output\n");
}

foreach my $arg ( @ARGV ? @ARGV : ('-') )
{
  append( $arg, $target );
}