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