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