solenv/bin/modules/SourceConfig.pm

   1 #*************************************************************************
   2 #
   3 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 #
   5 # Copyright 2008 by Sun Microsystems, Inc.
   6 #
   7 # OpenOffice.org - a multi-platform office productivity suite
   8 #
   9 # $RCSfile: SourceConfig.pm,v $
  10 #
  11 # $Revision: 1.0 $
  12 #
  13 # This file is part of OpenOffice.org.
  14 #
  15 # OpenOffice.org is free software: you can redistribute it and/or modify
  16 # it under the terms of the GNU Lesser General Public License version 3
  17 # only, as published by the Free Software Foundation.
  18 #
  19 # OpenOffice.org is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU Lesser General Public License version 3 for more details
  23 # (a copy is included in the LICENSE file that accompanied this code).
  24 #
  25 # You should have received a copy of the GNU Lesser General Public License
  26 # version 3 along with OpenOffice.org.  If not, see
  27 # <http://www.openoffice.org/license.html>
  28 # for a copy of the LGPLv3 License.
  29 #
  30 #*************************************************************************
  31
  32 #*************************************************************************
  33 #
  34 # SourceConfig - Perl extension for parsing general info databases
  35 #
  36 # usage: see below
  37 #
  38 #*************************************************************************
  39
  40 package SourceConfig;
  41
  42 use strict;
  43
  44 use constant SOURCE_CONFIG_FILE_NAME => 'source_config';
  45
  46 use Carp;
  47
  48 #####  profiling #####
  49
  50 ##### ctor #####
  51
  52 sub new {
  53     my $proto = shift;
  54     my $class = ref($proto) || $proto;
  55     my $source_root = shift;
  56     if (defined $source_root) {
  57         $source_root =~ s/\\|\/$//;
  58     } else {
  59         $source_root = $ENV{SOLARSRC};
  60     };
  61     my $self = {};
  62     $self->{DEBUG} = 0;
  63     $self->{SOURCE_ROOT} = $source_root;
  64     $self->{REPOSITORIES} = {};
  65     $self->{MODULE_PATHS} = {};
  66     $self->{MODULE_BUILD_LIST_PATHS} = {};
  67     $self->{ACTIVE_MODULES} = {};
  68     $self->{MODULE_REPOSITORY} = {};
  69     $self->{SOURCE_CONFIG_FILE} = get_config_file($source_root);
  70     $self->{SOURCE_CONFIG_DEFAULT} = Cwd::realpath($source_root) .'/'.SOURCE_CONFIG_FILE_NAME;
  71     read_config_file($self);
  72     bless($self, $class);
  73     return $self;
  74 }
  75
  76 ##### methods #####
  77
  78 sub get_repositories
  79 {
  80     my $self        = shift;
  81     return sort keys %{$self->{REPOSITORIES}};
  82 }
  83
  84 sub get_config_file_default_path {
  85     my $self        = shift;
  86     return $self->{SOURCE_CONFIG_DEFAULT};
  87 }
  88
  89 sub get_config_file_path {
  90     my $self = shift;
  91     return $self->{SOURCE_CONFIG_FILE};
  92 }
  93
  94 sub get_module_repository {
  95     my $self = shift;
  96     my $module = shift;
  97     $self -> get_module_paths() if (!scalar keys %{$self->{MODULE_PATHS}});
  98     if (defined ${$self->{MODULE_REPOSITORY}}{$module}) {
  99         return ${$self->{MODULE_REPOSITORY}}{$module};
 100     } else {
 101         Carp::cluck("No such module $module in active repositories!!\n");
 102         return undef;
 103     };
 104 }
 105
 106 sub get_module_path {
 107     my $self = shift;
 108     my $module = shift;
 109     $self -> get_module_paths() if (!scalar keys %{$self->{MODULE_PATHS}});
 110     if (defined ${$self->{MODULE_PATHS}}{$module}) {
 111         return ${$self->{MODULE_PATHS}}{$module};
 112     } else {
 113         Carp::cluck("No path for module $module in active repositories!!\n");
 114         return undef;
 115     };
 116 }
 117
 118 sub get_module_build_list {
 119     my $self = shift;
 120     my $module = shift;
 121     $self -> get_buildlist_paths() if (!scalar keys %{$self->{MODULE_BUILD_LIST_PATHS}});
 122     if (defined ${$self->{MODULE_BUILD_LIST_PATHS}}{$module}) {
 123         return ${$self->{MODULE_BUILD_LIST_PATHS}}{$module};
 124     } else {
 125         Carp::cluck("No build list in module $module found!!\n") if ($self->{DEBUG});
 126         return undef;
 127     };
 128 }
 129
 130 sub get_all_modules
 131 {
 132     my $self = shift;
 133     my $module = shift;
 134     $self -> get_module_paths() if (!scalar keys %{$self->{MODULE_PATHS}});
 135     return sort keys %{$self->{MODULE_PATHS}};
 136 };
 137
 138
 139 sub get_active_modules
 140 {
 141     my $self        = shift;
 142     return sort keys %{$self->{ACTIVE_MODULES}};
 143 }
 144
 145
 146 ##### private methods #####
 147
 148 sub get_buildlist_paths {
 149     my $self        = shift;
 150     $self -> get_module_paths() if (!scalar keys %{$self->{MODULE_PATHS}});
 151     my @possible_build_lists = ('build.lst', 'build.xlist'); # build lists names
 152     foreach my $module (keys %{$self->{MODULE_PATHS}}) {
 153         foreach (@possible_build_lists) {
 154             my $possible_path = ${$self->{MODULE_PATHS}}{$module} . "/prj/$_";
 155             ${$self->{MODULE_BUILD_LIST_PATHS}}{$module} = $possible_path if (-e $possible_path);
 156         };
 157     };
 158 };
 159
 160 sub get_module_paths {
 161     my $self        = shift;
 162     foreach my $repository (keys %{$self->{REPOSITORIES}}) {
 163         my $repository_path = ${$self->{REPOSITORIES}}{$repository};
 164         if (opendir DIRHANDLE, $repository_path) {
 165             foreach my $module (readdir(DIRHANDLE)) {
 166                 next if ($module =~ /^\.+/);
 167                 my $module_entry = $module;
 168                 $module =~ s/\.lnk$//;
 169                 $module =~ s/\.link$//;
 170                 my $possible_path = "$repository_path/$module_entry";
 171                 if (-d $possible_path) {
 172                     if (defined ${$self->{MODULE_PATHS}}{$module}) {
 173                         close DIRHANDLE;
 174                         croak("Ambiguous paths for module $module: $possible_path and " . ${$self->{MODULE_PATHS}}{$module});
 175                     };
 176                     ${$self->{MODULE_PATHS}}{$module} = $possible_path;
 177                     ${$self->{MODULE_REPOSITORY}}{$module} = $repository;
 178                 }
 179             };
 180             close DIRHANDLE;
 181         } else {
 182             croak("Cannot read $_ repository content");
 183         };
 184     };
 185 };
 186
 187 sub get_config_file {
 188     my $source_root = shift;
 189     foreach ($source_root, $source_root . '/..') {
 190         if (-f $_ . '/' . SOURCE_CONFIG_FILE_NAME) {
 191             return Cwd::realpath($_) .'/'.SOURCE_CONFIG_FILE_NAME;
 192         };
 193     };
 194     return '';
 195 };
 196
 197 sub read_config_file {
 198     my $self = shift;
 199     if (!$self->{SOURCE_CONFIG_FILE}) {
 200         ${$self->{REPOSITORIES}}{File::Basename::basename($self->{SOURCE_ROOT})} = $self->{SOURCE_ROOT};
 201         return;
 202     };
 203     my $repository_section = 0;
 204     my $module_section = 0;
 205     my $line = 0;
 206     if (open(SOURCE_CONFIG_FILE, $self->{SOURCE_CONFIG_FILE})) {
 207         foreach (<SOURCE_CONFIG_FILE>) {
 208             $line++;
 209             chomp;
 210             next if (!/^\S+/);
 211             next if (/^\s*#+/);
 212             s/\r\n//;
 213             if (/^\[repositories\]\s*(\s+#)*/) {
 214                 $module_section = 0;
 215                 $repository_section = 1;
 216                 next;
 217             };
 218             if (/^\[modules\]\s*(\s+#)*/) {
 219                 $module_section = 1;
 220                 $repository_section = 0;
 221                 next;
 222             };
 223             next if (!$repository_section && !$module_section);
 224             if (/\s*(\S+)=active\s*(\s+#)*/) {
 225                 if ($repository_section) {
 226                     ${$self->{REPOSITORIES}}{$1} = File::Basename::dirname($self->{SOURCE_ROOT}) . "/$1";
 227                     next;
 228                 }
 229                 if ($module_section) {
 230                     ${$self->{ACTIVE_MODULES}}{$1}++;
 231                     next;
 232                 };
 233             };
 234             croak("Line $line in " . $self->{SOURCE_CONFIG_FILE} . 'violates format. Please make your checks!!');
 235         };
 236         close SOURCE_CONFIG_FILE;
 237     } else {
 238         croak('Cannot open ' . $self->{SOURCE_CONFIG_FILE} . 'for reading');
 239     };
 240 };
 241
 242 ##### finish #####
 243
 244 1; # needed by use or require
 245
 246 __END__
 247
 248 =head1 NAME
 249
 250 SourceConfig - Perl extension for parsing general info databases
 251
 252 =head1 SYNOPSIS
 253
 254     # example that will read source_config file and return the active repositories
 255
 256     use SourceConfig;
 257
 258     # Create a new instance of the parser:
 259     $a = SourceConfig->new();
 260
 261     # Get repositories for the actual workspace:
 262     $a->get_repositories();
 263
 264
 265 =head1 DESCRIPTION
 266
 267 SourceConfig is a perl extension to load and parse General Info Databses.
 268 It uses a simple object oriented interface to retrieve the information stored
 269 in the database.
 270
 271 Methods:
 272
 273 SourceConfig::new()
 274
 275 Creates a new instance of SourceConfig. Can't fail.
 276
 277
 278 SourceConfig::get_repositories()
 279
 280 Returns sorted list of active repositories for the actual workspace
 281
 282
 283 SourceConfig::get_active_modules()
 284
 285 Returns a sorted list of active modules
 286
 287 SourceConfig::get_all_modules()
 288
 289 Returns sorted list of all modules in active repositories.
 290
 291 SourceConfig::get_module_path($module)
 292
 293 Returns absolute module path
 294
 295 SourceConfig::get_module_build_list($module)
 296
 297 Returns absolute module build list path
 298
 299 SourceConfig::get_module_repository($module)
 300
 301 Returns the module's repository
 302
 303 SourceConfig::get_config_file_path()
 304
 305 Returns absolute module to the source configuration file
 306
 307 SourceConfig::get_config_file_default_path()
 308
 309 Returns default path for source configuration file
 310
 311 =head2 EXPORT
 312
 313 SourceConfig::new()
 314 SourceConfig::get_repositories()
 315 SourceConfig::get_active_modules()
 316 SourceConfig::get_all_modules()
 317 SourceConfig::get_module_path($module)
 318 SourceConfig::get_module_build_list($module)
 319 SourceConfig::get_module_repository($module)
 320 SourceConfig::get_config_file_path()
 321 SourceConfig::get_config_file_default_path()
 322
 323 =head1 AUTHOR
 324
 325 Vladimir Glazunov, vg@openoffice.com
 326
 327 =head1 SEE ALSO
 328
 329 perl(1).
 330
 331 =cut