| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
# $Id: find-lang.pl 243013 2008-06-23 13:01:50Z pixel $ |
| 4 |
|
| 5 |
use strict; |
| 6 |
use warnings; |
| 7 |
use File::Find; |
| 8 |
use Getopt::Long; |
| 9 |
use Pod::Usage; |
| 10 |
|
| 11 |
GetOptions( |
| 12 |
'all-name' => \my $allname, |
| 13 |
'with-gnome' => \my $withgnome, |
| 14 |
'with-help' => \my $withhelp, |
| 15 |
'with-kde' => \my $withkde, |
| 16 |
'with-html' => \my $withhtml, |
| 17 |
'without-mo' => \my $withoutmo, |
| 18 |
'with-man' => \my $withman, |
| 19 |
'debug' => \my $debug, |
| 20 |
) or pod2usage(); |
| 21 |
|
| 22 |
my ($buildroot, @searchname) = @ARGV; |
| 23 |
$buildroot or die "No buildroot given\n"; |
| 24 |
$buildroot =~ s!/+$!!; # removing trailing / |
| 25 |
my ($pkgname) = @searchname or die "Main name to find missing\n"; |
| 26 |
|
| 27 |
sub debug { |
| 28 |
$debug or return; |
| 29 |
my ($msg, @val) = @_; |
| 30 |
printf("DEBUG: $msg\n", @val); |
| 31 |
} |
| 32 |
|
| 33 |
my %finallist; # filename => attr, easy way to perform uniq |
| 34 |
|
| 35 |
File::Find::find( |
| 36 |
sub { |
| 37 |
my $file = substr($File::Find::name, length($buildroot)); |
| 38 |
-f $File::Find::name or -l $File::Find::name or return; |
| 39 |
debug("next file is %s", $file); |
| 40 |
if ($file =~ m!^((.*/share/locale)/([^/@]+)[^/]*).*/([^/]+)\.mo!) { |
| 41 |
return if $withoutmo; |
| 42 |
my ($pkg, $lang) = ($4, $3); |
| 43 |
own_file($file, $lang) if pkg_match($pkg); |
| 44 |
} elsif ($file =~ m!^((.*/gnome/help)/([^/]+)/([^/]+))!) { |
| 45 |
return if !$withgnome; |
| 46 |
my ($pkg, $lang, $langfile) = ($3, $4, $1); |
| 47 |
parent_to_own($langfile, $file, $lang) if pkg_match($pkg); |
| 48 |
} elsif ($file =~ m!^((.*/share/help)/([^/]+)/([^/]+))/([^/]+)!) { |
| 49 |
return if !$withhelp; |
| 50 |
my ($pkg, $lang, $langfile) = ($4, $3, $1); |
| 51 |
parent_to_own($langfile, $file, $lang) if pkg_match($pkg); |
| 52 |
} elsif ($file =~ m!^((.*/doc/kde)/HTML/([^/@]+)[^/]*)/([^/]+)/!) { |
| 53 |
return if !$withkde; |
| 54 |
my ($pkg, $lang, $langfile) = ($4, $3, $1); |
| 55 |
parent_to_own($langfile, $file, $lang) if pkg_match($pkg); |
| 56 |
} elsif ($file =~ m!^((.*/doc)/HTML/([^/@]+)[^/]*)/([^/_]+)!) { |
| 57 |
return if !$withhtml; |
| 58 |
my ($pkg, $lang, $langfile) = ($4, $3, $1); |
| 59 |
parent_to_own($langfile, $file, $lang) if pkg_match($pkg); |
| 60 |
} elsif ($file =~ m!^((/+usr/share/man)/([^/@.]+)[^/]*)/man[^/]+/([^/.]+)\.\d[^/]*!) { |
| 61 |
return if !$withman; |
| 62 |
my ($pkg, $lang, $langfile) = ($4, $3, $1); |
| 63 |
$file =~ s/\.[^\.]+$/.*/; |
| 64 |
parent_to_own($langfile, $file, $lang) if pkg_match($pkg); |
| 65 |
} else { |
| 66 |
return; |
| 67 |
} |
| 68 |
}, |
| 69 |
$buildroot || '/' |
| 70 |
); |
| 71 |
|
| 72 |
open(my $hlang, '>', "$pkgname.lang") or die "cannot open $pkgname.lang\n"; |
| 73 |
|
| 74 |
foreach my $f (sort keys %finallist) { |
| 75 |
my ($lang, @otherlang) = keys %{ $finallist{$f}{lang} || {} }; |
| 76 |
my $l = sprintf("%s%s%s", |
| 77 |
$finallist{$f}{dir} ? '%dir ' : '', |
| 78 |
@otherlang == 0 && $lang && $lang ne 'C' |
| 79 |
? "%lang($lang) " |
| 80 |
: '', # skip if multiple lang, 'C' or dir |
| 81 |
$f |
| 82 |
); |
| 83 |
debug('OUT: %s', $l); |
| 84 |
print $hlang "$l\n"; |
| 85 |
|
| 86 |
} |
| 87 |
|
| 88 |
close($hlang); |
| 89 |
|
| 90 |
exit(0); |
| 91 |
|
| 92 |
sub pkg_match { |
| 93 |
my ($pkg) = @_; |
| 94 |
return 1 if $allname; |
| 95 |
return 1 if grep { $_ eq $pkg } @searchname; |
| 96 |
return; |
| 97 |
} |
| 98 |
|
| 99 |
sub own_file { |
| 100 |
my ($file, $lang) = @_; |
| 101 |
$finallist{$file}{lang}{$lang} = 1; |
| 102 |
} |
| 103 |
|
| 104 |
sub parent_to_own { |
| 105 |
my ($parent, $file, $lang) = @_; |
| 106 |
debug("parent_to_own: $parent, $file, $lang"); |
| 107 |
if ($allname) { |
| 108 |
#my @subdir = grep { $_ } split('/', substr($file, length($parent))); |
| 109 |
#$parent .= '/' . shift @subdir; |
| 110 |
$finallist{$parent}{lang}{$lang} = 1; |
| 111 |
debug("Parent %s will be %s", $parent, $lang); |
| 112 |
} else { |
| 113 |
my @subdir = grep { $_ } split('/', substr($file, length($parent))); |
| 114 |
pop @subdir; |
| 115 |
$finallist{$parent}{dir} = 1; |
| 116 |
$finallist{$parent}{lang}{$lang} = 1; |
| 117 |
debug("Parent %s will be %s", $parent, $lang); |
| 118 |
while (my $part = shift @subdir) { |
| 119 |
$parent .= "/$part"; |
| 120 |
$finallist{$parent}{dir} = 1; |
| 121 |
$finallist{$parent}{lang}{$lang} = 1; |
| 122 |
debug("Parent %s will be %s", $parent, $lang); |
| 123 |
} |
| 124 |
own_file($file, $lang); |
| 125 |
debug("Parent %s will be %s", $file, $lang); |
| 126 |
|
| 127 |
} |
| 128 |
} |
Parent Directory
| 
Revision Log