1*9780544fSAndrew Rist#************************************************************** 2*9780544fSAndrew Rist# 3*9780544fSAndrew Rist# Licensed to the Apache Software Foundation (ASF) under one 4*9780544fSAndrew Rist# or more contributor license agreements. See the NOTICE file 5*9780544fSAndrew Rist# distributed with this work for additional information 6*9780544fSAndrew Rist# regarding copyright ownership. The ASF licenses this file 7*9780544fSAndrew Rist# to you under the Apache License, Version 2.0 (the 8*9780544fSAndrew Rist# "License"); you may not use this file except in compliance 9*9780544fSAndrew Rist# with the License. You may obtain a copy of the License at 10*9780544fSAndrew Rist# 11*9780544fSAndrew Rist# http://www.apache.org/licenses/LICENSE-2.0 12*9780544fSAndrew Rist# 13*9780544fSAndrew Rist# Unless required by applicable law or agreed to in writing, 14*9780544fSAndrew Rist# software distributed under the License is distributed on an 15*9780544fSAndrew Rist# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16*9780544fSAndrew Rist# KIND, either express or implied. See the License for the 17*9780544fSAndrew Rist# specific language governing permissions and limitations 18*9780544fSAndrew Rist# under the License. 19*9780544fSAndrew Rist# 20*9780544fSAndrew Rist#************************************************************** 21*9780544fSAndrew Rist 22*9780544fSAndrew Rist 23cdf0e10cSrcweir 24cdf0e10cSrcweir#************************************************************************* 25cdf0e10cSrcweir# 26cdf0e10cSrcweir# SourceConfig - Perl extension for parsing general info databases 27cdf0e10cSrcweir# 28cdf0e10cSrcweir# usage: see below 29cdf0e10cSrcweir# 30cdf0e10cSrcweir#************************************************************************* 31cdf0e10cSrcweir 32cdf0e10cSrcweirpackage SourceConfig; 33cdf0e10cSrcweir 34cdf0e10cSrcweiruse strict; 35cdf0e10cSrcweir 36cdf0e10cSrcweiruse constant SOURCE_CONFIG_FILE_NAME => 'source_config'; 37cdf0e10cSrcweiruse constant SOURCE_CONFIG_VERSION => 3; 38cdf0e10cSrcweir 39cdf0e10cSrcweiruse Carp; 40cdf0e10cSrcweiruse Cwd; 41cdf0e10cSrcweiruse RepositoryHelper; 42cdf0e10cSrcweiruse File::Basename; 43cdf0e10cSrcweiruse File::Temp qw(tmpnam); 44cdf0e10cSrcweir 45cdf0e10cSrcweirmy $debug = 0; 46cdf0e10cSrcweir 47cdf0e10cSrcweir##### profiling ##### 48cdf0e10cSrcweir 49cdf0e10cSrcweir##### ctor ##### 50cdf0e10cSrcweir 51cdf0e10cSrcweirsub new { 52cdf0e10cSrcweir my $proto = shift; 53cdf0e10cSrcweir my $class = ref($proto) || $proto; 54cdf0e10cSrcweir my $source_root = shift; 55149f2bc0SAndre Fischer my @additional_repositories = @_; 56149f2bc0SAndre Fischer 57cdf0e10cSrcweir my $self = {}; 58cdf0e10cSrcweir $self->{USER_SOURCE_ROOT} = undef; 59cdf0e10cSrcweir $self->{SOURCE_CONFIG_FILE} = undef; 60cdf0e10cSrcweir if (defined $source_root) { 61cdf0e10cSrcweir $source_root = Cwd::realpath($source_root); 62cdf0e10cSrcweir $source_root =~ s/\\|\/$//; 63cdf0e10cSrcweir if (-f $source_root) { 64cdf0e10cSrcweir # We have path to source_config 65cdf0e10cSrcweir if (File::Basename::basename($source_root) eq 'source_config') { 66cdf0e10cSrcweir # We have path to source_config 67cdf0e10cSrcweir $self->{SOURCE_CONFIG_FILE} = $source_root; 68cdf0e10cSrcweir $source_root = File::Basename::dirname($source_root); 69cdf0e10cSrcweir } else { 70cdf0e10cSrcweir croak("$source_root is not a source_config file"); 71cdf0e10cSrcweir }; 72cdf0e10cSrcweir } else { 73cdf0e10cSrcweir $self->{USER_SOURCE_ROOT} = $source_root; 74cdf0e10cSrcweir $source_root .= '/..'; 75cdf0e10cSrcweir } 76cdf0e10cSrcweir } else { 77cdf0e10cSrcweir $source_root = $ENV{SOURCE_ROOT_DIR}; 78cdf0e10cSrcweir }; 79cdf0e10cSrcweir $source_root = Cwd::realpath($source_root); 80cdf0e10cSrcweir $self->{SOURCE_ROOT} = $source_root; 81cdf0e10cSrcweir $self->{DEBUG} = 0; 82cdf0e10cSrcweir $self->{VERBOSE} = 0; 83cdf0e10cSrcweir $self->{REPOSITORIES} = {}; 84cdf0e10cSrcweir $self->{ACTIVATED_REPOSITORIES} = {}; 85cdf0e10cSrcweir $self->{MODULE_PATHS} = {}; 86cdf0e10cSrcweir $self->{MODULE_BUILD_LIST_PATHS} = {}; 87cdf0e10cSrcweir $self->{ACTIVATED_MODULES} = {}; 88cdf0e10cSrcweir $self->{MODULE_REPOSITORY} = {}; 89cdf0e10cSrcweir $self->{REAL_MODULES} = {}; 90cdf0e10cSrcweir $self->{NEW_MODULES} = []; 91cdf0e10cSrcweir $self->{REMOVE_MODULES} = {}; 92cdf0e10cSrcweir $self->{REMOVE_REPOSITORIES} = {}; 93cdf0e10cSrcweir $self->{NEW_REPOSITORIES} = []; 94cdf0e10cSrcweir $self->{WARNINGS} = []; 95cdf0e10cSrcweir $self->{REPORT_MESSAGES} = []; 96cdf0e10cSrcweir $self->{CONFIG_FILE_CONTENT} = []; 97cdf0e10cSrcweir if (defined $self->{USER_SOURCE_ROOT}) { 98cdf0e10cSrcweir ${$self->{REPOSITORIES}}{File::Basename::basename($self->{USER_SOURCE_ROOT})} = $self->{USER_SOURCE_ROOT}; 99cdf0e10cSrcweir }; 100cdf0e10cSrcweir $self->{SOURCE_CONFIG_FILE} = get_config_file($self->{SOURCE_ROOT}) if (!defined $self->{SOURCE_CONFIG_FILE}); 101cdf0e10cSrcweir $self->{SOURCE_CONFIG_DEFAULT} = $self->{SOURCE_ROOT} .'/'.SOURCE_CONFIG_FILE_NAME; 102cdf0e10cSrcweir if (defined $self->{USER_SOURCE_ROOT}) { 103cdf0e10cSrcweir ${$self->{REPOSITORIES}}{File::Basename::basename($self->{USER_SOURCE_ROOT})} = $self->{USER_SOURCE_ROOT}; 104cdf0e10cSrcweir }; 105149f2bc0SAndre Fischer foreach my $additional_repository (@additional_repositories) 106149f2bc0SAndre Fischer { 107149f2bc0SAndre Fischer ${$self->{REPOSITORIES}}{File::Basename::basename($additional_repository)} = $additional_repository; 108149f2bc0SAndre Fischer } 109149f2bc0SAndre Fischer 110cdf0e10cSrcweir read_config_file($self); 111cdf0e10cSrcweir get_module_paths($self); 112cdf0e10cSrcweir bless($self, $class); 113cdf0e10cSrcweir return $self; 114cdf0e10cSrcweir} 115cdf0e10cSrcweir 116cdf0e10cSrcweir##### methods ##### 117cdf0e10cSrcweir 118cdf0e10cSrcweirsub get_version { 119cdf0e10cSrcweir return SOURCE_CONFIG_VERSION; 120cdf0e10cSrcweir}; 121cdf0e10cSrcweir 122cdf0e10cSrcweirsub get_repositories 123cdf0e10cSrcweir{ 124cdf0e10cSrcweir my $self = shift; 125cdf0e10cSrcweir return sort keys %{$self->{REPOSITORIES}}; 126cdf0e10cSrcweir} 127cdf0e10cSrcweir 128cdf0e10cSrcweirsub add_repository 129cdf0e10cSrcweir{ 130cdf0e10cSrcweir my $self = shift; 131cdf0e10cSrcweir my $new_rep_path = shift; 132cdf0e10cSrcweir $new_rep_path = Cwd::realpath($new_rep_path); 133cdf0e10cSrcweir my $new_rep_name = File::Basename::basename($new_rep_path); 134cdf0e10cSrcweir if (defined ${$self->{REPOSITORIES}}{$new_rep_name}) { 135cdf0e10cSrcweir croak("Repository $new_rep_name is already defined!!"); 136cdf0e10cSrcweir }; 137cdf0e10cSrcweir ${$self->{REPOSITORIES}}{$new_rep_name} = $new_rep_path; 138cdf0e10cSrcweir $self -> get_repository_module_paths($new_rep_name); 139cdf0e10cSrcweir} 140cdf0e10cSrcweir 141cdf0e10cSrcweirsub get_config_file_default_path { 142cdf0e10cSrcweir my $self = shift; 143cdf0e10cSrcweir return $self->{SOURCE_CONFIG_DEFAULT}; 144cdf0e10cSrcweir} 145cdf0e10cSrcweir 146cdf0e10cSrcweirsub get_config_file_path { 147cdf0e10cSrcweir my $self = shift; 148cdf0e10cSrcweir return $self->{SOURCE_CONFIG_FILE}; 149cdf0e10cSrcweir} 150cdf0e10cSrcweir 151cdf0e10cSrcweirsub get_module_repository { 152cdf0e10cSrcweir my $self = shift; 153cdf0e10cSrcweir my $module = shift; 154cdf0e10cSrcweir if (defined ${$self->{MODULE_REPOSITORY}}{$module}) { 155cdf0e10cSrcweir return ${$self->{MODULE_REPOSITORY}}{$module}; 156cdf0e10cSrcweir } else { 157cdf0e10cSrcweir Carp::cluck("No such module $module in active repositories!!\n"); 158cdf0e10cSrcweir return undef; 159cdf0e10cSrcweir }; 160cdf0e10cSrcweir} 161cdf0e10cSrcweir 162cdf0e10cSrcweirsub get_module_path { 163cdf0e10cSrcweir my $self = shift; 164cdf0e10cSrcweir my $module = shift; 165cdf0e10cSrcweir if (defined ${$self->{MODULE_PATHS}}{$module}) { 166cdf0e10cSrcweir return ${$self->{MODULE_PATHS}}{$module}; 167cdf0e10cSrcweir } else { 168cdf0e10cSrcweir Carp::cluck("No path for module $module in active repositories!!\n") if ($debug); 169cdf0e10cSrcweir return undef; 170cdf0e10cSrcweir }; 171cdf0e10cSrcweir} 172cdf0e10cSrcweir 173cdf0e10cSrcweirsub get_module_build_list { 174cdf0e10cSrcweir my $self = shift; 175cdf0e10cSrcweir my $module = shift; 176cdf0e10cSrcweir if (defined ${$self->{MODULE_BUILD_LIST_PATHS}}{$module}) { 177cdf0e10cSrcweir return ${$self->{MODULE_BUILD_LIST_PATHS}}{$module}; 178cdf0e10cSrcweir } else { 179cdf0e10cSrcweir my @possible_build_lists = ('build.lst', 'build.xlist'); # build lists names 180cdf0e10cSrcweir foreach (@possible_build_lists) { 181cdf0e10cSrcweir my $possible_path = ${$self->{MODULE_PATHS}}{$module} . "/prj/$_"; 182cdf0e10cSrcweir if (-e $possible_path) { 183cdf0e10cSrcweir ${$self->{MODULE_BUILD_LIST_PATHS}}{$module} = $possible_path; 184cdf0e10cSrcweir return $possible_path; 185cdf0e10cSrcweir }; 186cdf0e10cSrcweir }; 187cdf0e10cSrcweir Carp::cluck("No build list in module $module found!!\n") if ($self->{DEBUG}); 188cdf0e10cSrcweir return undef; 189cdf0e10cSrcweir }; 190cdf0e10cSrcweir} 191cdf0e10cSrcweir 192cdf0e10cSrcweirsub get_all_modules 193cdf0e10cSrcweir{ 194cdf0e10cSrcweir my $self = shift; 195cdf0e10cSrcweir my $module = shift; 196cdf0e10cSrcweir return sort keys %{$self->{MODULE_PATHS}}; 197cdf0e10cSrcweir}; 198cdf0e10cSrcweir 199cdf0e10cSrcweirsub get_active_modules 200cdf0e10cSrcweir{ 201cdf0e10cSrcweir my $self = shift; 202cdf0e10cSrcweir if (scalar keys %{$self->{ACTIVATED_MODULES}}) { 203cdf0e10cSrcweir return sort keys %{$self->{ACTIVATED_MODULES}}; 204cdf0e10cSrcweir } 205cdf0e10cSrcweir return sort keys %{$self->{REAL_MODULES}}; 206cdf0e10cSrcweir} 207cdf0e10cSrcweir 208cdf0e10cSrcweirsub is_active 209cdf0e10cSrcweir{ 210cdf0e10cSrcweir my $self = shift; 211cdf0e10cSrcweir my $module = shift; 212cdf0e10cSrcweir if (scalar keys %{$self->{ACTIVATED_MODULES}}) { 213cdf0e10cSrcweir return exists ($self->{ACTIVATED_MODULES}{$module}); 214cdf0e10cSrcweir } 215cdf0e10cSrcweir return exists ($self->{REAL_MODULES}{$module}); 216cdf0e10cSrcweir} 217cdf0e10cSrcweir 218cdf0e10cSrcweir##### private methods ##### 219cdf0e10cSrcweir 220cdf0e10cSrcweirsub get_repository_module_paths { 221cdf0e10cSrcweir my $self = shift; 222cdf0e10cSrcweir my $repository = shift; 223cdf0e10cSrcweir my $repository_path = ${$self->{REPOSITORIES}}{$repository}; 224cdf0e10cSrcweir if (opendir DIRHANDLE, $repository_path) { 225cdf0e10cSrcweir foreach my $module (readdir(DIRHANDLE)) { 226cdf0e10cSrcweir next if (($module =~ /^\.+/) || (!-d "$repository_path/$module")); 227cdf0e10cSrcweir my $module_entry = $module; 228cdf0e10cSrcweir if (($module !~ s/\.lnk$//) && ($module !~ s/\.link$//)) { 229cdf0e10cSrcweir $self->{REAL_MODULES}{$module}++; 230cdf0e10cSrcweir } 231cdf0e10cSrcweir my $possible_path = "$repository_path/$module_entry"; 232cdf0e10cSrcweir if (-d $possible_path) { 233cdf0e10cSrcweir if (defined ${$self->{MODULE_PATHS}}{$module}) { 234cdf0e10cSrcweir close DIRHANDLE; 235cdf0e10cSrcweir croak("Ambiguous paths for module $module: $possible_path and " . ${$self->{MODULE_PATHS}}{$module}); 236cdf0e10cSrcweir }; 237cdf0e10cSrcweir ${$self->{MODULE_PATHS}}{$module} = $possible_path; 238cdf0e10cSrcweir ${$self->{MODULE_REPOSITORY}}{$module} = $repository; 239cdf0e10cSrcweir } 240cdf0e10cSrcweir }; 241cdf0e10cSrcweir close DIRHANDLE; 242cdf0e10cSrcweir } else { 243cdf0e10cSrcweir croak("Cannot read $repository_path repository content"); 244cdf0e10cSrcweir }; 245cdf0e10cSrcweir}; 246cdf0e10cSrcweir 247cdf0e10cSrcweirsub get_module_paths { 248cdf0e10cSrcweir my $self = shift; 249cdf0e10cSrcweir foreach my $repository (keys %{$self->{REPOSITORIES}}) { 250cdf0e10cSrcweir get_repository_module_paths($self, $repository); 251cdf0e10cSrcweir }; 252cdf0e10cSrcweir my @false_actives = (); 253cdf0e10cSrcweir foreach (keys %{$self->{ACTIVATED_MODULES}}) { 254cdf0e10cSrcweir push(@false_actives, $_) if (!defined ${$self->{MODULE_PATHS}}{$_}); 255cdf0e10cSrcweir }; 256cdf0e10cSrcweir croak("Error!! Activated module(s): @false_actives\nnot found in the active repositories!! Please check your " . $self->{SOURCE_CONFIG_FILE} . "\n") if (scalar @false_actives); 257cdf0e10cSrcweir croak("No modules found!") if (!scalar keys %{$self->{MODULE_PATHS}}); 258cdf0e10cSrcweir}; 259cdf0e10cSrcweir 260cdf0e10cSrcweirsub get_config_file { 261cdf0e10cSrcweir my $source_root = shift; 262cdf0e10cSrcweir my $possible_path = $source_root . '/' . SOURCE_CONFIG_FILE_NAME; 263cdf0e10cSrcweir return $possible_path if (-f $possible_path); 264cdf0e10cSrcweir return ''; 265cdf0e10cSrcweir}; 266cdf0e10cSrcweir 267cdf0e10cSrcweir# 268cdf0e10cSrcweir# Fallback - fallback repository is based on RepositoryHelper educated guess 269cdf0e10cSrcweir# 270cdf0e10cSrcweirsub get_fallback_repository { 271cdf0e10cSrcweir my $self = shift; 272cdf0e10cSrcweir my $repository_root = RepositoryHelper->new()->get_repository_root(); 273cdf0e10cSrcweir ${$self->{REPOSITORIES}}{File::Basename::basename($repository_root)} = $repository_root; 274cdf0e10cSrcweir}; 275cdf0e10cSrcweir 276cdf0e10cSrcweirsub read_config_file { 277cdf0e10cSrcweir my $self = shift; 278cdf0e10cSrcweir if (!$self->{SOURCE_CONFIG_FILE}) { 279cdf0e10cSrcweir if (!defined $self->{USER_SOURCE_ROOT}) { 280cdf0e10cSrcweir get_fallback_repository($self); 281cdf0e10cSrcweir }; 282cdf0e10cSrcweir return; 283cdf0e10cSrcweir }; 284cdf0e10cSrcweir my $repository_section = 0; 285cdf0e10cSrcweir my $module_section = 0; 286cdf0e10cSrcweir my $line = 0; 287cdf0e10cSrcweir my @file_content = (); 288cdf0e10cSrcweir 289cdf0e10cSrcweir if (open(SOURCE_CONFIG_FILE, $self->{SOURCE_CONFIG_FILE})) { 290cdf0e10cSrcweir foreach (<SOURCE_CONFIG_FILE>) { 291cdf0e10cSrcweir push (@{$self->{CONFIG_FILE_CONTENT}}, $_); 292cdf0e10cSrcweir $line++; 293cdf0e10cSrcweir chomp; 294cdf0e10cSrcweir next if (!/^\S+/); 295cdf0e10cSrcweir next if (/^\s*#+/); 296cdf0e10cSrcweir s/\r\n//; 297cdf0e10cSrcweir if (/^\[repositories\]\s*(\s+#)*/) { 298cdf0e10cSrcweir $module_section = 0; 299cdf0e10cSrcweir $repository_section = 1; 300cdf0e10cSrcweir next; 301cdf0e10cSrcweir }; 302cdf0e10cSrcweir if (/^\[modules\]\s*(\s+#)*/) { 303cdf0e10cSrcweir $module_section = 1; 304cdf0e10cSrcweir $repository_section = 0; 305cdf0e10cSrcweir next; 306cdf0e10cSrcweir }; 307cdf0e10cSrcweir next if (!$repository_section && !$module_section); 308cdf0e10cSrcweir if (/\s*(\S+)=active\s*(\s+#)*/) { 309cdf0e10cSrcweir if ($repository_section) { 310cdf0e10cSrcweir my $repository_source_path = $self->{SOURCE_ROOT} . "/$1"; 311cdf0e10cSrcweir if (defined $ENV{UPDMINOREXT}) { 312cdf0e10cSrcweir $repository_source_path .= $ENV{UPDMINOREXT}; 313cdf0e10cSrcweir if (defined ${$self->{REPOSITORIES}}{$1.$ENV{UPDMINOREXT}}) { 314cdf0e10cSrcweir delete ${$self->{REPOSITORIES}}{$1.$ENV{UPDMINOREXT}}; 315cdf0e10cSrcweir }; 316cdf0e10cSrcweir }; 317cdf0e10cSrcweir ${$self->{REPOSITORIES}}{$1} = $repository_source_path; 318cdf0e10cSrcweir ${$self->{ACTIVATED_REPOSITORIES}}{$1}++; 319cdf0e10cSrcweir next; 320cdf0e10cSrcweir } 321cdf0e10cSrcweir if ($module_section) { 322cdf0e10cSrcweir ${$self->{ACTIVATED_MODULES}}{$1}++; 323cdf0e10cSrcweir next; 324cdf0e10cSrcweir }; 325cdf0e10cSrcweir }; 326cdf0e10cSrcweir croak("Line $line in " . $self->{SOURCE_CONFIG_FILE} . ' violates format. Please make your checks!'); 327cdf0e10cSrcweir }; 328cdf0e10cSrcweir close SOURCE_CONFIG_FILE; 329cdf0e10cSrcweir if (!scalar keys %{$self->{REPOSITORIES}}) { 330cdf0e10cSrcweir get_fallback_repository($self); 331cdf0e10cSrcweir }; 332cdf0e10cSrcweir } else { 333cdf0e10cSrcweir croak('Cannot open ' . $self->{SOURCE_CONFIG_FILE} . ' for reading'); 334cdf0e10cSrcweir }; 335cdf0e10cSrcweir}; 336cdf0e10cSrcweir 337cdf0e10cSrcweirsub remove_all_activated_repositories { 338cdf0e10cSrcweir my $self = shift; 339cdf0e10cSrcweir $self->remove_activated_repositories([keys %{$self->{ACTIVATED_REPOSITORIES}}]); 340cdf0e10cSrcweir}; 341cdf0e10cSrcweir 342cdf0e10cSrcweirsub remove_activated_repositories { 343cdf0e10cSrcweir my $self = shift; 344cdf0e10cSrcweir my $new_repositories_ref = shift; 345cdf0e10cSrcweir push(@{$self->{WARNINGS}}, "\nWARNING: Empty repository list passed for removing from source_config\n") if (!scalar @$new_repositories_ref); 346cdf0e10cSrcweir $self->{VERBOSE} = shift; 347cdf0e10cSrcweir $self->{REMOVE_REPOSITORIES} = {}; 348cdf0e10cSrcweir foreach (@$new_repositories_ref) { 349cdf0e10cSrcweir if (!defined ${$self->{ACTIVATED_REPOSITORIES}}{$_}) { 350cdf0e10cSrcweir push (@{$self->{WARNINGS}}, "\nWARNING: repository $_ is not activated in ". $self->get_config_file_default_path()."\n"); 351cdf0e10cSrcweir } else { 352cdf0e10cSrcweir ${$self->{REMOVE_REPOSITORIES}}{$_}++; 353cdf0e10cSrcweir delete ${$self->{ACTIVATED_REPOSITORIES}}{$_}; 354cdf0e10cSrcweir }; 355cdf0e10cSrcweir }; 356cdf0e10cSrcweir generate_config_file($self); 357cdf0e10cSrcweir}; 358cdf0e10cSrcweir 359cdf0e10cSrcweirsub remove_all_activated_modules { 360cdf0e10cSrcweir my $self = shift; 361cdf0e10cSrcweir $self->remove_activated_modules([keys %{$self->{ACTIVATED_MODULES}}]); 362cdf0e10cSrcweir}; 363cdf0e10cSrcweir 364cdf0e10cSrcweirsub remove_activated_modules { 365cdf0e10cSrcweir my $self = shift; 366cdf0e10cSrcweir my $new_modules_ref = shift; 367cdf0e10cSrcweir push(@{$self->{WARNINGS}}, "\nWARNING: Empty module list passed for removing from source_config\n") if (!scalar @$new_modules_ref); 368cdf0e10cSrcweir $self->{VERBOSE} = shift; 369cdf0e10cSrcweir $self->{REMOVE_MODULES} = {}; 370cdf0e10cSrcweir foreach (@$new_modules_ref) { 371cdf0e10cSrcweir if (!defined ${$self->{ACTIVATED_MODULES}}{$_}) { 372cdf0e10cSrcweir push (@{$self->{WARNINGS}}, "\nWARNING: module $_ is not activated in ". $self->get_config_file_default_path()."\n"); 373cdf0e10cSrcweir } else { 374cdf0e10cSrcweir ${$self->{REMOVE_MODULES}}{$_}++; 375cdf0e10cSrcweir delete ${$self->{ACTIVATED_MODULES}}{$_}; 376cdf0e10cSrcweir }; 377cdf0e10cSrcweir }; 378cdf0e10cSrcweir generate_config_file($self); 379cdf0e10cSrcweir}; 380cdf0e10cSrcweir 381cdf0e10cSrcweirsub add_active_repositories { 382cdf0e10cSrcweir my $self = shift; 383cdf0e10cSrcweir $self->{NEW_REPOSITORIES} = shift; 384cdf0e10cSrcweir croak('Empty repository list passed for addition to source_config') if (!scalar @{$self->{NEW_REPOSITORIES}}); 385cdf0e10cSrcweir $self->{VERBOSE} = shift; 386cdf0e10cSrcweir foreach (@{$self->{NEW_REPOSITORIES}}) { 387cdf0e10cSrcweir $self->add_repository($_); 388cdf0e10cSrcweir }; 389cdf0e10cSrcweir generate_config_file($self); 390cdf0e10cSrcweir}; 391cdf0e10cSrcweir 392cdf0e10cSrcweirsub add_active_modules { 393cdf0e10cSrcweir my $self = shift; 394cdf0e10cSrcweir my $module_list_ref = shift; 395cdf0e10cSrcweir my $ignored_modules_string = ''; 396cdf0e10cSrcweir my @real_modules = (); 397cdf0e10cSrcweir foreach my $module (sort @$module_list_ref) { 398cdf0e10cSrcweir if ($self->get_module_path($module)) { 399cdf0e10cSrcweir push(@real_modules, $module); 400cdf0e10cSrcweir } else { 401cdf0e10cSrcweir $ignored_modules_string .= " $module"; 402cdf0e10cSrcweir }; 403cdf0e10cSrcweir }; 404cdf0e10cSrcweir push (@{$self->{WARNINGS}}, "\nWARNING: following modules are not found in active repositories, and have not been added to the " . $self->get_config_file_default_path() . ":$ignored_modules_string\n") if ($ignored_modules_string); 405cdf0e10cSrcweir $self->{NEW_MODULES} = \@real_modules; 406cdf0e10cSrcweir croak('Empty module list passed for addition to source_config') if (!scalar @{$self->{NEW_MODULES}}); 407cdf0e10cSrcweir $self->{VERBOSE} = shift; 408cdf0e10cSrcweir generate_config_file($self); 409cdf0e10cSrcweir}; 410cdf0e10cSrcweir 411cdf0e10cSrcweirsub add_content { 412cdf0e10cSrcweir my $self = shift; 413cdf0e10cSrcweir my $content = shift; 414cdf0e10cSrcweir my $entries_to_add = shift; 415cdf0e10cSrcweir return if (!scalar @$entries_to_add); 416cdf0e10cSrcweir my $message; 417cdf0e10cSrcweir my $message_part1; 418cdf0e10cSrcweir my $warning_message; 419cdf0e10cSrcweir my $activated_entries; 420cdf0e10cSrcweir 421cdf0e10cSrcweir if ($entries_to_add == $self->{NEW_MODULES}) { 422cdf0e10cSrcweir $self->{NEW_MODULES} = []; 423cdf0e10cSrcweir $message_part1 = "Module(s):\n"; 424cdf0e10cSrcweir $activated_entries = $self->{ACTIVATED_MODULES}; 425cdf0e10cSrcweir } elsif ($entries_to_add == $self->{NEW_REPOSITORIES}) { 426cdf0e10cSrcweir $self->{NEW_REPOSITORIES} = []; 427cdf0e10cSrcweir $message_part1 = "Repositories:\n"; 428cdf0e10cSrcweir $activated_entries = $self->{ACTIVATED_REPOSITORIES}; 429cdf0e10cSrcweir }; 430cdf0e10cSrcweir foreach my $entry (@$entries_to_add) { 431cdf0e10cSrcweir if (defined $$activated_entries{$entry}) { 432cdf0e10cSrcweir $warning_message .= "$entry " 433cdf0e10cSrcweir } else { 434cdf0e10cSrcweir push(@$content, "$entry=active\n"); 435cdf0e10cSrcweir ${$activated_entries}{$entry}++; 436cdf0e10cSrcweir $message .= "$entry " 437cdf0e10cSrcweir }; 438cdf0e10cSrcweir }; 439cdf0e10cSrcweir 440cdf0e10cSrcweir push(@{$self->{REPORT_MESSAGES}}, "\n$message_part1 $message\nhave been added to the ". $self->get_config_file_default_path()."\n") if ($message); 441cdf0e10cSrcweir push (@{$self->{WARNINGS}}, "\nWARNING: $message_part1 $warning_message\nare already added to the ". $self->get_config_file_default_path()."\n") if ($warning_message); 442cdf0e10cSrcweir}; 443cdf0e10cSrcweir 444cdf0e10cSrcweirsub generate_config_file { 445cdf0e10cSrcweir my $self = shift; 446cdf0e10cSrcweir my @config_content_new = (); 447cdf0e10cSrcweir my ($module_section, $repository_section); 448cdf0e10cSrcweir my %removed_modules = (); 449cdf0e10cSrcweir my %removed_repositories = (); 450cdf0e10cSrcweir foreach (@{$self->{CONFIG_FILE_CONTENT}}) { 451cdf0e10cSrcweir if (/^\[repositories\]\s*(\s+#)*/) { 452cdf0e10cSrcweir if ($module_section) { 453cdf0e10cSrcweir $self->add_content(\@config_content_new, $self->{NEW_MODULES}); 454cdf0e10cSrcweir }; 455cdf0e10cSrcweir $module_section = 0; 456cdf0e10cSrcweir $repository_section = 1; 457cdf0e10cSrcweir }; 458cdf0e10cSrcweir if (/^\[modules\]\s*(\s+#)*/) { 459cdf0e10cSrcweir if ($repository_section) { 460cdf0e10cSrcweir $self->add_content(\@config_content_new, $self->{NEW_REPOSITORIES}); 461cdf0e10cSrcweir }; 462cdf0e10cSrcweir $module_section = 1; 463cdf0e10cSrcweir $repository_section = 0; 464cdf0e10cSrcweir }; 465cdf0e10cSrcweir if ($module_section && /\s*(\S+)=active\s*(\s+#)*/) { 466cdf0e10cSrcweir if (defined ${$self->{REMOVE_MODULES}}{$1}) { 467cdf0e10cSrcweir $removed_modules{$1}++; 468cdf0e10cSrcweir next; 469cdf0e10cSrcweir }; 470cdf0e10cSrcweir } 471cdf0e10cSrcweir if ($repository_section && /\s*(\S+)=active\s*(\s+#)*/) { 472cdf0e10cSrcweir if (defined ${$self->{REMOVE_REPOSITORIES}}{$1}) { 473cdf0e10cSrcweir $removed_repositories{$1}++; 474cdf0e10cSrcweir next; 475cdf0e10cSrcweir }; 476cdf0e10cSrcweir } 477cdf0e10cSrcweir push(@config_content_new, $_); 478cdf0e10cSrcweir }; 479cdf0e10cSrcweir if (scalar @{$self->{NEW_MODULES}}) { 480cdf0e10cSrcweir push(@config_content_new, "[modules]\n") if (!$module_section); 481cdf0e10cSrcweir $self->add_content(\@config_content_new, $self->{NEW_MODULES}); 482cdf0e10cSrcweir }; 483cdf0e10cSrcweir if (scalar @{$self->{NEW_REPOSITORIES}}) { 484cdf0e10cSrcweir push(@config_content_new, "[repositories]\n") if (!$repository_section); 485cdf0e10cSrcweir $self->add_content(\@config_content_new, $self->{NEW_REPOSITORIES}); 486cdf0e10cSrcweir }; 487cdf0e10cSrcweir if (scalar keys %removed_modules) { 488cdf0e10cSrcweir my @deleted_modules = keys %removed_modules; 489cdf0e10cSrcweir push(@{$self->{REPORT_MESSAGES}}, "\nModules: @deleted_modules\nhave been removed from the ". $self->get_config_file_default_path()."\n"); 490cdf0e10cSrcweir 491cdf0e10cSrcweir }; 492cdf0e10cSrcweir if (scalar keys %removed_repositories) { 493cdf0e10cSrcweir my @deleted_repositories = keys %removed_repositories; 494cdf0e10cSrcweir push(@{$self->{REPORT_MESSAGES}}, "\nRepositories: @deleted_repositories\nhave been removed from the ". $self->get_config_file_default_path()."\n"); 495cdf0e10cSrcweir 496cdf0e10cSrcweir }; 497cdf0e10cSrcweir 498cdf0e10cSrcweir # Writing file, printing warnings and reports 499cdf0e10cSrcweir 500cdf0e10cSrcweir #check if we need to write a new file 501cdf0e10cSrcweir my $write_needed = 0; 502cdf0e10cSrcweir if ((scalar @{$self->{CONFIG_FILE_CONTENT}}) != (scalar @config_content_new)) { 503cdf0e10cSrcweir $write_needed++; 504cdf0e10cSrcweir } else { 505cdf0e10cSrcweir foreach my $i (0 .. $#{$self->{CONFIG_FILE_CONTENT}}) { 506cdf0e10cSrcweir if (${$self->{CONFIG_FILE_CONTENT}}[$i] ne $config_content_new[$i]) { 507cdf0e10cSrcweir $write_needed++; 508cdf0e10cSrcweir last; 509cdf0e10cSrcweir }; 510cdf0e10cSrcweir }; 511cdf0e10cSrcweir }; 512cdf0e10cSrcweir if ($write_needed) { 513cdf0e10cSrcweir my $temp_config_file = File::Temp::tmpnam($ENV{TMP}); 514cdf0e10cSrcweir die("Cannot open $temp_config_file") if (!open(NEW_CONFIG, ">$temp_config_file")); 515cdf0e10cSrcweir print NEW_CONFIG $_ foreach (@config_content_new); 516cdf0e10cSrcweir close NEW_CONFIG; 517cdf0e10cSrcweir rename($temp_config_file, $self->get_config_file_default_path()) or system("mv", $temp_config_file, $self->get_config_file_default_path()); 518cdf0e10cSrcweir if (-e $temp_config_file) { 519cdf0e10cSrcweir system("rm -rf $temp_config_file") if (!unlink $temp_config_file); 520cdf0e10cSrcweir }; 521cdf0e10cSrcweir $self->{CONFIG_FILE_CONTENT} = \@config_content_new; 522cdf0e10cSrcweir }; 523cdf0e10cSrcweir if ($self->{VERBOSE}) { 524cdf0e10cSrcweir print $_ foreach (@{$self->{WARNINGS}}); 525cdf0e10cSrcweir $self->{VERBOSE} = 0; 526cdf0e10cSrcweir }; 527cdf0e10cSrcweir $self->{WARNINGS} = []; 528cdf0e10cSrcweir print $_ foreach (@{$self->{REPORT_MESSAGES}}); 529cdf0e10cSrcweir $self->{REPORT_MESSAGES} = []; 530cdf0e10cSrcweir}; 531cdf0e10cSrcweir 532cdf0e10cSrcweir##### finish ##### 533cdf0e10cSrcweir 534cdf0e10cSrcweir1; # needed by use or require 535cdf0e10cSrcweir 536cdf0e10cSrcweir__END__ 537cdf0e10cSrcweir 538cdf0e10cSrcweir=head1 NAME 539cdf0e10cSrcweir 540cdf0e10cSrcweirSourceConfig - Perl extension for parsing general info databases 541cdf0e10cSrcweir 542cdf0e10cSrcweir=head1 SYNOPSIS 543cdf0e10cSrcweir 544cdf0e10cSrcweir # example that will read source_config file and return the active repositories 545cdf0e10cSrcweir 546cdf0e10cSrcweir use SourceConfig; 547cdf0e10cSrcweir 548cdf0e10cSrcweir # Create a new instance of the parser: 549cdf0e10cSrcweir $a = SourceConfig->new(); 550cdf0e10cSrcweir 551cdf0e10cSrcweir # Get repositories for the actual workspace: 552cdf0e10cSrcweir $a->get_repositories(); 553cdf0e10cSrcweir 554cdf0e10cSrcweir # Add a repository new_repository for the actual workspace (via full path): 555cdf0e10cSrcweir $a->add_repository(/DEV300/new_repository); 556cdf0e10cSrcweir 557cdf0e10cSrcweir=head1 DESCRIPTION 558cdf0e10cSrcweir 559cdf0e10cSrcweirSourceConfig is a perl extension to load and parse General Info Databses. 560cdf0e10cSrcweirIt uses a simple object oriented interface to retrieve the information stored 561cdf0e10cSrcweirin the database. 562cdf0e10cSrcweir 563cdf0e10cSrcweirMethods: 564cdf0e10cSrcweir 565cdf0e10cSrcweirSourceConfig::new() 566cdf0e10cSrcweir 567cdf0e10cSrcweirCreates a new instance of SourceConfig. Can be initialized by: path to the default repository, path to the source_config, default - empty, the source_config will be taken from the environment 568cdf0e10cSrcweir 569cdf0e10cSrcweir 570cdf0e10cSrcweirSourceConfig::get_version() 571cdf0e10cSrcweir 572cdf0e10cSrcweirReturns version number of the module. Can't fail. 573cdf0e10cSrcweir 574cdf0e10cSrcweir 575cdf0e10cSrcweirSourceConfig::get_repositories() 576cdf0e10cSrcweir 577cdf0e10cSrcweirReturns sorted list of active repositories for the actual workspace 578cdf0e10cSrcweir 579cdf0e10cSrcweir 580cdf0e10cSrcweirSourceConfig::add_repository(REPOSITORY_PATH) 581cdf0e10cSrcweir 582cdf0e10cSrcweirAdds a repository to the list of active repositories 583cdf0e10cSrcweir 584cdf0e10cSrcweir 585cdf0e10cSrcweirSourceConfig::get_active_modules() 586cdf0e10cSrcweir 587cdf0e10cSrcweirReturns a sorted list of active modules 588cdf0e10cSrcweir 589cdf0e10cSrcweirSourceConfig::get_all_modules() 590cdf0e10cSrcweir 591cdf0e10cSrcweirReturns sorted list of all modules in active repositories. 592cdf0e10cSrcweir 593cdf0e10cSrcweirSourceConfig::get_module_path($module) 594cdf0e10cSrcweir 595cdf0e10cSrcweirReturns absolute module path 596cdf0e10cSrcweir 597cdf0e10cSrcweirSourceConfig::get_module_build_list($module) 598cdf0e10cSrcweir 599cdf0e10cSrcweirReturns absolute module build list path 600cdf0e10cSrcweir 601cdf0e10cSrcweirSourceConfig::get_module_repository($module) 602cdf0e10cSrcweir 603cdf0e10cSrcweirReturns the module's repository 604cdf0e10cSrcweir 605cdf0e10cSrcweirSourceConfig::get_config_file_path() 606cdf0e10cSrcweir 607cdf0e10cSrcweirReturns absolute module to the source configuration file 608cdf0e10cSrcweir 609cdf0e10cSrcweirSourceConfig::get_config_file_default_path() 610cdf0e10cSrcweir 611cdf0e10cSrcweirReturns default path for source configuration file 612cdf0e10cSrcweir 613cdf0e10cSrcweirSourceConfig::is_active() 614cdf0e10cSrcweir 615cdf0e10cSrcweirReturns 1 (TRUE) if a module is active 616cdf0e10cSrcweirReturns 0 (FALSE) if a module is not active 617cdf0e10cSrcweir 618cdf0e10cSrcweirSourceConfig::add_active_modules($module_array_ref) 619cdf0e10cSrcweir 620cdf0e10cSrcweirAdds modules from the @$module_array_ref as active to the source_config file 621cdf0e10cSrcweir 622cdf0e10cSrcweirSourceConfig::add_active_repositories($repository_array_ref) 623cdf0e10cSrcweir 624cdf0e10cSrcweirAdds repositories from the @$repository_array_ref as active to the source_config file 625cdf0e10cSrcweir 626cdf0e10cSrcweirSourceConfig::remove_activated_modules($module_array_ref) 627cdf0e10cSrcweir 628cdf0e10cSrcweirRemoves modules from the @$module_array_ref from the source_config file 629cdf0e10cSrcweir 630cdf0e10cSrcweirSourceConfig::remove_all_activated_modules() 631cdf0e10cSrcweir 632cdf0e10cSrcweirRemoves all activated modules from the source_config file 633cdf0e10cSrcweir 634cdf0e10cSrcweirSourceConfig::remove_activated_repositories($repository_array_ref) 635cdf0e10cSrcweir 636cdf0e10cSrcweirRemoves repositories from the @$repository_array_ref from the source_config file 637cdf0e10cSrcweir 638cdf0e10cSrcweirSourceConfig::remove_all_activated_repositories() 639cdf0e10cSrcweir 640cdf0e10cSrcweirRemoves all activated repositories from the source_config file 641cdf0e10cSrcweir 642cdf0e10cSrcweir 643cdf0e10cSrcweir=head2 EXPORT 644cdf0e10cSrcweir 645cdf0e10cSrcweirSourceConfig::new() 646cdf0e10cSrcweirSourceConfig::get_version() 647cdf0e10cSrcweirSourceConfig::get_repositories() 648cdf0e10cSrcweirSourceConfig::add_repository() 649cdf0e10cSrcweirSourceConfig::get_active_modules() 650cdf0e10cSrcweirSourceConfig::get_all_modules() 651cdf0e10cSrcweirSourceConfig::get_module_path($module) 652cdf0e10cSrcweirSourceConfig::get_module_build_list($module) 653cdf0e10cSrcweirSourceConfig::get_module_repository($module) 654cdf0e10cSrcweirSourceConfig::get_config_file_path() 655cdf0e10cSrcweirSourceConfig::get_config_file_default_path() 656cdf0e10cSrcweirSourceConfig::is_active($module) 657cdf0e10cSrcweirSourceConfig::add_active_modules($module_array_ref) 658cdf0e10cSrcweirSourceConfig::add_active_repositories($repository_array_ref) 659cdf0e10cSrcweirSourceConfig::remove_activated_modules($module_array_ref) 660cdf0e10cSrcweirSourceConfig::remove_all_activated_modules() 661cdf0e10cSrcweirSourceConfig::remove_activated_repositories($repository_array_ref) 662cdf0e10cSrcweirSourceConfig::remove_all_activated_repositories() 663cdf0e10cSrcweir 664cdf0e10cSrcweir=head1 AUTHOR 665cdf0e10cSrcweir 666cdf0e10cSrcweirVladimir Glazunov, vg@openoffice.org 667cdf0e10cSrcweir 668cdf0e10cSrcweir=head1 SEE ALSO 669cdf0e10cSrcweir 670cdf0e10cSrcweirperl(1). 671cdf0e10cSrcweir 672cdf0e10cSrcweir=cut 673