#!/usr/bin/env perl # $Id$ # Public domain. Originally written by Sebastian Rahtz. # # Process a "cooked" tree directory (probably created by ctan2tds in # Build/tmp.cooked), and integrate into the main texmf trees. # # Basic usage: place PKG # to process ./PKG. Best invoked from ctan2tl, not directly. BEGIN { chomp ($mydir = `dirname $0`); # we are in Master/tlpkg/bin unshift (@INC, "$mydir/.."); } use File::Basename; use File::Find; use Cwd; use TeXLive::TLConfig qw/$InfraLocation $DatabaseName/; use TeXLive::TLPSRC; use TeXLive::TLPOBJ; use TeXLive::TLPDB; use TeXLive::TLTREE; if ($ARGV[0] eq "-n") { $chicken = 1; shift; } else { $chicken = 0; } print "place: chicken mode = $chicken\n"; die "usage: $0 PKGNAME\n" unless @ARGV == 1; $package = $ARGV[0]; $newpackage = 0; %dirs = (); # dirs we make changes in $TMP = $ENV{"TMPDIR"} || "/tmp"; $cooked = getcwd(); # ctan2tl invokes us in the cooked dire -d "$cooked/$package" || die "$0: No such package in $cooked: $package\n"; &xchdir ("$mydir/../.."); $M = getcwd(); xchdir ("$cooked/$package"); if (-d "texmf-dist") {$Root="texmf-dist"; } elsif (-d "texmf-doc") {$Root="texmf-doc"; } elsif (-d "texmf") {$Root="texmf"; } else { die ("no top level texmf in " . `pwd`); } if ($Root eq 'texmf-doc') { $Type = 'Documentation'; } elsif ($Root eq 'texmf-dist') { $Type = 'Package'; } elsif ($Root eq 'texmf') { # can't handle binary stuff yet, but can do some hyphenations. $Type = 'TLCore'; } else { die "cannot handle Root=$Root"; } # initialize TLPDB my $tlpdb = new TeXLive::TLPDB ( root => "$M" ); # create TLTREE from stuff in cooked/$pkg my $tltree = TeXLive::TLTREE->new( 'svnroot' => "$cooked/$package" ); $tltree->init_from_files; # get package from TLPDB; my $tlpold = $tlpdb->get_package("$package"); if (defined($tlpold)) { # what to do with binfiles, but they are not place-ed!!! foreach ($tlpold->srcfiles, $tlpold->runfiles, $tlpold->docfiles) { $Old{$_} = 1; } } else { $newpackage = 1; } # create new tlpsrc and tlpobj my $tlpsrc = TeXLive::TLPSRC; if (! -r "$M/tlpkg/tlpsrc/$package.tlpsrc") { $tlpsrc->name("$package"); $tlpsrc->category($Type); if (!$chicken) { open TMP, ">$M/tlpkg/tlpsrc/$package.tlpsrc" or die "Cannot open tlpsrc file!"; $tlpsrc->writeout(\*TMP); close TMP } } else { $tlpsrc->from_file("$M/tlpkg/tlpsrc/$package.tlpsrc"); } my $tlpnew = $tlpsrc->make_tlpobj($tltree); # we took over the comparison of files from the ctan2tl script since # we are here in perl world, which makes it easier ... print "\n\f "; if (!defined($tlpold)) { print "place: $package not present in $M/$InfraLocation/$DatabaseName\n\n"; } else { print "new vs. present $package\n"; my @oldfiles; push @oldfiles, $tlpold->srcfiles; push @oldfiles, $tlpold->runfiles; push @oldfiles, $tlpold->docfiles; `rm -f $TMP/tlplace.old`; foreach (sort @oldfiles) { `echo $_ >> $TMP/tlplace.old`; } my @newfiles; push @newfiles, $tlpnew->srcfiles; push @newfiles, $tlpnew->runfiles; push @newfiles, $tlpnew->docfiles; `rm -f $TMP/tlplace.new`; foreach (sort @newfiles) { `echo $_ >> $TMP/tlplace.new`; } print `comm -3 $TMP/tlplace.new $TMP/tlplace.old`; my @difffiles = `comm -12 $TMP/tlplace.new $TMP/tlplace.old`; chomp (@difffiles); my $sum = 0; my $diff_file = "$TMP/tlplace.diff"; unlink ($diff_file); my $diff_cmd = "diff --text --ignore-all-space -U 0 -s"; foreach (@difffiles) { my @foo = `$diff_cmd $M/$_ $cooked/$package/$_ | tee -a $diff_file`; $sum += $#foo; # zero-based, so first line doesn't count. } my $nrcommfiles = @difffiles; # my $identical; if (-s $diff_file) { chomp ($identical = `grep --text 'are identical' $diff_file | wc -l`); } else { $identical = 0; } # my $changed = $nrcommfiles - $identical; print "$nrcommfiles common files, $changed changed, ~$sum lines different ($diff_file)\n\n\f\n"; #`rm -f $TMP/tlplace.new $TMP/tlplace.old $TMP/tlplace.diff`; } &xchdir ("$cooked/$package"); find (\&files,"."); foreach $file (sort keys %Old) { my $status = $New{$file} ? "retained" : "removed"; print "* $file\t[$status]\n"; # if the old file does not exist, don't try to remove it -- we # probably did so by hand and didn't bother to update. next unless -e "$M/$file"; # remove old files. if (! $New{$file}) { &my_system ("svn remove $M/$file"); } my $dname = dirname ("$M/$file"); $dirs{$dname}++; } # copy files my $job = "tar cf - . | (cd $M && tar xf - )"; &my_system ($job); # sort so dirs will be added before subdirs. foreach $file (sort keys %New) { if (! $Old{$file}) { &add_file ("$M/$file"); } } xchdir ($cooked); &my_system ("mv $package $package.done"); if ($newpackage) { &add_file ("$M/tlpkg/tlpsrc/$package.tlpsrc"); } # this file will often change, so be sure and include it. $dirs{"$M/tlpkg/tlpsrc/$package.tlpsrc"}++; # print dirs with changed files, for svn commit purposes. # if other files have been modified in those same dirs, though, this # won't detect it. It would be better to list exactly the *files* which # should be committed, but ... lazy. # # also write dir list to a separate file, for easy passing to a commit. # $DIRLIST = ">$TMP/tlplace.dirs"; open (DIRLIST) || die "open($DIRLIST) failed: $!"; # print "place: directories are:\n"; for my $dir (sort keys %dirs) { print "$dir\n"; print DIRLIST "$dir\n"; } # close (DIRLIST) || warn "close($DIRLIST) failed: $!"; #xx warn "WARNING WARNING Things we SHOULD/COULD do here:\n - Update the texlive.tlpdb\n - Compare the files ACTUALLY present in cooked/package with those included via tlpsrc/tltree generation!!!\n - Create list file\n - Update the list of available packages for web update\n - Create zip file(s)\n\n\n"; exit (0); #-------------------------------------- sub dirs { local @filenames; if (-d) { @filenames=&buildfilelist($File::Find::name); if (!@filenames) { rmdir $File::Find::name;} }} sub buildfilelist { my($me) = @_; my @files; opendir(DIR,$me) || cleanup ("cannot open directory $me"); @files =grep(!/^\.\.?/,readdir(DIR)); closedir(DIR); return @files; } sub files { if (-f || -l) { # consider files or symlinks $This = $File::Find::name; $This =~ s/^\.\///; $New{$This} = 1; } } # add a file to the repository. for svn, we also have to add the # containing dir, and the parent of that dir, if they are new. # (Should really just traverse ) # sub add_file { my ($newfile) = @_; my $newdir = dirname ($newfile); # when it's needed, parent must come first, else have svn "not working copy". my $parentdir = dirname ($newdir); unless (-d "$parentdir/.svn") { &my_system ("svn add -N $parentdir"); $dirs{$parentdir}++; } unless (-d "$newdir/.svn") { &my_system ("svn add -N $newdir"); } &my_system ("svn add $newfile"); # remember that we changed this directory. $dirs{$newdir}++; } sub xchdir { my ($dir) = @_; chomp (my $pwd = `pwd`); chdir ($dir) || die "chdir($dir) failed: $!\n(cwd=$pwd)"; print "place: chdir($dir)\n"; } sub my_system { my ($cmd) = @_; print "place: SYSTEM $cmd\n"; unless ($chicken) { my $ret = system ($cmd); die "`$cmd' failed, status=$ret, goodbye\n" if $ret != 0; } }