1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!/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/\.[^\.]+$/.*/;
parent_to_own($langfile, $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);
}
}
|
