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

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

use File::Basename;

# euenc
my @WorkingTPM = qw(
        12many
        a0poster aastex abbr abc abstract accfonts acmtrans acronym
          active-conf aguplus algorithm2e algorithmicx algorithms
          alnumsec altfont ams amsldoc-it amsrefs
          amsthdoc-it apacite appendix arabi arabtex archaic arcs arev
          armenian arrayjob arydshln ascii assignment attachfile
          aurical auto-pst-pdf
        babelbib beamer beamer-tut-pt begriff bera betababel
          bezos bghyphen bibhtml bibleref bibtopic bibunits bigfoot
          bitfield blacklettert1 blindtext booklet bophook
          boxhandler breakurl bussproofs bytefield 
        caption carlisle cbcoptic ccaption cdpbundl cellspace
          changebar chappg chem-journal chemcompounds cherokee circ
          citeref cjhebrew clefval clock cmdtrack cmll colorinfo
          colortbl commath compactbib complexity comprehensive
          computational-complexity cooking cool coollist coolstr cooltooltips
          coordsys courier-scaled courseoutline coursepaper coverpage
          crop csquotes ctable cursolatex cuisine currvita curve curve2e curves
          custom-bib cvsty cyrillic
        dancers dashbox dateiliste datetime dcpic decimal digiconfigs
          dinat dingbat directory dk-bib doipubmed dottex doublestroke dpfloat
          draftwatermark dramatist dtxtut dvdcoll dvipsconfig dyntree
        ebong ebsthesis eCards economic ednotes eemeir egameps egplot eijkhout
          ellipsis elpres elsevier elsevier-bib emulateapj endfloat endheads
          engrec enumitem envbig epiolmec eplain
          epsf epslatex-fr eqparbox es-tex-faq
          ESIEEcv esint esint-type1 eskd eskdx eso-pic etaremune
          ethiop ethiop-t1 euro europecv eurosans everypage exam
          examdesign examplep exercise expressg extarrows exteps
          extpfeil extract extsizes
        faktor fancyhdr fancynum fancyref fax featpost filecontents fixme
          flagderiv flippdf float floatflt floatrow flowfram fltpoint
          fmtcount fncychap foekfont fontch fontspec footbib forloop formular
          fourier fp free-math-font-survey frenchle fribrief fullpict functan
        galois gatech-thesis genmisc genmpage germbib ginpenc
          glossary gmdoc gmiflink gmutils gmverb gnuplottex gost graphics
          graphicx-psmin greenpoint
          grnumalt GuIT
        HA-prosper hands hepthesis hhtensor histogr hitec hrlatex hvfloat
          hyperref hyperxmp hyphen-base hyphen-basque
          hyphen-french hyphen-german
          hyphen-greek hyphen-norwegian hyphen-ukenglish
          hyphen-usorbian hyplain
        ibygrk icsv IEEEconf IEEEtran ifxetex ijqc inlinebib invoice
          iopart-num isorot isotope
        jneurosci jpsj jurabib juramisc
        kalender kerkis keystroke koma-script
        l2picfaq l2tabu-english labelcas labels latex latex-tds
          layouts lcd lcg leaflet ledmac lewis lfb lgreek lh
          limap linearA lineno lipsum listings listliketab lkproof lm
          logpap 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-turkish lshort-ukrainian
          lshort-vietnamese ltablex ltabptch ltxindex ltxmisc
        mafr magyar mailing makebox makecell makecirc makeglos
          makeplot maple marginnote mathdots mathmode maybemath
          mcaption mceinleger mdwtools memoir MemoirChapStyles mentis
          menu metaobj metaplot metatex metauml mfpic mftinc mhchem
          mhs microtype minipage-marginpar minitoc mla-paper
          moderncv moreverb movie15 msg mt11p multicap munich muthesis
          mwcls mwrite
        nag natbib nath nature ncclatex ncctools newlfm nih noitcrul
          nomencl nomentbl ntgclass ntheorem-vn numline numprint
        oberdiek ocr-latex octavo ofs ogham oldstyle onlyamsmath opcit osa
        papercdcase paresse parrun pauldoc pdf-trans pdfcprot
          pdfpages pdfscreen pdftex-def perception perltex permute
          pgf phaistos pict2e pictex pictex2 pittetd placeins plari plates
          poemscol polynom polytable powerdot ppr-prv pracjourn preprint
          prettyref preview probsoln procIAGssymp program protocol pseudocode
          psfrag psnfss pspicture pst-3d pst-3dplot pst-bar
          pst-barcode pst-blur pst-eps pst-eucl pst-fill pst-fr3d pst-func
          pst-geo pst-grad pst-infixplot pst-labo
          pst-lens pst-math pst-optic pst-osci pst-pdf pst-pdgr
          pst-slpe pst-uml pstricks pstricks-add
        qcm qtree
        randbild rccol rcsinfo refstyle regcount register resume robustcommand
          robustindex rsc rtkinenc rtklage
        sae sauerj sauterfonts savefnmark savesym savetrees scale
          scalebar scientificpaper sciposter screenplay script
          sectionbox sectsty semantic semaphor seminar semioneside
          seqsplit setspace sf298 sffms sgame shadbox shapepar
          shorttoc showdim showexpl showlabels sidecap sides siggraph
          SIstyle SIunits skaknew slideshow smalltableof smartref
          snapshot songbook sort-by-letters soul sparklines spie
          splines splitbib splitindex spotcolor sprite srcltx sseq
          ssqquote stack stage stdclsdv stdpage stellenbosch struktex
          sttools subeqn subeqnarray subfig subfigure subfloat substr sudoku
          sudokubundle sugconf supertabular svgcolor svn svn-multi svninfo
          swebib syntax syntrace synttree
        t-angles Tabbing tableaux tabulary tabvar talk tamethebeast
          tengwarscript tensor teubner tex-gyre texmate texshade
          textcase textfit textopo textpath textpos thesis-titlepage-fhac
          thumb thumbpdf ticket titlefoot titlesec titling tocbibind
          tocloft todo tokenizer toolbox tools toptesi totpages tracking
          trajan trfsigns trsym tugboat twoup Type1fonts typedref
          typogrid
        ucthesis uhrzeit uiucthesis umich-thesis uml umlaute underlin
          undertilde units unitsdef upquote ushort
        vancouver variations varindex vector velthuis verse versions
          vhistory visualfaq vmargin volumes vpe
        wallpaper warning warpcol williams wordlike wrapfig
        xcolor xifthen xkeyval xq xtab xyling xypic-tut-pt
          xytree
        york-thesis
    ); 
