sysui/desktop/share/create_mime_xml.pl

   1 #!/usr/bin/perl
   2 use 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
  12 open(DOCUMENTS_ULF, $ARGV[0]) || die 'Cannot open "documents.ulf".';
  13 while (<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 }
  34 close DOCUMENTS_ULF;
  35
  36 ## creating the xml on stdout
  37 print '<?xml version="1.0" encoding="UTF-8"?>';
  38 print '<mime-info xmlns="http://www.freedesktop.org/standards/shared-mime-info">';
  39
  40 foreach $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 }
  54 print '</mime-info>';
  55
  56 sub 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
  65 sub 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: