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.
    # xx don't check babel, heiko patched it.
    @ARGV = qw(
       12many ESIEEcv GuIT HA-prosper IEEEconf IEEEtran
       MemoirChapStyles SIstyle SIunits Tabbing Type1fonts
       a0poster aastex abbr abc abstract
       accfonts acronym algorithm2e algorithms
         ams amscls amsldoc-it amsltx2 amsmath amsrefs amsthdoc-it
         apacite arabtex
         archaic arev armenian ascii aurical
       babelbib beamer-tut-pt beebe betababel
         bezos bghyphen bibhtml
         bibleref bigfoot blacklettert1 booklet boxhandler
         breakurl bytefield 
       caption carlisle cbcoptic cellspace changebar chappg
         chemcompounds circ cjhebrew clock cmll colortbl commath
         complexity comprehensive computational-complexity coollist
         cooltooltips coverpage
         csquotes cursolatex ctable curve curve2e curves cyrillic
       dateiliste datetime devanagr dk-bib doipubmed dottex
         draftwatermark dtxtut dvipsconfig dyntree
       ednotes elpres emulateapj elsevier endfloat endheads enumitem
         esint esint-type1 eskdx eso-pic etaremune ethiop europecv
         everypage exercise exteps extpfeil
       faktor featpost fixme flagderiv flippdf floatflt
         floatrow flowfram 
         fltpoint fmtcount fncychap fontch fontspec formular
         fourier free-math-font-survey frenchle
       galois genmisc glossary gnuplottex gost graphics
         graphicx-psmin
       hepthesis hrlatex hyperref hyphen-base hyphen-basque hyphen-german
         hyphen-greek hyphen-norwegian hyphen-ukenglish
         hyphen-usorbian
       ibygrk icsv ifxetex iopart-num
       jneurosci juramisc
       koma-script
       l2picfaq l2tabu-english
         labelcas latex latex-tds ledmac lewis lfb lh linearA lineno listings lsc
         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-slovak lshort-spanish 
         lshort-thai lshort-ukrainian lshort-vietnamese
         ltabptch ltxmisc
       makecell makeplot mathdots mathmode mcaption
         memoir mentis metauml mfpic
         mhchem minipage-marginpar minitoc microtype minitoc mla-paper
         moderncv movie15 munich muthesis
       nag natbib ncclatex ncctools newlfm noitcrul
         nomencl nomentbl ntheorem-vn numprint 
       oberdiek octavo
       pauldoc pdf-trans pdfcprot pdfpages pdftex-def perception
         perltex pgf pictex pict2e placeins 
         polynom poemscol powerdot powerdot-doc-vn
         ppr-prv pracjourn preview probsoln proof psnfss pstricks pstricks-add
         pst-3d pst-barcode pst-blur pst-eucl pst-func
         pst-labo pst-lens pst-optic pst-osci pst-pdf pst-pdgr pst-slpe
         pst-uml
       qtree
       randbild robustcommand
       sciposter sectionbox sectsty semantic
         seminar semioneside
         setspace sf298 shapepar showexpl sides skaknew
         sort-by-letters sparklines splitindex spotcolor stellenbosch
         sttools struktex subfig sudoku sudokubundle sugconf svn-multi
         svninfo syntrace synttree
       t-angles tabulary tabvar talk tamethebeast tengwarscript tex-refs
         texmate texshade 
         textcase textpos thesis-titlepage-fhac thumbpdf
         titlesec tokenizer tools totpages trajan tugboat
         twoup typedref
       vancouver velthuis verse vhistory visualfaq volumes vpe
       wordlike wrapfig
       xifthen xltxtra xypic-tut-pt xytree
       york-thesis
       xcolor xkeyval
    ); 
#abstyles not updated but too old to matter
#lshort-russian # only zip files on CTAN
#malayalam # missing C sources on CTAN wrote author 5jun05.
#mathspic # inside pictex later
#mpattern # not up-to-date on CTAN wrote author 28may05.
#plnfss # only a zip file on CTAN
  }

  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;
}