1# -*-perl-*- hey - emacs - this is a perl file
2
3# src/tools/msvc/pgflex.pl
4
5use strict;
6use File::Basename;
7
8# silence flex bleatings about file path style
9$ENV{CYGWIN} = 'nodosfilewarning';
10
11# assume we are in the postgres source root
12
13do './src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
14
15my ($flexver) = `flex -V`;    # grab first line
16$flexver = (split(/\s+/, $flexver))[1];
17$flexver =~ s/[^0-9.]//g;
18my @verparts = split(/\./, $flexver);
19unless ($verparts[0] == 2
20	&& ($verparts[1] > 5 || ($verparts[1] == 5 && $verparts[2] >= 31)))
21{
22	print "WARNING! Flex install not found, or unsupported Flex version.\n";
23	print "echo Attempting to build without.\n";
24	exit 0;
25}
26
27my $input = shift;
28if ($input !~ /\.l$/)
29{
30	print "Input must be a .l file\n";
31	exit 1;
32}
33elsif (!-e $input)
34{
35	print "Input file $input not found\n";
36	exit 1;
37}
38
39(my $output = $input) =~ s/\.l$/.c/;
40
41# get flex flags from make file
42my $makefile = dirname($input) . "/Makefile";
43my ($mf, $make);
44open($mf, '<', $makefile);
45local $/ = undef;
46$make = <$mf>;
47close($mf);
48my $basetarg = basename($output);
49my $flexflags = ($make =~ /^$basetarg:\s*FLEXFLAGS\s*=\s*(\S.*)/m ? $1 : '');
50
51system("flex $flexflags -o$output $input");
52if ($? == 0)
53{
54
55	# Check for "%option reentrant" in .l file.
56	my $lfile;
57	open($lfile, '<', $input) || die "opening $input for reading: $!";
58	my $lcode = <$lfile>;
59	close($lfile);
60	if ($lcode =~ /\%option\sreentrant/)
61	{
62
63		# Reentrant scanners usually need a fix to prevent
64		# "unused variable" warnings with older flex versions.
65		system("perl src\\tools\\fix-old-flex-code.pl $output");
66	}
67	else
68	{
69
70		# For non-reentrant scanners we need to fix up the yywrap
71		# macro definition to keep the MS compiler happy.
72		# For reentrant scanners (like the core scanner) we do not
73		# need to (and must not) change the yywrap definition.
74		my $cfile;
75		open($cfile, '<', $output) || die "opening $output for reading: $!";
76		my $ccode = <$cfile>;
77		close($cfile);
78		$ccode =~ s/yywrap\(n\)/yywrap()/;
79		open($cfile, '>', $output) || die "opening $output for writing: $!";
80		print $cfile $ccode;
81		close($cfile);
82	}
83	if ($flexflags =~ /\s-b\s/)
84	{
85		my $lexback = "lex.backup";
86		open($lfile, '<', $lexback) || die "opening $lexback for reading: $!";
87		my $lexbacklines = <$lfile>;
88		close($lfile);
89		my $linecount = $lexbacklines =~ tr /\n/\n/;
90		if ($linecount != 1)
91		{
92			print "Scanner requires backup, see lex.backup.\n";
93			exit 1;
94		}
95		unlink $lexback;
96	}
97
98	exit 0;
99
100}
101else
102{
103	exit $? >> 8;
104}
105