1package Install; 2 3# 4# Package that provides 'make install' functionality for msvc builds 5# 6# src/tools/msvc/Install.pm 7# 8use strict; 9use warnings; 10use Carp; 11use File::Basename; 12use File::Copy; 13use File::Find (); 14 15use Exporter; 16our (@ISA, @EXPORT_OK); 17@ISA = qw(Exporter); 18@EXPORT_OK = qw(Install); 19 20my $insttype; 21my @client_contribs = ('oid2name', 'pgbench', 'vacuumlo'); 22my @client_program_files = ( 23 'clusterdb', 'createdb', 'createuser', 'dropdb', 24 'dropuser', 'ecpg', 'libecpg', 'libecpg_compat', 25 'libpgtypes', 'libpq', 'pg_basebackup', 'pg_config', 26 'pg_dump', 'pg_dumpall', 'pg_isready', 'pg_receivewal', 27 'pg_recvlogical', 'pg_restore', 'psql', 'reindexdb', 28 'vacuumdb', @client_contribs); 29 30sub lcopy 31{ 32 my $src = shift; 33 my $target = shift; 34 35 if (-f $target) 36 { 37 unlink $target || confess "Could not delete $target\n"; 38 } 39 40 copy($src, $target) 41 || confess "Could not copy $src to $target\n"; 42 43} 44 45sub Install 46{ 47 $| = 1; 48 49 my $target = shift; 50 $insttype = shift; 51 $insttype = "all" unless ($insttype); 52 53 # if called from vcregress, the config will be passed to us 54 # so no need to re-include these 55 our $config = shift; 56 unless ($config) 57 { 58 59 # suppress warning about harmless redeclaration of $config 60 no warnings 'misc'; 61 do "./config_default.pl"; 62 do "./config.pl" if (-f "config.pl"); 63 } 64 65 # Move to the root path depending on the current location. 66 if (-f "../../../configure") 67 { 68 chdir("../../.."); 69 } 70 elsif (-f "../../../../configure") 71 { 72 chdir("../../../.."); 73 } 74 75 my $conf = ""; 76 if (-d "debug") 77 { 78 $conf = "debug"; 79 } 80 if (-d "release") 81 { 82 $conf = "release"; 83 } 84 die "Could not find debug or release binaries" if ($conf eq ""); 85 my $majorver = DetermineMajorVersion(); 86 print "Installing version $majorver for $conf in $target\n"; 87 88 my @client_dirs = ('bin', 'lib', 'share', 'symbols'); 89 my @all_dirs = ( 90 @client_dirs, 'doc', 'doc/contrib', 'doc/extension', 'share/contrib', 91 'share/extension', 'share/timezonesets', 'share/tsearch_data'); 92 if ($insttype eq "client") 93 { 94 EnsureDirectories($target, @client_dirs); 95 } 96 else 97 { 98 EnsureDirectories($target, @all_dirs); 99 } 100 101 CopySolutionOutput($conf, $target); 102 my $sample_files = []; 103 my @top_dir = ("src"); 104 @top_dir = ("src\\bin", "src\\interfaces") if ($insttype eq "client"); 105 File::Find::find( 106 { wanted => sub { 107 /^.*\.sample\z/s 108 && push(@$sample_files, $File::Find::name); 109 110 # Don't find files of in-tree temporary installations. 111 $_ eq 'share' and $File::Find::prune = 1; 112 } 113 }, 114 @top_dir); 115 CopySetOfFiles('config files', $sample_files, $target . '/share/'); 116 CopyFiles( 117 'Import libraries', 118 $target . '/lib/', 119 "$conf\\", "postgres\\postgres.lib", "libpgcommon\\libpgcommon.lib", 120 "libpgport\\libpgport.lib"); 121 CopyContribFiles($config, $target); 122 CopyIncludeFiles($target); 123 124 if ($insttype ne "client") 125 { 126 CopySetOfFiles( 127 'timezone names', 128 [ glob('src\timezone\tznames\*.txt') ], 129 $target . '/share/timezonesets/'); 130 CopyFiles( 131 'timezone sets', 132 $target . '/share/timezonesets/', 133 'src/timezone/tznames/', 'Default', 'Australia', 'India'); 134 CopySetOfFiles( 135 'BKI files', 136 [ glob("src\\backend\\catalog\\postgres.*") ], 137 $target . '/share/'); 138 CopySetOfFiles( 139 'SQL files', 140 [ glob("src\\backend\\catalog\\*.sql") ], 141 $target . '/share/'); 142 CopyFiles( 143 'Information schema data', $target . '/share/', 144 'src/backend/catalog/', 'sql_features.txt'); 145 GenerateConversionScript($target); 146 GenerateTimezoneFiles($target, $conf); 147 GenerateTsearchFiles($target); 148 CopySetOfFiles( 149 'Stopword files', 150 [ glob("src\\backend\\snowball\\stopwords\\*.stop") ], 151 $target . '/share/tsearch_data/'); 152 CopySetOfFiles( 153 'Dictionaries sample files', 154 [ glob("src\\backend\\tsearch\\dicts\\*_sample*") ], 155 $target . '/share/tsearch_data/'); 156 157 my $pl_extension_files = []; 158 my @pldirs = ('src/pl/plpgsql/src'); 159 push @pldirs, "src/pl/plperl" if $config->{perl}; 160 push @pldirs, "src/pl/plpython" if $config->{python}; 161 push @pldirs, "src/pl/tcl" if $config->{tcl}; 162 File::Find::find( 163 { wanted => sub { 164 /^(.*--.*\.sql|.*\.control)\z/s 165 && push(@$pl_extension_files, $File::Find::name); 166 167 # Don't find files of in-tree temporary installations. 168 $_ eq 'share' and $File::Find::prune = 1; 169 } 170 }, 171 @pldirs); 172 CopySetOfFiles('PL Extension files', 173 $pl_extension_files, $target . '/share/extension/'); 174 } 175 176 GenerateNLSFiles($target, $config->{nls}, $majorver) if ($config->{nls}); 177 178 print "Installation complete.\n"; 179} 180 181sub EnsureDirectories 182{ 183 my $target = shift; 184 mkdir $target unless -d ($target); 185 while (my $d = shift) 186 { 187 mkdir $target . '/' . $d unless -d ($target . '/' . $d); 188 } 189} 190 191sub CopyFiles 192{ 193 my $what = shift; 194 my $target = shift; 195 my $basedir = shift; 196 197 print "Copying $what"; 198 while (my $f = shift) 199 { 200 print "."; 201 $f = $basedir . $f; 202 die "No file $f\n" if (!-f $f); 203 lcopy($f, $target . basename($f)); 204 } 205 print "\n"; 206} 207 208sub CopySetOfFiles 209{ 210 my $what = shift; 211 my $flist = shift; 212 my $target = shift; 213 print "Copying $what" if $what; 214 foreach (@$flist) 215 { 216 my $tgt = $target . basename($_); 217 print "."; 218 lcopy($_, $tgt) || croak "Could not copy $_: $!\n"; 219 } 220 print "\n"; 221} 222 223sub CopySolutionOutput 224{ 225 my $conf = shift; 226 my $target = shift; 227 my $rem = 228 qr{Project\("\{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942\}"\) = "([^"]+)"}; 229 230 my $sln = read_file("pgsql.sln") || croak "Could not open pgsql.sln\n"; 231 232 my $vcproj = 'vcproj'; 233 if ($sln =~ 234 /Microsoft Visual Studio Solution File, Format Version (\d+)\.\d+/ 235 && $1 >= 11) 236 { 237 $vcproj = 'vcxproj'; 238 } 239 240 print "Copying build output files..."; 241 while ($sln =~ $rem) 242 { 243 my $pf = $1; 244 245 # Hash-of-arrays listing where to install things. For each 246 # subdirectory there's a hash key, and the value is an array 247 # of file extensions to install in that subdirectory. Example: 248 # { 'bin' => [ 'dll', 'lib' ], 249 # 'lib' => [ 'lib' ] } 250 my %install_list; 251 my $is_sharedlib = 0; 252 253 $sln =~ s/$rem//; 254 255 next 256 if ($insttype eq "client" && !grep { $_ eq $pf } 257 @client_program_files); 258 259 my $proj = read_file("$pf.$vcproj") 260 || croak "Could not open $pf.$vcproj\n"; 261 262 # Check if this project uses a shared library by looking if 263 # SO_MAJOR_VERSION is defined in its Makefile, whose path 264 # can be found using the resource file of this project. 265 if (( $vcproj eq 'vcxproj' 266 && $proj =~ qr{ResourceCompile\s*Include="([^"]+)"}) 267 || ( $vcproj eq 'vcproj' 268 && $proj =~ qr{File\s*RelativePath="([^\"]+)\.rc"})) 269 { 270 my $projpath = dirname($1); 271 my $mfname = 272 -e "$projpath/GNUmakefile" 273 ? "$projpath/GNUmakefile" 274 : "$projpath/Makefile"; 275 my $mf = read_file($mfname) || croak "Could not open $mfname\n"; 276 277 $is_sharedlib = 1 if ($mf =~ /^SO_MAJOR_VERSION\s*=\s*(.*)$/mg); 278 } 279 280 if ($vcproj eq 'vcproj' && $proj =~ qr{ConfigurationType="([^"]+)"}) 281 { 282 if ($1 == 1) 283 { 284 push(@{ $install_list{'bin'} }, "exe"); 285 } 286 elsif ($1 == 2) 287 { 288 push(@{ $install_list{'lib'} }, "dll"); 289 if ($is_sharedlib) 290 { 291 push(@{ $install_list{'bin'} }, "dll"); 292 push(@{ $install_list{'lib'} }, "lib"); 293 } 294 } 295 else 296 { 297 298 # Static libraries, such as libpgport, only used internally 299 # during build, don't install. 300 next; 301 } 302 } 303 elsif ($vcproj eq 'vcxproj' 304 && $proj =~ qr{<ConfigurationType>(\w+)</ConfigurationType>}) 305 { 306 if ($1 eq 'Application') 307 { 308 push(@{ $install_list{'bin'} }, "exe"); 309 } 310 elsif ($1 eq 'DynamicLibrary') 311 { 312 push(@{ $install_list{'lib'} }, "dll"); 313 if ($is_sharedlib) 314 { 315 push(@{ $install_list{'bin'} }, "dll"); 316 push(@{ $install_list{'lib'} }, "lib"); 317 } 318 } 319 else # 'StaticLibrary' 320 { 321 322 # Static lib, such as libpgport, only used internally 323 # during build, don't install. 324 next; 325 } 326 } 327 else 328 { 329 croak "Could not parse $pf.$vcproj\n"; 330 } 331 332 # Install each element 333 foreach my $dir (keys %install_list) 334 { 335 foreach my $ext (@{ $install_list{$dir} }) 336 { 337 lcopy("$conf\\$pf\\$pf.$ext", "$target\\$dir\\$pf.$ext") 338 || croak "Could not copy $pf.$ext\n"; 339 } 340 } 341 lcopy("$conf\\$pf\\$pf.pdb", "$target\\symbols\\$pf.pdb") 342 || croak "Could not copy $pf.pdb\n"; 343 print "."; 344 } 345 print "\n"; 346} 347 348sub GenerateConversionScript 349{ 350 my $target = shift; 351 my $sql = ""; 352 my $F; 353 354 print "Generating conversion proc script..."; 355 my $mf = read_file('src/backend/utils/mb/conversion_procs/Makefile'); 356 $mf =~ s{\\\r?\n}{}g; 357 $mf =~ /^CONVERSIONS\s*=\s*(.*)$/m 358 || die "Could not find CONVERSIONS line in conversions Makefile\n"; 359 my @pieces = split /\s+/, $1; 360 while ($#pieces > 0) 361 { 362 my $name = shift @pieces; 363 my $se = shift @pieces; 364 my $de = shift @pieces; 365 my $func = shift @pieces; 366 my $obj = shift @pieces; 367 $sql .= "-- $se --> $de\n"; 368 $sql .= 369"CREATE OR REPLACE FUNCTION $func (INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) RETURNS VOID AS '\$libdir/$obj', '$func' LANGUAGE C STRICT;\n"; 370 $sql .= 371"COMMENT ON FUNCTION $func(INTEGER, INTEGER, CSTRING, INTERNAL, INTEGER) IS 'internal conversion function for $se to $de';\n"; 372 $sql .= "DROP CONVERSION pg_catalog.$name;\n"; 373 $sql .= 374"CREATE DEFAULT CONVERSION pg_catalog.$name FOR '$se' TO '$de' FROM $func;\n"; 375 $sql .= 376"COMMENT ON CONVERSION pg_catalog.$name IS 'conversion for $se to $de';\n\n"; 377 } 378 open($F, '>', "$target/share/conversion_create.sql") 379 || die "Could not write to conversion_create.sql\n"; 380 print $F $sql; 381 close($F); 382 print "\n"; 383} 384 385sub GenerateTimezoneFiles 386{ 387 my $target = shift; 388 my $conf = shift; 389 my $mf = read_file("src/timezone/Makefile"); 390 $mf =~ s{\\\r?\n}{}g; 391 392 $mf =~ /^TZDATAFILES\s*:?=\s*(.*)$/m 393 || die "Could not find TZDATAFILES line in timezone makefile\n"; 394 my @tzfiles = split /\s+/, $1; 395 396 $mf =~ /^POSIXRULES\s*:?=\s*(.*)$/m 397 || die "Could not find POSIXRULES line in timezone makefile\n"; 398 my $posixrules = $1; 399 $posixrules =~ s/\s+//g; 400 401 print "Generating timezone files..."; 402 403 my @args = 404 ("$conf/zic/zic", '-d', "$target/share/timezone", 405 '-p', "$posixrules", '-b', 'fat'); 406 foreach (@tzfiles) 407 { 408 my $tzfile = $_; 409 $tzfile =~ s|\$\(srcdir\)|src/timezone|; 410 push(@args, $tzfile); 411 } 412 413 system(@args); 414 print "\n"; 415} 416 417sub GenerateTsearchFiles 418{ 419 my $target = shift; 420 421 print "Generating tsearch script..."; 422 my $F; 423 my $tmpl = read_file('src/backend/snowball/snowball.sql.in'); 424 my $mf = read_file('src/backend/snowball/Makefile'); 425 $mf =~ s{\\\r?\n}{}g; 426 $mf =~ /^LANGUAGES\s*=\s*(.*)$/m 427 || die "Could not find LANGUAGES line in snowball Makefile\n"; 428 my @pieces = split /\s+/, $1; 429 open($F, '>', "$target/share/snowball_create.sql") 430 || die "Could not write snowball_create.sql"; 431 print $F read_file('src/backend/snowball/snowball_func.sql.in'); 432 433 while ($#pieces > 0) 434 { 435 my $lang = shift @pieces || last; 436 my $asclang = shift @pieces || last; 437 my $txt = $tmpl; 438 my $stop = ''; 439 440 if (-s "src/backend/snowball/stopwords/$lang.stop") 441 { 442 $stop = ", StopWords=$lang"; 443 } 444 445 $txt =~ s#_LANGNAME_#${lang}#gs; 446 $txt =~ s#_DICTNAME_#${lang}_stem#gs; 447 $txt =~ s#_CFGNAME_#${lang}#gs; 448 $txt =~ s#_ASCDICTNAME_#${asclang}_stem#gs; 449 $txt =~ s#_NONASCDICTNAME_#${lang}_stem#gs; 450 $txt =~ s#_STOPWORDS_#$stop#gs; 451 print $F $txt; 452 print "."; 453 } 454 close($F); 455 print "\n"; 456} 457 458sub CopyContribFiles 459{ 460 my $config = shift; 461 my $target = shift; 462 463 print "Copying contrib data files..."; 464 foreach my $subdir ('contrib', 'src/test/modules') 465 { 466 my $D; 467 opendir($D, $subdir) || croak "Could not opendir on $subdir!\n"; 468 while (my $d = readdir($D)) 469 { 470 # These configuration-based exclusions must match vcregress.pl 471 next if ($d eq "uuid-ossp" && !defined($config->{uuid})); 472 next if ($d eq "sslinfo" && !defined($config->{openssl})); 473 next if ($d eq "xml2" && !defined($config->{xml})); 474 next if ($d =~ /_plperl$/ && !defined($config->{perl})); 475 next if ($d =~ /_plpython$/ && !defined($config->{python})); 476 next if ($d eq "sepgsql"); 477 478 CopySubdirFiles($subdir, $d, $config, $target); 479 } 480 } 481 print "\n"; 482} 483 484sub CopySubdirFiles 485{ 486 my $subdir = shift; 487 my $module = shift; 488 my $config = shift; 489 my $target = shift; 490 491 return if ($module =~ /^\./); 492 return unless (-f "$subdir/$module/Makefile"); 493 return 494 if ($insttype eq "client" && !grep { $_ eq $module } @client_contribs); 495 496 my $mf = read_file("$subdir/$module/Makefile"); 497 $mf =~ s{\\\r?\n}{}g; 498 499 # Note: we currently don't support setting MODULEDIR in the makefile 500 my $moduledir = 'contrib'; 501 502 my $flist = ''; 503 if ($mf =~ /^EXTENSION\s*=\s*(.*)$/m) { $flist .= $1 } 504 if ($flist ne '') 505 { 506 $moduledir = 'extension'; 507 $flist = ParseAndCleanRule($flist, $mf); 508 509 foreach my $f (split /\s+/, $flist) 510 { 511 lcopy("$subdir/$module/$f.control", 512 "$target/share/extension/$f.control") 513 || croak("Could not copy file $f.control in contrib $module"); 514 print '.'; 515 } 516 } 517 518 $flist = ''; 519 if ($mf =~ /^DATA_built\s*=\s*(.*)$/m) { $flist .= $1 } 520 if ($mf =~ /^DATA\s*=\s*(.*)$/m) { $flist .= " $1" } 521 $flist =~ s/^\s*//; # Remove leading spaces if we had only DATA_built 522 523 if ($flist ne '') 524 { 525 $flist = ParseAndCleanRule($flist, $mf); 526 527 foreach my $f (split /\s+/, $flist) 528 { 529 lcopy("$subdir/$module/$f", 530 "$target/share/$moduledir/" . basename($f)) 531 || croak("Could not copy file $f in contrib $module"); 532 print '.'; 533 } 534 } 535 536 $flist = ''; 537 if ($mf =~ /^DATA_TSEARCH\s*=\s*(.*)$/m) { $flist .= $1 } 538 if ($flist ne '') 539 { 540 $flist = ParseAndCleanRule($flist, $mf); 541 542 foreach my $f (split /\s+/, $flist) 543 { 544 lcopy("$subdir/$module/$f", 545 "$target/share/tsearch_data/" . basename($f)) 546 || croak("Could not copy file $f in $subdir $module"); 547 print '.'; 548 } 549 } 550 551 $flist = ''; 552 if ($mf =~ /^DOCS\s*=\s*(.*)$/mg) { $flist .= $1 } 553 if ($flist ne '') 554 { 555 $flist = ParseAndCleanRule($flist, $mf); 556 557 # Special case for contrib/spi 558 $flist = 559"autoinc.example insert_username.example moddatetime.example refint.example timetravel.example" 560 if ($module eq 'spi'); 561 foreach my $f (split /\s+/, $flist) 562 { 563 lcopy("$subdir/$module/$f", "$target/doc/$moduledir/$f") 564 || croak("Could not copy file $f in contrib $module"); 565 print '.'; 566 } 567 } 568} 569 570sub ParseAndCleanRule 571{ 572 my $flist = shift; 573 my $mf = shift; 574 575 # Strip out $(addsuffix) rules 576 if (index($flist, '$(addsuffix ') >= 0) 577 { 578 my $pcount = 0; 579 my $i; 580 for ( 581 $i = index($flist, '$(addsuffix ') + 12; 582 $i < length($flist); 583 $i++) 584 { 585 $pcount++ if (substr($flist, $i, 1) eq '('); 586 $pcount-- if (substr($flist, $i, 1) eq ')'); 587 last if ($pcount < 0); 588 } 589 $flist = 590 substr($flist, 0, index($flist, '$(addsuffix ')) 591 . substr($flist, $i + 1); 592 } 593 return $flist; 594} 595 596sub CopyIncludeFiles 597{ 598 my $target = shift; 599 600 EnsureDirectories($target, 'include', 'include/libpq', 'include/internal', 601 'include/internal/libpq', 'include/server', 'include/server/parser'); 602 603 CopyFiles( 604 'Public headers', $target . '/include/', 605 'src/include/', 'postgres_ext.h', 606 'pg_config.h', 'pg_config_ext.h', 607 'pg_config_os.h', 'dynloader.h', 608 'pg_config_manual.h'); 609 lcopy('src/include/libpq/libpq-fs.h', $target . '/include/libpq/') 610 || croak 'Could not copy libpq-fs.h'; 611 612 CopyFiles( 613 'Libpq headers', 614 $target . '/include/', 615 'src/interfaces/libpq/', 'libpq-fe.h', 'libpq-events.h'); 616 CopyFiles( 617 'Libpq internal headers', 618 $target . '/include/internal/', 619 'src/interfaces/libpq/', 'libpq-int.h', 'pqexpbuffer.h'); 620 621 CopyFiles( 622 'Internal headers', 623 $target . '/include/internal/', 624 'src/include/', 'c.h', 'port.h', 'postgres_fe.h'); 625 lcopy('src/include/libpq/pqcomm.h', $target . '/include/internal/libpq/') 626 || croak 'Could not copy pqcomm.h'; 627 628 CopyFiles( 629 'Server headers', 630 $target . '/include/server/', 631 'src/include/', 'pg_config.h', 'pg_config_ext.h', 'pg_config_os.h', 632 'dynloader.h'); 633 CopyFiles( 634 'Grammar header', 635 $target . '/include/server/parser/', 636 'src/backend/parser/', 'gram.h'); 637 CopySetOfFiles( 638 '', 639 [ glob("src\\include\\*.h") ], 640 $target . '/include/server/'); 641 my $D; 642 opendir($D, 'src/include') || croak "Could not opendir on src/include!\n"; 643 644 CopyFiles( 645 'PL/pgSQL header', 646 $target . '/include/server/', 647 'src/pl/plpgsql/src/', 'plpgsql.h'); 648 649 # some xcopy progs don't like mixed slash style paths 650 (my $ctarget = $target) =~ s!/!\\!g; 651 while (my $d = readdir($D)) 652 { 653 next if ($d =~ /^\./); 654 next if ($d eq '.git'); 655 next if ($d eq 'CVS'); 656 next unless (-d "src/include/$d"); 657 658 EnsureDirectories("$target/include/server/$d"); 659 my @args = ( 660 'xcopy', '/s', '/i', '/q', '/r', '/y', "src\\include\\$d\\*.h", 661 "$ctarget\\include\\server\\$d\\"); 662 system(@args) && croak("Failed to copy include directory $d\n"); 663 } 664 closedir($D); 665 666 my $mf = read_file('src/interfaces/ecpg/include/Makefile'); 667 $mf =~ s{\\\r?\n}{}g; 668 $mf =~ /^ecpg_headers\s*=\s*(.*)$/m 669 || croak "Could not find ecpg_headers line\n"; 670 CopyFiles( 671 'ECPG headers', 672 $target . '/include/', 673 'src/interfaces/ecpg/include/', 674 'ecpg_config.h', split /\s+/, $1); 675 $mf =~ /^informix_headers\s*=\s*(.*)$/m 676 || croak "Could not find informix_headers line\n"; 677 EnsureDirectories($target . '/include', 'informix', 'informix/esql'); 678 CopyFiles( 679 'ECPG informix headers', 680 $target . '/include/informix/esql/', 681 'src/interfaces/ecpg/include/', 682 split /\s+/, $1); 683} 684 685sub GenerateNLSFiles 686{ 687 my $target = shift; 688 my $nlspath = shift; 689 my $majorver = shift; 690 691 print "Installing NLS files..."; 692 EnsureDirectories($target, "share/locale"); 693 my @flist; 694 File::Find::find( 695 { wanted => sub { 696 /^nls\.mk\z/s 697 && !push(@flist, $File::Find::name); 698 } 699 }, 700 "src"); 701 foreach (@flist) 702 { 703 my $prgm = DetermineCatalogName($_); 704 s/nls.mk/po/; 705 my $dir = $_; 706 next unless ($dir =~ /([^\/]+)\/po$/); 707 foreach (glob("$dir/*.po")) 708 { 709 my $lang; 710 next unless /([^\/]+)\.po/; 711 $lang = $1; 712 713 EnsureDirectories($target, "share/locale/$lang", 714 "share/locale/$lang/LC_MESSAGES"); 715 my @args = ( 716 "$nlspath\\bin\\msgfmt", 717 '-o', 718"$target\\share\\locale\\$lang\\LC_MESSAGES\\$prgm-$majorver.mo", 719 $_); 720 system(@args) && croak("Could not run msgfmt on $dir\\$_"); 721 print "."; 722 } 723 } 724 print "\n"; 725} 726 727sub DetermineMajorVersion 728{ 729 my $f = read_file('src/include/pg_config.h') 730 || croak 'Could not open pg_config.h'; 731 $f =~ /^#define\s+PG_MAJORVERSION\s+"([^"]+)"/m 732 || croak 'Could not determine major version'; 733 return $1; 734} 735 736sub DetermineCatalogName 737{ 738 my $filename = shift; 739 740 my $f = read_file($filename) || croak "Could not open $filename"; 741 $f =~ /CATALOG_NAME\s*\:?=\s*(\S+)/m 742 || croak "Could not determine catalog name in $filename"; 743 return $1; 744} 745 746sub read_file 747{ 748 my $filename = shift; 749 my $F; 750 my $t = $/; 751 752 undef $/; 753 open($F, '<', $filename) || die "Could not open file $filename\n"; 754 my $txt = <$F>; 755 close($F); 756 $/ = $t; 757 758 return $txt; 759} 760 7611; 762