File Coverage: lib/Makefile/Update.pm

# File Coverage

File: | lib/Makefile/Update.pm
Coverage: | 90.0%

line | stmt | bran | cond | sub | code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Makefile::Update;
2 |
3 |  |  |  |  | # ABSTRACT: Update make files.
4 |
5 | 23 23 23 |  |  | 23 | use strict;
6 | 23 23 23 |  |  | 23 | use warnings;
7 | 23 23 23 |  |  | 23 | use autodie;
8 |
9 | 23 23 23 |  |  | 23 | use Exporter qw(import);
10 |
11 |  |  |  |  | our @EXPORT = qw(read_files_list upmake);
12 |
13 |  |  |  |  | # VERSION
14 |
15 - 21 |  |
    =head1 SYNOPSIS

        use Makefile::Update;
        my $vars = read_files_list('files.lst');
        upmake('foo.vcxproj', $vars->{sources}, $vars->{headers});

    =cut
22 |
23 |  |  |  |  | =func read_files_list
24 |
25 |  |  |  |  | Reads the file containing the file lists definitions and returns a hash ref
26 |  |  |  |  | with variable names as keys and refs to arrays of the file names as values.
27 |
28 |  |  |  |  | Takes an (open) file handle as argument.
29 |
30 |  |  |  |  | The file contents is supposed to have the following very simple format:
31 |
32 |  |  |  |  | # Comments are allowed and ignored.
33 |  |  |  |  | #
34 |  |  |  |  | # The variable definitions must always be in the format shown below,
35 |  |  |  |  | # i.e. whitespace is significant and there should always be a single
36 |  |  |  |  | # file per line.
37 |  |  |  |  | sources =
38 |  |  |  |  | file1.cpp
39 |  |  |  |  | file2.cpp
40 |
41 |  |  |  |  | headers =
42 |  |  |  |  | file1.h
43 |  |  |  |  | file2.h
44 |
45 |  |  |  |  | # It is also possible to define variables in terms of other variables
46 |  |  |  |  | # defined before it in the file (no forward references):
47 |  |  |  |  | everything =
48 |  |  |  |  | $sources
49 |  |  |  |  | $headers
50 |  |  |  |  | =cut
51 |
52 |  |  |  |  | sub read_files_list
53 |  |  |  |  | {
54 | 3 |  |  | 3 | my ($fh) = @_;
55 |
56 | 3 |  |  |  | my ($var, %vars);
57 | 3 |  |  |  | while (<$fh>) {
58 | 42 |  |  |  | chomp;
59 | 42 |  |  |  | s/#.*$//;
60 | 42 |  |  |  | s/^\s+//;
61 | 42 |  |  |  | s/\s+$//;
62 | 42 | 100 |  |  | next if !$_;
63 |
64 | 27 | 100 |  |  | if (/^(\w+)\s*=$/) {
65 | 9 |  |  |  | $var = $1;
66 |  |  |  |  | } else {
67 | 18 | 50 |  |  | die "Unexpected contents outside variable definition at line $.\n"
68 |  |  |  |  | unless defined $var;
69 | 18 | 100 |  |  | if (/^\$(\w+)$/) {
70 | 6 |  |  |  | my $name = $1;
71 |  |  |  |  | die qq{Reference to undefined variable "$name" in the } .
72 |  |  |  |  | qq{assignment to "$var" at line $.\n}
73 | 6 | 50 |  |  | unless exists $vars{$name};
74 | 6 |  |  |  | my $value = $vars{$name};
75 | 6 12 |  |  |  | push @{$vars{$var}}, $_ for @$value;
76 |  |  |  |  | } else {
77 | 12 12 |  |  |  | push @{$vars{$var}}, $_;
78 |  |  |  |  | }
79 |  |  |  |  | }
80 |  |  |  |  | }
81 |
82 | 3 |  |  |  | return \%vars;
83 |  |  |  |  | }
84 |
85 |  |  |  |  | =func upmake
86 |
87 |  |  |  |  | Update a file in place using the specified function and passing it the rest of
88 |  |  |  |  | the arguments.
89 |
90 |  |  |  |  | The first parameter is either just the file path or a hash reference which may
91 |  |  |  |  | contain the following keys:
92 |
93 - 119 |  |
    =over

    =item C<file>

    The path to the file to be updated, required.

    =item C<verbose>

    If true, give more messages about what is being done.

    =item C<quiet>

    If true, don't output any non-error messages.

    =item C<dryrun>

    If true, don't really update the file but just output whether it would have
    been updated or not. If C<verbose> is also true, also output the diff of the
    changes that would have been done.

    =back

    This is meant to be used with C<update_xxx()> defined in different
    Makefile::Update::Xxx modules.

    Returns 1 if the file was changed or 0 otherwise.
    =cut
