1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
#!/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 there is no obsolete manpage
#TODO: check if all manpages are in po4a config file
#TODO: check the symlinks
#TODO: unhardcode this list
my @packages = ("at","bash","coreutils","cron","diffutils","e2fsprogs","findutils",
"glibc","grep","lilo","most","nfs-utils","procps","tar",
"util-linux");
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/unstable/$section/binary-i386/Packages.gz"))
or die "Unable to fetch $section source\n";
$sources .= Compress::Zlib::memGunzip($answer->content) ;
print STDERR "done\n";
}
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) {
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);
$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;
}
|
