1cdf0e10cSrcweir#!/usr/bin/perl
2*bb113e63SAndrew Rist# *************************************************************
3*bb113e63SAndrew Rist#
4*bb113e63SAndrew Rist#  Licensed to the Apache Software Foundation (ASF) under one
5*bb113e63SAndrew Rist#  or more contributor license agreements.  See the NOTICE file
6*bb113e63SAndrew Rist#  distributed with this work for additional information
7*bb113e63SAndrew Rist#  regarding copyright ownership.  The ASF licenses this file
8*bb113e63SAndrew Rist#  to you under the Apache License, Version 2.0 (the
9*bb113e63SAndrew Rist#  "License"); you may not use this file except in compliance
10*bb113e63SAndrew Rist#  with the License.  You may obtain a copy of the License at
11*bb113e63SAndrew Rist#
12*bb113e63SAndrew Rist#    http://www.apache.org/licenses/LICENSE-2.0
13*bb113e63SAndrew Rist#
14*bb113e63SAndrew Rist#  Unless required by applicable law or agreed to in writing,
15*bb113e63SAndrew Rist#  software distributed under the License is distributed on an
16*bb113e63SAndrew Rist#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
17*bb113e63SAndrew Rist#  KIND, either express or implied.  See the License for the
18*bb113e63SAndrew Rist#  specific language governing permissions and limitations
19*bb113e63SAndrew Rist#  under the License.
20*bb113e63SAndrew Rist#
21*bb113e63SAndrew Rist# *************************************************************
22cdf0e10cSrcweiruse File::Basename;
23cdf0e10cSrcweir$basedir = dirname($0);
24cdf0e10cSrcweir$productname = 'OpenOffice.org';
25cdf0e10cSrcweir$mimedir = $basedir.'/../mimetypes';
26cdf0e10cSrcweir
27cdf0e10cSrcweir$FS= ' ';		# field seperator (space) - for documents.ulf
28cdf0e10cSrcweir$, = "\n";		# set output field separator (newline)
29cdf0e10cSrcweir$\ = "\n";		# set output record separator (newline)
30cdf0e10cSrcweir
31cdf0e10cSrcweir## get list of components and corresponding translations from documents.ulf
32cdf0e10cSrcweiropen(DOCUMENTS_ULF, $ARGV[0]) || die 'Cannot open "documents.ulf".';
33cdf0e10cSrcweirwhile (<DOCUMENTS_ULF>) {
34cdf0e10cSrcweir	if (/^\[/) {
35cdf0e10cSrcweir		# section starts
36cdf0e10cSrcweir		s/^\[(.*)]/$1/;
37cdf0e10cSrcweir		chomp;
38cdf0e10cSrcweir		$module = $_;
39cdf0e10cSrcweir    } else {
40cdf0e10cSrcweir		# translated strings
41cdf0e10cSrcweir		($lang,$junk,$comment) = split($FS, $_, 3);
42cdf0e10cSrcweir		$comment =~ s/^"(.*)"$/$1/;
43cdf0e10cSrcweir		$comment =~ s/%PRODUCTNAME/$productname/;
44cdf0e10cSrcweir		chomp $lang;
45cdf0e10cSrcweir		chomp $comment;
46cdf0e10cSrcweir		if ($lang eq "en-US") {
47cdf0e10cSrcweir			$value = "    <comment>$comment</comment>";
48cdf0e10cSrcweir		} else {
49cdf0e10cSrcweir			$value = '    <comment xml:lang="'.$lang.'">'.$comment.'</comment>';
50cdf0e10cSrcweir		}
51cdf0e10cSrcweir		push(@{$mimehash{$module}}, $value) unless $lang eq "";
52cdf0e10cSrcweir	}
53cdf0e10cSrcweir}
54cdf0e10cSrcweirclose DOCUMENTS_ULF;
55cdf0e10cSrcweir
56cdf0e10cSrcweir## creating the xml on stdout
57cdf0e10cSrcweirprint '<?xml version="1.0" encoding="UTF-8"?>';
58cdf0e10cSrcweirprint '<mime-info xmlns="http://www.freedesktop.org/standards/shared-mime-info">';
59cdf0e10cSrcweir
60cdf0e10cSrcweirforeach $component (sort(keys %mimehash)) {
61cdf0e10cSrcweir	print STDERR "Processing entries for $component";
62cdf0e10cSrcweir	# mimetype and glob
63cdf0e10cSrcweir	getMimedata($component);
64cdf0e10cSrcweir	print '  <mime-type type="'.$mimetype.'">';
65cdf0e10cSrcweir	print (sort({customsort($a) cmp customsort($b)} @{$mimehash{$component}}));
66cdf0e10cSrcweir	print '    <glob pattern="'.$glob.'"/>';
67cdf0e10cSrcweir    if ( $component =~ /oasis/ ) {
68cdf0e10cSrcweir        print '    <magic'.( $mimetype =~ /-/  ? ' priority="60"' : '').'>';
69cdf0e10cSrcweir        print '        <match type="string" offset="38" value="'.$mimetype.'"/>';
70cdf0e10cSrcweir        print '    </magic>';
71cdf0e10cSrcweir    }
72cdf0e10cSrcweir	print '  </mime-type>';
73cdf0e10cSrcweir}
74cdf0e10cSrcweirprint '</mime-info>';
75cdf0e10cSrcweir
76cdf0e10cSrcweirsub customsort {
77cdf0e10cSrcweir		# sort <comment> before <comment xml:lang...>
78cdf0e10cSrcweir		$in = shift;
79cdf0e10cSrcweir		$in =~ tr/>/A/;
80cdf0e10cSrcweir		$in =~ tr/ /Z/;
81cdf0e10cSrcweir		return $in;
82cdf0e10cSrcweir}
83cdf0e10cSrcweir
84cdf0e10cSrcweir## get mime-type and glob from ../mimetype/*.desktop
85cdf0e10cSrcweirsub getMimedata {
86cdf0e10cSrcweir	$desktop_name = shift;
87cdf0e10cSrcweir	$desktop_file = $mimedir.'/'.$desktop_name.'.desktop';
88cdf0e10cSrcweir	$mimetype = "";
89cdf0e10cSrcweir	$glob = "";
90cdf0e10cSrcweir	open(DESKTOP_FILE, $desktop_file) || die 'Cannot open "desktop"-file.'.$!;
91cdf0e10cSrcweir	while (<DESKTOP_FILE>) {
92cdf0e10cSrcweir	    ## get mimetype
93cdf0e10cSrcweir	    if (/^MimeType=/) {
94cdf0e10cSrcweir		    s/^MimeType=(.*)\n$/$1/;
95cdf0e10cSrcweir		    $mimetype = "$_";
96cdf0e10cSrcweir	    }
97cdf0e10cSrcweir	    ## get glob
98cdf0e10cSrcweir	    if (/^Patterns=/) {
99cdf0e10cSrcweir		    s/^Patterns=(.*)\n$/\1/;
100cdf0e10cSrcweir		    $glob = "$_";
101cdf0e10cSrcweir	    }
102cdf0e10cSrcweir	}
103cdf0e10cSrcweir	close DESKTOP_FILE;
104cdf0e10cSrcweir	# die if we cannot determine the glob-pattern or mimtetype
105cdf0e10cSrcweir	die "Could not get mime-type fom $desktop_file" if ($mimetype eq "");
106cdf0e10cSrcweir	die "Could not get glob-pattern fom $desktop_file" if ($glob eq "");
107cdf0e10cSrcweir}
108cdf0e10cSrcweir
109cdf0e10cSrcweir## END vim: set ts=4:
110