path: root/Master/tlpkg/etc/tlrepo-from-minimals.pl

#!/usr/bin/env perl
#
# tlrepo-from-minimals.pl
# Copyright 2008 Norbert Preining
# Licensed under GPLv2 or higher

BEGIN {
  $^W = 1;
  chomp ($mydir = `dirname $0`);
  unshift (@INC, "$mydir/tlpkg");
}

use strict;

use TeXLive::TLConfig;
use TeXLive::TLPSRC;
use TeXLive::TLPOBJ;
use TeXLive::TLPDB;
use TeXLive::TLTREE;
use TeXLive::TLUtils;
use Getopt::Long;
use Pod::Usage;

my %min_to_tl_arch = qw/freebsd         i386-freebsd
                        linux-64        x86_64-linux
                        osx-universal   universal-darwin
                        linux           i386-linux
                        mswin           win32
                        sun             sparc-solaris/;

my $help = 0;
my $dist = "current";
my $dest = "web";
my $opt_luatex = 0;
my $opt_modules = 0;
my $opt_context = 1;
my $opt_all = 0;
my $opt_dontclean = 0;
my $source = ".";

TeXLive::TLUtils::process_logging_options();
GetOptions(
    "source=s" => \$source,
    "dist=s" => \$dist,
    "dest=s" => \$dest,
    "luatex" => \$opt_luatex,
    "modules" => \$opt_modules,
    "context" => \$opt_context,
    "all" => \$opt_all,
    "dont-clean" => \$opt_dontclean,
    "help|?" => \$help) or pod2usage(1);
pod2usage(-exitstatus => 0, -verbose => 2) if $help;

#
if ($opt_all) {
  $opt_luatex = $opt_context = $opt_modules = 1;
}

#
# create a temporary directory for storage of the various files
my $tmp = `mktemp -d`;
chomp($tmp);

info("Using tmp dir $tmp\n");

# copy context files
if ($opt_context) {
  info("Copying files for ConTeXt ... ");
  system("mkdir -p $tmp/texmf-dist");
  system("cp -a $source/$dist/context/current/* $tmp/texmf-dist");
  system("mkdir -p $tmp/tlpkg/tlpsrc");
  system("cp ./tlpkg/tlpsrc/context.tlpsrc $tmp/tlpkg/tlpsrc");
  system("cp ./tlpkg/tlpsrc/bin-context.tlpsrc $tmp/tlpkg/tlpsrc");
  for my $i (keys %min_to_tl_arch) {
    system("mkdir -p $tmp/bin/$min_to_tl_arch{$i}");
    system("cp -a $source/$dist/bin/context/$i/bin/* $tmp/bin/$min_to_tl_arch{$i}");
    if ($i eq "mswin") {
      info("WARNING: How should we ship metafun for Win32???\n");
    } else {
      system("ln -s mpost $tmp/bin/$min_to_tl_arch{$i}/metafun");
    }
    # that is needed otherwise the dangling symlink is ignored
    system("touch $tmp/bin/$min_to_tl_arch{$i}/mpost");
  }
  get_from_tug("texmf-dist/tex/mptopdf/config/mptopdf.ini",
               "$tmp/texmf-dist/tex/mptopdf/config/mptopdf.ini");
  get_from_tug("texmf/fmtutil/format.context.cnf",
               "$tmp/texmf/fmtutil/format.context.cnf");
  #
  # we want to create the .ini files for the used languages. We could
  # just copy from tug the files there, but some have been renamed, so
  # we create them on the spot.
  #
  # Copying would be:
  #for my $l (qw/cz de en fr it nl ro uk/) {
  # get_from_tug("texmf-dist/tex/context/config/cont-$l.ini"
  #               "$tmp/texmf-dist/tex/context/config/cont-$l.ini");
  #}
  for my $l (glob "$source/$dist/context/current/tex/context/base/cont-??.tex") {
    my $bn = TeXLive::TLUtils::basename($l);
    my $ll = $bn;
    $ll =~ s/cont-(..)\.tex/$1/;
    system('printf \'\\\\input ' . "$bn" . '\n\\\\endinput\n\' > ' . "$tmp/texmf-dist/tex/context/config/cont-$ll.ini");
  }
  info("done\n");
}

if ($opt_modules) {
  info("Copying files for ConTeXt modules ... ");
  system("cp -a $source/$dist/modules/all/* $tmp/texmf-dist");
  system("cp ./tlpkg/tlpsrc/context-*.tlpsrc $tmp/tlpkg/tlpsrc");
  # we didn't copy the context-letter and context-taspresent because
  # they are not present in the context minimals
  info("done\n");
}

if ($opt_luatex) {
  info("Copying files for luatex ... ");
  for my $i (keys %min_to_tl_arch) {
    system("mkdir -p $tmp/bin/$min_to_tl_arch{$i}");
    system("cp -a $source/$dist/bin/luatex/$i/bin/* $tmp/bin/$min_to_tl_arch{$i}");
    if ($i eq "mswin") {
      info("WARNING: How should we ship pdfluatex for Win32???\n");
    } else {
      system("ln -s luatex $tmp/bin/$min_to_tl_arch{$i}/pdfluatex");
    }
  }
  system("cp ./tlpkg/tlpsrc/luatex.tlpsrc $tmp/tlpkg/tlpsrc");
  get_from_tug("texmf/fmtutil/format.luatex.cnf",
               "$tmp/texmf/fmtutil/format.luatex.cnf");
  info("done\n");
}

