solenv/bin/slfl.pl

   1 :
   2 eval 'exec perl -wS $0 ${1+"$@"}'
   3     if 0;
   4 #*************************************************************************
   5 #
   6 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   7 #
   8 # Copyright 2000, 2010 Oracle and/or its affiliates.
   9 #
  10 # OpenOffice.org - a multi-platform office productivity suite
  11 #
  12 # This file is part of OpenOffice.org.
  13 #
  14 # OpenOffice.org is free software: you can redistribute it and/or modify
  15 # it under the terms of the GNU Lesser General Public License version 3
  16 # only, as published by the Free Software Foundation.
  17 #
  18 # OpenOffice.org is distributed in the hope that it will be useful,
  19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 # GNU Lesser General Public License version 3 for more details
  22 # (a copy is included in the LICENSE file that accompanied this code).
  23 #
  24 # You should have received a copy of the GNU Lesser General Public License
  25 # version 3 along with OpenOffice.org.  If not, see
  26 # <http://www.openoffice.org/license.html>
  27 # for a copy of the LGPLv3 License.
  28 #
  29 #*************************************************************************
  30 # Description: Wrapper script to change '/' to '\' in command-line
  31 # arguments.
  32
  33 #---------------------------------------------------------------------------
  34 # external modules
  35 use Text::ParseWords;
  36
  37 # global vars
  38 @params = ();
  39
  40 #---------------------------------------------------------------------------
  41 # procedures
  42
  43
  44 #----------------------------------------------------------
  45 # Function name: WinFormat
  46 # Description:   Format variables to Windows Format.
  47 # Arguments:     1. Variable (string) with one token
  48 # Return value:  Reformatted String
  49 #----------------------------------------------------------
  50 sub WinFormat {
  51     my $variable = shift @_;
  52
  53     $variable =~ s!(.)/!$1\\!g; # Replace all but the leading slashes with backslashes
  54
  55     if ( defined $debug ) {
  56         print(STDERR "WinFormat:\nresult:$variable\n");
  57     }
  58
  59     return $variable;
  60 }
  61
  62 #----------------------------------------------------------
  63 # Function name: replace_cyg
  64 # Description:   Process all arguments and change them to Windows Format.
  65 # Arguments:     Reference to array with arguments
  66 # Return value:  -
  67 #----------------------------------------------------------
  68 sub replace_cyg {
  69     my $args = shift;
  70     my( @cmd_file, @cmd_temp );
  71     my $atchars;
  72     foreach my $para ( @$args ) {
  73         if ( $para =~ "^@" ) {
  74             # it's a command file
  75             if ( defined $debug ) {
  76                 print(STDERR "----------------------------\n");
  77             }
  78             ;
  79             # Workaround, iz28717, keep number of @'s.
  80             $para =~ s/(^\@+)//;
  81             $atchars = $1;
  82             $filename = $para;
  83             if ( defined $debug ) {
  84                 print(STDERR "filename = $filename \n");
  85             }
  86             ;
  87             # open this command file for reading
  88             open(CMD, "$filename");
  89             while ( <CMD> ) {
  90                 # Remove DOS lineendings. Bug in Cygwin / Perl?
  91                 $_ =~ s/\r//g;
  92                 # Remove lineendings and trailing spaces. ( Needed by &parse_line )
  93                 $_ =~ s/\n$//g;
  94                 $_ =~ s/\s+$//g;
  95                 # Fill all tokens into array
  96                 @cmd_temp = &parse_line('\s+', 1, $_ );
  97                 if ( $#cmd_temp > -1 ) {
  98                     push( @cmd_file, @cmd_temp);
  99                 }
 100             }
 101             close(CMD);
 102             # reformat all tokens
 103             replace_cyg(\@cmd_file);
 104             if ( defined $debug ) {
 105                 print(STDERR "Tokens processed:\n");
 106             }
 107             ;
 108             foreach $i (@cmd_file) {
 109                 if ( defined $debug ) {
 110                     print(STDERR "!".$i."!\n");
 111                 }
 112                 ;
 113             }
 114             # open this filename for writing (truncate) Textmode?
 115             open(CMD, '>', $filename);
 116             # write all tokens back into this file
 117             print(CMD join(' ', @cmd_file));
 118             close(CMD);
 119             # convert '@filename' to dos style
 120             $para = WinFormat( $para );
 121             if ( defined $debug ) {
 122                 print(STDERR "----------------------------\n");
 123             }
 124             ;
 125             if ( (defined $debug_light) or (defined $debug) ) {
 126                 print(STDERR "\nParameter in File:".join(' ', @cmd_file).":\n");
 127             }
 128             $para = $atchars.$para;
 129         } else {
 130             # it's just a parameter
 131             if ( defined $debug ) {
 132                 print(STDERR "\nParameter:---${para}---\n");
 133             }
 134             ;
 135             # If $tmp1 is empty then $para is a parameter.
 136             my $is_no_para = 1;
 137             # remove .exe and convert to lower case
 138             $shortcommand = lc $command ;
 139             $shortcommand =~ s/\.exe$//;
 140             $shortcommand =~ /([^\/]+$)/;
 141             $shortcommand = $1;
 142             if ( $is_no_para ) {
 143                 $para = WinFormat($para);
 144             }
 145             if ( defined $debug ) {
 146                 print(STDERR "Converted line:${para}:\n" );
 147             }
 148         }                       # else
 149     }                           # foreach loop
 150 }
 151
 152
 153 #---------------------------------------------------------------------------
 154 # main
 155 @params = @ARGV;
 156
 157 $command = shift(@params);
 158
 159 while ( $command =~ /^-/ )
 160 {
 161     if ( $command eq "-dbg" ) {
 162         $debug="true";
 163     }
 164     elsif ( $command eq "-ldbg" ) {
 165         $debug_light="true";
 166     }
 167
 168     $command = shift(@params);
 169 }
 170
 171 if ( (defined $debug_light) or (defined $debug) ) { print( STDERR "Command: $command\n" ); }
 172
 173 replace_cyg(\@params);
 174 if ( (defined $debug_light) or (defined $debug) ) { print(STDERR "\n---------------------\nExecute: $command @params\n----------------\n");};
 175 exec( "$command", @params) or die( "\nError: slfl.pl: executing $command failed!\n" );
 176