#abstyles not updated but too old to matter
#amscls amsltx2 amsmath - AMS packages come from tds zips, all very weird
#beebe needs more work
#euenc - xetex people don't keep ctan up to date
#logic/gn-logic14 conflicts with logic font
#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
#slidenotes		# non-free: ALl rights reserved, nothing else!
#shortlst	# works, but license: no profit! needs catalogue update
#sae		# works, no profit license!
#xltxtra - xetex people don't keep ctan up to date

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;
  
  if ($ARGV[0] eq "--list-not-treated-tpm") {
    @AllTPM = glob("{texmf-dist,texmf-doc,texmf}/tpm/*.tpm");
    my @nottreatedtpm=();
    foreach (@AllTPM) {
      my $b = basename($_,".tpm");
      my @foo = grep(/^$b$/, @WorkingTPM);
      if ($#foo < 0) { push @nottreatedtpm, $_ ; }
    }
    print "List of tpms which are not in ctan-tpm-check:\n";
    foreach (@nottreatedtpm) {
      print "$_\n";
    }
    exit 0;
  }
  # 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 = @WorkingTPM;
  }

  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);
  return 1 unless keys %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
      next if m,active-header-2006.tex,;  # ctan example conflicts with
                                          # dtx-generated file
      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'`);

  if (! $ctan_dir) {
    warn "$0: oops, no CTAN directory for $me, fix fix\n";
    return ();
  }
  $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;
}