solenv/bin/guw.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: guw.pl,v $
  13 #
  14 # $Revision: 1.28 $
  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: ??
  35
  36 #---------------------------------------------------------------------------
  37 # external modules
  38 use Text::ParseWords;
  39
  40 # global vars
  41 @params = ();
  42
  43 # set debug mode here:
  44 #$debug="true";
  45 #$debug_light="true";
  46
  47 #---------------------------------------------------------------------------
  48 # Define known parameter exceptions
  49 %knownpara = ( 'echo', [ '/TEST', 'QQQ', 'CCC', 'uno:' ],
  50                'cl', [ '-clr:', '-Z' ],
  51                'csc', [ '-target:' ],
  52                'lib', [ 'OUT:', 'EXTRACT:','out:', 'def:', 'machine:' ],
  53                'link', [ 'BASE:', 'DEBUG', 'DLL', 'LIBPATH', 'MACHINE:',
  54                          'MAP', 'NODEFAULTLIB', 'OPT', 'PDB', 'RELEASE',
  55                          'SUBSYSTEM', 'STACK', 'out:', 'map:', 'ENTRY:',
  56                          'implib:', 'delayload:', 'def', 'COMMENT:' ],
  57                'regcomp', [ '-env:', 'vnd.sun.star.expand:' , 'vnd.openoffice.pymodule' ],
  58                'regmerge', [ '/UCR' ],
  59                'rc', [ '-D' ],
  60                'rsc', [ '-DOOO_' ] );
  61
  62 #---------------------------------------------------------------------------
  63 # procedures
  64
  65
  66 #----------------------------------------------------------
  67 # Function name: myCygpath
  68 # Description:   Transform POSIX path to DOS path
  69 # Arguments:     1. Variable (string) with one token
  70 #                2. optional - if set remove spaces and shorten to 8.3
  71 #                   representation.
  72 # Return value:  Reformatted String
  73 #----------------------------------------------------------
  74 sub myCygpath {
  75     my $posixpath = shift;
  76     my $shortenpath = shift || '';
  77
  78     my $dospath;
  79
  80     if ( $posixpath =~ / / and $shortenpath ) {
  81         chomp( $dospath = qx{cygpath -d "$posixpath"} );
  82         # "cygpath -d" returns "" if the file doesn't exist.
  83         if ($dospath eq "") {
  84             $dospath = ".";
  85             print(STDERR "Error: guw.pl: Path: $posixpath:\nhas a problem! Probably nonexistent filename with space.\n");
  86             if ( (defined $debug_light) or (defined $debug) ) {
  87                 die "exiting ...\n";
  88             }
  89         }
  90     } else {
  91         if ( $posixpath =~ /^\// ) {
  92             chomp( $dospath = qx{cygpath -w "$posixpath"} );
  93         } else {
  94             $dospath = $posixpath;
  95             $dospath =~ s/\//\\/g;
  96         }
  97     }
  98     return $dospath;
  99 }
 100
 101 #----------------------------------------------------------
 102 # Function name: WinFormat
 103 # Description:   Format variables to Windows Format.
 104 # Arguments:     1. Variable (string) with one token
 105 # Return value:  Reformatted String
 106 #----------------------------------------------------------
 107 sub WinFormat {
 108   my $variable = shift @_;
 109   my( $d1, $d1_prefix, $d2 );
 110
 111   $variable =~ s/(\$\w+)/$1/eeg ; # expand the variables
 112   $variable =~ s/(\$\w+)/$1/eeg ; # expand the variables twice!
 113
 114   # Include paths or parameters with filenames
 115   if ( $variable =~ /\A(-D[\w\.]*=)[\'\"]?((?:\/?[\w\.\-\+ ~]+)+\/?)[\'\"]?\Z/ ) {
 116       # This regex evaluates -D<something>=<path>, sometimes with quotes or "/" at the end
 117       # option -> $1, filename without quotes -> $2
 118       if ( defined $debug ) { print(STDERR "WinFormat:\ninclude (-D<something>=<path>) path:\n$variable\n"); }
 119       $d1_prefix = $1;
 120       $d1 = $2;
 121       $d2 = myCygpath($2,1);
 122       if ( $d2 ne "" ) {
 123              $d2 =~ s/\\/\\\\/g ;
 124       }
 125   } elsif ( $variable =~ /\A(-?\w[\w\.]*=)[\'\"]?((?:\/?[\w\.\-\+ ~]+)+\/?)[\'\"]?\Z/ ) {
 126       # This regex evaluates [-]X<something>=<path>, sometimes with quotes or "/" at the end
 127       # option -> $1, filename without quotes -> $2
 128       if ( defined $debug ) { print(STDERR "WinFormat:\ninclude ([-]<something>=<path>) path:\n$variable\n"); }
 129       $d1_prefix = $1;
 130       $d1 = $2;
 131       $d2 = myCygpath($2,1);
 132   } elsif ( $variable =~ /\A(--\w[\w\.\-]*=)[\'\"]?((?:\/?[\w\.\-\+ ~]+)+\/?)[\'\"]?\Z/ ) {
 133       # This regex evaluates --<something>=<path>, sometimes with quotes or "/" at the end
 134       # option -> $1, filename without quotes -> $2
 135       if ( defined $debug ) { print(STDERR "WinFormat:\ninclude (--<something>=<path>) path:\n$variable\n"); }
 136       $d1_prefix = $1;
 137       $d1 = $2;
 138       $d2 = myCygpath($2,1);
 139   } elsif ( $variable =~ /\A(-\w[\w\.]*:)[\'\"]?((?:\/?[\w\.\-\+ ~]+)+\/?)[\'\"]?\Z/ ) {
 140       # This regex evaluates -X<something>:<path>, sometimes with quotes or "/" at the end
 141       # option -> $1, filename without quotes -> $2
 142       if ( defined $debug ) { print(STDERR "WinFormat:\nFound (-<something>:<path>):\n$variable\n"); }
 143       $d1_prefix = $1;
 144       $d1 = $2;
 145       $d2 = myCygpath($2,1);
 146   } elsif ( $variable =~ /\A(-\w+:)(.*)\Z/ ) {
 147       # This regex evaluates -X<something>:<NO-path>, and prevents translating of these.
 148       # option -> $1, rest -> $2
 149       if ( defined $debug ) { print(STDERR "WinFormat:\nFound (-<something>:<no-path>):\n$variable\n"); }
 150       $d1_prefix = $1;
 151       $d1 = $2;
 152       $d2 = myCygpath($2,1);
 153   } elsif ( $variable =~ /\A(\w+:)[\'\"]?\/\/\/((?:\/?[\w\.\-\+ ~]+)+\/?)[\'\"]?\Z/ ) {
 154       # See iz35982 for the reason for the special treatment of this switch.
 155       # This regex evaluates <something>:///<path>, sometimes with quotes or "/" at the end
 156       # option -> $1, filename without quotes -> $2
 157       if ( defined $debug ) { print(STDERR "WinFormat:\nFound (<something>:///<path>):\n$variable\n"); }
 158       $d1_prefix = $1."///";
 159       $d1 = $2;
 160       $d2 = myCygpath($2,1);
 161       $d2 =~ s/\\/\//g ;
 162   } elsif ( $variable =~ /\A(-\w)[\'\"]?((?:\/[\w\.\-\+ ~]+)+\/?)[\'\"]?\Z/ ) {
 163       # This regex evaluates -X<path>, sometimes with quotes or "/" at the end
 164       # option -> $1, filename without quotes -> $2
 165       if ( defined $debug ) { print(STDERR "WinFormat:\ninclude (-X<absolute path>) path:\n$variable\n"); }
 166       $d1_prefix = $1;
 167       $d1 = $2;
 168       $d2 = myCygpath($2,1);
 169   } elsif ( $variable =~ /\A(-F[ARdemopr])[\'\"]?((?:\/[\w\.\-\+ ~]+)+\/?)[\'\"]?\Z/ ) {
 170       # This regex evaluates -FX<path> (MSVC switches for output naming), sometimes with quotes or "/" at the end
 171       # option -> $1, filename without quotes -> $2
 172       if ( defined $debug ) { print(STDERR "WinFormat:\ncompiler naming (-FX<absolute path>) path:\n$variable\n"); }
 173       $d1_prefix = $1;
 174       $d1 = $2;
 175       $d2 = myCygpath($2,1);
 176   } else {
 177       $d2 = "";
 178   }
 179   if ( $d2 ne "" ) {
 180       # Found a parameter
 181       $d1 =~ s/\+/\\\+/ ;
 182       $d1 =~ s/\./\\\./ ;
 183       $variable =~ s/$d1/$d2/ ;
 184   } else {
 185     # Found no parameter, assume a path
 186     $variable =~ s/:/;/g;
 187     $variable =~ s/([;]|\A)(\w);/$1$2:/g; # get back the drives
 188
 189     # Search for posix path ;entry; (The regex accepts valid paths with at least one /)
 190     # and replace with DOS path, accept quotes.
 191     # iz28717 Accept ',' as path seperator.
 192     while ( $variable =~ /(?:[;,]|\A)[\'\"]?([\w\.\-\+ ~]*(?:\/[\w\.\-\+ ~]+)+\/?)[\'\"]?(?:[;,]|\Z)/ ) {
 193         # Normal paths
 194         $d1 = $1;
 195         $d2 = myCygpath($d1);
 196         if ( defined $debug ) {
 197             print(STDERR "WinFormat:\nFull path:\n$variable\nTranslated part:$d2\n");
 198         }
 199     $d1 =~ s/\+/\\\+/ ;
 200         $variable =~ s/$d1/$d2/ ;
 201     }
 202   }
 203
 204   # Sanity check for -X<path>
 205   if ( $variable =~ /-\w[\'\"]?(?:(?:\/[\w\.\-\+ ~]+)+)/ ) {
 206       print(STDERR "Error: guw.pl: WinFormat: Not converted -X/... type switch in :$variable:.\n");
 207       if ( (defined $debug_light) or (defined $debug) ) { die "\nNot processed -X/...\n"; }
 208   }
 209   # Sanity check for [-]X<something>(:|=)<path> case
 210   if ( $variable =~ /\A-?\w[\w\.]*[=:][\'\"]?(?:\/[\w\.\-\+ ~]+)+/ ) {
 211       print(STDERR "Error: guw.pl: WinFormat: Not converted [-]X<something>(=|:)/<path> type switch in :$variable:.\n");
 212       if ( (defined $debug_light) or (defined $debug) ) { die "\nNot processed [-]X<something>(=|:)/...\n"; }
 213   }
 214
 215   if ( defined $debug ) { print(STDERR "WinFormat:\nresult:$variable\n");};
 216   return $variable;
 217 }
 218
 219 #----------------------------------------------------------
 220 # Function name: replace_cyg
 221 # Description:   Process all arguments and change them to Windows Format.
 222 # Arguments:     Reference to array with arguments
 223 # Return value:  -
 224 #----------------------------------------------------------
 225 sub replace_cyg {
 226     my $args = shift;
 227     my( @cmd_file, @cmd_temp );
 228     my $atchars;
 229     foreach my $para ( @$args )
 230       {
 231         if ( $para =~ "^@" ) {
 232           # it's a command file
 233           if ( defined $debug ) { print(STDERR "----------------------------\n");};
 234           # Workaround, iz28717, keep number of @'s.
 235           $para =~ s/(^\@+)//;
 236           $atchars = $1;
 237           $filename = $para;
 238           if ( defined $debug ) { print(STDERR "filename = $filename \n");};
 239           # open this command file for reading
 240           open(CMD, "$filename");
 241           while ( <CMD> ) {
 242             # Remove DOS lineendings. Bug in Cygwin / Perl?
 243             $_ =~ s/\r//g;
 244             # Remove lineendings and trailing spaces. ( Needed by &parse_line )
 245             $_ =~ s/\n$//g;
 246             $_ =~ s/\s+$//g;
 247             # Fill all tokens into array
 248             @cmd_temp = &parse_line('\s+', 1, $_ );
 249             if ( $#cmd_temp > -1 ) {
 250                 push( @cmd_file, @cmd_temp);
 251             }
 252           }
 253           close(CMD);
 254           # reformat all tokens
 255           replace_cyg(\@cmd_file);
 256           if ( defined $debug ) { print(STDERR "Tokens processed:\n");};
 257           foreach $i (@cmd_file) {
 258             if ( defined $debug ) { print(STDERR "!".$i."!\n");};
 259           }
 260           # open this filename for writing (truncate) Textmode?
 261           open(CMD, '>', $filename);
 262           # write all tokens back into this file
 263           print(CMD join(' ', @cmd_file));
 264           close(CMD);
 265           # convert '@filename' to dos style
 266           $para = WinFormat( $para );
 267           if ( defined $debug ) { print(STDERR "----------------------------\n");};
 268           if ( (defined $debug_light) or (defined $debug) ) { print(STDERR "\nParameter in File:".join(' ', @cmd_file).":\n");}
 269           $para = $atchars.$para;
 270         } else {
 271           # it's just a parameter
 272           if ( defined $debug ) { print(STDERR "\nParameter:---${para}---\n");};
 273           # If $tmp1 is empty then $para is a parameter.
 274           my $is_no_para = 1;
 275           # remove .exe and convert to lower case
 276           $shortcommand = lc $command ;
 277           $shortcommand =~ s/\.exe$//;
 278           $shortcommand =~ /([^\/]+$)/;
 279           $shortcommand = $1;
 280           foreach $i (@{$knownpara{$shortcommand}}) {
 281             if( $para =~ /$i/ ) {
 282               $is_no_para = 0;
 283               if ( defined $debug ) { print(STDERR "Is parameter exception for ${shortcommand}: ${para}:\n" );};
 284               last;
 285             }
 286           }
 287           if( $is_no_para ) {
 288             $para = WinFormat($para);
 289           }
 290           if ( defined $debug ) { print(STDERR "Converted line:${para}:\n" );};
 291         } # else
 292       } # foreach loop
 293 }
 294
 295 #----------------------------------------------------------
 296 # Function name: replace_cyg_env
 297 # Description:   Process selected environment variables and change
 298 #                them to Windows Format.
 299 # Arguments:     -
 300 # Return value:  -
 301 #----------------------------------------------------------
 302 sub replace_cyg_env {
 303     @affected_vars = (
 304         'SOLAR_VERSION',
 305         'SOLARVERSION',
 306         'SOLARVER',
 307         'SRC_ROOT',
 308         'LOCALINI',
 309         'GLOBALINI',
 310         'SOLARENV',
 311         'STAR_INSTPATH',
 312         'STAR_SOLARPATH',
 313         'STAR_PACKMISC',
 314         'STAR_SOLARENVPATH',
 315         'STAR_INITROOT',
 316         'STAR_STANDLST',
 317         'CLASSPATH',
 318         'JAVA_HOME'
 319     );
 320     foreach my $one_var ( @affected_vars )
 321     {
 322         my $this_var = $ENV{ $one_var };
 323         if ( defined $this_var )
 324         {
 325             if ( defined $debug ) { print(STDERR "ENV $one_var before: ".$ENV{ $one_var}."\n" );};
 326             $ENV{ $one_var } = WinFormat( $this_var );
 327             if ( defined $debug ) { print(STDERR "ENV $one_var after : ".$ENV{ $one_var}."\n" );};
 328         }
 329     }
 330
 331 }
 332 #---------------------------------------------------------------------------
 333 # main
 334 @params = @ARGV;
 335
 336 $command = shift(@params);
 337 while ( $command =~ /^-/ )
 338 {
 339     if ( $command eq "-env" )
 340     {
 341         replace_cyg_env;
 342     }
 343
 344     $command = shift(@params);
 345 }
 346 if ( (defined $debug_light) or (defined $debug) ) { print( STDERR "Command: $command\n" ); }
 347
 348 replace_cyg(\@params);
 349 if ( (defined $debug_light) or (defined $debug) ) { print(STDERR "\n---------------------\nExecute: $command @params\n----------------\n");};
 350 exec( "$command", @params) or die( "\nError: guw.pl: executing $command failed!\n" );
 351