summaryrefslogtreecommitdiff
path: root/Master/tlpkg/bin/check-wrapper-consistency
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2008-04-26 00:34:54 +0000
committerKarl Berry <karl@freefriends.org>2008-04-26 00:34:54 +0000
commitd18a85166ab3f33952f42e91c0cf1266db1d3918 (patch)
treefdd9d05c52deda4a5506b6f21a743895c13279e5 /Master/tlpkg/bin/check-wrapper-consistency
parent419a1f0cf66ecfd6f2198bc991c529b73dcc9b15 (diff)
make all wrappers the same file
git-svn-id: svn://tug.org/texlive/trunk@7660 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/bin/check-wrapper-consistency')
-rwxr-xr-xMaster/tlpkg/bin/check-wrapper-consistency84
1 files changed, 84 insertions, 0 deletions
diff --git a/Master/tlpkg/bin/check-wrapper-consistency b/Master/tlpkg/bin/check-wrapper-consistency
new file mode 100755
index 00000000000..f3025c2db1f
--- /dev/null
+++ b/Master/tlpkg/bin/check-wrapper-consistency
@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+# $Id$
+# Copyright 2008 TeX Users Group.
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# Check that the same set of files are wrappers on w32 and symlinks on
+# all others.
+
+BEGIN {
+ $^W = 1;
+ ($mydir = $0) =~ s,/[^/]*$,,;
+ unshift (@INC, "$mydir/..");
+}
+
+use Getopt::Long;
+use Pod::Usage;
+
+our $mydir;
+my $help = 0;
+
+GetOptions("help|?" => \$help) or pod2usage(1);
+pod2usage(-exitstatus => 0, -verbose => 2) if $help;
+
+exit (&main ());
+
+sub main
+{
+ my $err = 0;
+
+ chomp (my $Master = `cd $mydir/../.. && pwd`);
+ my $bindir = "$Master/bin";
+ chdir ($bindir) || die "chdir($bindir) failed: $!";
+
+ my %w = &unx_wrapper_entries ("i386-linux");
+
+ $cww = "$Master/../Build/source/texk/texlive/tl-w32-wrapper.texlua";
+ $err += &check_w32 ("win32", $cww, %w);
+
+ return $err;
+}
+
+
+
+# return all symlinks starting with ".." in DIR as a hash, with symlink
+# targets as the values.
+#
+sub unx_wrapper_entries
+{
+ my ($DIR) = @_;
+ my %ret;
+
+ local *DIR;
+ opendir (DIR, $DIR) || die "opendir($DIR) failed: $!";
+ while (my $ent = readdir (DIR)) {
+ my $file = "$DIR/$ent";
+ next unless -l $file; # skip all but symlinks
+
+ my $target = readlink ($file);
+ die "readlink($file) failed: $!" if !defined ($target);
+ next unless $target =~ /^\.\./; # skip all but .. symlinks
+
+ $ret{$ent} = $target; # remember name and link target
+ }
+ closedir (DIR) || warn "closedir($DIR) failed: $!";
+
+ return %ret;
+}
+
+
+
+# windows is special, as usual. given the list of wrappers in UW, check
+# that each of those entries exists in W32DIR and is a copy of the
+# canonical w32 wrapper specified in W32CANONICAL.
+#
+sub check_w32
+{
+ my ($w32dir, $w32canonical, %uw) = @_;
+
+ for my $k (sort keys %uw) {
+ system ("cmp $w32dir/$k.texlua $w32canonical");
+ #print "$k -> $uw{$k}\n";
+ }
+}