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