File Coverage: lib/Makefile/Update/VCProj.pm

# File Coverage

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 |  |  | 6 | use Exporter qw(import);
5 |  |  |  |  | our @EXPORT = qw(update_vcproj);
6 |
7 | 6 6 6 |  |  | 6 | use strict;
8 | 6 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 |  |  | 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 | 50 |  |  | if (!defined $filter_cb) {
44 |  |  |  |  | $filter_cb = sub {
45 | 33 |  |  | 33 | my ($file) = @_;
46 |
47 | 33 | 100 |  |  | return 'Source Files' if $file =~ q{\.c(c|pp|xx|\+\+)?$};
48 | 12 | 100 |  |  | 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 | 100 |  |  | 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 | 100 100 |  |  | if ($line =~ /^\s*<Filter$/) {
84 | 24 | 100 |  |  | 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 | 100 | 67 |  | if (defined $line_with_eol &&
93 |  |  |  |  | $line_with_eol =~ /^\s*Name="(.*)"\r?\n$/) {
94 | 18 |  |  |  | $filter = $1;
95 | 18 | 100 |  |  | 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 | 100 100 |  |  | if ($line =~ /^\s*<File$/) {
107 | 33 |  |  |  | my $line_file_start = $line_with_eol;
108 |
109 | 33 |  |  |  | $line_with_eol = <$in>;
110 | 33 | 100 | 67 |  | 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 | 100 |  |  | if ($file !~ /\.rc$/) {
124 | 27 | 100 |  |  | 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 | 100 |  |  | if (!$angle_bracket_on_same_line) {
134 | 3 | 50 |  |  | 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 | 50 |  |  | 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 | 100 |  |  | 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 | 100 |  |  | 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 | 100 |  |  | 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 | 50 |  |  | $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 |  |  |  | }