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

# File Coverage

File: | lib/Makefile/Update/Bakefile0.pm
Coverage: | 94.8%

line | stmt | bran | cond | sub | code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Makefile::Update::Bakefile0;
2 |  |  |  |  | # ABSTRACT: Update bakefile-0.x files list.
3 |
4 | 3 3 3 |  |  | 3 | use Exporter qw(import);
5 |  |  |  |  | our @EXPORT = qw(update_bakefile_0);
6 |
7 | 3 3 3 |  |  | 3 | use strict;
8 | 3 3 3 |  |  | 3 | use warnings;
9 |
10 |  |  |  |  | # VERSION
11 |
12 - 24 |  |
    =head1 SYNOPSIS

    This is used exclusively to update wxWidgets C<files.bkl> and is probably not
    useful outside of wxWidgets project.

        use Makefile::Update::Bakefile0;
        Makefile::Update::upmake('bakefiles/files.bkl', \&update_bakefile_0, $vars);

    =head1 SEE ALSO

    Makefile::Update

    =cut
25 |
26 |  |  |  |  | =func update_bakefile_0
27 |
28 |  |  |  |  | Update file with variable definitions in bakefile-0 format with the data
29 |  |  |  |  | from the hash ref containing all the file lists.
30 |
31 |  |  |  |  | Takes the (open) file handles of the files to read and to write and the file
32 |  |  |  |  | lists hash ref as arguments.
33 |
34 |  |  |  |  | Returns 1 if any changes were made.
35 |  |  |  |  | =cut
36 |
37 |  |  |  |  | sub update_bakefile_0
38 |  |  |  |  | {
39 | 3 |  |  | 3 | my ($in, $out, $vars) = @_;
40 |
41 |  |  |  |  | # Variable whose contents is being currently replaced.
42 | 3 |  |  |  | my $var;
43 |
44 |  |  |  |  | # Hash with files defined for the specified variable as keys and 0 or 1
45 |  |  |  |  | # depending on whether we have seen them in the input file as values.
46 |  |  |  |  | my %files;
47 |
48 |  |  |  |  | # Set to 1 if we made any changes.
49 | 3 |  |  |  | my $changed = 0;
50 | 3 |  |  |  | while (<$in>) {
51 | 63 |  |  |  | chomp;
52 |
53 | 63 | 100 100 | 67 |  | if (/<set var="(\w+)" hints="files">/ && exists $vars->{$1}) {
54 | 6 |  |  |  | $var = $1;
55 | 6 21 6 |  |  |  | %files = map { $_ => 0 } @{$vars->{$var}};
56 |  |  |  |  | } elsif (defined $var) {
57 | 27 |  |  |  | local $_ = $_;
58 | 27 |  |  |  | s/<!-- .* -->//;
59 | 27 |  |  |  | s/^\s+//;
60 | 27 |  |  |  | s/\s+$//;
61 | 27 | 100 100 |  |  | if (m{</set>}) {
62 |  |  |  |  | # Check if we have any new files.
63 |  |  |  |  | #
64 |  |  |  |  | # TODO Insert them in alphabetical order.
65 | 6 |  |  |  | while (my ($file, $seen) = each(%files)) {
66 | 21 | 100 |  |  | if (!$seen) {
67 |  |  |  |  | # This file was wasn't present in the input, add it.
68 |  |  |  |  | # TODO Use proper indentation.
69 | 6 |  |  |  | print $out " $file\n";
70 |
71 | 6 |  |  |  | $changed = 1;
72 |  |  |  |  | }
73 |  |  |  |  | }
74 |
75 | 6 |  |  |  | undef $var;
76 |  |  |  |  | } elsif ($_) {
77 | 18 | 100 |  |  | if (not exists $files{$_}) {
78 |  |  |  |  | # This file was removed.
79 | 3 |  |  |  | $changed = 1;
80 | 3 |  |  |  | next;
81 |  |  |  |  | }
82 |
83 | 15 | 50 |  |  | if ($files{$_}) {
84 | 0 |  |  |  | warn qq{Duplicate file "$_" in the definition of the } .
85 |  |  |  |  | qq{variable "$var" at line $.\n}
86 |  |  |  |  | } else {
87 | 15 |  |  |  | $files{$_} = 1;
88 |  |  |  |  | }
89 |  |  |  |  | }
90 |  |  |  |  | }
91 |
92 | 60 |  |  |  | print $out "$_\n";
93 |  |  |  |  | }
94 |
95 |  |  |  |  | $changed
96 | 3 |  |  |  | }