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