#!/usr/bin/perl -w

# manpages-watch -- Check updateness of manpages
#
# Copyright (C) 2006 Thomas Huriaux <thomas.huriaux@gmail.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
#
# This small script gets the version of every translated package that
# is in the archive, compares it to the one in the svn (by using
# <pkg>/VERSION), fetches the binary packages if needed, copy the
# new manpages in the appropriate directory and bump the VERSION files.
# Run a 'make clean' and commit the changes to finish the job.

use strict;
use Mail::Header;
use LWP::UserAgent;
use Compress::Zlib;
use File::Temp;
use File::Copy;

#TODO: check if all manpages are in po4a config file
#TODO: check the symlinks


#TODO: unhardcode this list
my @packages = ("at","bash","coreutils","cron","ddate","diffutils","dosfstools","e2fsprogs","findutils","glibc",
                "grep","lilo","most","nfs-utils","procps","reiser4progs","reiserfsprogs","startpar",
		"sysvinit","tar","util-linux","x11-xserver-utils");

my $new_versions = {};

my $Web_agent =  LWP::UserAgent -> new;
my $sources = "";
foreach my $section ("main","contrib","non-free") {
  print STDERR "Fetching source file of $section...";
  my $answer = $Web_agent->request(HTTP::Request->new(GET => "http://ftp.fr.debian.org/debian/dists/testing/$section/binary-i386/Packages.gz"))
      or die "Unable to fetch $section source\n";
  $sources .= Compress::Zlib::memGunzip($answer->content) ;
  print STDERR "done\n";
}

# List the source packages whose directory was already cleaned
# from old pages.
my %clean;

open (INDEX, "<", \$sources);
while (1) {
  my $reader = new Mail::Header \*INDEX;
  last unless($reader->get("Package"));
  my ($pkg, $source) = ($reader->get("Package"), $reader->get("Source"));
  $source = $pkg if (not defined $source);
  chomp($pkg, $source);
  my $version;
  if ($source =~ /^(\S+) \(([^)]+)\)$/) {
    ($source, $version) = ($1,$2);
  } else  {
    $version = $reader->get("Version");
  }
  my $pkgregexp = quotemeta($source);
  next unless(grep ( /^$pkgregexp$/, @packages));
  my $filename = $reader->get("Filename");
  chomp($version, $filename);
  $version =~ s/(-[^+])\+.*$/$1/;
  $new_versions->{$source} = $version;
  open (VERSION, "$source/VERSION");
  my $translated=<VERSION>;
  close (VERSION);
  chomp($translated);
  if ($translated ne $version) {
    unless ($clean{$source}) {
        print "Removing old manpages for $source\n";
        system ("rm -f $source/C/man[0-9]/*.[0-9]");
        $clean{$source} = 1;
    }
    print "Syncing $pkg ($source) with $version\n";
    parse_binary($source, $filename);
  }
}
close (INDEX);

foreach my $pkg (sort keys %$new_versions) {
  open (VERSION, ">$pkg/VERSION");
  print VERSION "$new_versions->{$pkg}\n";
  close VERSION;
}

sub parse_binary {
  my ($source, $filename) = (shift, shift, shift, shift);
  my $pkg = $source;
  $pkg =~ s/\/([^\/]+)$/$1/;
  my $tmpdir = mkdtemp("labXXXXXX");
  my $answer = $Web_agent->request(HTTP::Request->new(GET => "http://ftp.fr.debian.org/debian/$filename"));
  open (PACKAGE,">$tmpdir/$pkg");
  print PACKAGE $answer->content;
  close (PACKAGE);
  system ("dpkg -x $tmpdir/$pkg $tmpdir");
  process_mandir($tmpdir, $source);
  File::Path::rmtree($tmpdir);
}

sub process_mandir {
  my ($curdir, $source) = (shift, shift);
  $curdir .= "/usr/share/man/";
  return unless (-d $curdir);
  opendir DIR, $curdir or die "Cannot open directory $curdir";
  my @allfiles = grep !/^\.\.?$/, readdir DIR;
  closedir DIR;
  foreach my $section (@allfiles) {
    process_section($curdir, $section, $source);
  }
}

sub process_section {
  my ($curdir, $section, $source) = (shift, shift, shift);
  if ($section !~ m/^man/) {
    warn "Ignoring manpage from section $section";
    return;
  }
  $curdir = "$curdir/$section";
  opendir DIR, $curdir or die "Cannot open directory $curdir";
  foreach my $man (grep !/^\.\.?$/, readdir DIR) {
    next if (-l "$curdir/$man");
    my $dest_man = $man;
    $dest_man =~ s/\.gz$//;
    open(MAN,">$source/C/$section/$dest_man")
       or die "Failed to write in $source/C/$section/$dest_man";
    my $buffer;
    my $gz = gzopen("$curdir/$man", "rb");
    print MAN $buffer while $gz->gzread($buffer) > 0;
    $gz->gzclose();
    close MAN;
  }
  closedir DIR;
}
