solenv/bin/mkout.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
  31 #
  32 # mkout.pl - create output tree
  33 #
  34
  35 use Cwd;
  36 use Getopt::Std;
  37 use File::Path;
  38
  39 #### script id #####
  40
  41 ( $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
  42
  43 #### globals ####
  44
  45 $is_debug   = 0;
  46
  47 $base_dir   = 0;            # path to module base directory
  48 $dir_mode   = 0755;         # default directory creation mode
  49
  50 $envpath    = 0;            # platform/product combination
  51 $opt_r      = 0;            # create 'remote' subdirs
  52
  53 %sub_dirs   = (
  54 #               dirname    remote(yes/no)
  55                 'bin'   => 1,
  56                 'class' => 0,
  57                 'inc'   => 0,
  58                 'lib'   => 1,
  59                 'misc/logs'  => 1,
  60                 'obj'   => 1,
  61                 'res'   => 1,
  62                 'slb'   => 1,
  63                 'slo'   => 1,
  64                 'srs'   => 1
  65             );
  66
  67 #### main ####
  68
  69 parse_options();
  70 init_globals();
  71 create_dirs();
  72
  73 exit(0);
  74
  75 #### subroutines #####
  76
  77 sub parse_options {
  78     my $rc;
  79
  80     $rc = getopts('r');
  81
  82     if ( !$rc || $#ARGV > 0 ) {
  83         usage();
  84         exit(1);
  85     }
  86     $envpath = $ARGV[0] if defined($ARGV[0]);
  87 }
  88
  89 sub init_globals {
  90     my $umask;
  91     $base_dir =  get_base();
  92     print "Base_Diri=$base_dir\n" if $is_debug;
  93
  94     $umask = umask();
  95     if ( defined($umask) ) {
  96         $dir_mode = 0777 - $umask;
  97     }
  98     $envpath = $ENV{INPATH} unless $envpath;
  99
 100     if ( !$envpath ) {
 101         print_error("can't determine platform/environment");
 102         exit(3);
 103     }
 104     print "Platform/Environment: $envpath\n" if $is_debug;
 105 }
 106
 107 sub get_base {
 108     # a module base dir contains a subdir 'prj'
 109     # which in turn contains a file 'd.lst'
 110     my (@field, $base, $dlst);
 111     my $path = cwd();
 112
 113     @field = split(/\//, $path);
 114
 115     while ( $#field != -1 ) {
 116         $base = join('/', @field);
 117         $dlst = $base . '/prj/d.lst';
 118         last if -e $dlst;
 119         pop @field;
 120     }
 121
 122     if ( $#field == -1 ) {
 123         print_error("can't determine module");
 124         exit(2);
 125     }
 126     else {
 127         return $base;
 128     }
 129 }
 130
 131 sub create_dirs {
 132     foreach $dir ( keys %sub_dirs ) {
 133         $path = $base_dir . '/' . $envpath . '/' . $dir;
 134         if ( $opt_r && $sub_dirs{$dir} ) {
 135             $path .= "/remote";
 136         }
 137         eval { mkpath($path, 0, $dir_mode) };
 138         if ( $@ ) {
 139             print_error( "$@" );
 140         }
 141         print "Create path: $path\n" if $is_debug;
 142     }
 143 }
 144
 145 sub print_error {
 146     my $message = shift;
 147
 148     print STDERR "$script_name: ERROR: $message\n";
 149 }
 150
 151 sub usage {
 152     print STDERR "Usage:\n$script_name [-r] [platform/environment]\n";
 153     print STDERR "Options:\n  -r create 'remote' directories\n";
 154 }
 155
 156 # vim: set ts=4 shiftwidth=4 expandtab syntax=perl: