#!/usr/bin/perl
# -*- cperl -*-

use Data::Dumper;
use strict;

my @tars =
(
  ["GNU"       ,"/opt/csw/bin/gtar --format=ustar"],
  ["GNU+patch" ,"/home/bteam/my/build-200911051126-5.0.88/mysql-5.0.88-build/local/bin/tar --format=ustar"],
  ["Solaris"   ,"/usr/bin/tar"],
  ["CMake"     ,"/home/cteam/BuildStepper/bootstrap-dep/inst/bin/cmake -E tar"],
);

# For now, only testing those that should pass
my @tests =
(
  [155, 100],
  [155,  99],
  [154, 100],
  [154,  99],
  [100, 100],
  [100,  99],
  [ 99, 100],
  [ 99,  99],
  [100,  55, 100],
  [100,  55,  99],
  [ 99,  55, 100],
  [ 99,  54, 100],
  [ 99,  54,  50],
  [ 99,  54,  50,  50],
  [ 99,  54,  49,  50],
);

sub run_tests {
  my $mode= shift;                      # 'file' or 'dir'

  # ----------------------------------------------------------------------
  # Run each test for each TAR executable
  # ----------------------------------------------------------------------

  foreach my $split ( @tests ) {

    # ----------------------------------------------------------------------
    # Create the parts to use when forming the path
    # ----------------------------------------------------------------------
    my @parts;

    my $char= "a";
      my @split= @$split;                 # Take a copy

    while ( @split ) {
      my $part_size = shift @split;

      # If last part is a directory, remove one to fit the ending
      # "/". Not strictly required by standard but what is used.
      $part_size-- if !@split and $mode eq 'dir';

      # Create the part from "a", "b", ....
      push(@parts, $char x $part_size);
      $char = chr(ord($char)+1);        # Next character in alphabet
    }
#    print Dumper(\@parts);

    # ----------------------------------------------------------------------
    # Perform the test
    # ----------------------------------------------------------------------

    print "\n", "#" x 78, "\n\n";
    print "Path is split like ", join(" + " , @$split);
    print " (last part is a ", ( $mode eq 'dir' ? "directory" : "file" ), ")\n\n";

    my @unpack_errors;          # Collect and report at the end

    foreach my $tarinfo ( @tars ) {
      my ($tag,$tar) = @$tarinfo;
      system("rm -fr tartmp");
      -e "tartmp" and die "Could not remove tartmp";
      mkdir("tartmp") or die "Could not create tartmp";
      chdir("tartmp") or die "Can't change directory to tartmp";

      my $path = join("/", @parts);

      if ( $mode eq 'dir' ) {
        system("mkdir -p $path");
      } else {
        my @p = @parts;                   # Take a copy
        my $file = pop(@p);
        system("mkdir -p " . join("/", @p));
        system("echo 'some text' > $path");
      }

      my $cmd = "$tar -cf $tag.tar $parts[0]";
#     print "CMD: $cmd\n";
      my $out = `$cmd 2>&1`;
      my $res = $?;

      $out =~ s/(\w)\1{4,}/$1$1$1...$1$1$1/gs;
      $out =~ s,/[/\S]+tar:\s+,,g;
      $out =~ s,\btar:\s+,,g;
      $out =~ s,\nExiting.*,,;
      $out =~ s/\n/ /g;
      printf "%-10s : [%3d] %s\n", $tag, $res, $out;

      # Now, do simplistic test if all can "see" the stored path

      if ( $res == 0 ) {
        foreach my $tarinfo2 ( @tars ) {
          my ($tag2,$tar2) = @$tarinfo2;
          my $out2 = `$tar2 -tf $tag.tar 2>/dev/null`;
          unless ( $out2 =~ /^\Q$path/m ) {
            push(@unpack_errors, "$tag2 can't handle TAR produced by $tag");
#            print "  REAL PATH: $path\n";
#            print "  OUTPUT   : $out2\n";
          }
        }
      }

      chdir("..");
    }

    if ( @unpack_errors ) {
      print "\nUnpacking errors (tar -tf)\n\n";
      foreach my $msg ( @unpack_errors ) {
        print "  $msg\n";
      }
    }
  }
}

run_tests("file");
run_tests("dir");

__END__

src/tarheader gnu-patched.tar > GNU-PATCHED
src/tarheader gnu.tar > GNU
src/tarheader solaris.tar > SOLARIS
src/tarheader cmake.tar > CMAKE