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