120 |
121 |  |  |  |  | sub upmake
122 |  |  |  |  | {
123 | 31 |  |  | 31 | my $file_or_options = shift;
124 | 31 |  |  |  | my ($updater, @args) = @_;
125 |
126 | 31 |  |  |  | my ($fname, $verbose, $quiet, $dryrun);
127 | 31 | 100 |  |  | if (ref $file_or_options eq 'HASH') {
128 | 25 |  |  |  | $fname = $file_or_options->{file};
129 | 25 |  |  |  | $verbose = $file_or_options->{verbose};
130 | 25 |  |  |  | $quiet = $file_or_options->{quiet};
131 | 25 |  |  |  | $dryrun = $file_or_options->{dryrun};
132 |  |  |  |  | } else {
133 | 6 |  |  |  | $fname = $file_or_options;
134 | 6 |  |  |  | $verbose =
135 |  |  |  |  | $quiet =
136 |  |  |  |  | $dryrun = 0;
137 |  |  |  |  | }
138 |
139 | 31 | 100 |  |  | if ($dryrun) {
140 | 6 |  |  |  | my $old = do {
141 | 6 |  |  |  | local $/;
142 | 6 |  |  |  | open my $f, '<', $fname;
143 |  |  |  |  | <$f>
144 | 6 |  |  |  | };
145 | 6 |  |  |  | my $new = '';
146 |
147 | 6 |  |  |  | open my $in, '<', \$old;
148 | 6 |  |  |  | open my $out, '>', \$new;
149 |
150 | 6 | 100 |  |  | if ($updater->($in, $out, @args)) {
151 | 3 |  |  |  | print qq{Would update "$fname"};
152 |
153 | 3 | 50 |  |  | if ($verbose) {
154 | 0 0 | 0 |  |  | if (eval { require Text::Diff; }) {
155 | 0 |  |  |  | print " with the following changes:\n";
156 |
157 | 0 |  |  |  | print Text::Diff::diff(\$old, \$new, {
158 |  |  |  |  | FILENAME_A => $fname,
159 |  |  |  |  | FILENAME_B => "$fname.new"
160 |  |  |  |  | });
161 |  |  |  |  | } else {
162 | 0 |  |  |  | print ".\n";
163 |
164 | 0 |  |  |  | warn qq{Can't display diff of the changes, please install Text::Diff module.\n};
165 |  |  |  |  | }
166 |  |  |  |  | } else {
167 | 3 |  |  |  | print ".\n";
168 |  |  |  |  | }
169 |  |  |  |  | } else {
170 | 3 |  |  |  | print qq{Wouldn't change the file "$fname".\n};
171 |  |  |  |  | }
172 |
173 | 6 |  |  |  | return 0;
174 |  |  |  |  | }
175 |
176 | 25 |  |  |  | my $fname_new = "$fname.upmake.new"; # TODO make it more unique
177 |
178 | 25 |  |  |  | open my $in, '<', $fname;
179 | 25 |  |  |  | open my $out, '>', $fname_new;
180 |
181 | 25 |  |  |  | my $changed = $updater->($in, $out, @args);
182 |
183 | 25 |  |  |  | close $in;
184 | 25 |  |  |  | close $out;
185 |
186 | 25 | 100 |  |  | if ($changed) {
187 | 14 |  |  |  | rename $fname_new, $fname;
188 |  |  |  |  | } else {
189 | 11 |  |  |  | unlink $fname_new;
190 |  |  |  |  | }
191 |
192 | 25 | 100 |  |  | if ($changed) {
193 | 14 | 100 |  |  | print qq{File "$fname" successfully updated.\n} unless $quiet;
194 | 14 |  |  |  | return 1;
195 |  |  |  |  | } else {
196 | 11 | 100 |  |  | print qq{No changes in the file "$fname".\n} if $verbose;
197 | 11 |  |  |  | return 0;
198 |  |  |  |  | }
199 |  |  |  |  | }
200 |
201 |  |  |  |  | 1;