sysui/desktop/share/create_mime_xml.pl

   1 #!/usr/bin/env perl
   2 #
   3 # This file is part of the LibreOffice project.
   4 #
   5 # This Source Code Form is subject to the terms of the Mozilla Public
   6 # License, v. 2.0. If a copy of the MPL was not distributed with this
   7 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   8 #
   9 # This file incorporates work covered by the following license notice:
  10 #
  11 #   Licensed to the Apache Software Foundation (ASF) under one or more
  12 #   contributor license agreements. See the NOTICE file distributed
  13 #   with this work for additional information regarding copyright
  14 #   ownership. The ASF licenses this file to you under the Apache
  15 #   License, Version 2.0 (the "License"); you may not use this file
  16 #   except in compliance with the License. You may obtain a copy of
  17 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  18 #
  19
  20 use File::Basename;
  21 $basedir = dirname($0);
  22 $productname = 'LibreOffice';
  23 $mimedir = $basedir.'/../mimetypes';
  24
  25 $FS= ' ';       # field separator (space) - for documents.ulf
  26 $, = "\n";      # set output field separator (newline)
  27 $\ = "\n";      # set output record separator (newline)
  28
  29 ## get list of components and corresponding translations from documents.ulf
  30 open(DOCUMENTS_ULF, $ARGV[0]) || die 'Cannot open "documents.ulf".';
  31 while (<DOCUMENTS_ULF>) {
  32     if (/^\[/) {
  33         # section starts
  34         s/^\[(.*)]/$1/;
  35         chomp;
  36         $module = $_;
  37     } else {
  38         # translated strings
  39         ($lang,$junk,$comment) = split($FS, $_, 3);
  40         $comment =~ s/^"(.*)"$/$1/;
  41         $comment =~ s/%PRODUCTNAME/$productname/;
  42         chomp $lang;
  43         chomp $comment;
  44         if ($lang eq "en-US") {
  45             $value = "    <comment>$comment</comment>";
  46         } else {
  47             $value = '    <comment xml:lang="'.$lang.'">'.$comment.'</comment>';
  48         }
  49         push(@{$mimehash{$module}}, $value) unless $lang eq "";
  50     }
  51 }
  52 close DOCUMENTS_ULF;
  53
  54 ## creating the xml on stdout
  55 print '<?xml version="1.0" encoding="UTF-8"?>';
  56 print '<mime-info xmlns="http://www.freedesktop.org/standards/shared-mime-info">';
  57
  58 foreach $component (sort(keys %mimehash)) {
  59     # mimetype and glob
  60     getMimedata($component);
  61     print '  <mime-type type="'.$mimetype.'">';
  62     print (sort({customsort($a) cmp customsort($b)} @{$mimehash{$component}}));
  63     print '    <glob pattern="'.$glob.'"/>';
  64     if ( $component =~ /oasis/ ) {
  65         if ( $component =~ /flat-xml/ ) {
  66             print '    <sub-class-of type="application/xml"/>';
  67             print '    <magic'.( $mimetype =~ /-/  ? ' priority="60"' : '').'>';
  68             print '        <match value="&lt;?xml" type="string" offset="0">';
  69             print '            <match value="office:document" type="string" offset="4:100">';
  70             print '                <match value="office:mimetype=&quot;' . $mimetype . '&quot;" type="string" offset="100:4000"/>';
  71             print '            </match>';
  72             print '        </match>';
  73             print '    </magic>';
  74         } else {
  75             print '    <magic'.( $mimetype =~ /-/  ? ' priority="60"' : '').'>';
  76             print '        <match value="PK\003\004" type="string" offset="0">';
  77             print '            <match value="mimetype" type="string" offset="30">';
  78             print '                <match value="' . $mimetype . '" type="string" offset="38"/>';
  79             print '            </match>';
  80             print '        </match>';
  81             print '    </magic>';
  82         }
  83     }
  84     print '  </mime-type>';
  85 }
  86 print '</mime-info>';
  87
  88 sub customsort {
  89         # sort <comment> before <comment xml:lang...>
  90         $in = shift;
  91         $in =~ tr/>/A/;
  92         $in =~ tr/ /Z/;
  93         return $in;
  94 }
  95
  96 ## get mime-type and glob from ../mimetype/*.desktop
  97 sub getMimedata {
  98     $desktop_name = shift;
  99     $desktop_file = $mimedir.'/'.$desktop_name.'.desktop';
 100     $mimetype = "";
 101     $glob = "";
 102     open(DESKTOP_FILE, $desktop_file) || die "Cannot open desktop-file $desktop_file. ".$!;
 103     while (<DESKTOP_FILE>) {
 104         ## get mimetype
 105         if (/^MimeType=/) {
 106             s/^MimeType=(.*)\n$/$1/;
 107             $mimetype = "$_";
 108         }
 109         ## get glob
 110         if (/^Patterns=/) {
 111             s/^Patterns=(.*)\n$/\1/;
 112             $glob = "$_";
 113         }
 114     }
 115     close DESKTOP_FILE;
 116     # die if we cannot determine the glob-pattern or mimtetype
 117     die "Could not get mime-type from $desktop_file" if ($mimetype eq "");
 118     die "Could not get glob-pattern from $desktop_file" if ($glob eq "");
 119 }
 120
 121 ## END vim: set ts=4: