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