ddp/manpages/gen_db.pl

#!/usr/bin/perl -w

use strict;
use Getopt::Long;
use IO::Handle;
use File::Find;

#    These modules reside under webwml/Perl
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/../webwml/Perl";
use Webwml::L10n::Db;

our ($verbose, $MANDB_FILE);

$MANDB_FILE = 'mandb';

Getopt::Long::Configure("no_ignore_case", "bundling");
GetOptions(
        'verbose|v' => \$verbose,
        'o|output=s' => \$MANDB_FILE,
);

my $mandata = Webwml::L10n::Db->new();

sub get_infos {
        return unless $_ eq 'INFOS';
        my $pkg = $File::Find::dir;
        $pkg =~ s#^./(.*)/##;
        my $lang = $1;

        unless ($mandata->has_package($pkg)) {
                $mandata->package($pkg, $pkg);
                $mandata->version($pkg, 1);
                $mandata->maintainer($pkg, 1);
                $mandata->section($pkg, 1);
                $mandata->priority($pkg, 1);
                $mandata->pooldir($pkg, 1);
                $mandata->type($pkg, 1);
                $mandata->upstream($pkg, 1);
        };

        open (INFOS, "< INFOS");
        my ($manpage, $location, $line);
        while ($line = <INFOS>) {
                $line =~ s/\s*$//s;
                if ($line eq '') {
                        $mandata->add_man($pkg, $manpage, $lang, $location);
                        $manpage = $location = '';
                } elsif ($line =~ s/^manpage:\s*//i) {
                        $manpage = $line;
                } elsif ($line =~ s/^location:\s*//i) {
                        $location = $line;
                } elsif ($line =~ s/^Build-Source:\s*//i) {
                        $location = $line;
                }
        }
        $mandata->add_man($pkg, $manpage, $lang, $location) if $manpage;
        close (INFOS);
}

File::Find::find(\&get_infos, '.');

$mandata->write($MANDB_FILE);
1;
1	barbier	46	#!/usr/bin/perl -w
2
3			use strict;
4			use Getopt::Long;
5			use IO::Handle;
6			use File::Find;
7
8			# These modules reside under webwml/Perl
9			use lib ($0 =~ m\|(.*)/\|, $1 or ".") ."/../webwml/Perl";
10			use Webwml::L10n::Db;
11
12			our ($verbose, $MANDB_FILE);
13
14			$MANDB_FILE = 'mandb';
15
16			Getopt::Long::Configure("no_ignore_case", "bundling");
17			GetOptions(
18			'verbose\|v' => \$verbose,
19			'o\|output=s' => \$MANDB_FILE,
20			);
21
22			my $mandata = Webwml::L10n::Db->new();
23
24			sub get_infos {
25			return unless $_ eq 'INFOS';
26			my $pkg = $File::Find::dir;
27			$pkg =~ s#^./(.*)/##;
28			my $lang = $1;
29
30			unless ($mandata->has_package($pkg)) {
31			$mandata->package($pkg, $pkg);
32			$mandata->version($pkg, 1);
33			$mandata->maintainer($pkg, 1);
34			$mandata->section($pkg, 1);
35			$mandata->priority($pkg, 1);
36			$mandata->pooldir($pkg, 1);
37			$mandata->type($pkg, 1);
38			$mandata->upstream($pkg, 1);
39			};
40
41			open (INFOS, "< INFOS");
42			my ($manpage, $location, $line);
43			while ($line = <INFOS>) {
44			$line =~ s/\s*$//s;
45			if ($line eq '') {
46			$mandata->add_man($pkg, $manpage, $lang, $location);
47			$manpage = $location = '';
48			} elsif ($line =~ s/^manpage:\s*//i) {
49			$manpage = $line;
50			} elsif ($line =~ s/^location:\s*//i) {
51			$location = $line;
52			} elsif ($line =~ s/^Build-Source:\s*//i) {
53			$location = $line;
54			}
55			}
56			$mandata->add_man($pkg, $manpage, $lang, $location) if $manpage;
57			close (INFOS);
58			}
59
60			File::Find::find(\&get_infos, '.');
61
62			$mandata->write($MANDB_FILE);
63			1;