1
2# Copyright (c) 2021, PostgreSQL Global Development Group
3
4package Project;
5
6#
7# Package that encapsulates a Visual C++ project file generation
8#
9# src/tools/msvc/Project.pm
10#
11use Carp;
12use strict;
13use warnings;
14use File::Basename;
15
16sub _new
17{
18	my ($classname, $name, $type, $solution) = @_;
19	my $good_types = {
20		lib => 1,
21		exe => 1,
22		dll => 1,
23	};
24	confess("Bad project type: $type\n") unless exists $good_types->{$type};
25	my $self = {
26		name                  => $name,
27		type                  => $type,
28		guid                  => $^O eq "MSWin32" ? Win32::GuidGen() : 'FAKE',
29		files                 => {},
30		references            => [],
31		libraries             => [],
32		suffixlib             => [],
33		includes              => '',
34		prefixincludes        => '',
35		defines               => ';',
36		solution              => $solution,
37		disablewarnings       => '4018;4244;4273;4102;4090;4267',
38		disablelinkerwarnings => '',
39		platform              => $solution->{platform},
40	};
41
42	bless($self, $classname);
43	return $self;
44}
45
46sub AddFile
47{
48	my ($self, $filename) = @_;
49
50	$self->{files}->{$filename} = 1;
51	return;
52}
53
54sub AddFiles
55{
56	my $self = shift;
57	my $dir  = shift;
58
59	while (my $f = shift)
60	{
61		$self->{files}->{ $dir . "/" . $f } = 1;
62	}
63	return;
64}
65
66sub ReplaceFile
67{
68	my ($self, $filename, $newname) = @_;
69	my $re = "\\/$filename\$";
70
71	foreach my $file (keys %{ $self->{files} })
72	{
73
74		# Match complete filename
75		if ($filename =~ m!/!)
76		{
77			if ($file eq $filename)
78			{
79				delete $self->{files}{$file};
80				$self->{files}{$newname} = 1;
81				return;
82			}
83		}
84		elsif ($file =~ m/($re)/)
85		{
86			delete $self->{files}{$file};
87			$self->{files}{"$newname/$filename"} = 1;
88			return;
89		}
90	}
91	confess("Could not find file $filename to replace\n");
92}
93
94sub RemoveFile
95{
96	my ($self, $filename) = @_;
97	my $orig = scalar keys %{ $self->{files} };
98	delete $self->{files}->{$filename};
99	if ($orig > scalar keys %{ $self->{files} })
100	{
101		return;
102	}
103	confess("Could not find file $filename to remove\n");
104}
105
106sub RelocateFiles
107{
108	my ($self, $targetdir, $proc) = @_;
109	foreach my $f (keys %{ $self->{files} })
110	{
111		my $r = &$proc($f);
112		if ($r)
113		{
114			$self->RemoveFile($f);
115			$self->AddFile($targetdir . '/' . basename($f));
116		}
117	}
118	return;
119}
120
121sub AddReference
122{
123	my $self = shift;
124
125	while (my $ref = shift)
126	{
127		push @{ $self->{references} }, $ref;
128		$self->AddLibrary(
129			"__CFGNAME__/" . $ref->{name} . "/" . $ref->{name} . ".lib");
130	}
131	return;
132}
133
134sub AddLibrary
135{
136	my ($self, $lib, $dbgsuffix) = @_;
137
138	# quote lib name if it has spaces and isn't already quoted
139	if ($lib =~ m/\s/ && $lib !~ m/^[&]quot;/)
140	{
141		$lib = '"' . $lib . """;
142	}
143
144	push @{ $self->{libraries} }, $lib;
145	if ($dbgsuffix)
146	{
147		push @{ $self->{suffixlib} }, $lib;
148	}
149	return;
150}
151
152sub AddIncludeDir
153{
154	my ($self, $inc) = @_;
155
156	if ($self->{includes} ne '')
157	{
158		$self->{includes} .= ';';
159	}
160	$self->{includes} .= $inc;
161	return;
162}
163
164sub AddPrefixInclude
165{
166	my ($self, $inc) = @_;
167
168	$self->{prefixincludes} = $inc . ';' . $self->{prefixincludes};
169	return;
170}
171
172sub AddDefine
173{
174	my ($self, $def) = @_;
175
176	$def =~ s/"/""/g;
177	$self->{defines} .= $def . ';';
178	return;
179}
180
181sub FullExportDLL
182{
183	my ($self, $libname) = @_;
184
185	$self->{builddef} = 1;
186	$self->{def}      = "./__CFGNAME__/$self->{name}/$self->{name}.def";
187	$self->{implib}   = "__CFGNAME__/$self->{name}/$libname";
188	return;
189}
190
191sub UseDef
192{
193	my ($self, $def) = @_;
194
195	$self->{def} = $def;
196	return;
197}
198
199sub AddDir
200{
201	my ($self, $reldir) = @_;
202	my $mf = read_makefile($reldir);
203
204	$mf =~ s{\\\r?\n}{}g;
205	if ($mf =~ m{^(?:SUB)?DIRS[^=]*=\s*(.*)$}mg)
206	{
207		foreach my $subdir (split /\s+/, $1)
208		{
209			next
210			  if $subdir eq "\$(top_builddir)/src/timezone"
211			  ;    #special case for non-standard include
212			next
213			  if $reldir . "/" . $subdir eq "src/backend/port/darwin";
214
215			$self->AddDir($reldir . "/" . $subdir);
216		}
217	}
218	while ($mf =~ m{^(?:EXTRA_)?OBJS[^=]*=\s*(.*)$}m)
219	{
220		my $s         = $1;
221		my $filter_re = qr{\$\(filter ([^,]+),\s+\$\(([^\)]+)\)\)};
222		while ($s =~ /$filter_re/)
223		{
224
225			# Process $(filter a b c, $(VAR)) expressions
226			my $list   = $1;
227			my $filter = $2;
228			$list =~ s/\.o/\.c/g;
229			my @pieces = split /\s+/, $list;
230			my $matches = "";
231			foreach my $p (@pieces)
232			{
233
234				if ($filter eq "LIBOBJS")
235				{
236					no warnings qw(once);
237					if (grep(/$p/, @main::pgportfiles) == 1)
238					{
239						$p =~ s/\.c/\.o/;
240						$matches .= $p . " ";
241					}
242				}
243				else
244				{
245					confess "Unknown filter $filter\n";
246				}
247			}
248			$s =~ s/$filter_re/$matches/;
249		}
250		foreach my $f (split /\s+/, $s)
251		{
252			next if $f =~ /^\s*$/;
253			next if $f eq "\\";
254			next if $f =~ /\/SUBSYS.o$/;
255			$f =~ s/,$//
256			  ;    # Remove trailing comma that can show up from filter stuff
257			next unless $f =~ /.*\.o$/;
258			$f =~ s/\.o$/\.c/;
259			if ($f =~ /^\$\(top_builddir\)\/(.*)/)
260			{
261				$f = $1;
262				$self->{files}->{$f} = 1;
263			}
264			else
265			{
266				$self->{files}->{"$reldir/$f"} = 1;
267			}
268		}
269		$mf =~ s{OBJS[^=]*=\s*(.*)$}{}m;
270	}
271
272	# Match rules that pull in source files from different directories, eg
273	# pgstrcasecmp.c rint.c snprintf.c: % : $(top_srcdir)/src/port/%
274	my $replace_re =
275	  qr{^([^:\n\$]+\.c)\s*:\s*(?:%\s*: )?\$(\([^\)]+\))\/(.*)\/[^\/]+\n}m;
276	while ($mf =~ m{$replace_re}m)
277	{
278		my $match  = $1;
279		my $top    = $2;
280		my $target = $3;
281		my @pieces = split /\s+/, $match;
282		foreach my $fn (@pieces)
283		{
284			if ($top eq "(top_srcdir)")
285			{
286				eval { $self->ReplaceFile($fn, $target) };
287			}
288			elsif ($top eq "(backend_src)")
289			{
290				eval { $self->ReplaceFile($fn, "src/backend/$target") };
291			}
292			else
293			{
294				confess "Bad replacement top: $top, on line $_\n";
295			}
296		}
297		$mf =~ s{$replace_re}{}m;
298	}
299
300	$self->AddDirResourceFile($reldir);
301	return;
302}
303
304# If the directory's Makefile bears a description string, add a resource file.
305sub AddDirResourceFile
306{
307	my ($self, $reldir) = @_;
308	my $mf = read_makefile($reldir);
309
310	if ($mf =~ /^PGFILEDESC\s*=\s*\"([^\"]+)\"/m)
311	{
312		my $desc = $1;
313		my $ico;
314		if ($mf =~ /^PGAPPICON\s*=\s*(.*)$/m) { $ico = $1; }
315		$self->AddResourceFile($reldir, $desc, $ico);
316	}
317	return;
318}
319
320sub AddResourceFile
321{
322	my ($self, $dir, $desc, $ico) = @_;
323
324	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
325	  localtime(time);
326	my $d = sprintf("%02d%03d", ($year - 100), $yday);
327
328	if (Solution::IsNewer("$dir/win32ver.rc", 'src/port/win32ver.rc'))
329	{
330		print "Generating win32ver.rc for $dir\n";
331		open(my $i, '<', 'src/port/win32ver.rc')
332		  || confess "Could not open win32ver.rc";
333		open(my $o, '>', "$dir/win32ver.rc")
334		  || confess "Could not write win32ver.rc";
335		my $icostr = $ico ? "IDI_ICON ICON \"src/port/$ico.ico\"" : "";
336		while (<$i>)
337		{
338			s/FILEDESC/"$desc"/gm;
339			s/_ICO_/$icostr/gm;
340			s/(VERSION.*),0/$1,$d/;
341			if ($self->{type} eq "dll")
342			{
343				s/VFT_APP/VFT_DLL/gm;
344				my $name = $self->{name};
345				s/_INTERNAL_NAME_/"$name"/;
346				s/_ORIGINAL_NAME_/"$name.dll"/;
347			}
348			else
349			{
350				/_INTERNAL_NAME_/ && next;
351				/_ORIGINAL_NAME_/ && next;
352			}
353			print $o $_;
354		}
355		close($o);
356		close($i);
357	}
358	$self->AddFile("$dir/win32ver.rc");
359	return;
360}
361
362sub DisableLinkerWarnings
363{
364	my ($self, $warnings) = @_;
365
366	$self->{disablelinkerwarnings} .= ','
367	  unless ($self->{disablelinkerwarnings} eq '');
368	$self->{disablelinkerwarnings} .= $warnings;
369	return;
370}
371
372sub Save
373{
374	my ($self) = @_;
375
376	# If doing DLL and haven't specified a DEF file, do a full export of all symbols
377	# in the project.
378	if ($self->{type} eq "dll" && !$self->{def})
379	{
380		$self->FullExportDLL($self->{name} . ".lib");
381	}
382
383	# Warning 4197 is about double exporting, disable this per
384	# http://connect.microsoft.com/VisualStudio/feedback/ViewFeedback.aspx?FeedbackID=99193
385	$self->DisableLinkerWarnings('4197') if ($self->{platform} eq 'x64');
386
387	# Dump the project
388	open(my $f, '>', "$self->{name}$self->{filenameExtension}")
389	  || croak(
390		"Could not write to $self->{name}$self->{filenameExtension}\n");
391	$self->WriteHeader($f);
392	$self->WriteFiles($f);
393	$self->Footer($f);
394	close($f);
395	return;
396}
397
398sub GetAdditionalLinkerDependencies
399{
400	my ($self, $cfgname, $separator) = @_;
401	my $libcfg = (uc $cfgname eq "RELEASE") ? "MD" : "MDd";
402	my $libs = '';
403	foreach my $lib (@{ $self->{libraries} })
404	{
405		my $xlib = $lib;
406		foreach my $slib (@{ $self->{suffixlib} })
407		{
408			if ($slib eq $lib)
409			{
410				$xlib =~ s/\.lib$/$libcfg.lib/;
411				last;
412			}
413		}
414		$libs .= $xlib . $separator;
415	}
416	$libs =~ s/.$//;
417	$libs =~ s/__CFGNAME__/$cfgname/g;
418	return $libs;
419}
420
421# Utility function that loads a complete file
422sub read_file
423{
424	my $filename = shift;
425	my $F;
426	local $/ = undef;
427	open($F, '<', $filename) || croak "Could not open file $filename\n";
428	my $txt = <$F>;
429	close($F);
430
431	return $txt;
432}
433
434sub read_makefile
435{
436	my $reldir = shift;
437	my $F;
438	local $/ = undef;
439	open($F, '<', "$reldir/GNUmakefile")
440	  || open($F, '<', "$reldir/Makefile")
441	  || confess "Could not open $reldir/Makefile\n";
442	my $txt = <$F>;
443	close($F);
444
445	return $txt;
446}
447
4481;
449