solenv/bin/clipatchconfig.pl

   1 #
   2 # This file is part of the LibreOffice project.
   3 #
   4 # This Source Code Form is subject to the terms of the Mozilla Public
   5 # License, v. 2.0. If a copy of the MPL was not distributed with this
   6 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   7 #
   8 # This file incorporates work covered by the following license notice:
   9 #
  10 #   Licensed to the Apache Software Foundation (ASF) under one or more
  11 #   contributor license agreements. See the NOTICE file distributed
  12 #   with this work for additional information regarding copyright
  13 #   ownership. The ASF licenses this file to you under the Apache
  14 #   License, Version 2.0 (the "License"); you may not use this file
  15 #   except in compliance with the License. You may obtain a copy of
  16 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  17 #
  18
  19 use warnings;
  20 use strict;
  21
  22 sub trim;
  23 sub readRedirectionValues($);
  24
  25 my $usage =
  26    "Usage is: \n clipatchconfig.pl configTemplate redirections policyConfig
  27
  28    configTemplate: The config file which is used for the policy assembly. It
  29    contains place holders for the binding redirection.
  30
  31    redirections: file containing the values for oldVersion and newVersion tags
  32    which are used in the BindingRedirect element of the config files.
  33
  34    policyConfig: Name of the file in which we want to write the config file.
  35 ";
  36
  37
  38 if (scalar @ARGV < 3) {
  39    print $usage;
  40    exit -1;
  41 }
  42
  43
  44 my %redirectionValue = readRedirectionValues($ARGV[1]);
  45
  46
  47 #Read config file in which we will replace the versions
  48 $/ = undef;
  49 open TEMPLATE, $ARGV[0] or die $!;
  50 my $templ = <TEMPLATE>;
  51
  52 #Open the config file we are goint to write to
  53 open CONFIG, "> $ARGV[2]" or die "Cannot write to $ARGV[2] $!";
  54
  55 #No substitute the place holders for oldVersion and new Version in the config template with
  56 #the values obtained from the redirections file
  57 for (keys %redirectionValue) {
  58     $templ=~ s/\b$_\b/$redirectionValue{$_}/;
  59 }
  60 #Write the config file
  61 print CONFIG $templ;
  62
  63 #Reads the key value pairs from the files, which name must be passed in
  64 #the parameter. The file contains lines of the form name=value, for example
  65 #CLI_URETYPES_OLD_VERSION=1.1.0.0-1.1.1.0
  66 sub readRedirectionValues($)
  67 {
  68     #Read in the values for the version redirection
  69     open REDIR, $_[0] or die $!;
  70
  71     my %redirectionValues;
  72
  73     while (<REDIR>)
  74     {
  75         chomp;
  76     my $trimmed;
  77         #Skip empty lines
  78         if (length($trimmed = trim($_)) == 0) {
  79             next;
  80         }
  81
  82     #Skip comment symbol: #
  83     if ($trimmed =~ /^#/) {
  84         next;
  85     }
  86
  87         my @lineParts = split /=/,$_;
  88
  89         #Check if we have valid name value pairs.
  90         if (scalar @lineParts != 2) {
  91             print "Error: Values in $ARGV[1] are not correct (Entries must have the form name=value). Invalid line: \n$_\n";
  92             exit -1;
  93         }
  94
  95         #Trim the strings and check if they still contain characters
  96         my $name = trim($lineParts[0]);
  97         my $value = trim($lineParts[1]);
  98         if (length($name) == 0 || length($value) == 0) {
  99             print "Error: Values in $ARGV[1] are not correct. Invalid line: \n$_\n";
 100             exit -1;
 101         }
 102
 103         #Check if we have duplicate key names
 104         for (keys %redirectionValues) {
 105             if ( $name eq $_) {
 106                 print "Error: Values in $ARGV[1] are not correct. The name $_ is not unique.\n";
 107                 exit -1;
 108             }
 109         }
 110
 111         $redirectionValues{$name} = $value;
 112     }
 113     return %redirectionValues;
 114 }
 115
 116 sub trim($)
 117 {
 118     my $string = shift;
 119     $string =~ s/^\s+//;
 120     $string =~ s/\s+$//;
 121     return $string;
 122 }