diff options
author | Karl Berry <karl@freefriends.org> | 2008-04-26 00:34:54 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2008-04-26 00:34:54 +0000 |
commit | d18a85166ab3f33952f42e91c0cf1266db1d3918 (patch) | |
tree | fdd9d05c52deda4a5506b6f21a743895c13279e5 /Master/tlpkg/bin/check-wrapper-consistency | |
parent | 419a1f0cf66ecfd6f2198bc991c529b73dcc9b15 (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-x | Master/tlpkg/bin/check-wrapper-consistency | 84 |
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"; + } +} |