1#!/usr/bin/perl -w
2#
3# Copyright (C) 2011 Google Inc.  All rights reserved.
4#
5# This library is free software; you can redistribute it and/or
6# modify it under the terms of the GNU Library General Public
7# License as published by the Free Software Foundation; either
8# version 2 of the License, or (at your option) any later version.
9#
10# This library is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13# Library General Public License for more details.
14#
15# You should have received a copy of the GNU Library General Public License
16# along with this library; see the file COPYING.LIB.  If not, write to
17# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18# Boston, MA 02110-1301, USA.
19#
20
21use strict;
22
23use File::Basename;
24use Getopt::Long;
25use Cwd;
26
27my $defines;
28my $preprocessor;
29my $idlFilesList;
30my $supplementalDependencyFile;
31my $windowConstructorsFile;
32my $workerContextConstructorsFile;
33my $supplementalMakefileDeps;
34
35GetOptions('defines=s' => \$defines,
36           'preprocessor=s' => \$preprocessor,
37           'idlFilesList=s' => \$idlFilesList,
38           'supplementalDependencyFile=s' => \$supplementalDependencyFile,
39           'windowConstructorsFile=s' => \$windowConstructorsFile,
40           'workerContextConstructorsFile=s' => \$workerContextConstructorsFile,
41           'supplementalMakefileDeps=s' => \$supplementalMakefileDeps);
42
43die('Must specify #define macros using --defines.') unless defined($defines);
44die('Must specify an output file using --supplementalDependencyFile.') unless defined($supplementalDependencyFile);
45die('Must specify an output file using --windowConstructorsFile.') unless defined($windowConstructorsFile);
46die('Must specify an output file using --workerContextConstructorsFile.') unless defined($workerContextConstructorsFile);
47die('Must specify the file listing all IDLs using --idlFilesList.') unless defined($idlFilesList);
48
49open FH, "< $idlFilesList" or die "Cannot open $idlFilesList\n";
50my @idlFiles = <FH>;
51chomp(@idlFiles);
52close FH;
53
54# Parse all IDL files.
55my %interfaceNameToIdlFile;
56my %idlFileToInterfaceName;
57my %supplementalDependencies;
58my %supplementals;
59my $windowConstructorsCode = "";
60my $workerContextConstructorsCode = "";
61# Get rid of duplicates in idlFiles array.
62my %idlFileHash = map { $_, 1 } @idlFiles;
63foreach my $idlFile (sort keys %idlFileHash) {
64    my $fullPath = Cwd::realpath($idlFile);
65    my $idlFileContents = getFileContents($fullPath);
66    my $partialInterfaceName = getPartialInterfaceNameFromIDL($idlFileContents);
67    if ($partialInterfaceName) {
68        $supplementalDependencies{$fullPath} = $partialInterfaceName;
69        next;
70    }
71    my $interfaceName = fileparse(basename($idlFile), ".idl");
72    unless (isCallbackInterfaceFromIDL($idlFileContents)) {
73        my $extendedAttributes = getInterfaceExtendedAttributesFromIDL($idlFileContents);
74        unless ($extendedAttributes->{"NoInterfaceObject"}) {
75            my $globalContext = $extendedAttributes->{"GlobalContext"} || "WindowOnly";
76            my $attributeCode = GenerateConstructorAttribute($interfaceName, $extendedAttributes);
77            $windowConstructorsCode .= $attributeCode unless $globalContext eq "WorkerOnly";
78            $workerContextConstructorsCode .= $attributeCode unless $globalContext eq "WindowOnly"
79        }
80    }
81    $interfaceNameToIdlFile{$interfaceName} = $fullPath;
82    $idlFileToInterfaceName{$fullPath} = $interfaceName;
83    $supplementals{$fullPath} = [];
84}
85
86# Generate DOMWindow Constructors partial interface.
87GeneratePartialInterface("DOMWindow", $windowConstructorsCode, $windowConstructorsFile);
88
89# Generate WorkerContext Constructors partial interface.
90GeneratePartialInterface("WorkerContext", $workerContextConstructorsCode, $workerContextConstructorsFile);
91
92# Resolves partial interfaces dependencies.
93foreach my $idlFile (keys %supplementalDependencies) {
94    my $baseFile = $supplementalDependencies{$idlFile};
95    my $targetIdlFile = $interfaceNameToIdlFile{$baseFile};
96    push(@{$supplementals{$targetIdlFile}}, $idlFile);
97    delete $supplementals{$idlFile};
98}
99
100# Outputs the dependency.
101# The format of a supplemental dependency file:
102#
103# DOMWindow.idl P.idl Q.idl R.idl
104# Document.idl S.idl
105# Event.idl
106# ...
107#
108# The above indicates that DOMWindow.idl is supplemented by P.idl, Q.idl and R.idl,
109# Document.idl is supplemented by S.idl, and Event.idl is supplemented by no IDLs.
110# The IDL that supplements another IDL (e.g. P.idl) never appears in the dependency file.
111my $dependencies = "";
112foreach my $idlFile (sort keys %supplementals) {
113    $dependencies .= "$idlFile @{$supplementals{$idlFile}}\n";
114}
115WriteFileIfChanged($supplementalDependencyFile, $dependencies);
116
117if ($supplementalMakefileDeps) {
118    my $makefileDeps = "";
119    foreach my $idlFile (sort keys %supplementals) {
120        my $basename = $idlFileToInterfaceName{$idlFile};
121
122        my @dependencies = map { basename($_) } @{$supplementals{$idlFile}};
123
124        $makefileDeps .= "JS${basename}.h: @{dependencies}\n";
125        $makefileDeps .= "DOM${basename}.h: @{dependencies}\n";
126        $makefileDeps .= "WebDOM${basename}.h: @{dependencies}\n";
127        foreach my $dependency (@dependencies) {
128            $makefileDeps .= "${dependency}:\n";
129        }
130    }
131
132    WriteFileIfChanged($supplementalMakefileDeps, $makefileDeps);
133}
134
135sub WriteFileIfChanged
136{
137    my $fileName = shift;
138    my $contents = shift;
139
140    if (-f $fileName) {
141        open FH, "<", $fileName or die "Couldn't open $fileName: $!\n";
142        my @lines = <FH>;
143        my $oldContents = join "", @lines;
144        close FH;
145        return if $contents eq $oldContents;
146    }
147    open FH, ">", $fileName or die "Couldn't open $fileName: $!\n";
148    print FH $contents;
149    close FH;
150}
151
152sub GeneratePartialInterface
153{
154    my $interfaceName = shift;
155    my $attributesCode = shift;
156    my $destinationFile = shift;
157
158    my $contents = "partial interface ${interfaceName} {\n$attributesCode};\n";
159    WriteFileIfChanged($destinationFile, $contents);
160
161    my $fullPath = Cwd::realpath($destinationFile);
162    $supplementalDependencies{$fullPath} = $interfaceName if $interfaceNameToIdlFile{$interfaceName};
163}
164
165sub GenerateConstructorAttribute
166{
167    my $interfaceName = shift;
168    my $extendedAttributes = shift;
169
170    my $code = "    ";
171    my @extendedAttributesList;
172    foreach my $attributeName (keys %{$extendedAttributes}) {
173      next unless ($attributeName eq "Conditional" || $attributeName eq "EnabledAtRuntime" || $attributeName eq "EnabledBySetting");
174      my $extendedAttribute = $attributeName;
175      $extendedAttribute .= "=" . $extendedAttributes->{$attributeName} unless $extendedAttributes->{$attributeName} eq "VALUE_IS_MISSING";
176      push(@extendedAttributesList, $extendedAttribute);
177    }
178    $code .= "[" . join(', ', @extendedAttributesList) . "] " if @extendedAttributesList;
179
180    my $originalInterfaceName = $interfaceName;
181    $interfaceName = $extendedAttributes->{"InterfaceName"} if $extendedAttributes->{"InterfaceName"};
182    $code .= "attribute " . $originalInterfaceName . "Constructor $interfaceName;\n";
183
184    # In addition to the regular property, for every [NamedConstructor] extended attribute on an interface,
185    # a corresponding property MUST exist on the ECMAScript global object.
186    if ($extendedAttributes->{"NamedConstructor"}) {
187        my $constructorName = $extendedAttributes->{"NamedConstructor"};
188        $constructorName =~ s/\(.*//g; # Extract function name.
189        $code .= "    ";
190        $code .= "[" . join(', ', @extendedAttributesList) . "] " if @extendedAttributesList;
191        $code .= "attribute " . $originalInterfaceName . "NamedConstructor $constructorName;\n";
192    }
193    return $code;
194}
195
196sub getFileContents
197{
198    my $idlFile = shift;
199
200    open FILE, "<", $idlFile;
201    my @lines = <FILE>;
202    close FILE;
203
204    # Filter out preprocessor lines.
205    @lines = grep(!/^\s*#/, @lines);
206
207    return join('', @lines);
208}
209
210sub getPartialInterfaceNameFromIDL
211{
212    my $fileContents = shift;
213
214    if ($fileContents =~ /partial\s+interface\s+(\w+)/gs) {
215        return $1;
216    }
217}
218
219sub isCallbackInterfaceFromIDL
220{
221    my $fileContents = shift;
222    return ($fileContents =~ /callback\s+interface\s+\w+/gs);
223}
224
225sub trim
226{
227    my $string = shift;
228    $string =~ s/^\s+|\s+$//g;
229    return $string;
230}
231
232sub getInterfaceExtendedAttributesFromIDL
233{
234    my $fileContents = shift;
235
236    my $extendedAttributes = {};
237
238    if ($fileContents =~ /\[(.*)\]\s+(interface|exception)\s+(\w+)/gs) {
239        my @parts = split(',', $1);
240        foreach my $part (@parts) {
241            my @keyValue = split('=', $part);
242            my $key = trim($keyValue[0]);
243            next unless length($key);
244            my $value = "VALUE_IS_MISSING";
245            $value = trim($keyValue[1]) if @keyValue > 1;
246            $extendedAttributes->{$key} = $value;
247        }
248    }
249
250    return $extendedAttributes;
251}
252