flatten rewritten in perl (first hack)

[Jens Ritter <jens@hilbert.weh.rwth-aachen.de>]

Hallo all,

I rewrote the "flatten" step of the slink_cd-0.93 in perl because it is
one of the most time consuming steps (bad for fast development). It is
included as attachment.

Here is a comparision:

# time ./slink_cd.orig clean  
[...]
real    0m44.705s
user    0m0.310s
sys     0m2.680s

# time ./slink_cd.orig genlist tree flatten
[...]
real    17m12.846s
user    4m59.670s
sys     9m16.620s

# time ./slink_cd.orig clean
[...]
real    0m32.695s
user    0m0.650s
sys     0m5.030s

# time ./slink_cd genlist tree flatten
[...]
real    1m55.225s
user    0m28.900s
sys     0m46.740s


-#|:-)

I didn't test, wether there are any differences. I am open to suggestions
how to test that.

HTH and TIA,

Jens
-- 
Jens.Ritter@weh.rwth-aachen.de       grimaldi@debian.org
KeyID: 2048/E451C639 1998/01/28
Print: 5F 3D 43 1E 24 1E CC 48  1E 05 93 3A A7 10 73 37
Wie siehst Du denn aus? Bist Du gerannt?
                -- Manni (Lola rennt)

#!/usr/bin/perl -w 

# This is a perl rewrite of the flatten subsection of
# the slink_cd script.  

#flatten: expects a list of files as standard
#     input.  leaves symlinks into the current tree alone, 
#     changes other links. Needs the directories of the mirror 
#     and the non-us mirror.

# syntax: "cat <files > | flatten mirror non-us"

# (c) 1998 Jens Ritter
# Apply the GNU Public License V 2 or later if necessary.


# We extensively work on $_!
while (<STDIN>)
{
    chop;          # Chop "\n" from end.
    if ( ! -l )    # If not symlink, next.
    { 
	print $_, ": normal file\n"; 
        next; 
    }  

    /^(.*\/)(.*)$/;    # regexps are greedy (replaces basename and dirname).

    $dirname  = $1;
    $filename = $2;

    # Count the number of slashes in $dirname and in the
    # sym-link. If the sym-link has more then we need to
    # remove the (external) sym-link and make a hard link
    
    $dirslash = $dirname =~ s/\//\// ; # counts the number of slashes
                                       # (by replacing "/" with "/")

    $linkname = readlink;

    $linkslash = $linkname =~ s/\//\//; 
  
    $i = $linkname;
    $linkname =~ s/\.\.\///g;
    $abslink = $ARGV[0] . "/dists/" . $linkname;

    # Gross hack for non-US. Sort out the tree!!!
    if ( /non-US/ ) 
    {
	$linkslash = $linkslash + 3;
	$abslink = $ARGV[1] . "/" . $linkname;
    }
 
    # And now for the top-level docs packages; why are these sym-links?
    if ( /package-developer/ ) 
    {
	$abslink = $ARGV[0] . "/" . $linkname;
    }

    if ($dirslash < $linkslash)
    {
	print $_, " out of tree; replacing\n";

	# Debugging output.
	print "remove: $_\n";
        print "link: $abslink, $_\n";

	# Uncomment next to lines to remove safeguard.
	# unlink;
	# link $abslink, $_;
    }
    else
    {
	print $_, " inside of tree; leaving alone\n";
    }
    print $_,",", $i,",", $abslink,".\n";
}

print "end\n";

--- slink_cd.orig	Mon Dec 21 23:43:26 1998
+++ slink_cd	Mon Dec 21 23:45:22 1998
@@ -357,47 +357,9 @@
     if [ "$FLATTEN"x = "1"x ] ; then
 	echo Flattening external symlinks
 
-	# Clever? stuff to check for sym-links
-	for file in `cat binary targz diffgz dsc`
-	do
-	    # Do we have a sym-link? If not, drop out here
-	    if [ -L $file ] ; then
-	
-		FILENAME=`basename $file`	
-		DIRNAME=`dirname $file`	
-		
-		# Count the number of slashes in $dirname and in the
-		# sym-link. If the sym-link has more then we need to
-		# remove the (external) sym-link and make a hard link
+	# This is done in perl.
+	cat binary targz diffgz dsc | $STARTDIR/flatten $MIRROR $NONUS
 
-		DIRSLASH=`echo $DIRNAME | tr -d a-zA-Z0-9_.+- | wc -c`
-		LINKNAME=`ls -l $file | awk '{print $11}'`
-		LINKSLASH=`echo $LINKNAME | tr -d a-zA-Z0-9_.+- | wc -c`
-
-		ABSLINK="$MIRROR/dists/"`echo $LINKNAME | sed 's/\.\.\///g'`
-
-		# Gross hack for non-US. Sort out the tree!!!
-		if [ `echo $file | grep -s non-US` ] ; then
-		    LINKSLASH=$[ $LINKSLASH + 3 ]
-		    ABSLINK="$NONUS/"`echo $LINKNAME | sed 's/\.\.\///g'`
-		fi
-
-		# And now for the top-level docs packages; why are these sym-links?
-		if [ `echo $file | grep -s package-developer` ] ; then
-		    ABSLINK="$MIRROR/"`echo $LINKNAME | sed 's/\.\.\///g'`
-		fi
-
-		if [ $DIRSLASH -lt $LINKSLASH ] ; then
-		    # We have a winner!
-		    echo "$file: symlink outside of tree; replacing"
-		    rm $file && ln $ABSLINK $file
-		else
-		    echo "$file: symlink inside of tree; leaving alone"
-		fi
-	    else
-		echo $file: normal file		
-	    fi
-	done
     fi
 fi