1#************************************************************** 2# 3# Licensed to the Apache Software Foundation (ASF) under one 4# or more contributor license agreements. See the NOTICE file 5# distributed with this work for additional information 6# regarding copyright ownership. The ASF licenses this file 7# to you under the Apache License, Version 2.0 (the 8# "License"); you may not use this file except in compliance 9# with the License. You may obtain a copy of the License at 10# 11# http://www.apache.org/licenses/LICENSE-2.0 12# 13# Unless required by applicable law or agreed to in writing, 14# software distributed under the License is distributed on an 15# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16# KIND, either express or implied. See the License for the 17# specific language governing permissions and limitations 18# under the License. 19# 20#************************************************************** 21 22 23 24#************************************************************************* 25# 26# SourceConfigHelper - Perl extension for parsing general info databases 27# 28# usage: see below 29# 30#************************************************************************* 31 32package SourceConfigHelper; 33 34use strict; 35 36use RepositoryHelper; 37use SourceConfig; 38use Cwd qw (cwd); 39use Carp; 40 41my $debug = 0; 42my @source_config_list; # array of sourceconfig objects 43 44#----------------------------------------------------------------------- 45# Constants 46#----------------------------------------------------------------------- 47 48use constant SOURCE_CONFIG_NONE => 0; 49use constant SOURCE_CONFIG_CURRENT_FIRST => 1; 50use constant SOURCE_CONFIG_ENVIRONMENT_FIRST => 2; 51use constant SOURCE_CONFIG_CURRENT_ONLY => 3; 52use constant SOURCE_CONFIG_ENVIRONMENT_ONLY => 4; 53 54use constant SOURCE_CONFIG_DEFAULT => SOURCE_CONFIG_CURRENT_FIRST; 55 56##### profiling ##### 57 58##### ctor ##### 59 60sub new { 61 my $proto = shift; 62 my $class = ref($proto) || $proto; 63 my $init_action = shift; 64 my $self = {}; 65 my $SourceConfigCurrent; 66 my $SourceConfigEnvironment; 67 68 $init_action = SOURCE_CONFIG_DEFAULT if (!defined ($init_action)); 69 if (!eval ($init_action) or ($init_action < SOURCE_CONFIG_NONE) or ($init_action > SOURCE_CONFIG_ENVIRONMENT_ONLY)) { 70 croak("wrong initial parameter: $init_action\n"); 71 } 72 73 if ($init_action != SOURCE_CONFIG_NONE) { 74 my $repositoryHash_ref = {}; 75 if ($init_action != SOURCE_CONFIG_ENVIRONMENT_ONLY) { 76 my $initial_directory = cwd(); 77 my $result = is_repository($initial_directory, $repositoryHash_ref); 78 if ($result) { 79 $SourceConfigCurrent = SourceConfig->new($repositoryHash_ref->{REPOSITORY_ROOT}); 80 } 81 } 82 if ($init_action != SOURCE_CONFIG_CURRENT_ONLY) { 83 my $source_config = $ENV{SOURCE_ROOT_DIR} . '/' . SourceConfig::SOURCE_CONFIG_FILE_NAME; 84 if (-f $source_config) { 85 $SourceConfigEnvironment = SourceConfig->new($source_config); 86 } 87 } 88 89 # fill array 90 91 if (($init_action == SOURCE_CONFIG_CURRENT_FIRST) or ($init_action == SOURCE_CONFIG_CURRENT_ONLY)) { 92 if (defined ($SourceConfigCurrent)) { 93 push (@source_config_list, $SourceConfigCurrent); 94 } 95 if ($init_action == SOURCE_CONFIG_CURRENT_FIRST) { 96 if (defined ($SourceConfigEnvironment)) { 97 push (@source_config_list, $SourceConfigEnvironment); 98 } 99 } 100 } 101 elsif (($init_action == SOURCE_CONFIG_ENVIRONMENT_FIRST) or ($init_action == SOURCE_CONFIG_ENVIRONMENT_ONLY)) { 102 if (defined ($SourceConfigEnvironment)) { 103 push (@source_config_list, $SourceConfigEnvironment); 104 } 105 if ($init_action == SOURCE_CONFIG_ENVIRONMENT_FIRST) { 106 if (defined ($SourceConfigCurrent)) { 107 push (@source_config_list, $SourceConfigCurrent); 108 } 109 } 110 } 111 } 112 113 $self->{SOURCE_CONFIG_LIST} = \@source_config_list; 114 115 bless($self, $class); 116 return $self; 117} 118 119##### methods ##### 120 121############################################################################################ 122 123sub add_SourceConfig { 124 my $self = shift; 125 my $source_config = shift; 126 push (@{$self->{SOURCE_CONFIG_LIST}}, $source_config); 127} 128 129############################################################################################ 130 131sub get_SourceConfigList { 132 my $self = shift; 133 return @{$self->{SOURCE_CONFIG_LIST}}; 134} 135 136############################################################################################ 137 138sub has_SourceConfig { 139 my $self = shift; 140 my $result = 0; 141 my $count = @{$self->{SOURCE_CONFIG_LIST}}; 142 $result = 1 if ($count > 0); 143 return $result; 144} 145 146############################################################################################ 147 148sub get_module_path { 149 my $self = shift; 150 my $module = shift; 151 my $function = \&SourceConfig::get_module_path; 152 my $result; 153 $result = $self->get_StringResult ($function, $module); 154 return $result; 155} 156 157############################################################################################ 158 159sub get_active_modules { 160 my $self = shift; 161 my $parameter; # empty 162 my $function = \&SourceConfig::get_active_modules; 163 my $array_ref; 164 $array_ref = $self->get_ArrayResult ($function, $parameter); 165 return @$array_ref; 166} 167 168############################################################################################ 169 170sub get_repositories { 171 my $self = shift; 172 my $parameter; # empty 173 my $function = \&SourceConfig::get_repositories; 174 my $array_ref; 175 $array_ref = $self->get_ArrayResult ($function, $parameter); 176 return @$array_ref; 177} 178 179############################################################################################ 180 181sub get_module_repository { 182 my $self = shift; 183 my $module = shift; 184 my $function = \&SourceConfig::get_module_repository; 185 my $result; 186 $result = $self->get_StringResult ($function, $module); 187 return $result; 188} 189 190############################################################################################ 191 192sub is_active { 193 my $self = shift; 194 my $module = shift; 195 my $function = \&SourceConfig::is_active; 196 my $result_ref; 197 my $is_active = 0; 198 $result_ref = $self->get_ResultOfList ($function, $module); 199 my $count = @$result_ref; 200 if ($count>0) { 201 foreach my $active (@$result_ref) { 202 if ($active) { 203 $is_active = $active; 204 } 205 } 206 } 207 return $is_active; 208} 209 210##### private methods ##### 211 212############################################################################################ 213# 214# is_repository () : check if the directory is a valid repository 215# 216# input: - directory 217# - hash reference, where the output will be stored 218# 219# output: 0 = FALSE, the directory is no valid repository 220# 1 = TRUE, the repository root can be found in $repositoryHash_ref->{REPOSITORY_ROOT} 221# 222############################################################################################ 223 224sub is_repository { 225 my $directory = shift; 226 my $repositoryHash_ref = shift; 227 $repositoryHash_ref->{INITIAL_DIRECTORY} = $directory; 228 $repositoryHash_ref->{REPOSITORY_ROOT} = undef; 229 $repositoryHash_ref->{REPOSITORY_NAME} = undef; 230 my $result = RepositoryHelper::search_via_build_lst($repositoryHash_ref); 231 chdir $repositoryHash_ref->{INITIAL_DIRECTORY}; 232 if (!$result) { 233 $result = RepositoryHelper::search_for_hg($repositoryHash_ref); 234 } 235 return $result; 236} 237 238############################################################################################ 239# 240# get_ResultOfList(): give back an array reference from all SourceConfig Objects results 241# 242# input: - function : reference to the called function of each SourceConfig Object 243# - parameter : parameter for the called function 244# 245# output: result : array of all results 246# 247############################################################################################ 248 249sub get_ResultOfList { 250 my $self = shift; 251 my $function = shift; 252 my $parameter = shift; 253 my @result; 254 foreach my $source_config (@{$self->{SOURCE_CONFIG_LIST}}) { 255 push (@result, &$function ($source_config, $parameter)); 256 } 257 return \@result; 258} 259 260############################################################################################ 261# 262# get_StringResult(): give back the first defined result from all SourceConfig Objects 263# 264# input: - function : reference to the called function of each SourceConfig Object 265# - parameter : parameter for the called function 266# 267# output: result : scalar variable (string), undef if no result 268# 269############################################################################################ 270 271sub get_StringResult { 272 my $self = shift; 273 my $function = shift; 274 my $parameter = shift; 275 my $result_ref; 276 $result_ref = $self->get_ResultOfList ($function, $parameter); 277 my $count = @$result_ref; 278 if ($count>0) { 279 my $value; 280 my $i = 0; 281 while (($i < $count) and !defined ($value)) { # search the first defined result 282 $value = $$result_ref[$i]; 283 $i++; 284 } 285 return $value; 286 } 287 return undef; 288} 289 290############################################################################################ 291# 292# get_StringResult(): give back a sorted and uniqe array reference of the results 293# from all SourceConfig Objects 294# 295# input: - function : reference to the called function of each SourceConfig Object 296# - parameter : parameter for the called function 297# 298# output: result : sorted and uniqe array reference 299# 300############################################################################################ 301 302sub get_ArrayResult { 303 my $self = shift; 304 my $function = shift; 305 my $parameter = shift; 306 my $result_ref; 307 my @modules; 308 $result_ref = $self->get_ResultOfList ($function, $parameter); 309 my $count = @$result_ref; 310 if ($count>0) { 311 my %moduleHash; 312 foreach my $module (@$result_ref) { 313 $moduleHash{$module}++; 314 } 315 @modules = sort keys %moduleHash; 316 } 317 return \@modules; 318} 319 320 ##### finish ##### 321 3221; # needed by use or require 323 324__END__ 325 326=head1 NAME 327 328SourceConfigHelper - Perl extension for handling with SourceConfigObjetcs 329 330=head1 SYNOPSIS 331 332 # example that will read source_config file and return the active repositories 333 334 use SourceConfigHelper; 335 336 # Create a new instance: 337 $a = SourceConfigHelper->new(); 338 339 # Get repositories for the actual workspace: 340 $a->get_repositories(); 341 342=head1 DESCRIPTION 343 344SourceConfigHelper is a perl extension to handle more than one objects of SourceConfig 345to set up a search order for modules. 346 347Methods: 348 349SourceConfigHelper::new() 350 351Creates a new instance of SourceConfigHelper. Can be initialized by: default - empty or with a constant of search order. default: the source_config will be taken first from the current repository and second from the environment 352Possible parameters are: 353SourceConfigHelper::SOURCE_CONFIG_NONE - no SourceConfig Object will be created 354SourceConfigHelper::SOURCE_CONFIG_CURRENT_FIRST - use the current repository first 355SourceConfigHelper::SOURCE_CONFIG_ENVIRONMENT_FIRST - use the repository of the environment first 356SourceConfigHelper::SOURCE_CONFIG_CURRENT_ONLY - use only the current repository 357SourceConfigHelper::SOURCE_CONFIG_ENVIRONMENT_ONLY - use only the repository of the environment 358 359SourceConfigHelper::get_repositories() 360 361Returns sorted list of active repositories for the actual workspace 362 363SourceConfigHelper::get_active_modules() 364 365Returns a sorted list of active modules 366 367SourceConfigHelper::get_all_modules() 368 369Returns sorted list of all modules in active repositories. 370 371SourceConfigHelper::get_module_path($module) 372 373Returns absolute module path. If the module is not active or don't exists, "undef" will be returned. 374 375SourceConfigHelper::get_module_repository($module) 376 377Returns the module's repository. If the module is not active or don't exists, "undef" will be returned. 378 379SourceConfigHelper::is_active() 380 381Returns 1 (TRUE) if a module is active 382Returns 0 (FALSE) if a module is not active 383 384SourceConfigHelper::add_SourceConfig($SourceConfigObject) 385 386Add the SourceConfigObject to the end of the list 387 388SourceConfigHelper::get_SourceConfigList() 389 390Return an array of SourceConfigObjects 391 392SourceConfigHelper::has_SourceConfig() 393 394Returns 1 (TRUE) if one or more SourceConfig Objects is in the list 395Returns 0 (FALSE) if no SourceConfig Object is in the list (can happen if there is no valid repository) 396 397=head2 EXPORT 398 399SourceConfigHelper::new() 400SourceConfigHelper::get_repositories() 401SourceConfigHelper::get_active_modules() 402SourceConfigHelper::get_all_modules() 403SourceConfigHelper::get_module_path($module) 404SourceConfigHelper::get_module_repository($module) 405SourceConfigHelper::is_active($module) 406SourceConfigHelper::add_SourceConfig($SourceConfigObject) 407SourceConfigHelper::get_SourceConfigList() 408SourceConfigHelper::has_SourceConfig() 409 410=head1 AUTHOR 411 412Kurt Zenker, kz@openoffice.org 413 414=head1 SEE ALSO 415 416perl(1). 417 418=cut 419