xref: /trunk/main/sysui/desktop/share/create_mime_xml.pl (revision fc9fd3f14a55d77b35643a64034752a178b2a5b0) 
1#!/usr/bin/perl
2use File::Basename;
3$basedir = dirname($0);
4$productname = 'OpenOffice.org';
5$mimedir = $basedir.'/../mimetypes';
6
7$FS= ' ';       # field seperator (space) - for documents.ulf
8$, = "\n";      # set output field separator (newline)
9$\ = "\n";      # set output record separator (newline)
10
11## get list of components and corresponding translations from documents.ulf
12open(DOCUMENTS_ULF, $ARGV[0]) || die 'Cannot open "documents.ulf".';
13while (<DOCUMENTS_ULF>) {
14    if (/^\[/) {
15        # section starts
16        s/^\[(.*)]/$1/;
17        chomp;
18        $module = $_;
19    } else {
20        # translated strings
21        ($lang,$junk,$comment) = split($FS, $_, 3);
22        $comment =~ s/^"(.*)"$/$1/;
23        $comment =~ s/%PRODUCTNAME/$productname/;
24        chomp $lang;
25        chomp $comment;
26        if ($lang eq "en-US") {
27            $value = "    <comment>$comment</comment>";
28        } else {
29            $value = '    <comment xml:lang="'.$lang.'">'.$comment.'</comment>';
30        }
31        push(@{$mimehash{$module}}, $value) unless $lang eq "";
32    }
33}
34close DOCUMENTS_ULF;
35
36## creating the xml on stdout
37print '<?xml version="1.0" encoding="UTF-8"?>';
38print '<mime-info xmlns="http://www.freedesktop.org/standards/shared-mime-info">';
39
40foreach $component (sort(keys %mimehash)) {
41    print STDERR "Processing entries for $component";
42    # mimetype and glob
43    getMimedata($component);
44    print '  <mime-type type="'.$mimetype.'">';
45    print (sort({customsort($a) cmp customsort($b)} @{$mimehash{$component}}));
46    print '    <glob pattern="'.$glob.'"/>';
47    if ( $component =~ /oasis/ ) {
48        print '    <magic'.( $mimetype =~ /-/  ? ' priority="60"' : '').'>';
49        print '        <match type="string" offset="38" value="'.$mimetype.'"/>';
50        print '    </magic>';
51    }
52    print '  </mime-type>';
53}
54print '</mime-info>';
55
56sub customsort {
57        # sort <comment> before <comment xml:lang...>
58        $in = shift;
59        $in =~ tr/>/A/;
60        $in =~ tr/ /Z/;
61        return $in;
62}
63
64## get mime-type and glob from ../mimetype/*.desktop
65sub getMimedata {
66    $desktop_name = shift;
67    $desktop_file = $mimedir.'/'.$desktop_name.'.desktop';
68    $mimetype = "";
69    $glob = "";
70    open(DESKTOP_FILE, $desktop_file) || die 'Cannot open "desktop"-file.'.$!;
71    while (<DESKTOP_FILE>) {
72        ## get mimetype
73        if (/^MimeType=/) {
74            s/^MimeType=(.*)\n$/$1/;
75            $mimetype = "$_";
76        }
77        ## get glob
78        if (/^Patterns=/) {
79            s/^Patterns=(.*)\n$/\1/;
80            $glob = "$_";
81        }
82    }
83    close DESKTOP_FILE;
84    # die if we cannot determine the glob-pattern or mimtetype
85    die "Could not get mime-type fom $desktop_file" if ($mimetype eq "");
86    die "Could not get glob-pattern fom $desktop_file" if ($glob eq "");
87}
88
89## END vim: set ts=4:
90