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