fs branch point - common parent dir

When using certain common tools -- common to *nix-like OSes, anyway -- one might sometimes like to have a way to find the "closest common containing parent" of two directories. One example would be the invocation one makes of the diff(1) tool. In Unified mode (diff switch -u) the diff tool takes two directories and compares each file found in the first with the same file found in the second (if it exists) (see the manual page for diff for a better description of its operation).

Because the diff output contains "chunks" of data each lead by a pair of lines that describe the "before" and "after" file locations, we could have a very long line in either case if the path from the working directory wherein diff was invoked is long. To improve readability / esthetics the author prefers to keep these path specifying lines as short as possible.

The snippet presented here can be used as a shell script helper by substituting its output into a cd (chdir) command so that the diff tool can be invoked from a filesystem directory as close as possible to each target directory.

#!/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-lexi
+cals 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__
[download]

Links provided for reader convenience:

links last checked: 2005.05.15
This software's documentation as POD: common_parent_dir
This script as syntax-hilighted HTML (without embedded POD): common_parent_dir.html
Script "production copy" "complete" (with inline POD): common_parent_dir.perl

Comment on fs branch point - common parent dir Download Code

Replies are listed 'Best First'.
Re: fs branch point - common parent dir by jdporter (Paladin) on May 16, 2005 at 17:12 UTC
I'm thinking that main subroutine could be more cleanly written as `sub find_common_parent_node { my( $dir1, $dir2 ) = @_; my @dir1 = ( $dir1->volume, $dir1->dir_list ); my @dir2 = ( $dir2->volume, $dir2->dir_list ); my @sharan; while ( @dir1 and @dir2 and $dir1[0] eq $dir2[0] ) { push @sharan, shift @dir1; shift @dir2; } # if needed: my $dir_A = dir( @dir1 ); my $dir_B = dir( @dir2 ); dir( @sharan ) }` [download] but I may be missing something (besides the debug code...)	[reply] [d/l]
Re: fs branch point - common parent dir by 5mi11er (Deacon) on May 16, 2005 at 18:53 UTC
My favorite trick in cases like these is to create a symbolic link to the "directory far far away". Then run diff against the current directory (or files in current directory), and the symbolic link. example: `$ pwd /home/user/src/perly-stuff $ ln -s /usr/local/lib/some/other/directory .otherdir $ diff -s ./ .otherdir/` [download] -Scott	[reply] [d/l]