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