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# CwsConfig.pm - package for read CWS config data 27cdf0e10cSrcweir# 28cdf0e10cSrcweir 29cdf0e10cSrcweirpackage CwsConfig; 30cdf0e10cSrcweiruse strict; 31cdf0e10cSrcweir 32cdf0e10cSrcweiruse Carp; 33cdf0e10cSrcweiruse URI::Escape; 34cdf0e10cSrcweir 35cdf0e10cSrcweir##### ctor #### 36cdf0e10cSrcweir 37cdf0e10cSrcweirsub new 38cdf0e10cSrcweir{ 39cdf0e10cSrcweir my $invocant = shift; 40cdf0e10cSrcweir my $class = ref($invocant) || $invocant; 41cdf0e10cSrcweir my $self = {}; 42cdf0e10cSrcweir $self->{_CONFIG_FILE} = undef; # config file 43cdf0e10cSrcweir $self->{_GLOBAL} = undef; # is it a global config file? 44cdf0e10cSrcweir $self->{VCSID} = undef; # VCSID 45cdf0e10cSrcweir $self->{CWS_DB_URL_LIST_REF} = undef; # list of CWS DB servers 46cdf0e10cSrcweir $self->{NET_PROXY} = undef; # network proxy 47cdf0e10cSrcweir $self->{CWS_SERVER_ROOT} = undef; # cvs server 48cdf0e10cSrcweir $self->{CWS_MIRROR_ROOT} = undef; # mirror of cvs server 49cdf0e10cSrcweir $self->{CWS_LOCAL_ROOT} = undef; # local cvs server 50cdf0e10cSrcweir $self->{PUBLIC_SVN_SERVER} = undef; # public svn server 51cdf0e10cSrcweir $self->{PRIVATE_SVN_SERVER} = undef; # private svn server 52cdf0e10cSrcweir bless ($self, $class); 53cdf0e10cSrcweir return $self; 54cdf0e10cSrcweir} 55cdf0e10cSrcweir 56cdf0e10cSrcweirsub vcsid 57cdf0e10cSrcweir{ 58cdf0e10cSrcweir my $self = shift; 59cdf0e10cSrcweir 60cdf0e10cSrcweir if ( !defined($self->{VCSID}) ) { 61cdf0e10cSrcweir # environment overrides config file 62cdf0e10cSrcweir my $vcsid = $ENV{VCSID}; 63cdf0e10cSrcweir if ( !defined($vcsid) ) { 64cdf0e10cSrcweir # check config file 65cdf0e10cSrcweir my $config_file = $self->get_config_file(); 66cdf0e10cSrcweir $vcsid = $config_file->{CWS_CONFIG}->{'CVS_ID'}; 67cdf0e10cSrcweir if ( !defined($vcsid) ) { 68cdf0e10cSrcweir # give up 69cdf0e10cSrcweir croak("ERROR: no CVS_ID entry found in '\$HOME/.cwsrc'.\n" ); 70cdf0e10cSrcweir } 71cdf0e10cSrcweir } 72cdf0e10cSrcweir $self->{VCSID} = $vcsid; 73cdf0e10cSrcweir } 74cdf0e10cSrcweir return $self->{VCSID}; 75cdf0e10cSrcweir} 76cdf0e10cSrcweir 77cdf0e10cSrcweirsub cws_db_url_list_ref 78cdf0e10cSrcweir{ 79cdf0e10cSrcweir my $self = shift; 80cdf0e10cSrcweir 81cdf0e10cSrcweir if ( !defined($self->{CWS_DB_URL_LIST_REF}) ) { 82cdf0e10cSrcweir my $config_file = $self->get_config_file(); 83cdf0e10cSrcweir 84cdf0e10cSrcweir my $i = 1; 85cdf0e10cSrcweir my @cws_db_servers; 86cdf0e10cSrcweir 87cdf0e10cSrcweir while ( 1 ) { 88cdf0e10cSrcweir my $val = $config_file->{CWS_CONFIG}->{"CWS_DB_SERVER_$i"}; 89cdf0e10cSrcweir last if !defined($val); 90cdf0e10cSrcweir push(@cws_db_servers, $val); 91cdf0e10cSrcweir $i++; 92cdf0e10cSrcweir } 93cdf0e10cSrcweir 94cdf0e10cSrcweir if ( !@cws_db_servers) { 95cdf0e10cSrcweir croak("ERROR: no CWS_DB_SERVER_* entry found in '\$HOME/.cwsrc'.\n" ); 96cdf0e10cSrcweir } 97cdf0e10cSrcweir 98cdf0e10cSrcweir if ( $cws_db_servers[0] =~ /^https:\/\// ) { 99cdf0e10cSrcweir my $id = $self->vcsid(); 100cdf0e10cSrcweir my $password = $config_file->{CWS_CONFIG}->{'CVS_PASSWORD'}; 101cdf0e10cSrcweir 102cdf0e10cSrcweir if ( !defined($password) ) { 103cdf0e10cSrcweir croak("ERROR: no CVS_PASSWORD entry found in '\$HOME/.cwsrc'.\n" ); 104cdf0e10cSrcweir } 105cdf0e10cSrcweir 106cdf0e10cSrcweir # *i49473* - do not accept scrambled passwords ending with a space 107cdf0e10cSrcweir if ( $password =~ / $/) { 108cdf0e10cSrcweir croak("ERROR: The (scrambled) CVS_PASSWORD ends with a space. This is known to cause problems when connecting to the OpenOffice.org EIS database. Please change your OOo account's password" ); 109cdf0e10cSrcweir } 110cdf0e10cSrcweir 111cdf0e10cSrcweir # We are going to stuff $id and $password in an URL, do proper escaping. 112cdf0e10cSrcweir $id = uri_escape($id); 113cdf0e10cSrcweir $password = uri_escape($password); 114cdf0e10cSrcweir 115cdf0e10cSrcweir foreach ( @cws_db_servers ) { 116cdf0e10cSrcweir s/^https:\/\//https:\/\/$id:$password@/; 117cdf0e10cSrcweir } 118cdf0e10cSrcweir } 119cdf0e10cSrcweir 120cdf0e10cSrcweir $self->{CWS_DB_URL_LIST_REF} = \@cws_db_servers; 121cdf0e10cSrcweir } 122cdf0e10cSrcweir return $self->{CWS_DB_URL_LIST_REF}; 123cdf0e10cSrcweir} 124cdf0e10cSrcweir 125cdf0e10cSrcweirsub net_proxy 126cdf0e10cSrcweir{ 127cdf0e10cSrcweir my $self = shift; 128cdf0e10cSrcweir 129cdf0e10cSrcweir if ( !defined($self->{NET_PROXY}) ) { 130cdf0e10cSrcweir my $config_file = $self->get_config_file(); 131cdf0e10cSrcweir my $net_proxy = $config_file->{CWS_CONFIG}->{'PROXY'}; 132cdf0e10cSrcweir if ( !defined($net_proxy) ) { 133cdf0e10cSrcweir $net_proxy = ""; 134cdf0e10cSrcweir } 135cdf0e10cSrcweir $self->{NET_PROXY} = $net_proxy; 136cdf0e10cSrcweir } 137cdf0e10cSrcweir return $self->{NET_PROXY} ? $self->{NET_PROXY} : undef; 138cdf0e10cSrcweir} 139cdf0e10cSrcweir 140cdf0e10cSrcweirsub cvs_binary 141cdf0e10cSrcweir{ 142cdf0e10cSrcweir my $self = shift; 143cdf0e10cSrcweir 144cdf0e10cSrcweir if ( !defined($self->{CVS_BINARY}) ) { 145cdf0e10cSrcweir my $config_file = $self->get_config_file(); 146cdf0e10cSrcweir my $cvs_binary = $config_file->{CWS_CONFIG}->{'CVS_BINARY'}; 147cdf0e10cSrcweir if ( !defined($cvs_binary) ) { 148cdf0e10cSrcweir # defaults 149cdf0e10cSrcweir $cvs_binary = ($^O eq 'MSWin32') ? 'cvs.exe' : 'cvs'; 150cdf0e10cSrcweir } 151cdf0e10cSrcweir # special case, don't ask 152cdf0e10cSrcweir if ( $self->{_GLOBAL} && $cvs_binary =~ /cvs.clt2/ && $^O eq 'MSWin32' ) { 153cdf0e10cSrcweir $cvs_binary = 'cvsclt2.exe'; 154cdf0e10cSrcweir } 155cdf0e10cSrcweir $self->{CVS_BINARY} = $cvs_binary; 156cdf0e10cSrcweir } 157cdf0e10cSrcweir return $self->{CVS_BINARY}; 158cdf0e10cSrcweir} 159cdf0e10cSrcweir 160cdf0e10cSrcweirsub cvs_server_root 161cdf0e10cSrcweir{ 162cdf0e10cSrcweir my $self = shift; 163cdf0e10cSrcweir 164cdf0e10cSrcweir if ( !defined($self->{CVS_SERVER_ROOT}) ) { 165cdf0e10cSrcweir my $config_file = $self->get_config_file(); 166cdf0e10cSrcweir my $cvs_server_root = $config_file->{CWS_CONFIG}->{'CVS_SERVER_ROOT'}; 167cdf0e10cSrcweir if ( !defined($cvs_server_root) ) { 168cdf0e10cSrcweir # give up, this is a mandatory entry 169cdf0e10cSrcweir croak("ERROR: can't parse CVS_SERVER_ROOT entry in '\$HOME/.cwsrc'.\n"); 170cdf0e10cSrcweir } 171cdf0e10cSrcweir if ( $self->{_GLOBAL} ) { 172cdf0e10cSrcweir # a global config file will almost always have the wrong vcsid in 173cdf0e10cSrcweir # the cvsroot -> substitute vcsid 174cdf0e10cSrcweir my $id = $self->vcsid(); 175cdf0e10cSrcweir $cvs_server_root =~ s/:pserver:\w+@/:pserver:$id@/; 176cdf0e10cSrcweir } 177cdf0e10cSrcweir $self->{CVS_SERVER_ROOT} = $cvs_server_root; 178cdf0e10cSrcweir } 179cdf0e10cSrcweir return $self->{CVS_SERVER_ROOT}; 180cdf0e10cSrcweir} 181cdf0e10cSrcweir 182cdf0e10cSrcweirsub cvs_mirror_root 183cdf0e10cSrcweir{ 184cdf0e10cSrcweir my $self = shift; 185cdf0e10cSrcweir 186cdf0e10cSrcweir if ( !defined($self->{CVS_MIRROR_ROOT}) ) { 187cdf0e10cSrcweir my $config_file = $self->get_config_file(); 188cdf0e10cSrcweir my $cvs_mirror_root = $config_file->{CWS_CONFIG}->{'CVS_MIRROR_ROOT'}; 189cdf0e10cSrcweir if ( !defined($cvs_mirror_root) ) { 190cdf0e10cSrcweir $cvs_mirror_root = ""; 191cdf0e10cSrcweir } 192cdf0e10cSrcweir $self->{CVS_MIRROR_ROOT} = $cvs_mirror_root; 193cdf0e10cSrcweir } 194cdf0e10cSrcweir return $self->{CVS_MIRROR_ROOT} ? $self->{CVS_MIRROR_ROOT} : undef; 195cdf0e10cSrcweir} 196cdf0e10cSrcweir 197cdf0e10cSrcweirsub cvs_local_root 198cdf0e10cSrcweir{ 199cdf0e10cSrcweir my $self = shift; 200cdf0e10cSrcweir 201cdf0e10cSrcweir if ( !defined($self->{CVS_LOCAL_ROOT}) ) { 202cdf0e10cSrcweir my $config_file = $self->get_config_file(); 203cdf0e10cSrcweir my $cvs_local_root = $config_file->{CWS_CONFIG}->{'CVS_LOCAL_ROOT'}; 204cdf0e10cSrcweir if ( !defined($cvs_local_root) ) { 205cdf0e10cSrcweir $cvs_local_root = ""; 206cdf0e10cSrcweir } 207cdf0e10cSrcweir $self->{CVS_LOCAL_ROOT} = $cvs_local_root; 208cdf0e10cSrcweir } 209cdf0e10cSrcweir return $self->{CVS_LOCAL_ROOT} ? $self->{CVS_LOCAL_ROOT} : undef; 210cdf0e10cSrcweir} 211cdf0e10cSrcweir 212cdf0e10cSrcweirsub get_cvs_server 213cdf0e10cSrcweir{ 214cdf0e10cSrcweir my $self = shift; 215cdf0e10cSrcweir 216cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_server_root(), 'SERVER'); 217cdf0e10cSrcweir return $server; 218cdf0e10cSrcweir} 219cdf0e10cSrcweir 220cdf0e10cSrcweirsub get_cvs_mirror 221cdf0e10cSrcweir{ 222cdf0e10cSrcweir my $self = shift; 223cdf0e10cSrcweir 224cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_mirror_root(), 'MIRROR'); 225cdf0e10cSrcweir return $server; 226cdf0e10cSrcweir} 227cdf0e10cSrcweir 228cdf0e10cSrcweirsub get_cvs_local 229cdf0e10cSrcweir{ 230cdf0e10cSrcweir my $self = shift; 231cdf0e10cSrcweir 232cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_local_root(), 'LOCAL'); 233cdf0e10cSrcweir return $server; 234cdf0e10cSrcweir} 235cdf0e10cSrcweir 236cdf0e10cSrcweirsub get_cvs_server_method 237cdf0e10cSrcweir{ 238cdf0e10cSrcweir my $self = shift; 239cdf0e10cSrcweir 240cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_server_root(), 'SERVER'); 241cdf0e10cSrcweir return $method; 242cdf0e10cSrcweir} 243cdf0e10cSrcweir 244cdf0e10cSrcweirsub get_cvs_mirror_method 245cdf0e10cSrcweir{ 246cdf0e10cSrcweir my $self = shift; 247cdf0e10cSrcweir 248cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_mirror_root(), 'MIRROR'); 249cdf0e10cSrcweir return $method; 250cdf0e10cSrcweir} 251cdf0e10cSrcweir 252cdf0e10cSrcweirsub get_cvs_local_method 253cdf0e10cSrcweir{ 254cdf0e10cSrcweir my $self = shift; 255cdf0e10cSrcweir 256cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_local_root(), 'LOCAL'); 257cdf0e10cSrcweir return $method; 258cdf0e10cSrcweir} 259cdf0e10cSrcweir 260cdf0e10cSrcweirsub get_cvs_server_repository 261cdf0e10cSrcweir{ 262cdf0e10cSrcweir my $self = shift; 263cdf0e10cSrcweir 264cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_server_root(), 'SERVER'); 265cdf0e10cSrcweir return $repository; 266cdf0e10cSrcweir} 267cdf0e10cSrcweir 268cdf0e10cSrcweirsub get_cvs_mirror_repository 269cdf0e10cSrcweir{ 270cdf0e10cSrcweir my $self = shift; 271cdf0e10cSrcweir 272cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_mirror_root(), 'MIRROR'); 273cdf0e10cSrcweir return $repository; 274cdf0e10cSrcweir} 275cdf0e10cSrcweir 276cdf0e10cSrcweirsub get_cvs_local_repository 277cdf0e10cSrcweir{ 278cdf0e10cSrcweir my $self = shift; 279cdf0e10cSrcweir 280cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_local_root(), 'LOCAL'); 281cdf0e10cSrcweir return $repository; 282cdf0e10cSrcweir} 283cdf0e10cSrcweir 284cdf0e10cSrcweirsub get_cvs_server_id 285cdf0e10cSrcweir{ 286cdf0e10cSrcweir my $self = shift; 287cdf0e10cSrcweir 288cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_server_root(), 'SERVER'); 289cdf0e10cSrcweir return $id; 290cdf0e10cSrcweir} 291cdf0e10cSrcweir 292cdf0e10cSrcweirsub get_cvs_mirror_id 293cdf0e10cSrcweir{ 294cdf0e10cSrcweir my $self = shift; 295cdf0e10cSrcweir 296cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_mirror_root(), 'MIRROR'); 297cdf0e10cSrcweir return $id; 298cdf0e10cSrcweir} 299cdf0e10cSrcweir 300cdf0e10cSrcweirsub get_cvs_local_id 301cdf0e10cSrcweir{ 302cdf0e10cSrcweir my $self = shift; 303cdf0e10cSrcweir 304cdf0e10cSrcweir my ($method, $id, $server, $repository) = CwsConfig::split_root($self->cvs_local_root(), 'LOCAL'); 305cdf0e10cSrcweir return $id; 306cdf0e10cSrcweir} 307cdf0e10cSrcweir 308cdf0e10cSrcweir#### SVN methods #### 309cdf0e10cSrcweir 310cdf0e10cSrcweirsub get_ooo_svn_server 311cdf0e10cSrcweir{ 312cdf0e10cSrcweir my $self = shift; 313cdf0e10cSrcweir 314cdf0e10cSrcweir if ( !defined($self->{SVN_SERVER}) ) { 315cdf0e10cSrcweir my $config_file = $self->get_config_file(); 316cdf0e10cSrcweir my $ooo_svn_server = $config_file->{CWS_CONFIG}->{'SVN_SERVER'}; 317cdf0e10cSrcweir if ( !defined($ooo_svn_server) ) { 318cdf0e10cSrcweir $ooo_svn_server = ""; 319cdf0e10cSrcweir } 320cdf0e10cSrcweir $self->{SVN_SERVER} = $ooo_svn_server; 321cdf0e10cSrcweir } 322cdf0e10cSrcweir return $self->{SVN_SERVER} ? $self->{SVN_SERVER} : undef; 323cdf0e10cSrcweir} 324cdf0e10cSrcweir 325cdf0e10cSrcweirsub get_so_svn_server 326cdf0e10cSrcweir{ 327cdf0e10cSrcweir my $self = shift; 328cdf0e10cSrcweir 329cdf0e10cSrcweir if ( !defined($self->{SO_SVN_SERVER}) ) { 330cdf0e10cSrcweir my $config_file = $self->get_config_file(); 331cdf0e10cSrcweir my $so_svn_server = $config_file->{CWS_CONFIG}->{'SO_SVN_SERVER'}; 332cdf0e10cSrcweir if ( !defined($so_svn_server) ) { 333cdf0e10cSrcweir $so_svn_server = ""; 334cdf0e10cSrcweir } 335cdf0e10cSrcweir $self->{SO_SVN_SERVER} = $so_svn_server; 336cdf0e10cSrcweir } 337cdf0e10cSrcweir return $self->{SO_SVN_SERVER} ? $self->{SO_SVN_SERVER} : undef; 338cdf0e10cSrcweir} 339cdf0e10cSrcweir 340cdf0e10cSrcweir#### HG methods #### 341cdf0e10cSrcweir 342cdf0e10cSrcweirsub _get_hg_source 343cdf0e10cSrcweir{ 344cdf0e10cSrcweir my $self = shift; 345cdf0e10cSrcweir my $repository_source = shift; 346cdf0e10cSrcweir if ( !defined($self->{$repository_source}) ) { 347cdf0e10cSrcweir my $config_file = $self->get_config_file(); 348cdf0e10cSrcweir my $source = $config_file->{CWS_CONFIG}->{$repository_source}; 349cdf0e10cSrcweir if ( !defined($source) ) { 350cdf0e10cSrcweir $source = ""; 351cdf0e10cSrcweir } 352cdf0e10cSrcweir $self->{$repository_source} = $source; 353cdf0e10cSrcweir } 354cdf0e10cSrcweir return $self->{$repository_source} ? $self->{$repository_source} : undef; 355cdf0e10cSrcweir 356cdf0e10cSrcweir} 357cdf0e10cSrcweir 358cdf0e10cSrcweirsub get_hg_source 359cdf0e10cSrcweir{ 360cdf0e10cSrcweir my $self = shift; 361cdf0e10cSrcweir my $repository = shift; 362cdf0e10cSrcweir my $location = shift; 363cdf0e10cSrcweir 364cdf0e10cSrcweir #Special prefix handling, see cwsrc 365cdf0e10cSrcweir if ($repository eq "OOO") 366cdf0e10cSrcweir { 367cdf0e10cSrcweir if ($location eq "LOCAL") 368cdf0e10cSrcweir { 369cdf0e10cSrcweir return $self->_get_hg_source('HG_LOCAL_SOURCE'); 370cdf0e10cSrcweir } 371cdf0e10cSrcweir elsif ($location eq "LAN") 372cdf0e10cSrcweir { 373cdf0e10cSrcweir return $self->_get_hg_source('HG_LAN_SOURCE'); 374cdf0e10cSrcweir } 375cdf0e10cSrcweir elsif ($location eq "REMOTE") 376cdf0e10cSrcweir { 377cdf0e10cSrcweir return $self->_get_hg_source('HG_REMOTE_SOURCE'); 378cdf0e10cSrcweir } 379cdf0e10cSrcweir } 380cdf0e10cSrcweir else 381cdf0e10cSrcweir { 382cdf0e10cSrcweir if ($location eq "LOCAL") 383cdf0e10cSrcweir { 384cdf0e10cSrcweir return $self->_get_hg_source($repository.'_HG_LOCAL_SOURCE'); 385cdf0e10cSrcweir } 386cdf0e10cSrcweir elsif ($location eq "LAN") 387cdf0e10cSrcweir { 388cdf0e10cSrcweir return $self->_get_hg_source($repository.'_HG_LAN_SOURCE'); 389cdf0e10cSrcweir } 390cdf0e10cSrcweir elsif ($location eq "REMOTE") 391cdf0e10cSrcweir { 392cdf0e10cSrcweir return $self->_get_hg_source($repository.'_HG_REMOTE_SOURCE'); 393cdf0e10cSrcweir } 394cdf0e10cSrcweir } 395cdf0e10cSrcweir} 396cdf0e10cSrcweir 397cdf0e10cSrcweir#### Prebuild binaries configuration #### 398cdf0e10cSrcweir 399cdf0e10cSrcweirsub get_prebuild_binaries_location 400cdf0e10cSrcweir{ 401cdf0e10cSrcweir my $self = shift; 402cdf0e10cSrcweir 403cdf0e10cSrcweir if ( !defined($self->{PREBUILD_BINARIES}) ) { 404cdf0e10cSrcweir my $config_file = $self->get_config_file(); 405cdf0e10cSrcweir my $pre_build_binaries = $config_file->{CWS_CONFIG}->{'PREBUILD_BINARIES'}; 406cdf0e10cSrcweir if ( !defined($pre_build_binaries) ) { 407cdf0e10cSrcweir $pre_build_binaries = ""; 408cdf0e10cSrcweir } 409cdf0e10cSrcweir $self->{PREBUILD_BINARIES} = $pre_build_binaries; 410cdf0e10cSrcweir } 411cdf0e10cSrcweir return $self->{PREBUILD_BINARIES} ? $self->{PREBUILD_BINARIES} : undef; 412cdf0e10cSrcweir} 413cdf0e10cSrcweir 414cdf0e10cSrcweir 415cdf0e10cSrcweir 416cdf0e10cSrcweir#### class methods ##### 417cdf0e10cSrcweirsub get_config 418cdf0e10cSrcweir{ 419cdf0e10cSrcweir my $config = CwsConfig->new(); 420cdf0e10cSrcweir return $config; 421cdf0e10cSrcweir} 422cdf0e10cSrcweir 423cdf0e10cSrcweirsub split_root 424cdf0e10cSrcweir{ 425cdf0e10cSrcweir my $root = shift; 426cdf0e10cSrcweir my $type = shift; 427cdf0e10cSrcweir 428cdf0e10cSrcweir if ( !defined($root) ) { 429cdf0e10cSrcweir return (undef, undef, undef, undef); 430cdf0e10cSrcweir } 431cdf0e10cSrcweir 432cdf0e10cSrcweir my ($dummy, $method, $id_at_host, $repository) = split(/:/, $root); 433cdf0e10cSrcweir $repository =~ s/^\d*//; 434cdf0e10cSrcweir my ($id, $server); 435cdf0e10cSrcweir if ( $id_at_host ) { 436cdf0e10cSrcweir ($id, $server) = split(/@/, $id_at_host); 437cdf0e10cSrcweir } 438cdf0e10cSrcweir if ( !defined($method) || !defined($id) || !defined($server) || !defined($repository) ) { 439cdf0e10cSrcweir # give up 440cdf0e10cSrcweir print "$method, $id, $server, $repository\n"; 441cdf0e10cSrcweir croak("ERROR: can't parse CVS_".$type."_ROOT entry in '\$HOME/.cwsrc'.\n"); 442cdf0e10cSrcweir } 443cdf0e10cSrcweir return ($method, $id, $server, $repository); 444cdf0e10cSrcweir} 445cdf0e10cSrcweir 446cdf0e10cSrcweir#### private helper methods #### 447cdf0e10cSrcweir 448cdf0e10cSrcweirsub get_config_file 449cdf0e10cSrcweir{ 450cdf0e10cSrcweir my $self = shift; 451cdf0e10cSrcweir 452cdf0e10cSrcweir if ( !defined $self->{_CONFIG_FILE} ) { 453cdf0e10cSrcweir $self->parse_config_file(); 454cdf0e10cSrcweir } 455cdf0e10cSrcweir return $self->{_CONFIG_FILE}; 456cdf0e10cSrcweir} 457cdf0e10cSrcweir 458cdf0e10cSrcweirsub read_config 459cdf0e10cSrcweir{ 460cdf0e10cSrcweir my $self = shift; 461cdf0e10cSrcweir my $fname = shift; 462cdf0e10cSrcweir my $fhandle; 463cdf0e10cSrcweir my $section = ''; 464cdf0e10cSrcweir my %config; 465cdf0e10cSrcweir 466cdf0e10cSrcweir open ($fhandle, $fname) || croak("ERROR: Can't open '$fname': $!"); 467cdf0e10cSrcweir while ( <$fhandle> ) { 468cdf0e10cSrcweir tr/\r\n//d; # win32 pain 469cdf0e10cSrcweir # Issue #i62815#: Scrambled CVS passwords may contain one or more '#'. 470cdf0e10cSrcweir # Ugly special case needed: still allow in-line (perl style) comments 471cdf0e10cSrcweir # elsewhere because existing configuration files may depend on them. 472cdf0e10cSrcweir if ( !/^\s*CVS_PASSWORD/ ) { 473cdf0e10cSrcweir s/\#.*//; # kill comments 474cdf0e10cSrcweir } 475cdf0e10cSrcweir /^\s*$/ && next; 476cdf0e10cSrcweir 477cdf0e10cSrcweir if (/\[\s*(\S+)\s*\]/) { 478cdf0e10cSrcweir $section = $1; 479cdf0e10cSrcweir if (!defined $config{$section}) { 480cdf0e10cSrcweir $config{$section} = {}; 481cdf0e10cSrcweir } 482cdf0e10cSrcweir } 483cdf0e10cSrcweir defined $config{$section} || croak("ERROR: unknown / no section '$section'\n"); 484cdf0e10cSrcweir if ( m/(\w[\w\d]*)=(.*)/ ) { 485cdf0e10cSrcweir my $var = $1; 486cdf0e10cSrcweir my $val = $2; 487cdf0e10cSrcweir # New style value strings may be surrounded by quotes 488cdf0e10cSrcweir if ( $val =~ s/\s*(['"])(.*)\1\s*$/$2/ ) { 489cdf0e10cSrcweir my $quote = $1; 490cdf0e10cSrcweir # If and only if the value string is surrounded by quotes we 491cdf0e10cSrcweir # can expect that \" or \' are escaped characters. In an unquoted 492cdf0e10cSrcweir # old style value string they could mean exactly what is standing there 493cdf0e10cSrcweir # 494cdf0e10cSrcweir # Actually the RE above works without quoting the quote character 495cdf0e10cSrcweir # (either " or ') inside the value string but users will probably 496cdf0e10cSrcweir # expect that they need to be escaped if quotes are used. 497cdf0e10cSrcweir # 498cdf0e10cSrcweir # This is still not completly correct for all thinkable situations but 499cdf0e10cSrcweir # should be good enough for all practical use cases. 500cdf0e10cSrcweir $val =~ s/\\($quote)/$1/g; 501cdf0e10cSrcweir } 502cdf0e10cSrcweir $config{$section}->{$var} = $val; 503cdf0e10cSrcweir # print "Set '$var' to '$val'\n"; 504cdf0e10cSrcweir } 505cdf0e10cSrcweir } 506cdf0e10cSrcweir close ($fhandle) || croak("ERROR: Failed to close: $!"); 507cdf0e10cSrcweir 508cdf0e10cSrcweir $self->{_CONFIG_FILE} = \%config; 509cdf0e10cSrcweir} 510cdf0e10cSrcweir 511cdf0e10cSrcweirsub parse_config_file 512cdf0e10cSrcweir{ 513cdf0e10cSrcweir my $self = shift; 514cdf0e10cSrcweir 515cdf0e10cSrcweir my $config_file; 516cdf0e10cSrcweir # check for config files 517cdf0e10cSrcweir if ( -e "$ENV{HOME}/.cwsrc" ) { 518cdf0e10cSrcweir $self->read_config("$ENV{HOME}/.cwsrc"); 519cdf0e10cSrcweir $self->{_GLOBAL} = 0; 520cdf0e10cSrcweir } 521cdf0e10cSrcweir elsif ( -e "$ENV{COMMON_ENV_TOOLS}/cwsrc" ) { 522cdf0e10cSrcweir $self->read_config("$ENV{COMMON_ENV_TOOLS}/cwsrc"); 523cdf0e10cSrcweir $self->{_GLOBAL} = 1; 524cdf0e10cSrcweir } 525cdf0e10cSrcweir else { 526cdf0e10cSrcweir croak("ERROR: can't find CWS config file '\$HOME/.cwsrc'.\n"); 527cdf0e10cSrcweir } 528cdf0e10cSrcweir} 529cdf0e10cSrcweir 530cdf0e10cSrcweirsub sointernal 531cdf0e10cSrcweir{ 532cdf0e10cSrcweir my $self = shift; 533cdf0e10cSrcweir my $config_file = $self->get_config_file(); 534cdf0e10cSrcweir my $val = ($config_file->{CWS_CONFIG}->{"SO_INTERNAL"}) ? 1 : 0; 535cdf0e10cSrcweir return $val; 536cdf0e10cSrcweir} 537cdf0e10cSrcweir1; # needed by "use" or "require" 538