source: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractConfigComparator.pm @ 5099

Last change on this file since 5099 was 5095, checked in by abarral, 4 months ago

Revert cosp*/ from the trunk, as it's external code
Add missing bits from FCM2 source
File size: 11.6 KB
Line 
1# ------------------------------------------------------------------------------
2# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
3#
4# This file is part of FCM, tools for managing and building source code.
5#
6# FCM is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10#
11# FCM is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with FCM. If not, see <http://www.gnu.org/licenses/>.
18# ------------------------------------------------------------------------------
19use strict;
20use warnings;
21
22################################################################################
23# A generic reporter of the comparator's result
24{
25    package Reporter;
26
27    ############################################################################
28    # Class method: Constructor
29    sub new {
30        my ($class) = @_;
31        return bless(\do{my $annon_scalar}, $class);
32    }
33
34    ############################################################################
35    # Class method: Factory for Reporter object
36    sub get_reporter {
37        my ($self, $comparator) = @_;
38        my $class = defined($comparator->get_wiki()) ? 'WikiReporter'
39                  :                                    'TextReporter'
40                  ;
41        return $class->new();
42    }
43
44    ############################################################################
45    # Reports the results
46    sub report {
47        my ($self, $comparator) = @_;
48        if (keys(%{$comparator->get_log_of()})) {
49            print("Revisions at which extract declarations are modified:\n\n");
50        }
51        $self->report_impl($comparator);
52    }
53
54    ############################################################################
55    # Does the actual reporting
56    sub report_impl {
57        my ($self, $comparator) = @_;
58    }
59}
60
61################################################################################
62# Reports the comparator's result in Trac wiki format
63{
64    package WikiReporter;
65    our @ISA = qw{Reporter};
66
67    use FCM1::CmUrl;
68    use FCM1::Keyword;
69    use FCM1::Util qw{tidy_url};
70
71    ############################################################################
72    # Reports the comparator's result
73    sub report_impl {
74        my ($self, $comparator) = @_;
75        # Output in wiki format
76        my $wiki_url = FCM1::CmUrl->new(
77            URL => tidy_url(FCM1::Keyword::expand($comparator->get_wiki()))
78        );
79        my $base_trac
80            = $comparator->get_wiki()
81            ? FCM1::Keyword::get_browser_url($wiki_url->project_url())
82            : $wiki_url;
83        if (!$base_trac) {
84            $base_trac = $wiki_url;
85        }
86
87        for my $key (sort keys(%{$comparator->get_log_of()})) {
88            my $branch_trac = FCM1::Keyword::get_browser_url($key);
89            $branch_trac =~ s{\A $base_trac (?:/*|\z)}{source:}xms;
90            print("[$branch_trac]:\n");
91            my %branch_of = %{$comparator->get_log_of()->{$key}};
92            for my $rev (sort {$b <=> $a} keys(%branch_of)) {
93                print(
94                    $branch_of{$rev}->display_svnlog($rev, $base_trac), "\n",
95                );
96            }
97            print("\n");
98        }
99    }
100}
101
102################################################################################
103# Reports the comparator's result in simple text format
104{
105    package TextReporter;
106    our @ISA = qw{Reporter};
107
108    use FCM1::Config;
109
110    my $SEPARATOR = q{-} x 80 . "\n";
111
112    ############################################################################
113    # Reports the comparator's result
114    sub report_impl {
115        my ($self, $comparator) = @_;
116        for my $key (sort keys(%{$comparator->get_log_of()})) {
117            # Output in plain text format
118            print $key, ':', "\n";
119            my %branch_of = %{$comparator->get_log_of()->{$key}};
120            if (FCM1::Config->instance()->verbose() > 1) {
121                for my $rev (sort {$b <=> $a} keys(%branch_of)) {
122                    print(
123                        $SEPARATOR, $branch_of{$rev}->display_svnlog($rev), "\n"
124                    );
125                }
126            }
127            else {
128                print(join(q{ }, sort {$b <=> $a} keys(%branch_of)), "\n");
129            }
130            print $SEPARATOR, "\n";
131        }
132    }
133}
134
135package FCM1::ExtractConfigComparator;
136
137use FCM1::CmUrl;
138use FCM1::Extract;
139
140################################################################################
141# Class method: Constructor
142sub new {
143    my ($class, $args_ref) = @_;
144    return bless({%{$args_ref}}, $class);
145}
146
147################################################################################
148# Returns an array containing the 2 configuration files to compare
149sub get_files {
150    my ($self) = @_;
151    return (wantarray() ? @{$self->{files}} : $self->{files});
152}
153
154################################################################################
155# Returns the wiki link on wiki mode
156sub get_wiki {
157    my ($self) = @_;
158    return $self->{wiki};
159}
160
161################################################################################
162# Returns the result log
163sub get_log_of {
164    my ($self) = @_;
165    return (wantarray() ? %{$self->{log_of}} : $self->{log_of});
166}
167
168################################################################################
169# Invokes the comparator
170sub invoke {
171    my ($self) = @_;
172
173    # Reads the extract configurations
174    my (@cfg, $rc);
175    for my $i (0 .. 1) {
176        $cfg[$i] = FCM1::Extract->new();
177        $cfg[$i]->cfg()->src($self->get_files()->[$i]);
178        $cfg[$i]->parse_cfg();
179        $rc = $cfg[$i]->expand_cfg();
180        if (!$rc) {
181            e_report();
182        }
183    }
184
185    # Get list of URLs
186    # --------------------------------------------------------------------------
187    my @urls = ();
188    for my $i (0 .. 1) {
189        # List of branches in each extract configuration file
190        my @branches = @{$cfg[$i]->branches()};
191        BRANCH:
192        for my $branch (@branches) {
193            # Ignore declarations of local directories
194            if ($branch->type() eq 'user') {
195                next BRANCH;
196            }
197
198            # List of SRC declarations in each branch
199            my %dirs = %{$branch->dirs()};
200
201            for my $dir (values(%dirs)) {
202                # Set up a new instance of FCM1::CmUrl object for each SRC
203                my $cm_url = FCM1::CmUrl->new (
204                    URL => $dir . (
205                        $branch->revision() ? '@' . $branch->revision() : q{}
206                    ),
207                );
208
209                $urls[$i]{$cm_url->branch_url()}{$dir} = $cm_url;
210            }
211        }
212    }
213
214    # Compare
215    # --------------------------------------------------------------------------
216    $self->{log_of} = {};
217    for my $i (0 .. 1) {
218        # Compare the first file with the second one and then vice versa
219        my $j = ($i == 0) ? 1 : 0;
220
221        for my $branch (sort keys(%{$urls[$i]})) {
222            if (exists($urls[$j]{$branch})) {
223                # Same REPOS declarations in both files
224                DIR:
225                for my $dir (sort keys(%{$urls[$i]{$branch}})) {
226                    if (exists($urls[$j]{$branch}{$dir})) {
227                        if ($i == 1) {
228                            next DIR;
229                        }
230
231                        my $this_url = $urls[$i]{$branch}{$dir};
232                        my $that_url = $urls[$j]{$branch}{$dir};
233
234                        # Compare their last changed revisions
235                        my $this_rev
236                            = $this_url->svninfo(FLAG => 'commit:revision');
237                        my $that_rev
238                            = $that_url->svninfo(FLAG => 'commit:revision');
239
240                        # Make sure last changed revisions differ
241                        if ($this_rev eq $that_rev) {
242                            next DIR;
243                        }
244
245                        # Not interested in the log before the minimum revision
246                        my $min_rev
247                            = $this_url->pegrev() > $that_url->pegrev()
248                              ? $that_url->pegrev() : $this_url->pegrev();
249
250                        $this_rev = $min_rev if $this_rev < $min_rev;
251                        $that_rev = $min_rev if $that_rev < $min_rev;
252
253                        # Get list of changed revisions using the commit log
254                        my $u = ($this_rev > $that_rev) ? $this_url : $that_url;
255                        my %revs = $u->svnlog(REV => [$this_rev, $that_rev]);
256
257                        REV:
258                        for my $rev (keys %revs) {
259                            # Check if revision is already in the list
260                            if (
261                                   exists($self->{log_of}{$branch}{$rev})
262                                || $rev == $min_rev
263                            ) {
264                                next REV;
265                            }
266
267                            # Get list of changed paths. Accept this revision
268                            # only if it contains changes in the current branch
269                            my %paths  = %{$revs{$rev}{paths}};
270
271                            PATH:
272                            for my $path (keys(%paths)) {
273                                my $change_url
274                                    = FCM1::CmUrl->new(URL => $u->root() . $path);
275
276                                if ($change_url->branch() eq $u->branch()) {
277                                    $self->{log_of}{$branch}{$rev} = $u;
278                                    last PATH;
279                                }
280                            }
281                        }
282                    }
283                    else {
284                        $self->_report_added(
285                            $urls[$i]{$branch}{$dir}->url_peg(), $i, $j);
286                    }
287                }
288            }
289            else {
290                $self->_report_added($branch, $i, $j);
291            }
292        }
293    }
294
295    my $reporter = Reporter->get_reporter($self);
296    $reporter->report($self);
297    return $rc;
298}
299
300################################################################################
301# Reports added/deleted declaration
302sub _report_added {
303    my ($self, $branch, $i, $j) = @_;
304    printf(
305        "%s:\n  in    : %s\n  not in: %s\n\n",
306        $branch, $self->get_files()->[$i], $self->get_files()->[$j],
307    );
308}
309
3101;
311__END__
312
313=head1 NAME
314
315FCM1::ExtractConfigComparator
316
317=head1 SYNOPSIS
318
319    use FCM1::ExtractConfigComparator;
320    my $comparator = FCM1::ExtractConfigComparator->new({files => \@files});
321    $comparator->invoke();
322
323=head1 DESCRIPTION
324
325An object of this class represents a comparator of FCM extract configuration.
326It is used to compare the VC branch declarations in 2 FCM extract configuration
327files.
328
329=head1 METHODS
330
331=over 4
332
333=item C<new({files =E<gt> \@files, wiki =E<gt> $wiki})>
334
335Constructor.
336
337=item get_files()
338
339Returns an array containing the 2 configuration files to compare.
340
341=item get_wiki()
342
343Returns the wiki link on wiki mode.
344
345=item invoke()
346
347Invokes the comparator.
348
349=back
350
351=head1 TO DO
352
353More documentation.
354
355Improve the parser for extract configuration.
356
357Separate the comparator with the reporters.
358
359Add reporter to display HTML.
360
361More unit tests.
362
363=head1 SEE ALSO
364
365L<FCM1::Extract|FCM1::Extract>
366
367=head1 COPYRIGHT
368
369Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
370
371=cut
Note: See TracBrowser for help on using the repository browser.