File: | lib/Makefile/Update/VCProj.pm |
Coverage: | 94.4% |
line | stmt | bran | cond | sub | code |
---|---|---|---|---|---|
1 | package Makefile::Update::VCProj; | ||||
2 | # ABSTRACT: Update list of sources and headers in Visual C++ projects. | ||||
3 | |||||
4 | 6 6 6 | use Exporter qw(import); | |||
5 | our @EXPORT = qw(update_vcproj); | ||||
6 | |||||
7 | 6 6 6 | use strict; | |||
8 | 6 6 6 | use warnings; | |||
9 | |||||
10 | # VERSION | ||||
11 | |||||
12 - 24 | =head1 SYNOPSIS The function L<update_vcproj()> can be used to update the list of headers and sources in the given Visual C++ project file C<project.vcproj>: use Makefile::Update::VCProj; upmake_msbuild_project('project.vcproj', \@sources, \@headers); =head1 SEE ALSO Makefile::Update, Makefile::Update::MSBuild =cut | ||||
25 | |||||
26 | =func update_vcproj | ||||
27 | |||||
28 | Update sources and headers in a VC++ project. | ||||
29 | |||||
30 | Parameters: input and output file handles, array references to the sources | ||||
31 | and the headers to be used in this project and a callback used to determine | ||||
32 | the filter for the new files. | ||||
33 | |||||
34 | Returns 1 if any changes were made. | ||||
35 | =cut | ||||
36 | |||||
37 | sub update_vcproj | ||||
38 | { | ||||
39 | 18 | my ($in, $out, $sources, $headers, $filter_cb) = @_; | |||
40 | |||||
41 | # Use standard/default classifier for the files if none is explicitly | ||||
42 | # specified. | ||||
43 | 18 | if (!defined $filter_cb) { | |||
44 | $filter_cb = sub { | ||||
45 | 33 | my ($file) = @_; | |||
46 | |||||
47 | 33 | return 'Source Files' if $file =~ q{\.c(c|pp|xx|\+\+)?$}; | |||
48 | 12 | return 'Header Files' if $file =~ q{\.h(h|pp|xx|\+\+)?$}; | |||
49 | |||||
50 | 3 | warn qq{No filter defined for the file "$file".\n}; | |||
51 | |||||
52 | undef | ||||
53 | 3 | } | |||
54 | 18 | } | |||
55 | |||||
56 | # Hash mapping the filter to all the files using it (whether sources or | ||||
57 | # headers). | ||||
58 | 18 | my %files_by_filter; | |||
59 | 18 | foreach my $file (@$sources, @$headers) { | |||
60 | 33 | my $filter = $filter_cb->($file); | |||
61 | 33 | if (defined $filter) { | |||
62 | 30 30 | push @{$files_by_filter{$filter}}, $file | |||
63 | } | ||||
64 | } | ||||
65 | |||||
66 | # Name of the current filter, if any. | ||||
67 | 18 | my $filter; | |||
68 | |||||
69 | # Hash containing 0 or 1 for each file using the current filter. | ||||
70 | my %seen; | ||||
71 | |||||
72 | # Indicates whether the closing angle bracket of "<File>" tags is on its | ||||
73 | # own line (which is how MSVS 2005 and 2008 format their files) or on the | ||||
74 | # same line as "RelativePath" attribute (which is how MSVS 2003 does it). | ||||
75 | 18 | my $angle_bracket_on_same_line = 0; | |||
76 | |||||
77 | # Set to 1 if we made any changes. | ||||
78 | 18 | my $changed = 0; | |||
79 | |||||
80 | 18 | while (defined (my $line_with_eol = <$in>)) { | |||
81 | 399 | (my $line = $line_with_eol) =~ s/\r?\n$//; | |||
82 | |||||
83 | 399 | if ($line =~ /^\s*<Filter$/) { | |||
84 | 24 | if (defined($filter)) { | |||
85 | 3 | warn qq{Nested <Filter> tag at line $. while parsing filter } . | |||
86 | qq{"$filter" is not supported.\n}; | ||||
87 | 3 | next; | |||
88 | } | ||||
89 | |||||
90 | 21 | print $out $line_with_eol; | |||
91 | 21 | $line_with_eol = <$in>; | |||
92 | 21 | if (defined $line_with_eol && | |||
93 | $line_with_eol =~ /^\s*Name="(.*)"\r?\n$/) { | ||||
94 | 18 | $filter = $1; | |||
95 | 18 | if (!exists $files_by_filter{$filter}) { | |||
96 | # If we don't have any files for this filter, don't remove | ||||
97 | # all the files from it, just skip it entirely instead. | ||||
98 | 3 | undef $filter; | |||
99 | } else { | ||||
100 | 15 27 15 | %seen = map { $_ => 0 } @{$files_by_filter{$filter}}; | |||
101 | } | ||||
102 | } else { | ||||
103 | 3 | warn qq{Unrecognized format for <Filter> tag at line $..\n}; | |||
104 | } | ||||
105 | } elsif (defined $filter) { | ||||
106 | 99 | if ($line =~ /^\s*<File$/) { | |||
107 | 33 | my $line_file_start = $line_with_eol; | |||
108 | |||||
109 | 33 | $line_with_eol = <$in>; | |||
110 | 33 | if (defined $line_with_eol && | |||
111 | $line_with_eol =~ /^\s*RelativePath="(.*)"(>?)\r?\n$/) { | ||||
112 | 30 | $angle_bracket_on_same_line = $2 eq '>'; | |||
113 | |||||
114 | # Normalize path separators to Unix and remove the leading | ||||
115 | # dot which MSVC likes to use for some reason. | ||||
116 | 30 | (my $file = $1) =~ s@\\@/@g; | |||
117 | 30 | $file =~ s@^\./@@; | |||
118 | |||||
119 | # Special hack for resource files that sometimes occur in | ||||
120 | # the "Source Files" section of MSVC projects too: don't | ||||
121 | # remove them, even if they don't appear in the master | ||||
122 | # files list, because they are never going to appear in it. | ||||
123 | 30 | if ($file !~ /\.rc$/) { | |||
124 | 27 | if (!exists $seen{$file}) { | |||
125 | # This file is not in the master file list any | ||||
126 | # more, delete it from the project file as well by | ||||
127 | # not copying the lines corresponding to it to the | ||||
128 | # output. | ||||
129 | 9 | $changed = 1; | |||
130 | |||||
131 | # Skip the next line unless we had already seen | ||||
132 | # the angle bracket. | ||||
133 | 9 | if (!$angle_bracket_on_same_line) { | |||
134 | 3 | if (<$in> !~ /^\s*>\r?\n$/) { | |||
135 | 0 | warn qq{Expected closing '>' on the line $.\n} | |||
136 | } | ||||
137 | } | ||||
138 | |||||
139 | # And skip everything up to and including the | ||||
140 | # closing </File> tag in any case. | ||||
141 | 9 | while (<$in>) { | |||
142 | 9 | last if qr{^\s*</File>\r?\n$} | |||
143 | } | ||||
144 | |||||
145 | 9 | next; | |||
146 | } | ||||
147 | |||||
148 | # This file is still in the files list, mark it as seen. | ||||
149 | 18 | if ($seen{$file}) { | |||
150 | 3 | warn qq{Duplicate file "$file" in the project at line $.\n}; | |||
151 | } else { | ||||
152 | 15 | $seen{$file} = 1; | |||
153 | } | ||||
154 | } | ||||
155 | } else { | ||||
156 | 3 | warn qq{Unrecognized format for <File> tag inside filter } . | |||
157 | qq{"$filter" at line $..\n}; | ||||
158 | } | ||||
159 | |||||
160 | # Don't lose the original line, it won't be printed at the | ||||
161 | # end of the loop any more. | ||||
162 | 24 | print $out $line_file_start; | |||
163 | } elsif ($line =~ qr{^\s*</Filter>$}) { | ||||
164 | 15 | my $angle_bracket = $angle_bracket_on_same_line | |||
165 | ? '>' | ||||
166 | : "\n\t\t\t\t>"; | ||||
167 | |||||
168 | # Add new files, if any. | ||||
169 | # | ||||
170 | # TODO Insert them in alphabetical order. | ||||
171 | 15 | while (my ($file, $seen) = each(%seen)) { | |||
172 | 27 | if (!$seen) { | |||
173 | # Convert path separator to the one used by MSVC. | ||||
174 | 12 | $file =~ s@/@\\@g; | |||
175 | |||||
176 | # And use path even for the files in this directory. | ||||
177 | 12 | $file = ".\\$file" if $file !~ /\\/; | |||
178 | |||||
179 | 12 | print $out <<END | |||
180 | \t\t\t<File | ||||
181 | \t\t\t\tRelativePath="$file"$angle_bracket | ||||
182 | \t\t\t</File> | ||||
183 | END | ||||
184 | ; | ||||
185 | |||||
186 | 12 | $changed = 1; | |||
187 | } | ||||
188 | } | ||||
189 | |||||
190 | 15 | undef $filter; | |||
191 | } | ||||
192 | } | ||||
193 | |||||
194 | 387 | print $out $line_with_eol; | |||
195 | } | ||||
196 | |||||
197 | $changed | ||||
198 | 18 | } |