#!/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 ESIEEcv GuIT HA-prosper IEEEconf IEEEtran
       MemoirChapStyles SIstyle SIunits Tabbing Type1fonts
       a0poster aastex abbr abc abstract
       accfonts acronym active-conf aguplus algorithm2e algorithms
         algorithmicx 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 bigfoot birthday blacklettert1 booklet boxhandler
         breakurl bussproofs bytefield 
       caption carlisle cbcoptic cellspace changebar chappg
         chemcompounds circ cjhebrew clock cmll colortbl commath
         complexity comprehensive computational-complexity cool coollist
         coolstr cooltooltips coverpage
         csquotes cursolatex ctable curve curve2e curves cyrillic
       dateiliste datetime dk-bib doipubmed dottex
         draftwatermark dtxtut dvdcoll dvipsconfig dyntree
       ebong economic ednotes egameps eijkhout elpres emulateapj
         elsevier endfloat endheads enumitem es-tex-faq
         esint esint-type1 eskdx eso-pic etaremune ethiop europecv
         everypage examdesign exercise exteps extpfeil
       faktor fancyhdr fancynum fax featpost fixme flagderiv flippdf floatflt
         floatrow flowfram 
         fltpoint fmtcount fncychap foekfont fontch fontspec forloop formular
         fourier free-math-font-survey frenchle
       galois genmisc genmpage glossary gnuplottex gost graphics
         graphicx-psmin grnumalt
       hepthesis hhtensor hrlatex hyperref hyplain 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 lkproof 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
         ltabptch ltxmisc
       mafr magyar makecell makeplot marginnote mathdots mathmode
         mcaption mdwtools
         memoir mentis metauml mfpic
         mhchem minipage-marginpar minitoc microtype minitoc mla-paper
         moderncv movie15 msg munich muthesis
       nag natbib ncclatex ncctools newlfm nih noitcrul
         nomencl nomentbl ntheorem-vn numprint 
       oberdiek ocr-latex octavo opcit
       pauldoc pdf-trans pdfcprot pdfpages pdftex-def perception
         perltex pgf pictex pict2e placeins plari
         polynom poemscol powerdot 
         ppr-prv pracjourn preview probsoln psfrag psnfss pstricks
         pstricks-add
         pst-3d pst-3dplot 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 refstyle robustcommand rtklage
       sciposter screenplay sectionbox sectsty semantic
         seminar semioneside
         setspace sf298 sgame shapepar showexpl sides skaknew songbook
         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 ticket
         titlesec tokenizer tools totpages trajan tugboat
         twoup typedref
       ucthesis uhrzeit uiucthesis
         umlaute umich-thesis underlin undertilde units unitsdef 
	 upquote ushort
       vancouver variations varindex vector velthuis verse versions 
       vhistory visualfaq vmargin volumes vpe
       wallpaper warning warpcol
       williams wordlike wrapfig
       xifthen xltxtra xq xyling xypic-tut-pt xytree
       york-thesis
       xcolor xkeyval xtab
    ); 
#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



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