solenv/bin/slfl.pl

   1 :
   2 eval 'exec perl -wS $0 ${1+"$@"}'
   3     if 0;
   4 #
   5 # This file is part of the LibreOffice project.
   6 #
   7 # This Source Code Form is subject to the terms of the Mozilla Public
   8 # License, v. 2.0. If a copy of the MPL was not distributed with this
   9 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
  10 #
  11 # This file incorporates work covered by the following license notice:
  12 #
  13 #   Licensed to the Apache Software Foundation (ASF) under one or more
  14 #   contributor license agreements. See the NOTICE file distributed
  15 #   with this work for additional information regarding copyright
  16 #   ownership. The ASF licenses this file to you under the Apache
  17 #   License, Version 2.0 (the "License"); you may not use this file
  18 #   except in compliance with the License. You may obtain a copy of
  19 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  20 #
  21 # Description: Wrapper script to change '/' to '\' in command-line
  22 # arguments.
  23
  24 #---------------------------------------------------------------------------
  25 # external modules
  26 use Text::ParseWords;
  27
  28 # global vars
  29 @params = ();
  30
  31 #---------------------------------------------------------------------------
  32 # procedures
  33
  34
  35 #----------------------------------------------------------
  36 # Function name: WinFormat
  37 # Description:   Format variables to Windows Format.
  38 # Arguments:     1. Variable (string) with one token
  39 # Return value:  Reformatted String
  40 #----------------------------------------------------------
  41 sub WinFormat {
  42     my $variable = shift @_;
  43
  44     $variable =~ s!(.)/!$1\\!g; # Replace all but the leading slashes with backslashes
  45
  46     if ( defined $debug ) {
  47         print(STDERR "WinFormat:\nresult:$variable\n");
  48     }
  49
  50     return $variable;
  51 }
  52
  53 #----------------------------------------------------------
  54 # Function name: replace_cyg
  55 # Description:   Process all arguments and change them to Windows Format.
  56 # Arguments:     Reference to array with arguments
  57 # Return value:  -
  58 #----------------------------------------------------------
  59 sub replace_cyg {
  60     my $args = shift;
  61     my( @cmd_file, @cmd_temp );
  62     my $atchars;
  63     foreach my $para ( @$args ) {
  64         if ( $para =~ "^@" ) {
  65             # it's a command file
  66             if ( defined $debug ) {
  67                 print(STDERR "----------------------------\n");
  68             }
  69             ;
  70             # Workaround, iz28717, keep number of @'s.
  71             $para =~ s/(^\@+)//;
  72             $atchars = $1;
  73             $filename = $para;
  74             if ( defined $debug ) {
  75                 print(STDERR "filename = $filename \n");
  76             }
  77             ;
  78             # open this command file for reading
  79             open(CMD, "$filename");
  80             while ( <CMD> ) {
  81                 # Remove DOS lineendings. Bug in Cygwin / Perl?
  82                 $_ =~ s/\r//g;
  83                 # Remove lineendings and trailing spaces. ( Needed by &parse_line )
  84                 $_ =~ s/\n$//g;
  85                 $_ =~ s/\s+$//g;
  86                 # Fill all tokens into array
  87                 @cmd_temp = &parse_line('\s+', 1, $_ );
  88                 if ( $#cmd_temp > -1 ) {
  89                     push( @cmd_file, @cmd_temp);
  90                 }
  91             }
  92             close(CMD);
  93             # reformat all tokens
  94             replace_cyg(\@cmd_file);
  95             if ( defined $debug ) {
  96                 print(STDERR "Tokens processed:\n");
  97             }
  98             ;
  99             foreach $i (@cmd_file) {
 100                 if ( defined $debug ) {
 101                     print(STDERR "!".$i."!\n");
 102                 }
 103                 ;
 104             }
 105             # open this filename for writing (truncate) Textmode?
 106             open(CMD, '>', $filename);
 107             # write all tokens back into this file
 108             print(CMD join(' ', @cmd_file));
 109             close(CMD);
 110             # convert '@filename' to dos style
 111             $para = WinFormat( $para );
 112             if ( defined $debug ) {
 113                 print(STDERR "----------------------------\n");
 114             }
 115             ;
 116             if ( (defined $debug_light) or (defined $debug) ) {
 117                 print(STDERR "\nParameter in File:".join(' ', @cmd_file).":\n");
 118             }
 119             $para = $atchars.$para;
 120         } else {
 121             # it's just a parameter
 122             if ( defined $debug ) {
 123                 print(STDERR "\nParameter:---${para}---\n");
 124             }
 125             ;
 126             # If $tmp1 is empty then $para is a parameter.
 127             my $is_no_para = 1;
 128             # remove .exe and convert to lower case
 129             $shortcommand = lc $command ;
 130             $shortcommand =~ s/\.exe$//;
 131             $shortcommand =~ /([^\/]+$)/;
 132             $shortcommand = $1;
 133             if ( $is_no_para ) {
 134                 $para = WinFormat($para);
 135             }
 136             if ( defined $debug ) {
 137                 print(STDERR "Converted line:${para}:\n" );
 138             }
 139         }                       # else
 140     }                           # foreach loop
 141 }
 142
 143
 144 #---------------------------------------------------------------------------
 145 # main
 146 @params = @ARGV;
 147
 148 $command = shift(@params);
 149
 150 while ( $command =~ /^-/ )
 151 {
 152     if ( $command eq "-dbg" ) {
 153         $debug="true";
 154     }
 155     elsif ( $command eq "-ldbg" ) {
 156         $debug_light="true";
 157     }
 158
 159     $command = shift(@params);
 160 }
 161
 162 if ( (defined $debug_light) or (defined $debug) ) { print( STDERR "Command: $command\n" ); }
 163
 164 replace_cyg(\@params);
 165 if ( (defined $debug_light) or (defined $debug) ) { print(STDERR "\n---------------------\nExecute: $command @params\n----------------\n");};
 166 exec( "$command", @params) or die( "\nError: slfl.pl: executing $command failed!\n" );
 167