#!/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;

my @WorkingTPM = qw(
        12many
        a0poster aastex abbr abc abstract accfonts acmtrans acronym
          active-conf aguplus algorithm2e algorithmicx algorithms
          alnumsec ams amscls amsldoc-it amsltx2 amsmath amsrefs
          amsthdoc-it apacite appendix arabtex archaic arcs arev
          armenian arrayjob arydshln ascii assignment attachfile
          aurical
        babelbib beamer beamer-tut-pt beebe begriff betababel bezos
          bghyphen bibhtml bibleref bibtopic bibunits bigfoot
          birthday 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 cool coollist coolstr cooltooltips
          coordsys courier-scaled courseoutline coursepaper coverpage
          crop csquotes ctable cursolatex curve curve2e curves
          custom-bib cvsty cyrillic
        dancers dashbox dateiliste datetime dcpic decimal digiconfigs
          dinat dingbat directory dk-bib doipubmed dottex dpfloat
          draftwatermark dramatist dtxtut dvdcoll dvipsconfig dyntree
        ebong ebsthesis eCards economic ednotes eemeir egameps egplot eijkhout
          ellipsis elpres elsevier emulateapj endfloat endheads
          engrec enumitem envbig epiolmec epsf 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 fax featpost filecontents fixme
          flagderiv flippdf 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 gnuplottex gost graphics graphicx-psmin greenpoint
          grnumalt GuIT
        HA-prosper hands hepthesis hhtensor histogr hitec hrlatex hvfloat
          hyperref hyperxmp hyphen-base hyphen-basque hyphen-german
          hyphen-greek hyphen-norwegian hyphen-ukenglish
          hyphen-usorbian hyplain
        ibygrk icsv IEEEconf IEEEtran ifxetex 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 leawood ledmac lewis lfb lgreek lh
          limap linearA lineno lipsum listings listliketab lkproof
          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 minitoc mla-paper
          moderncv movie15 msg 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 opcit osa
        papercdcase paresse parrun pauldoc pdf-trans pdfcprot
          pdfpages pdfscreen pdftex-def perception perltex permute
          pgf phaistos pict2e pictex 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-eucl pst-fr3d pst-func 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 subfloat substr sudoku
          sudokubundle sugconf supertabular svn svn-multi svninfo
          swebib syntax syntrace synttree
        t-angles Tabbing tableaux tabulary tabvar talk tamethebeast
          tengwarscript tensor teubner tex-refs texmate texshade
          textcase textfit textopo textpos thesis-titlepage-fhac
          thumb thumbpdf ticket titlefoot titlesec titling tocbibind
          tocloft todo tokenizer toolbox tools totpages tracking
          trajan trfsigns trsym tugboat twoup Type1fonts typedref
          typogrid
        ucthesis uhrzeit uiucthesis umich-thesis 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 xltxtra xq xtab xyling xypic-tut-pt
          xytree
        york-thesis
    ); 
#abstyles not updated but too old to matter
#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!
#subfigure	# installs ltxdoc.cfg!!!
#shortlst	# works, but license: no profit! needs catalogue update
#sae		# works, no profit license!



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