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