solenv/bin/image-sort.pl

   1 #!/usr/bin/env perl -w
   2 # -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil -*-
   3 #
   4 # This file is part of the LibreOffice project.
   5 #
   6 # This Source Code Form is subject to the terms of the Mozilla Public
   7 # License, v. 2.0. If a copy of the MPL was not distributed with this
   8 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   9 #
  10 # This file incorporates work covered by the following license notice:
  11 #
  12 #   Licensed to the Apache Software Foundation (ASF) under one or more
  13 #   contributor license agreements. See the NOTICE file distributed
  14 #   with this work for additional information regarding copyright
  15 #   ownership. The ASF licenses this file to you under the Apache
  16 #   License, Version 2.0 (the "License"); you may not use this file
  17 #   except in compliance with the License. You may obtain a copy of
  18 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  19 #
  20
  21 my @global_list = ();
  22 my %global_hash = ();
  23 my $base_path;
  24
  25 sub read_icons($)
  26 {
  27     my $fname = shift;
  28     my $fileh;
  29     my @images;
  30     if (! -e "$base_path/$fname") {
  31         print "Skipping non-existent $base_path/$fname\n";
  32         return @images;
  33     }
  34     open ($fileh, "$base_path/$fname") || die "Can't open $base_path/$fname: $!";
  35     while (<$fileh>) {
  36         m/xlink:href=\"\.uno:(\S+)\"\s+/ || next;
  37         push @images, lc($1);
  38     }
  39     close ($fileh);
  40
  41     return @images;
  42 }
  43
  44 # filter out already seen icons & do prefixing
  45 sub read_new_icons($$)
  46 {
  47     my $fname = shift;
  48     my $prefix = shift;
  49     my @images = read_icons ($fname);
  50     my @new_icons;
  51     my %new_icons;
  52     for my $icon (@images) {
  53         my $iname = "cmd/" . $prefix . $icon . ".png";
  54         if (!defined $global_hash{$iname} &&
  55             !defined $new_icons{$iname}) {
  56             push @new_icons, $iname;
  57             $new_icons{$iname} = 1;
  58         }
  59     }
  60     return @new_icons;
  61 }
  62
  63 sub process_group($@)
  64 {
  65     my $prefix = shift;
  66     my @uiconfigs = @_;
  67     my %group;
  68     my $cur_max = 1.0;
  69
  70 # a very noddy sorting algorithm
  71     for my $uiconfig (@uiconfigs) {
  72         my @images = read_new_icons ($uiconfig, $prefix);
  73         my $prev = '';
  74         for my $icon (@images) {
  75             if (!defined $group{$icon}) {
  76                 if (!defined $group{$prev}) {
  77                     $group{$icon} = $cur_max;
  78                     $cur_max += 1.0;
  79                 } else {
  80                     $group{$icon} = $group{$prev} + (1.0 - 0.5 / $cur_max);
  81                 }
  82             } # else a duplicate
  83         }
  84     }
  85     for my $icon (sort { $group{$a} <=> $group{$b} } keys %group) {
  86         push @global_list, $icon;
  87         $global_hash{$icon} = 1;
  88     }
  89 }
  90
  91 sub process_file($$)
  92 {
  93     my @images = read_new_icons (shift, shift);
  94
  95     for my $icon (@images) {
  96         push @global_list, $icon;
  97         $global_hash{$icon} = 1;
  98     }
  99 }
 100
 101 sub chew_controlfile($)
 102 {
 103     my $fname = shift;
 104     my $fileh;
 105     my @list;
 106     open ($fileh, $fname) || die "Can't open $fname: $!";
 107     while (<$fileh>) {
 108         /^\#/ && next;
 109         s/[\r\n]*$//;
 110         /^\s*$/ && next;
 111
 112         my $line = $_;
 113         if ($line =~ s/^-- (\S+)\s*//) {
 114             # control code
 115             my $code = $1;
 116             my $small = (lc ($line) eq 'small');
 117             if (lc($code) eq 'group') {
 118                 if (!$small) {
 119                     process_group ("lc_", @list);
 120                 }
 121                 process_group ("sc_", @list);
 122             } elsif (lc ($code) eq 'ordered') {
 123                 if (!$small) {
 124                     for my $file (@list) {
 125                         process_file ($file, "lc_");
 126                     }
 127                 }
 128                 for my $file (@list) {
 129                     process_file ($file, "sc_");
 130                 }
 131             } elsif (lc ($code) eq 'literal') {
 132                 for my $file (@list) {
 133                     if (!defined $global_hash{$file}) {
 134                         push @global_list, $file;
 135                         $global_hash{$file} = 1;
 136                     }
 137                 }
 138             } else {
 139                 die ("Unknown code '$code'");
 140             }
 141             @list = ();
 142         } else {
 143             push @list, $line;
 144         }
 145     }
 146     close ($fileh);
 147 }
 148
 149 if (!@ARGV) {
 150     print "image-sort <image-sort.lst> /path/to/OOOo/source/root\n";
 151     exit 1;
 152 }
 153
 154 # where the control file lives
 155 my $control = shift @ARGV;
 156 # where the uiconfigs live
 157 $base_path = shift @ARGV;
 158 # output
 159 if (@ARGV) {
 160     my $outf = shift @ARGV;
 161     open ($output, ">$outf") || die "Can't open $outf: $!";
 162     $stdout_out = 0;
 163 } else {
 164     $output = STDOUT;
 165     $stdout_out = 1;
 166 }
 167
 168 chew_controlfile ($control);
 169
 170 for my $icon (@global_list) {
 171     print $output $icon . "\n" if (!($icon =~ /^sc_/));
 172 }
 173 for my $icon (@global_list) {
 174     print $output $icon . "\n" if ($icon =~ /^sc_/);
 175 }
 176
 177 close $output if (!$stdout_out);
 178
 179 # dnl vim:set shiftwidth=4 softtabstop=4 expandtab: