diff options
Diffstat (limited to 'find-lang.pl')
-rwxr-xr-x | find-lang.pl | 128 |
1 files changed, 0 insertions, 128 deletions
diff --git a/find-lang.pl b/find-lang.pl deleted file mode 100755 index ba35ff9..0000000 --- a/find-lang.pl +++ /dev/null @@ -1,128 +0,0 @@ -#!/usr/bin/perl - -# $Id: find-lang.pl 243013 2008-06-23 13:01:50Z pixel $ - -use strict; -use warnings; -use File::Find; -use Getopt::Long; -use Pod::Usage; - -GetOptions( - 'all-name' => \my $allname, - 'with-gnome' => \my $withgnome, - 'with-help' => \my $withhelp, - '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); - if ($file =~ m!^((.*/share/locale)/([^/@]+)[^/]*).*/([^/]+)\.mo!) { - return if $withoutmo; - my ($pkg, $lang) = ($4, $3); - own_file($file, $lang) if pkg_match($pkg); - } elsif ($file =~ m!^((.*/gnome/help)/([^/]+)/([^/]+))!) { - return if !$withgnome; - my ($pkg, $lang, $langfile) = ($3, $4, $1); - parent_to_own($langfile, $file, $lang) if pkg_match($pkg); - } elsif ($file =~ m!^((.*/share/help)/([^/]+)/([^/]+))/([^/]+)!) { - return if !$withhelp; - my ($pkg, $lang, $langfile) = ($4, $3, $1); - parent_to_own($langfile, $file, $lang) if pkg_match($pkg); - } elsif ($file =~ m!^((.*/doc/kde)/HTML/([^/@]+)[^/]*)/([^/]+)/!) { - return if !$withkde; - my ($pkg, $lang, $langfile) = ($4, $3, $1); - parent_to_own($langfile, $file, $lang) if pkg_match($pkg); - } elsif ($file =~ m!^((.*/doc)/HTML/([^/@]+)[^/]*)/([^/_]+)!) { - return if !$withhtml; - my ($pkg, $lang, $langfile) = ($4, $3, $1); - parent_to_own($langfile, $file, $lang) if pkg_match($pkg); - } elsif ($file =~ m!^((/+usr/share/man)/([^/@.]+)[^/]*)/man[^/]+/([^/]+)\.\d[^/]*!) { - return if !$withman; - my ($pkg, $lang, $langfile) = ($4, $3, $1); - $file =~ s/\.[^\.]+$/.*/; - own_file($file, $lang) if pkg_match($pkg); - } else { - return; - } - }, - $buildroot || '/' -); - -open(my $hlang, '>', "$pkgname.lang") or die "cannot 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) = @_; - return 1 if $allname; - return 1 if grep { $_ eq $pkg } @searchname; - 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); - - } -} |