1#!/usr/bin/perl 2# Habit . . . 3# 4# Extract info from Config.VMS, and add extra data here, to generate Config.sh 5# Edit the static information after __END__ to reflect your site and options 6# that went into your perl binary. In addition, values which change from run 7# to run may be supplied on the command line as key=val pairs. 8# 9# Rev. 16-Feb-1998 Charles Bailey bailey@newman.upenn.edu 10# 11 12#==== Locations of installed Perl components 13$prefix='perl_root'; 14$builddir="$prefix:[000000]"; 15$installbin="$prefix:[000000]"; 16$installscript="$prefix:[000000]"; 17$installman1dir="$prefix:[man.man1]"; 18$installman3dir="$prefix:[man.man3]"; 19$installprivlib="$prefix:[lib]"; 20$installsitelib="$prefix:[lib.site_perl]"; 21 22unshift(@INC,'lib'); # In case someone didn't define Perl_Root 23 # before the build 24 25if ($ARGV[0] eq '-f') { 26 open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n"; 27 @ARGV = (); 28 while (<ARGS>) { 29 chomp; 30 push(@ARGV,split(/\|/,$_)); 31 } 32 close ARGS; 33} 34 35if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; } 36elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; } 37elsif (-f "config.h") { $infile = "config.h"; $outdir = "[]";} 38 39if ($infile) { print "Generating Config.sh from $infile . . .\n"; } 40else { die <<EndOfGasp; 41Can't find config.vms or config.h to read! 42 Please run this script from the perl source directory or 43 the VMS subdirectory in the distribution. 44EndOfGasp 45} 46$outdir = ''; 47open(IN,"$infile") || die "Can't open $infile: $!\n"; 48open(OUT,">${outdir}Config.sh") || die "Can't open ${outdir}Config.sh: $!\n"; 49 50$time = localtime; 51$cf_by = (getpwuid($<))[0]; 52$archsufx = `Write Sys\$Output F\$GetSyi("HW_MODEL")` > 1024 ? 'AXP' : 'VAX'; 53($vers = $]) =~ tr/./_/; 54$installarchlib = VMS::Filespec::vmspath($installprivlib); 55$installarchlib =~ s#\]#.VMS_$archsufx.$vers\]#; 56$installsitearch = VMS::Filespec::vmspath($installsitelib); 57$installsitearch =~ s#\]#.VMS_$archsufx\]#; 58($osvers = `Write Sys\$Output F\$GetSyi("VERSION")`) =~ s/^V?(\S+)\s*\n?$/$1/; 59 60print OUT <<EndOfIntro; 61# This file generated by GenConfig.pl on a VMS system. 62# Input obtained from: 63# $infile 64# $0 65# Time: $time 66 67package='perl5' 68CONFIG='true' 69cf_time='$time' 70cf_by='$cf_by' 71ccdlflags='undef' 72cccdlflags='undef' 73mab='undef' 74libpth='/sys\$share /sys\$library' 75ld='Link' 76lddlflags='/Share' 77ranlib='undef' 78ar='undef' 79eunicefix=':' 80hint='none' 81hintfile='undef' 82useshrplib='define' 83usemymalloc='n' 84usevfork='true' 85spitshell='write sys\$output ' 86dlsrc='dl_vms.c' 87binexp='$installbin' 88man1ext='rno' 89man3ext='rno' 90arch='VMS_$archsufx' 91archname='VMS_$archsufx' 92bincompat3='undef' 93d_bincompat3='undef' 94osvers='$osvers' 95prefix='$prefix' 96builddir='$builddir' 97installbin='$installbin' 98installscript='$installscript' 99installman1dir='$installman1dir' 100installman3dir='$installman3dir' 101installprivlib='$installprivlib' 102installarchlib='$installarchlib' 103installsitelib='$installsitelib' 104installsitearch='$installsitearch' 105path_sep='|' 106startperl='\$ perl 'f\$env("procedure")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' ! 107\$ exit++ + ++\$status != 0 and \$exit = \$status = undef;' 108EndOfIntro 109 110foreach (@ARGV) { 111 ($key,$val) = split('=',$_,2); 112 if ($key eq 'cc') { # Figure out which C compiler we're using 113 my($cc,$ccflags) = split('/',$val,2); 114 my($d_attr); 115 $ccflags = "/$ccflags"; 116 if ($ccflags =~s!/DECC!!ig) { 117 $cc .= '/DECC'; 118 $cctype = 'decc'; 119 $d_attr = 'undef'; 120 } 121 elsif ($ccflags =~s!/VAXC!!ig) { 122 $cc .= '/VAXC'; 123 $cctype = 'vaxc'; 124 $d_attr = 'undef'; 125 } 126 elsif (`$val/NoObject/NoList _nla0:/Version` =~ /GNU C version (\S+)/) { 127 $cctype = 'gcc'; 128 $d_attr = 'define'; 129 print OUT "gccversion='$1'\n"; 130 } 131 elsif ($archsufx eq 'VAX' && 132 # Check exit status too, in case message is turned off 133 ( `$val/NoObject/NoList /prefix=all _nla0:` =~ /IVQUAL/ || 134 $? == 0x38240 )) { 135 $cctype = 'vaxc'; 136 $d_attr = 'undef'; 137 } 138 else { 139 $cctype = 'decc'; 140 $d_attr = 'undef'; 141 } 142 print OUT "vms_cc_type='$cctype'\n"; 143 print OUT "d_attribute_format='$d_attr'\n"; 144 # XXX The following attributes may be able to use $d_attr, too. 145 print OUT "d_attribute_malloc='undef'\n"; 146 print OUT "d_attribute_nonnull='undef'\n"; 147 print OUT "d_attribute_noreturn='undef'\n"; 148 print OUT "d_attribute_pure='undef'\n"; 149 print OUT "d_attribute_unused='undef'\n"; 150 print OUT "d_attribute_warn_unused_result='undef'\n"; 151 print OUT "cc='$cc'\n"; 152 if ( ($cctype eq 'decc' and $archsufx eq 'VAX') || $cctype eq 'gcc') { 153 # gcc and DECC for VAX requires filename in /object qualifier, so we 154 # have to remove it here. Alas, this means we lose the user's 155 # object file suffix if it's not .obj. 156 $ccflags =~ s#/obj(?:ect)?=[^/\s]+##i; 157 } 158 $debug = $optimize = ''; 159 while ( ($qual) = $ccflags =~ m|(/(No)?Deb[^/]*)|i ) { 160 $debug = $qual; 161 $ccflags =~ s/$qual//; 162 } 163 while ( ($qual) = $ccflags =~ m|(/(No)?Opt[^/]*)|i ) { 164 $optimize = $qual; 165 $ccflags =~ s/$qual//; 166 } 167 $usethreads = ($ccflags =~ m!/DEF[^/]+USE_5005THREADS!i and 168 $ccflags !~ m!/UND[^/]+USE_5005THREADS!i); 169 print OUT "usethreads='",($usethreads ? 'define' : 'undef'),"'\n";; 170 $optimize = "$debug$optimize"; 171 print OUT "ccflags='$ccflags'\n"; 172 print OUT "optimize='$optimize'\n"; 173 $dosock = ($ccflags =~ m!/DEF[^/]+VMS_DO_SOCKETS!i and 174 $ccflags !~ m!/UND[^/]+VMS_DO_SOCKETS!i); 175 print OUT "d_vms_do_sockets=",$dosock ? "'define'\n" : "'undef'\n"; 176 print OUT "d_socket=",$dosock ? "'define'\n" : "'undef'\n"; 177 print OUT "d_sockpair=",$dosock ? "'define'\n" : "'undef'\n"; 178 print OUT "d_gethent=",$dosock ? "'define'\n" : "'undef'\n"; 179 print OUT "d_sethent=",$dosock ? "'define'\n" : "'undef'\n"; 180 print OUT "d_select=",$dosock ? "'define'\n" : "'undef'\n"; 181 print OUT "i_netdb=",$dosock ? "'define'\n" : "'undef'\n"; 182 print OUT "i_niin=",$dosock ? "'define'\n" : "'undef'\n"; 183 print OUT "i_neterrno=",$dosock ? "'define'\n" : "'undef'\n"; 184 print OUT "d_gethbyname=",$dosock ? "'define'\n" : "'undef'\n"; 185 print OUT "d_gethbyaddr=",$dosock ? "'define'\n" : "'undef'\n"; 186 print OUT "d_getpbyname=",$dosock ? "'define'\n" : "'undef'\n"; 187 print OUT "d_getpbynumber=",$dosock ? "'define'\n" : "'undef'\n"; 188 print OUT "d_getsbyname=",$dosock ? "'define'\n" : "'undef'\n"; 189 print OUT "d_getsbyport=",$dosock ? "'define'\n" : "'undef'\n"; 190 print OUT "d_endhent=",$dosock ? "'define'\n" : "'undef'\n"; 191 print OUT "d_getpent=",$dosock ? "'define'\n" : "'undef'\n"; 192 print OUT "d_setpent=",$dosock ? "'define'\n" : "'undef'\n"; 193 print OUT "d_endpent=",$dosock ? "'define'\n" : "'undef'\n"; 194 print OUT "d_getsent=",$dosock ? "'define'\n" : "'undef'\n"; 195 print OUT "d_setsent=",$dosock ? "'define'\n" : "'undef'\n"; 196 print OUT "d_endsent=",$dosock ? "'define'\n" : "'undef'\n"; 197 print OUT "netdb_name_type=",$dosock ? "'char *'\n" : "'undef'\n"; 198 print OUT "netdb_host_type=",$dosock ? "'char *'\n" : "'undef'\n"; 199 print OUT "netdb_hlen_type=",$dosock ? "'int'\n" : "'undef'\n"; 200 print OUT "d_gethostprotos=",$dosock ? "'define'\n" : "'undef'\n"; 201 print OUT "d_getnetprotos=",$dosock ? "'define'\n" : "'undef'\n"; 202 print OUT "d_getservprotos=",$dosock ? "'define'\n" : "'undef'\n"; 203 print OUT "d_getprotoprotos=",$dosock ? "'define'\n" : "'undef'\n"; 204 205 if ($dosock and $cctype eq 'decc' and $ccflags =~ /DECCRTL_SOCKETS/) { 206 print OUT "selecttype='fd_set'\n"; 207 print OUT "d_getnbyaddr='define'\n"; 208 print OUT "d_getnbyname='define'\n"; 209 print OUT "d_getnent='define'\n"; 210 print OUT "d_setnent='define'\n"; 211 print OUT "d_endnent='define'\n"; 212 print OUT "netdb_net_type='long'\n"; 213 } 214 else { 215 print OUT "selecttype='int'\n"; 216 print OUT "d_getnybname='undef'\n"; 217 print OUT "d_getnybaddr='undef'\n"; 218 print OUT "d_getnent='undef'\n"; 219 print OUT "d_setnent='undef'\n"; 220 print OUT "d_endnent='undef'\n"; 221 print OUT "netdb_net_type='undef'\n"; 222 } 223 224 if ($cctype eq 'decc') { 225 $rtlhas = 'define'; 226 print OUT "useposix='true'\n"; 227 ($ccver,$vmsver) = `$cc/VERSION` =~ /V(\S+) on .*V(\S+)$/; 228 # Best guess; the may be wrong on systems which have separately 229 # installed the new CRTL. 230 if ($ccver >= 5.2 and $vmsver >= 7) { $rtlnew = 'define'; } 231 else { $rtlnew = 'undef'; } 232 } 233 else { $rtlhas = $rtlnew = 'undef'; print OUT "useposix='false'\n"; } 234 foreach (qw[ d_stdstdio d_stdio_ptr_lval d_stdio_cnt_lval d_stdiobase 235 d_locconv d_setlocale i_locale d_mbstowcs d_mbtowc 236 d_wcstombs d_wctomb d_mblen d_mktime d_strcoll d_strxfrm ]) { 237 print OUT "$_='$rtlhas'\n"; 238 } 239 print OUT "d_stdio_ptr_lval_sets_cnt='undef'\n"; 240 print OUT "d_stdio_ptr_lval_nochange_cnt='undef'\n"; 241 foreach (qw[ d_gettimeod d_uname d_truncate d_wait4 d_index 242 d_pathconf d_fpathconf d_sysconf d_sigsetjmp ]) { 243 print OUT "$_='$rtlnew'\n"; 244 } 245 next; 246 } 247 elsif ($key eq 'exe_ext') { 248 my($nodot) = $val; 249 $nodot =~ s!\.!!; 250 print OUT "so='$nodot'\ndlext='$nodot'\n"; 251 } 252 elsif ($key eq 'obj_ext') { print OUT "dlobj='dl_vms$val'\n"; } 253 print OUT "$key='$val'\n"; 254} 255 256# Are there any other logicals which TCP/IP stacks use for the host name? 257$myname = $ENV{'ARPANET_HOST_NAME'} || $ENV{'INTERNET_HOST_NAME'} || 258 $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'} || 259 $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'}; 260if (!$myname) { 261 ($myname) = `hostname` =~ /^(\S+)/; 262 if ($myname =~ /IVVERB/) { 263 warn "Can't determine TCP/IP hostname" if $dosock; 264 $myname = ''; 265 } 266} 267$myname = $ENV{'SYS$NODE'} unless $myname; 268($myhostname,$mydomain) = split(/\./,$myname,2); 269print OUT "myhostname='$myhostname'\n" if $myhostname; 270if ($mydomain) { 271 print OUT "mydomain='.$mydomain'\n"; 272 print OUT "perladmin='$cf_by\@$myhostname.$mydomain'\n"; 273 print OUT "cf_email='$cf_by\@$myhostname.$mydomain'\n"; 274} 275else { 276 print OUT "perladmin='$cf_by'\n"; 277 print OUT "cf_email='$cf_by'\n"; 278} 279chomp($hwname = `Write Sys\$Output F\$GetSyi("HW_NAME")`); 280$hwname = $archsufx if $hwname =~ /IVKEYW/; # *really* old VMS version 281print OUT "myuname='VMS $myname $osvers $hwname'\n"; 282 283# Before we read the C header file, find out what config.sh constants are 284# equivalent to the C preprocessor macros 285if (open(SH,"${outdir}config_h.SH")) { 286 while (<SH>) { 287 next unless m%^#(?!if).*\$%; 288 s/^#//; s!(.*?)\s*/\*.*!$1!; 289 my(@words) = split; 290 $words[1] =~ s/\(.*//; # Clip off args from macro 291 # Did we use a shell variable for the preprocessor directive? 292 if ($words[0] =~ m!^\$(\w+)!) { $pp_vars{$words[1]} = $1; } 293 if (@words > 2) { # We may also have a shell var in the value 294 shift @words; # Discard preprocessor directive 295 my($token) = shift @words; # and keep constant name 296 my($word); 297 foreach $word (@words) { 298 next unless $word =~ m!\$(\w+)!; 299 $val_vars{$token} = $1; 300 last; 301 } 302 } 303 } 304 close SH; 305} 306else { warn "Couldn't read ${outdir}config_h.SH: $!\n"; } 307$pp_vars{UNLINK_ALL_VERSIONS} = 'd_unlink_all_versions'; # VMS_specific 308 309# OK, now read the C header file, and retcon statements into config.sh 310while (<IN>) { # roll through the comment header in Config.VMS 311 last if /config-start/; 312} 313 314while (<IN>) { 315 chop; 316 while (/\\\s*$/) { # pick up contination lines 317 my $line = $_; 318 $line =~ s/\\\s*$//; 319 $_ = <IN>; 320 s/^\s*//; 321 $_ = $line . $_; 322 } 323 next unless my ($blocked,$un,$token,$val) = 324 m%^(\/\*)?\s*\#\s*(un)?def\w*\s+([A-Za-z0-9]\w+)\S*\s*(.*)%; 325 if (/config-skip/) { 326 delete $pp_vars{$token} if exists $pp_vars{$token}; 327 delete $val_vars{$token} if exists $val_vars{$token}; 328 next; 329 } 330 $val =~ s!\s*/\*.*!!; # strip off trailing comment 331 my($had_val); # Maybe a macro with args that we just #undefd or commented 332 if (!length($val) and $val_vars{$token} and ($un || $blocked)) { 333 print OUT "$val_vars{$token}=''\n" unless exists $done{$val_vars{$token}}; 334 $done{$val_vars{$token}}++; 335 delete $val_vars{$token}; 336 $had_val = 1; 337 } 338 $state = ($blocked || $un) ? 'undef' : 'define'; 339 if ($pp_vars{$token}) { 340 print OUT "$pp_vars{$token}='$state'\n" unless exists $done{$pp_vars{$token}}; 341 $done{$pp_vars{$token}}++; 342 delete $pp_vars{$token}; 343 } 344 elsif (not length $val and not $had_val) { 345 # Wups -- should have been shell var for C preprocessor directive 346 warn "Constant $token not found in config_h.SH\n"; 347 $token = lc $token; 348 $token = "d_$token" unless $token =~ /^i_/; 349 print OUT "$token='$state'\n"; 350 } 351 next unless length $val; 352 $val =~ s/^"//; $val =~ s/"$//; # remove end quotes 353 $val =~ s/","/ /g; # make signal list look nice 354 # Library directory; convert to VMS syntax 355 $val = VMS::Filespec::vmspath($val) if ($token =~ /EXP$/); 356 if ($val_vars{$token}) { 357 print OUT "$val_vars{$token}='$val'\n" unless exists $done{$val_vars{$token}}; 358 if ($val_vars{$token} =~ s/exp$//) { 359 print OUT "$val_vars{$token}='$val'\n" unless exists $done{$val_vars{$token}};; 360 } 361 $done{$val_vars{$token}}++; 362 delete $val_vars{$token}; 363 } 364 elsif (!$pp_vars{$token}) { # Haven't seen it previously, either 365 warn "Constant $token not found in config_h.SH (val=|$val|)\n"; 366 $token = lc $token; 367 print OUT "$token='$val'\n"; 368 if ($token =~ s/exp$//) {print OUT "$token='$val'\n";} 369 } 370} 371close IN; 372# Special case -- preprocessor manifest "VMS" is defined automatically 373# on VMS systems, but is also used erroneously by the Perl build process 374# as the manifest for the obsolete variable $d_eunice. 375print OUT "d_eunice='undef'\n"; delete $pp_vars{VMS}; 376 377# XXX temporary -- USE_5005THREADS is currently on CC command line 378delete $pp_vars{'USE_5005THREADS'}; 379 380foreach (sort keys %pp_vars) { 381 warn "Didn't see $_ in $infile\n"; 382} 383foreach (sort keys %val_vars) { 384 warn "Didn't see $_ in $infile(val)\n"; 385} 386 387if (open(OPT,"${outdir}crtl.opt")) { 388 while (<OPT>) { 389 next unless m#/(sha|lib)#i; 390 chomp; 391 if (/crtl/i || /gcclib/i) { push(@crtls,$_); } 392 else { push(@libs,$_); } 393 } 394 close OPT; 395 print OUT "libs='",join(' ',@libs),"'\n"; 396 push(@crtls,'(DECCRTL)') if $cctype eq 'decc'; 397 print OUT "libc='",join(' ',@crtls),"'\n"; 398} 399else { warn "Can't read ${outdir}crtl.opt - skipping 'libs' & 'libc'"; } 400 401if (open(PL,"${outdir}patchlevel.h")) { 402 while (<PL>) { 403 if (/^#define PERL_VERSION\s+(\S+)/) { 404 print OUT "PERL_VERSION='$1'\n"; 405 print OUT "PATCHLEVEL='$1'\n"; # XXX compat 406 } 407 elsif (/^#define PERL_SUBVERSION\s+(\S+)/) { 408 print OUT "PERL_SUBVERSION='$1'\n"; 409 print OUT "SUBVERSION='$1'\n"; # XXX compat 410 } 411 } 412 close PL; 413} 414else { warn "Can't read ${outdir}patchlevel.h - skipping 'PATCHLEVEL'"; } 415 416# simple pager support for perldoc 417if (`most not..file` =~ /IVVERB/) { 418 $pager = 'more'; 419 if (`more nl:` =~ /IVVERB/) { $pager = 'type/page'; } 420} 421else { $pager = 'most'; } 422print OUT "pager='$pager'\n"; 423 424close OUT; 425