script pour po4a

[Julien Louis <ptitlouis.nospam@ptitlouis.dyndns.org>]

Bonjour,

Je viens d'écrire un petit script pour générer un fichier de configuration pour
po4a.

Pardonnez moi si le code est un peu sale mais c'est mes débuts en Perl :)
Il n'est pas encore parfait, mais je prévois déjà de l'améliorer un peu.

Tous les retours d'expériences/patchs sont les bienvenus.

-- 
PETITE NATURE

M : J'ai tourné dans un film de cul zoophile... J'ai dû chier dans la bouche d'une nana qui se faisait enculer par un cochon... J'ai vomi...
P : Toi ?!
M : Ils avaient mis du Carlos comme musique d'ambiance...

#!/usr/bin/perl -w

# Copyright 2004 by Julien Louis <leonptitlouis@wanadoo.fr>
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of GPL (see COPYING).

use strict;
use Getopt::Mixed "nextOption";
use File::Basename qw(fileparse);
my $config_file = "po4a.cfg";
my @lang;

sub help {
	print STDERR "make_po4a usage:\n";
	print STDERR "  -c --config file   write configuration in config file\n";
	print STDERR "  -l --lang lang     write configuration for the specified
	lang separated by comas\n";
	print STDERR "  -h --help          display this help message\n";
}

# This function search manual page in directories passed in argument of the
# script. Actualy, it support manpages which ends by a section numbe (1 to 8)
# and written in pod format (perl documentation style) and sgml format.
# TODO: should make recursive searches.
sub findman {
	my $dir = shift ;
	my %files;
		opendir PACKAGE, $dir or die "Unable to open directory $dir: $!\n";
		# Find all manpages
		foreach (readdir PACKAGE) {
			(my $name, my $path, my $type) = fileparse("$_",qw{\d pod sgml});
			$files{"$name"} = $type if ($type ne "");
		}
		closedir PACKAGE;

		# Delete all translated manpages
		while (my ($key, $value) = each %files) {
			if ($key =~ /\.[a-z]{2}\.$/) {
#				print "$key > $files{$key}\n";
				delete $files{$key};
			}
		}
		return %files;
	}	

# This function make a config file for po4a.
sub write_config {
#	foreach (@_) { print "$_"; }
	my ($dir, $conffile, %files) = @_;
#	print "&write_config -> $conffile\n";
	open CONFIG, ">$dir/$conffile";
	
	# Write the po4a paths where potfiles are written.
	print CONFIG "[po4a_paths] po/" . substr($dir,0,length($dir)-1) . ".pot ";
	if (@lang) {
		foreach (@lang) {
			print CONFIG "$_:po/$_.po ";
		}
	}
	
	foreach (keys %files) {
		my $type;
#		print "$_\n";
		# set the type of the file 
		if ($files{$_} =~ /\d+/) {
			$type = "man";
		} elsif ($files{$_} =~ /pod/) {
			$type = "pod";
		} elsif ($files{$_} =~ /sgml/) {
			$type = "sgml";
		} else {
			warn "Unknown type for $_\n";
		}
		
		# Write all informations needed by po4a(1) to update po and build manpages.
		print CONFIG "\n[type: $type] ./$_" . "$files{$_} ";
		if (@lang) {
			foreach my $trans (@lang) {
				print CONFIG "$trans:./$_$trans" . ".$files{$_} ";
			}
		}
	}
}

# Parse the command line to 
Getopt::Mixed::init("l=s lang>l c=s config>c h help>h");
my $opt = my $arg = undef;
while (($opt, $arg) = nextOption()) {
	if ($opt eq "h" || $opt eq "help") {
		&help;
		exit 1;
	} elsif ($opt eq "l" || $opt eq "lang") {
			@lang = split /,/,$arg;
#		foreach (@lang) { print "$_\n"; }
	} elsif ($opt eq "c" || $opt eq "config") {
			$config_file = $arg;
#			print "$config_file\n";
	}
}
Getopt::Mixed::cleanup();
#print "$config_file\n";

# Main loop
foreach (@ARGV) {
#	print "$config_file\n";
	print "Writing po4a configuration file for " . substr($_,0,length($_)-1) .
	" package\n";
	my %manpages = &findman($_);
#	while ((my $cle, my $valeur) = each %manpages) {
#		print "  $cle => $valeur\n";
#	}
#	print "$config_file\n";
	&write_config($_, $config_file, %manpages);
}