From 534a83fcf6edb644f1785091c2838c2e2915148e Mon Sep 17 00:00:00 2001
From: David Schleef <ds@schleef.org>
Date: Sat, 10 Nov 2001 12:02:35 +0000
Subject: Limited Debian architectures to the ones we can actually build.
 Improved mksnapshot script; now adds a bogus changelog entry. Added fixlinks
 script that automatically converts symlinks to conform to Debian policy and
 updated rules to use it.  Added another bogus man page, prolonging the
 pretense that I'll actually write real ones.

---
 debian/fixlinks | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100755 debian/fixlinks

(limited to 'debian/fixlinks')

diff --git a/debian/fixlinks b/debian/fixlinks
new file mode 100755
index 000000000..39f719b12
--- /dev/null
+++ b/debian/fixlinks
@@ -0,0 +1,80 @@
+#!/usr/bin/perl -w
+# vi: set ts=4:
+
+
+@LINKS=`find . -type l|xargs ls -l`;
+
+#print @LINKS;
+
+
+while($_ = shift @LINKS){
+	chomp;
+	my ($perm,$nlinks,$owner,$group,$size,$month,$day,$year,$file) =
+		split(' ', $_, 9);
+	my $link;
+
+	if($perm =~ m/^l/){
+		($relfile, $link) = split(' -> ', $file);
+	}
+
+	# chop off leading . in $file
+	$file = $relfile;
+	$file =~ s/^\.//;
+
+	if($perm =~ m/^l/){
+		my @pathcomponents = split('/', $file);
+		my @linkcomponents = split('/', $link);
+
+		if($link =~ m/^\//){
+			@newcomponents = @linkcomponents;
+		}else{
+			@newcomponents = @pathcomponents;
+
+			# chop off filename
+			pop(@newcomponents);
+
+			while($comp = shift @linkcomponents){
+				#print "path: ",join(':',@newcomponents)," -- $comp -- ", join(':',@linkcomponents),"\n";
+
+				if($comp eq ""){
+					# ignore
+				}elsif($comp eq ".."){
+					pop(@newcomponents);
+				}else{
+					push @newcomponents,$comp;
+				}
+			}
+		}
+
+		if($newcomponents[0] eq ""){
+			shift(@newcomponents);
+		}
+		if($pathcomponents[0] eq ""){
+			shift(@pathcomponents);
+		}
+
+		#print "from ",join('/',@pathcomponents),"\n";
+		#print "to ",join('/',@newcomponents),"\n";
+
+		if($newcomponents[0] eq $pathcomponents[0]){
+			#print $newcomponents[0],", ",$pathcomponents[0];
+			#print "should be relative\n";
+			while($newcomponents[0] eq $pathcomponents[0]){
+				shift(@newcomponents);
+				shift(@pathcomponents);
+			}
+			while(@pathcomponents > 1){
+				shift(@pathcomponents);
+				unshift(@newcomponents,"..");
+			}
+		}else{
+			#print "should be absolute\n";
+			unshift(@newcomponents,"");
+		}
+		$newlink=join('/',@newcomponents);
+		print "ln -sf $newlink $relfile\n";
+		unlink($relfile);
+		symlink($newlink,$relfile);
+	}
+}
+
-- 
cgit v1.2.3