#!/usr/bin/env perl
eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

##--CVS/RCS control boilerplate--------
# $Author: SorenSpecial $ Last modified: 20:19(TZ:EDT) 14-May-2005
# Last cvs commit on: $Date: 2005/05/14 23:47:03 $
##-------------------------------------

use strict;
use vars '$DeBUG'; $DeBUG = 0;
use vars qw($VERSION $script_revision); # must be file-global non-lexicals to be seen
                                        # when using SelfLoader.
$script_revision = q$Revision: 1.3 $;
$VERSION = 0.03 ;

use Path::Class;
use Getopt::Long;
use Pod::Usage;
my( $help, $finemanualpage );

GetOptions('help|h|usage|u|?' => \$help, 'man' => \$finemanualpage)
                           or pod2usage(2);
           pod2usage(1) if $help;
           pod2usage(-exitstatus => 0, -verbose => 2)
                           if $finemanualpage;
           pod2usage(1) if not $#ARGV >= 1;

my $root_token = File::Spec->rootdir;

sub togglroot {
    if   ( $_[0] =~ /\A[a-zA-Z]:/ )  {
       return @_
    }
    return (substr( $_[0],0,1 ) eq $root_token)
                ?  ( '', @_ ) : @_
}

sub find_common_parent_node {

    my ($seen_comm, @dir1,@dir2, $dir_A,$dir_B, $cntup, $sharan);

    my( $dir1 , $dir2 ) = @_;

    $cntup =
          scalar (@dir1 = ($dir1->volume(), $dir1->dir_list()))
       <= scalar (@dir2 = ($dir2->volume(), $dir2->dir_list())) ?
                    scalar @dir1 : scalar @dir2;

    while ( ++$seen_comm < $cntup )  {
	$dir1[$seen_comm] eq $dir2[$seen_comm] ? next : --$seen_comm,last;
    }
    if ($DeBUG)     {
                   printf STDERR qq:\n  Dir1 has %u components\n  %s\n  and seems to be %s:,
			 scalar @dir1, do { join qq[ ]=>map qq["$_"]=>@dir1 },
			$dir1->is_absolute ? $dir1->stringify() :
			 File::Spec::Unix->rel2abs( File::Spec::Unix->catdir(grep $_,@dir1));
                   printf STDERR qq:\n  Dir2 has %u components\n   %s\n  and seems to be %s:,
			 scalar @dir2, do { join qq[ ]=>map qq["$_"]=>@dir2 },
			$dir2->is_absolute ? $dir2->stringify() :
	         	 File::Spec::Unix->rel2abs( File::Spec::Unix->catdir(grep $_,@dir2));
		   print STDERR qq:\n:;
    }

    if ($seen_comm) {
	           $sharan = dir(@dir1[0 .. $seen_comm]);
            if ($DeBUG)  { print STDERR "common ancestor is $sharan\n" }
                    $dir_A = $dir1->relative( $sharan );
                    $dir_B = $dir2->relative( $sharan );
    } else {            $dir_A = $dir1 and  $dir_B = $dir2      }

# print STDERR q[$dir_A is composed of elements ], map(qq["$_"],$dir_A->dir_list), qq[\n];
    print STDERR "Comparing treelets rooted at [$sharan]:\n   $dir_A\n   $dir_B\n" if $DeBUG;
    return $sharan;
}

my ($dir1 ,
    $dir2) = ( dir(togglroot shift @ARGV)->cleanup,
	       dir(togglroot shift @ARGV)->cleanup );

print find_common_parent_node($dir1,$dir2) .qq[\n];

__END__