New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
ExtractConfigComparator.pm in branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/EXTERNAL/fcm/lib/Fcm – NEMO

source: branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm @ 9499

Last change on this file since 9499 was 9499, checked in by davestorkey, 6 years ago

branches/UKMO/dev_merge_2017_CICE_interface : clear SVN keywords.

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