- rewrite find-lang

1 files changed, 84 insertions, 0 deletions

diff --git a/find-lang.pl b/find-lang.pl
new file mode 100644
index 0000000..f8063a7
--- /dev/null
+++ b/find-lang.pl
@@ -0,0 +1,84 @@
+#!/usr/sbin/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,
+) or pod2usage();
+
+my ($buildroot, $pkgname) = @ARGV;
+
+my @regexps = (
+    '^.*/share/locale/([^/_]+)',
+);
+
+
+my %finallist = (); # filename => attr, easy way to perform uniq
+
+find(
+    sub {
+        my $file = substr($File::Find::name, length($buildroot));
+        my ($pkg, $lang, $parent);
+        if ($file =~ m:^((.*/share/locale)/([^/_@]+)[^/]*).*/([^/]+)\.mo:) {
+            if ($withoutmo) {
+                return;
+            }
+            ($pkg, $lang, $parent) = ($4, $3, $2);
+        } elsif ($file =~ m:^(.*/gnome/help/([^/_@]+))[^/]*/([^/]+)$:) {
+            if (!$withgnome) {
+                return;
+            }
+            ($pkg, $lang, $parent) = ($2, $3, $1);
+        } elsif ($file =~ m:^(.*/doc/kde/HTML)/([^/_@]+)[^/]*/([^/]+)$:) {
+            if (!$withkde) {
+                return;
+            }
+            ($pkg, $lang, $parent) = ($2, $3, $1);
+        } elsif ($file =~ m:^(.*/doc/HTML)/([^/_@]+)[^/]*/([^/]+)$:) {
+            if (!$withhtml) {
+                return;
+            }
+            ($pkg, $lang, $parent) = ($3, $2, $1);
+        } else {
+            return;
+        }
+        if ($pkg ne $pkgname && !$allname) {
+            return;
+        }
+        my $rpmlang = $lang eq 'C' ? "" : "%lang($lang)";
+
+        parent_to_own($parent, $file, $rpmlang);
+        $finallist{$file} = "$rpmlang ";
+
+    },
+    $buildroot || '/'
+);
+
+open(my $hlang, ">", "$pkgname.lang") or die "canno't open $pkgname.lang\n";
+
+foreach (sort keys %finallist) {
+    print "$finallist{$_}$_\n";
+}
+
+exit(0);
+
+sub parent_to_own {
+    my ($parent, $file, $lang) = @_;
+    my @subdir = grep { $_ } split('/', substr($file, length($parent)));
+    pop(@subdir);
+    #$finallist{$parent} = "$lang %dir";
+    while (my $part = shift(@subdir)) {
+        $parent .= "/$part";
+        $finallist{$parent} = "$lang %dir ";
+    }
+}