File Coverage

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

linestmtbrancondsubcode
1package Makefile::Update::VCProj;
2# ABSTRACT: Update list of sources and headers in Visual C++ projects.
3
4
6
6
6
use Exporter qw(import);
5our @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
28Update sources and headers in a VC++ project.
29
30Parameters: input and output file handles, array references to the sources
31and the headers to be used in this project and a callback used to determine
32the filter for the new files.
33
34Returns 1 if any changes were made.
35=cut
36
37sub 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>
183END
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
}