# copy the tlpkg stuff
info("Copying files for infrastructure ... ");
system("cp -a ./tlpkg/TeXLive $tmp/tlpkg");
system("cp -a ./tlpkg/bin $tmp/tlpkg");
system("cp ./tlpkg/tlpsrc/00texlive.config.tlpsrc $tmp/tlpkg/tlpsrc");
info("done\n");

# create new tlpdb
info("Creating the texlive.tlpdb ... \n");
system("perl $tmp/tlpkg/bin/tlpsrc2tlpdb -from-files -with-win-pattern-warning -all");
info("done\n");

# get the current texlive.tlpdb from the tug server
get_from_tug("tlpkg/texlive.tlpdb", "$tmp/texlive-dist.tlpdb");
my $tltlpdb = TeXLive::TLPDB->new;
$tltlpdb->from_file("$tmp/texlive-dist.tlpdb");
die("Cannot read original tlpdb from $tmp/texlive-dist.tlpdb") unless defined($tltlpdb);

my $mitlpdb = TeXLive::TLPDB->new(root => "$tmp");
die("Cannot read minimals tlpdb from $tmp/tlpkg/texlive.tlpdb") unless defined($mitlpdb);

for my $p ($mitlpdb->list_packages) {
  next if ($p =~ m/^00texlive/);
  my $mitlp = $mitlpdb->get_package($p);
  die "Cannot get $p from minimals tlpdb" unless defined($mitlp);
  my $tltlp = $tltlpdb->get_package($p);
  die "Cannot get $p from original tlpdb" unless defined($tltlp);
  # fix the revision by adding 1 to the revision as currently shipped by TL
  $mitlp->revision($tltlp->revision + 1);
  # the following is actually replacing the original tlpobj
  $mitlpdb->add_tlpobj($mitlp);

  # now make basic comparision of the file lists
  my @tlrun = $tltlp->runfiles;
  my @mirun = $mitlp->runfiles;
  my @diffrun = compare_lists(\@tlrun, \@mirun);
  my @tlsrc = $tltlp->srcfiles;
  my @misrc = $mitlp->srcfiles;
  my @diffsrc = compare_lists(\@tlsrc, \@misrc);
  my @tldoc = $tltlp->docfiles;
  my @midoc = $mitlp->docfiles;
  my @diffdoc = compare_lists(\@tldoc, \@midoc);
  my %tlbin = %{$tltlp->binfiles};
  my %mibin = %{$mitlp->binfiles};
  my @tlbin = ();
  my @mibin = ();
  for my $a (values %min_to_tl_arch) {
    push @tlbin, @{$tlbin{$a}} if defined($tlbin{$a});
    push @mibin, @{$mibin{$a}} if defined($mibin{$a});
  }
  my @diffbin = compare_lists(\@tlbin, \@mibin);
  if (@diffrun || @diffbin || @diffdoc || @diffsrc) {
    print "\nDifferences for $p found:\n(- removed from texlive for minimals)\n(+ added to minimals (not present in texlive))\n";
    print "runfiles:\n" if (@diffrun);
    for my $l (@diffrun) {
      print "$l\n";
    }
    print "binfiles:\n" if (@diffbin);
    for my $l (@diffbin) {
      print "$l\n";
    }
    print "docfiles:\n" if (@diffdoc);
    for my $l (@diffdoc) {
      print "$l\n";
    }
    print "srcfiles:\n" if (@diffsrc);
    for my $l (@diffsrc) {
      print "$l\n";
    }
    print "\n";
  }
}

$mitlpdb->save;

# create the containers
info("Creating containers ... ");
system("perl $tmp/tlpkg/bin/tl-update-containers-context --location $dest --recreate");
info("done\ņ");

if (!$opt_dontclean) {
  info("Cleaning tmp directory (probably dangerous!!!) ... ");
  system("rm -rf \"$tmp\"");
  info ("done\n");
}

info("Finished!\n");


sub compare_lists {
  my ($aref, $bref) = @_;
  my @aa = @$aref;
  my @bb = @$bref;
  my @added = ();
  my @removed = ();
  my @diff = ();
  AA: for my $a (@aa) {
    for my $b (@bb) {
      next AA if ($a eq $b);
    }
    # next AA was not called, so it was not found under $b, thus it is removed
    push @removed, $a;
  }
  BB: for my $b (@bb) {
    for my $a (@aa) {
      next BB if ($a eq $b);
    }
    # next BB was not called, so it was not found under $a, thus it is added
    push @added, $b;
  }
  for my $a (sort @removed) {
    push @diff, "-$a";
  }
  for my $a (sort @added) {
    push @diff, "+$a";
  }
  return(@diff);
}

sub get_from_tug {
  my ($what, $dest) = @_;
  my $dn = TeXLive::TLUtils::dirname($dest);
  system("mkdir -p $dn");
  #system("rsync .... Master/$what $dest");
  info("WARNING: we are not actually fetching $what from tug, but copying!\n");
  system("cp /src/TeX/texlive-svn/Master/$what $dest");
}

### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #