path: root/Build/tools/tpm-ctan-check

#!/usr/local/bin/perl
# $Id$
# Public domain.  Originally written 2005, Karl Berry.
# Check if a package in TL has any changes on CTAN.  Just the beginnings.

chomp (my $mydir = `dirname $0`);
chomp ($mydir = `cd $mydir && pwd`);
chomp ($TL = `cd $mydir/../../Master && pwd`);
chdir ($TL) || die "chdir($TL) failed: $!";

exit (&main ());

sub main
{
  $OPT{"verbose"} = 1;
  
  # xx read FILES.last7days, determine CTAN changes, map to TL packages
  # xx alternatively, check all tpm's
  if ($ARGV[0] eq "--check") {
    $OPT{"verbose"} = 0;

    # xx but for now, just check the few packages we have worked with.
    @ARGV = (
       "12many", "ESIEEcv", "GuIT", "HA-prosper", "IEEEconf", "IEEEtran",
       "MemoirChapStyles", "SIstyle", "SIunits", "Tabbing", "Type1fonts",
       "a0poster", "aastex", "abbr", "abstract",
#"abstyles", not updated, but too old to matter
       "accfonts", "acronym", "algorithm2e", "algorithms",
         "amsldoc-it", "amsthdoc-it", "apacite", "arabtex",
         "archaic", "arev", "ascii", "aurical",
       "babel", "babelbib", "beamer-tut-pt", "beebe", "betababel",
         "bezos", "bghyphen", "bibhtml",
         "bibleref", "blacklettert1", "booklet", "boxhandler",
         "breakurl", "bytefield" ,
       "caption", "carlisle", "cbcoptic", "changebar", "chappg",
         "chemcompounds", "circ", "cjhebrew", "clock", "colortbl", "commath",
         "complexity", "comprehensive", "computational-complexity",
         "csquotes", "cursolatex", "curve", "curves",
       "dateiliste", "datetime", "devanagr", "dk-bib", "doipubmed", "dottex",
         "draftwatermark", "dtxtut",
       "ednotes", "elpres", "emulateapj", "endfloat", "endheads", "enumitem",
         "etaremune", "esint",
         "esint-type1", "ethiop", "europecv", "everypage", "exercise",
         "exteps", "extpfeil",
       "faktor", "featpost", "fixme", "flagderiv", "flippdf", "floatflt",
         "floatrow", "flowfram", 
         "fltpoint", "fmtcount", "fncychap", "fontspec", "formular",
         "fourier", "free-math-font-survey", "frenchle",
       "genmisc", "glossary", "gnuplottex", "gost", "graphics",
         "graphicx-psmin",
       "hrlatex", "hyphen-base", "hyphen-basque", "hyphen-german",
         "hyphen-greek", "hyphen-norwegian", "hyphen-ukenglish",
         "hyphen-usorbian",
       "ibygrk", "ifxetex", "iopart-num",
       "jneurosci", "juramisc",
       "koma-script",
       "l2picfaq", "l2tabu-english",
         "labelcas", "ledmac", "lewis", "lfb", "lh", "lineno", "listings",
         "lshort-bulgarian", "lshort-dutch", "lshort-english",
         "lshort-finnish", "lshort-french",  "lshort-german", 
         "lshort-italian", "lshort-japanese", "lshort-korean", 
         "lshort-mongolian", "lshort-polish", "lshort-portuguese", 
#"lshort-russian", # only zip files on CTAN
         "lshort-slovak", "lshort-spanish", 
         "lshort-thai", "lshort-ukrainian", "lshort-vietnamese",
         "ltabptch", "ltxmisc",
#"malayalam", # missing C sources on CTAN, wrote author 5jun05.
#"mathspic", # inside pictex, later
       "makecell", "makeplot", "mathmode", "mcaption", "memoir", "mfpic",
         "mhchem", "minitoc", "microtype", "minitoc", "mla-paper",
         "moderncv", "movie15", "muthesis",
#"mpattern", # not up-to-date on CTAN, wrote author 28may05.
       "nag", "ncclatex", "ncctools", "newlfm", "noitcrul",
         "nomencl", "nomentbl", "numprint", 
       "oberdiek", "octavo",
       "pauldoc", "pdf-trans", "pdfcprot", "pdftex-def", "perception",
         "perltex", "pgf", "pictex", "placeins", 
#"plnfss", # only a zip file on CTAN
         "polynom", "poemscol", "powerdot", "powerdot-doc-vn",
         "ppr-prv", "preview", "proof", "pstricks", "pstricks-add",
         "pst-3d", "pst-barcode", "pst-blur", "pst-eucl", "pst-func",
         "pst-labo", "pst-lens", "pst-osci", "pst-pdf", "pst-pdgr", "pst-slpe",
       "qtree",
       "randbild", "robustcommand",
       "sciposter", "sectionbox", "sectsty", "semantic",
         "seminar", "semioneside",
         "setspace", "sf298", "sides", "skaknew", "sort-by-letters",
         "sparklines", "spotcolor",
         "sttools", "struktex", "subfig", "sudoku", "svn-multi", "svninfo",
       "t-angles", "tabulary", "talk", "tamethebeast", "tex-refs",
         "texmate", "texshade", 
         "textcase", "textpos", "thesis-titlepage-fhac", "thumbpdf",
         "titlesec", "tokenizer", "totpages", "trajan", "tugboat",
         "twoup", "typedref",
       "velthuis", "verse", "vhistory", "volumes",
       "wordlike", "wrapfig",
       "xltxtra", "xypic-tut-pt",
       "york-thesis",
       "xcolor", "xkeyval"
    ); 
  }

  my $errcount = 0;
  for my $tpm (@ARGV) {
    
    # look in our various hierarchies.
    my $found = "";
    for my $dir ("texmf-dist", "texmf-doc", "texmf") {
      my $try = "$dir/tpm/$tpm.tpm";
      if (-r $try) {
        $found = $try;
        last;
      }
    }
    
    if ($found) {
      print "checking $tpm..." if $OPT{"verbose"};
      $errcount += &do_tpm ($found);
    } else {
      warn "$0: cannot find tpm file $tpm\n";
      $errcount++;
    }
  }
  return $errcount;
}



# Return 1 if TPM needs updating, 0 if ok.
# 
sub do_tpm
{
  my ($tpm) = @_;
  my $needed = 0;
  
  my %tpm = &read_tpm ($tpm);
  my @tpm_files = @{$tpm{"files"}};

  my @compared = ();
  for my $file (@tpm_files) {
#warn "checking file $file\n";
    my $tl_file = "$TL/$file";
    if (! -e $tl_file) {
      warn "$tl_file: TL file missing\n";
      next;
    }
    
    (my $basefile = $file) =~ s,^.*/,,;
    chomp (my @ctan_files = `find $tpm{CTANdir}/ -name $basefile`);
#warn "ctan find $basefile: @ctan_files\n";
    # the trailing / is so if we happen to hit a symlink on CTAN, it'll
    # go through.
    next if @ctan_files > 1; # if more than one file by same name, skip

    my $ctan_file = $ctan_files[0];
#warn "ctan file is $ctan_file\n";
    if (! -e $ctan_file) {
      # maybe it'll be there with a case change in the name
      chomp (@ctan_files = `find $tpm{CTANdir}/ -iname $basefile`);
      next if @ctan_files > 1; # if more than one file by same name, skip
      $ctan_file = $ctan_files[0];
      
      if (! -e $ctan_file) {
        # we generate lots of files, eg perlmacros.sty, so might skip.
        warn "$ctan_file: CTAN file missing\n"
        if $ctan_file && $ctan_file !~ /(cfg|dvi|sty|tex)$/;
        next;
      }
    }

    push (@compared, $basefile);
    if (&files_differ ($tl_file, $ctan_file)) {
      # we sometimes regenerate pdf's for TL, so we don't complain if
      # they are different.  On the other hand, we don't always
      # regenerate them, so might as well check first.
      next if $tl_file =~ /\.pdf$/;

      print "# $tpm\ndiff $ctan_file $tl_file\n";
      $needed = 1;
      last;
    }
  }
  
  # xx check ctan dir for new files
  
  if (@compared == 0) {
    warn "\n$tpm: no files to compare in $tpm{CTANdir}, fixme!\n";
    warn "(tpm_files = @tpm_files)\n";
  } elsif ($needed == 0) {
    print "ok, " . (@compared + 0) . " compared (@compared)\n"
      if $OPT{"verbose"};
  }

  return $needed;
}



# Return useful information from a TPM.
# 
sub read_tpm
{
  my ($tpm) = @_;
  my %ret;
  
  local *TPM;
  open (TPM, $tpm) || die "open($tpm) failed: $!\n";

  my @files = ();
  while (<TPM>) {
    if (m!</TPM:.*Files!) {  # might be on same line
      $collecting = 0;
    } elsif (/<TPM:.*Files/) {
      $collecting = 1;
      next;
    }
    if ($collecting) {
      chomp;
      next if m,plain/tugboat,;  # have to rely on latex tugboat,
                                 # plain tugboat README conflicts
      push (@files, $_) if $_ !~ /\.tpm$/;
    }
  }
  close (TPM) || warn "close($tpm) failed: $!\n";

  warn "$tpm: no files found\n" if ! @files;  # probably misparsed the tpm
  $ret{"files"} = \@files;

  (my $me = $tpm) =~ s,.*/,,;
  $me =~ s/\.tpm$//;
  chomp (my $ctan_dir = `$mydir/tlpkginfo --ctan-dir '$me'`);

  die "$0: no CTAN directory for $me\n" if ! $ctan_dir;
  $ret{"CTANdir"} = $ctan_dir;
  
  return %ret;
}



# 0 if files are the same, 1 if they are different.
# 
sub files_differ
{
  my ($tl_file,$ctan_file) = @_;
#warn "comparing $tl_file $ctan_file\n";
  
  my $different = 0;
  if (-s $tl_file != -s $ctan_file) {
    # sometimes what's checked into CTAN vs. TL differs in the eol
    # conventions.  Don't worry about that.
    if (system ("diff -q --strip-trailing-cr $tl_file $ctan_file >/dev/null")
        != 0) {
      $different = 1;
    }
  }

  return $different;
}