From 2290654a562daebf8ff3cecfd279e2d513218eb6 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Fri, 23 Jan 2009 18:51:52 +0000 Subject: (compare_disk_vs_tlpobj): new fn to report on any stray files that are in the package but did not get matched by the tlpsrc patterns. git-svn-id: svn://tug.org/texlive/trunk@11953 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/libexec/place | 52 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 40 insertions(+), 12 deletions(-) (limited to 'Master/tlpkg/libexec/place') diff --git a/Master/tlpkg/libexec/place b/Master/tlpkg/libexec/place index 509aa36b852..cc754a93c46 100755 --- a/Master/tlpkg/libexec/place +++ b/Master/tlpkg/libexec/place @@ -63,13 +63,14 @@ if ($Root eq 'texmf-doc') { die "top-level README in $Root, that can't be right" if -e "$Root/README"; -# initialize TLPDB -my $tlpdb = new TeXLive::TLPDB ('root' => $M); +# initialize TLPDB. +my $tlpdb = new TeXLive::TLPDB ("root" => $M); # create TLTREE from stuff in cooked/$pkg -my $tltree = TeXLive::TLTREE->new ('svnroot' => "$cooked/$package"); +my $tltree = TeXLive::TLTREE->new ("svnroot" => "$cooked/$package"); $tltree->init_from_files; -# get package from TLPDB; +# get package from TLPDB. +my %Old; my $tlpold = $tlpdb->get_package ($package); if (defined($tlpold)) { foreach ($tlpold->all_files) { @@ -79,7 +80,7 @@ if (defined($tlpold)) { $newpackage = 1; } -# create new tlpsrc and tlpobj +# create new tlpsrc. my $tlpsrc = TeXLive::TLPSRC; my $tlpsrcfile = "$M/tlpkg/tlpsrc/$package.tlpsrc"; if (! -r $tlpsrcfile) { @@ -99,14 +100,17 @@ if (! -r $tlpsrcfile) { # make the new tlpobj. my $tlpnew = $tlpsrc->make_tlpobj($tltree, $M); -# we took over the comparison of files from the ctan2tl script since -# we are here in perl world, which makes it easier ... + +# show comparison of old and new. print "\n\f "; + +&compare_disk_vs_tlpobj ("$cooked/$package", $tlpnew); + if (!defined($tlpold)) { print "place: $package not present in $M/$InfraLocation/$DatabaseName\n\n"; } else { print "new vs. present $package (present is indented)\n"; - my @oldfiles = $tlpold->all_files; + my @oldfiles = keys %Old; `rm -f $tmpfile.old`; foreach (sort @oldfiles) { `echo $_ >>$tmpfile.old`; @@ -176,7 +180,7 @@ my $job = "tar cf - . | (cd $M && tar xf - )"; &xsystem ($job); # sort so dirs will be added before subdirs. -foreach $file (sort keys %New) { +for my $file (sort keys %New) { if (! $Old{$file}) { &add_file ("$M/$file"); } @@ -185,7 +189,6 @@ foreach $file (sort keys %New) { &xchdir ($cooked); &xsystem ("mv $package $package.done"); - if ($newpackage) { &add_file ("$M/tlpkg/tlpsrc/$package.tlpsrc"); } @@ -212,7 +215,7 @@ for my $dir (sort keys %dirs) { # close (DIRLIST) || warn "close($DIRLIST) failed: $!"; -# Always run svn update, even without --place. This will let a user +# Always run svn update, even without --place. This will let a worker # detect that a particular package update has already been done by # someone else. print ("\nsvn update of those directories:\n"); @@ -222,7 +225,6 @@ exit (0); -#-------------------------------------- sub dirs { local @filenames; @@ -285,7 +287,33 @@ sub add_file $dirs{$newdir}++; } + +# compare against independent list of files in the new hierarchy, in +# case some of them did not get matched by the patterns. +sub compare_disk_vs_tlpobj +{ + my ($diskdir,$tlp) = @_; + chomp (my @files_on_disk = `cd $diskdir && find \! -type d`); + s,^\./,, foreach @files_on_disk; # remove leading ./ + @files_on_disk{@files_on_disk} = (); # make list into hash + + for my $tlpfile ($tlp->all_files) { + if (exists $files_on_disk{$tlpfile}) { + delete $files_on_disk{$tlpfile}; + } else { + print "$tlpfile in tlp but not on disk?!\n"; + } + } + + print "\n*** not matched in new tlp: ", + join ("\n ", keys %files_on_disk), + "\n" + if keys %files_on_disk; +} + + + sub xchdir { my ($dir) = @_; -- cgit v1.2.3