solenv/bin/modules/SourceConfig.pm

   1 # -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*-
   2 #*************************************************************************
   3 #
   4 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   5 #
   6 # Copyright 2000, 2010 Oracle and/or its affiliates.
   7 #
   8 # OpenOffice.org - a multi-platform office productivity suite
   9 #
  10 # This file is part of OpenOffice.org.
  11 #
  12 # OpenOffice.org is free software: you can redistribute it and/or modify
  13 # it under the terms of the GNU Lesser General Public License version 3
  14 # only, as published by the Free Software Foundation.
  15 #
  16 # OpenOffice.org is distributed in the hope that it will be useful,
  17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 # GNU Lesser General Public License version 3 for more details
  20 # (a copy is included in the LICENSE file that accompanied this code).
  21 #
  22 # You should have received a copy of the GNU Lesser General Public License
  23 # version 3 along with OpenOffice.org.  If not, see
  24 # <http://www.openoffice.org/license.html>
  25 # for a copy of the LGPLv3 License.
  26 #
  27 #*************************************************************************
  28
  29 #*************************************************************************
  30 #
  31 # SourceConfig - Perl extension for parsing general info databases
  32 #
  33 # usage: see below
  34 #
  35 #*************************************************************************
  36
  37 package SourceConfig;
  38
  39 use strict;
  40
  41 use constant SOURCE_CONFIG_VERSION => 3;
  42
  43 use Carp;
  44 use Cwd;
  45 use RepositoryHelper;
  46 use File::Basename;
  47 use File::Temp qw(tmpnam);
  48
  49 my $debug = 0;
  50
  51 #####  profiling #####
  52
  53 ##### ctor #####
  54
  55 sub new {
  56     my $proto = shift;
  57     my $class = ref($proto) || $proto;
  58     my $source_root = shift;
  59     my $self = {};
  60     $self->{USER_SOURCE_ROOT} = undef;
  61     if (defined $source_root) {
  62         $source_root = Cwd::realpath($source_root);
  63         $source_root =~ s/\\|\/$//;
  64         $self->{USER_SOURCE_ROOT} = $source_root;
  65         $source_root .= '/..';
  66     }
  67     else
  68     {
  69         $source_root = $ENV{SRC_ROOT};
  70     };
  71     $source_root = Cwd::realpath($source_root);
  72     $self->{SOURCE_ROOT} = $source_root;
  73     $self->{DEBUG} = 0;
  74     $self->{VERBOSE} = 0;
  75     $self->{REPOSITORIES} = {};
  76     $self->{ACTIVATED_REPOSITORIES} = {};
  77     $self->{MODULE_PATHS} = {};
  78     $self->{MODULE_GBUILDIFIED} = {};
  79     $self->{MODULE_BUILD_LIST_PATHS} = {};
  80     $self->{MODULE_REPOSITORY} = {};
  81     $self->{REAL_MODULES} = {};
  82     $self->{NEW_MODULES} = [];
  83     $self->{REMOVE_MODULES} = {};
  84     $self->{REMOVE_REPOSITORIES} = {};
  85     $self->{NEW_REPOSITORIES} = [];
  86     $self->{WARNINGS} = [];
  87     $self->{REPORT_MESSAGES} = [];
  88     $self->{CONFIG_FILE_CONTENT} = [];
  89     if (defined $self->{USER_SOURCE_ROOT})
  90     {
  91         ${$self->{REPOSITORIES}}{File::Basename::basename($self->{USER_SOURCE_ROOT})} = $self->{USER_SOURCE_ROOT};
  92     }
  93     else
  94     {
  95         get_fallback_repository($self);
  96     };
  97
  98     get_module_paths($self);
  99     bless($self, $class);
 100     return $self;
 101 }
 102
 103 ##### methods #####
 104
 105 sub get_version {
 106     return SOURCE_CONFIG_VERSION;
 107 };
 108
 109 sub get_repositories
 110 {
 111     my $self        = shift;
 112     return sort keys %{$self->{REPOSITORIES}};
 113 }
 114
 115 sub get_module_repository {
 116     my $self = shift;
 117     my $module = shift;
 118     if (defined ${$self->{MODULE_REPOSITORY}}{$module}) {
 119         return ${$self->{MODULE_REPOSITORY}}{$module};
 120     } else {
 121         Carp::cluck("No such module $module in active repositories!!\n");
 122         return undef;
 123     };
 124 }
 125
 126 sub get_module_path {
 127     my $self = shift;
 128     my $module = shift;
 129     if (defined ${$self->{MODULE_PATHS}}{$module}) {
 130         return ${$self->{MODULE_PATHS}}{$module};
 131     } else {
 132         Carp::cluck("No path for module $module in active repositories!!\n");
 133         return undef;
 134     };
 135 }
 136
 137 sub get_module_build_list {
 138     my $self = shift;
 139     my $module = shift;
 140     if (defined ${$self->{MODULE_BUILD_LIST_PATHS}}{$module}) {
 141         return ${$self->{MODULE_BUILD_LIST_PATHS}}{$module};
 142     }
 143     else
 144     {
 145         my $module_path = ${$self->{MODULE_PATHS}}{$module};
 146         if ( -e $module_path . "/prj/build.lst")
 147         {
 148             ${$self->{MODULE_BUILD_LIST_PATHS}}{$module} = $module_path . "/prj/build.lst";
 149
 150             if (!-e $module_path . "/prj/dmake" )
 151             {
 152 #                print "module $module -> gbuild\n";
 153                 ${$self->{MODULE_GBUILDIFIED}}{$module} = 1;
 154             }
 155             else
 156             {
 157 #                print "module $module -> dmake\n";
 158                 ${$self->{MODULE_GBUILDIFIED}}{$module} = 0;
 159             }
 160             return $module_path . "/prj/build.lst";
 161         };
 162         Carp::cluck("No build list in module $module found!!\n") if ($self->{DEBUG});
 163         return undef;
 164     };
 165 }
 166
 167 sub get_all_modules
 168 {
 169     my $self = shift;
 170     my $module = shift;
 171     return sort keys %{$self->{MODULE_PATHS}};
 172 };
 173
 174 sub get_active_modules
 175 {
 176     my $self        = shift;
 177     return sort keys %{$self->{REAL_MODULES}};
 178 }
 179
 180 sub is_active
 181 {
 182     my $self        = shift;
 183     my $module      = shift;
 184     return exists ($self->{REAL_MODULES}{$module});
 185 }
 186
 187 sub is_gbuild
 188 {
 189     my $self        = shift;
 190     my $module      = shift;
 191     if (defined ${$self->{MODULE_GBUILDIFIED}}{$module})
 192     {
 193         return ${$self->{MODULE_GBUILDIFIED}}{$module};
 194     };
 195     return undef;
 196 }
 197
 198 ##### private methods #####
 199
 200 sub get_repository_module_paths {
 201     my $self        = shift;
 202     my $repository        = shift;
 203     my $repository_path = ${$self->{REPOSITORIES}}{$repository};
 204     if (opendir DIRHANDLE, $repository_path) {
 205         foreach my $module (readdir(DIRHANDLE)) {
 206             next if (($module =~ /^\.+/) || (!-d "$repository_path/$module"));
 207             my $module_entry = $module;
 208             if (($module !~ s/\.lnk$//) && ($module !~ s/\.link$//)) {
 209                 $self->{REAL_MODULES}{$module}++;
 210             }
 211             my $possible_path = "$repository_path/$module_entry";
 212             if (-d $possible_path) {
 213                 if (defined ${$self->{MODULE_PATHS}}{$module}) {
 214                     close DIRHANDLE;
 215                     croak("Ambiguous paths for module $module: $possible_path and " . ${$self->{MODULE_PATHS}}{$module});
 216                 };
 217                 ${$self->{MODULE_PATHS}}{$module} = $possible_path;
 218                 ${$self->{MODULE_REPOSITORY}}{$module} = $repository;
 219             }
 220         };
 221         close DIRHANDLE;
 222     } else {
 223         croak("Cannot read $repository_path repository content");
 224     };
 225 };
 226
 227 sub get_module_paths {
 228     my $self        = shift;
 229     foreach my $repository (keys %{$self->{REPOSITORIES}}) {
 230         get_repository_module_paths($self, $repository);
 231     };
 232     croak("No modules found!") if (!scalar keys %{$self->{MODULE_PATHS}});
 233 };
 234
 235 #
 236 # Fallback - fallback repository is based on RepositoryHelper educated guess
 237 #
 238 sub get_fallback_repository {
 239     my $self = shift;
 240     my $repository_root = RepositoryHelper->new()->get_repository_root();
 241     ${$self->{REPOSITORIES}}{File::Basename::basename($repository_root)} = $repository_root;
 242 };
 243
 244 ##### finish #####
 245
 246 1; # needed by use or require
 247