#!/usr/bin/perl # $Id$ use strict; use warnings; use File::Find; use Getopt::Long; use Pod::Usage; GetOptions( 'all-name' => \my $allname, 'with-gnome' => \my $withgnome, 'with-kde' => \my $withkde, 'with-html' => \my $withhtml, 'without-mo' => \my $withoutmo, 'with-man' => \my $withman, 'debug' => \my $debug, ) or pod2usage(); my ($buildroot, @searchname) = @ARGV; $buildroot or die "No buildroot given\n"; $buildroot =~ s:/+$::; # removing trailing / my ($pkgname) = @searchname or die "Main name to find missing\n"; sub debug { $debug or return; my ($msg, @val) = @_; printf("DEBUG: $msg\n", @val); } my %finallist; # filename => attr, easy way to perform uniq File::Find::find( sub { my $file = substr($File::Find::name, length($buildroot)); -f $File::Find::name or -l $File::Find::name or return; debug("next file is %s", $file); my $langfile = $file; if ($file =~ m:^((.*/share/locale)/([^/@]+)[^/]*).*/([^/]+)\.mo:) { if ($withoutmo) { return; } my ($pkg, $lang, $parent, $langfile) = ($4, $3, $2, $1); if (pkg_match($pkg)) { own_file($file, $lang); } } elsif ($file =~ m:^((.*/gnome/help)/([^/]+)/([^/]+)).*:) { if (!$withgnome) { return; } my ($pkg, $lang, $parent, $langfile) = ($3, $4, $2, $1); if (pkg_match($pkg)) { parent_to_own($langfile, $file, $lang); } } elsif ($file =~ m:^((.*/doc/kde)/HTML/([^/@]+)[^/]*)/([^/]+)/.*:) { if (!$withkde) { return; } my ($pkg, $lang, $parent, $langfile) = ($4, $3, $2, $1); if (pkg_match($pkg)) { parent_to_own($langfile, $file, $lang); } } elsif ($file =~ m:^((.*/doc)/HTML/([^/@]+)[^/]*)/([^/_]+).*:) { if (!$withhtml) { return; } my ($pkg, $lang, $parent, $langfile) = ($4, $3, $2, $1); if (pkg_match($pkg)) { parent_to_own($langfile, $file, $lang); } } elsif ($file =~ m:^((/+usr/share/man)/([^/@\.]+)[^/]*)/man[^/]+/([^/.]+)\.\d[^/]*:) { if (!$withman) { return; } my ($pkg, $lang, $parent, $langfile) = ($4, $3, undef, $1); $file =~ s/\.[^\.]+$//; $file .= '.*'; if (pkg_match($pkg)) { parent_to_own($langfile, $file, $lang); } } else { return; } }, $buildroot || '/' ); open(my $hlang, '>', "$pkgname.lang") or die "canno't open $pkgname.lang\n"; foreach my $f (sort keys %finallist) { my ($lang, @otherlang) = keys %{ $finallist{$f}{'lang'} || {}}; my $l = sprintf("%s%s%s", $finallist{$f}{'dir'} ? '%dir ' : '', @otherlang == 0 && $lang && $lang ne 'C' ? "%lang($lang) " : '', # skip if multiple lang, 'C' or dir $f ); debug('OUT: %s', $l); print $hlang "$l\n"; } close($hlang); exit(0); sub pkg_match { my ($pkg) = @_; if ($allname) { return 1 }; if (grep { $_ eq $pkg } @searchname) { return 1; } return; } sub own_file { my ($file, $lang) = @_; $finallist{$file}{'lang'}{$lang} = 1; } sub parent_to_own { my ($parent, $file, $lang) = @_; debug("parent_to_own: $parent, $file, $lang"); if ($allname) { #my @subdir = grep { $_ } split('/', substr($file, length($parent))); #$parent .= '/' . shift(@subdir); $finallist{$parent}{'lang'}{$lang} = 1; debug("Parent %s will be %s", $parent, $lang); } else { my @subdir = grep { $_ } split('/', substr($file, length($parent))); pop(@subdir); $finallist{$parent}{dir} = 1; $finallist{$parent}{'lang'}{$lang} = 1; debug("Parent %s will be %s", $parent, $lang); while (my $part = shift(@subdir)) { $parent .= "/$part"; $finallist{$parent}{dir} = 1; $finallist{$parent}{'lang'}{$lang} = 1; debug("Parent %s will be %s", $parent, $lang); } own_file($file, $lang); debug("Parent %s will be %s", $file, $lang); } }