359 lines
11 KiB
Perl
Executable File
359 lines
11 KiB
Perl
Executable File
# ------------------------------------------------------------------------------
|
|
# (C) Crown copyright Met Office. All rights reserved.
|
|
# For further details please refer to the file COPYRIGHT.txt
|
|
# which you should have received as part of this distribution.
|
|
# ------------------------------------------------------------------------------
|
|
use strict;
|
|
use warnings;
|
|
|
|
################################################################################
|
|
# A generic reporter of the comparator's result
|
|
{
|
|
package Reporter;
|
|
|
|
############################################################################
|
|
# Class method: Constructor
|
|
sub new {
|
|
my ($class) = @_;
|
|
return bless(\do{my $annon_scalar}, $class);
|
|
}
|
|
|
|
############################################################################
|
|
# Class method: Factory for Reporter object
|
|
sub get_reporter {
|
|
my ($self, $comparator) = @_;
|
|
my $class = defined($comparator->get_wiki()) ? 'WikiReporter'
|
|
: 'TextReporter'
|
|
;
|
|
return $class->new();
|
|
}
|
|
|
|
############################################################################
|
|
# Reports the results
|
|
sub report {
|
|
my ($self, $comparator) = @_;
|
|
if (keys(%{$comparator->get_log_of()})) {
|
|
print("Revisions at which extract declarations are modified:\n\n");
|
|
}
|
|
$self->report_impl($comparator);
|
|
}
|
|
|
|
############################################################################
|
|
# Does the actual reporting
|
|
sub report_impl {
|
|
my ($self, $comparator) = @_;
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
# Reports the comparator's result in Trac wiki format
|
|
{
|
|
package WikiReporter;
|
|
our @ISA = qw{Reporter};
|
|
|
|
use Fcm::CmUrl;
|
|
use Fcm::Keyword;
|
|
use Fcm::Util qw{tidy_url};
|
|
|
|
############################################################################
|
|
# Reports the comparator's result
|
|
sub report_impl {
|
|
my ($self, $comparator) = @_;
|
|
# Output in wiki format
|
|
my $wiki_url = Fcm::CmUrl->new(
|
|
URL => tidy_url(Fcm::Keyword::expand($comparator->get_wiki()))
|
|
);
|
|
my $base_trac
|
|
= $comparator->get_wiki()
|
|
? Fcm::Keyword::get_browser_url($wiki_url->project_url())
|
|
: $wiki_url;
|
|
if (!$base_trac) {
|
|
$base_trac = $wiki_url;
|
|
}
|
|
|
|
for my $key (sort keys(%{$comparator->get_log_of()})) {
|
|
my $branch_trac = Fcm::Keyword::get_browser_url($key);
|
|
$branch_trac =~ s{\A $base_trac (?:/*|\z)}{source:}xms;
|
|
print("[$branch_trac]:\n");
|
|
my %branch_of = %{$comparator->get_log_of()->{$key}};
|
|
for my $rev (sort {$b <=> $a} keys(%branch_of)) {
|
|
print(
|
|
$branch_of{$rev}->display_svnlog($rev, $base_trac), "\n",
|
|
);
|
|
}
|
|
print("\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
# Reports the comparator's result in simple text format
|
|
{
|
|
package TextReporter;
|
|
our @ISA = qw{Reporter};
|
|
|
|
use Fcm::Config;
|
|
|
|
my $SEPARATOR = q{-} x 80 . "\n";
|
|
|
|
############################################################################
|
|
# Reports the comparator's result
|
|
sub report_impl {
|
|
my ($self, $comparator) = @_;
|
|
for my $key (sort keys(%{$comparator->get_log_of()})) {
|
|
# Output in plain text format
|
|
print $key, ':', "\n";
|
|
my %branch_of = %{$comparator->get_log_of()->{$key}};
|
|
if (Fcm::Config->instance()->verbose() > 1) {
|
|
for my $rev (sort {$b <=> $a} keys(%branch_of)) {
|
|
print(
|
|
$SEPARATOR, $branch_of{$rev}->display_svnlog($rev), "\n"
|
|
);
|
|
}
|
|
}
|
|
else {
|
|
print(join(q{ }, sort {$b <=> $a} keys(%branch_of)), "\n");
|
|
}
|
|
print $SEPARATOR, "\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
package Fcm::ExtractConfigComparator;
|
|
|
|
use Fcm::CmUrl;
|
|
use Fcm::Extract;
|
|
|
|
################################################################################
|
|
# Class method: Constructor
|
|
sub new {
|
|
my ($class, $args_ref) = @_;
|
|
return bless({%{$args_ref}}, $class);
|
|
}
|
|
|
|
################################################################################
|
|
# Returns an array containing the 2 configuration files to compare
|
|
sub get_files {
|
|
my ($self) = @_;
|
|
return (wantarray() ? @{$self->{files}} : $self->{files});
|
|
}
|
|
|
|
################################################################################
|
|
# Returns the wiki link on wiki mode
|
|
sub get_wiki {
|
|
my ($self) = @_;
|
|
return $self->{wiki};
|
|
}
|
|
|
|
################################################################################
|
|
# Returns the result log
|
|
sub get_log_of {
|
|
my ($self) = @_;
|
|
return (wantarray() ? %{$self->{log_of}} : $self->{log_of});
|
|
}
|
|
|
|
################################################################################
|
|
# Invokes the comparator
|
|
sub invoke {
|
|
my ($self) = @_;
|
|
|
|
# Reads the extract configurations
|
|
my (@cfg, $rc);
|
|
for my $i (0 .. 1) {
|
|
$cfg[$i] = Fcm::Extract->new();
|
|
$cfg[$i]->cfg()->src($self->get_files()->[$i]);
|
|
$cfg[$i]->parse_cfg();
|
|
$rc = $cfg[$i]->expand_cfg();
|
|
if (!$rc) {
|
|
e_report();
|
|
}
|
|
}
|
|
|
|
# Get list of URLs
|
|
# --------------------------------------------------------------------------
|
|
my @urls = ();
|
|
for my $i (0 .. 1) {
|
|
# List of branches in each extract configuration file
|
|
my @branches = @{$cfg[$i]->branches()};
|
|
BRANCH:
|
|
for my $branch (@branches) {
|
|
# Ignore declarations of local directories
|
|
if ($branch->type() eq 'user') {
|
|
next BRANCH;
|
|
}
|
|
|
|
# List of SRC declarations in each branch
|
|
my %dirs = %{$branch->dirs()};
|
|
|
|
for my $dir (values(%dirs)) {
|
|
# Set up a new instance of Fcm::CmUrl object for each SRC
|
|
my $cm_url = Fcm::CmUrl->new (
|
|
URL => $dir . (
|
|
$branch->revision() ? '@' . $branch->revision() : q{}
|
|
),
|
|
);
|
|
|
|
$urls[$i]{$cm_url->branch_url()}{$dir} = $cm_url;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Compare
|
|
# --------------------------------------------------------------------------
|
|
$self->{log_of} = {};
|
|
for my $i (0 .. 1) {
|
|
# Compare the first file with the second one and then vice versa
|
|
my $j = ($i == 0) ? 1 : 0;
|
|
|
|
for my $branch (sort keys(%{$urls[$i]})) {
|
|
if (exists($urls[$j]{$branch})) {
|
|
# Same REPOS declarations in both files
|
|
DIR:
|
|
for my $dir (sort keys(%{$urls[$i]{$branch}})) {
|
|
if (exists($urls[$j]{$branch}{$dir})) {
|
|
if ($i == 1) {
|
|
next DIR;
|
|
}
|
|
|
|
my $this_url = $urls[$i]{$branch}{$dir};
|
|
my $that_url = $urls[$j]{$branch}{$dir};
|
|
|
|
# Compare their last changed revisions
|
|
my $this_rev
|
|
= $this_url->svninfo(FLAG => 'Last Changed Rev');
|
|
my $that_rev
|
|
= $that_url->svninfo(FLAG => 'Last Changed Rev');
|
|
|
|
# Make sure last changed revisions differ
|
|
if ($this_rev eq $that_rev) {
|
|
next DIR;
|
|
}
|
|
|
|
# Not interested in the log before the minimum revision
|
|
my $min_rev
|
|
= $this_url->pegrev() > $that_url->pegrev()
|
|
? $that_url->pegrev() : $this_url->pegrev();
|
|
|
|
$this_rev = $min_rev if $this_rev < $min_rev;
|
|
$that_rev = $min_rev if $that_rev < $min_rev;
|
|
|
|
# Get list of changed revisions using the commit log
|
|
my $u = ($this_rev > $that_rev) ? $this_url : $that_url;
|
|
my %revs = $u->svnlog(REV => [$this_rev, $that_rev]);
|
|
|
|
REV:
|
|
for my $rev (keys %revs) {
|
|
# Check if revision is already in the list
|
|
if (
|
|
exists($self->{log_of}{$branch}{$rev})
|
|
|| $rev == $min_rev
|
|
) {
|
|
next REV;
|
|
}
|
|
|
|
# Get list of changed paths. Accept this revision
|
|
# only if it contains changes in the current branch
|
|
my %paths = %{$revs{$rev}{paths}};
|
|
|
|
PATH:
|
|
for my $path (keys(%paths)) {
|
|
my $change_url
|
|
= Fcm::CmUrl->new(URL => $u->root() . $path);
|
|
|
|
if ($change_url->branch() eq $u->branch()) {
|
|
$self->{log_of}{$branch}{$rev} = $u;
|
|
last PATH;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$self->_report_added(
|
|
$urls[$i]{$branch}{$dir}->url_peg(), $i, $j);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$self->_report_added($branch, $i, $j);
|
|
}
|
|
}
|
|
}
|
|
|
|
my $reporter = Reporter->get_reporter($self);
|
|
$reporter->report($self);
|
|
return $rc;
|
|
}
|
|
|
|
################################################################################
|
|
# Reports added/deleted declaration
|
|
sub _report_added {
|
|
my ($self, $branch, $i, $j) = @_;
|
|
printf(
|
|
"%s:\n in : %s\n not in: %s\n\n",
|
|
$branch, $self->get_files()->[$i], $self->get_files()->[$j],
|
|
);
|
|
}
|
|
|
|
1;
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Fcm::ExtractConfigComparator
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Fcm::ExtractConfigComparator;
|
|
my $comparator = Fcm::ExtractConfigComparator->new({files => \@files});
|
|
$comparator->invoke();
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
An object of this class represents a comparator of FCM extract configuration.
|
|
It is used to compare the VC branch declarations in 2 FCM extract configuration
|
|
files.
|
|
|
|
=head1 METHODS
|
|
|
|
=over 4
|
|
|
|
=item C<new({files =E<gt> \@files, wiki =E<gt> $wiki})>
|
|
|
|
Constructor.
|
|
|
|
=item get_files()
|
|
|
|
Returns an array containing the 2 configuration files to compare.
|
|
|
|
=item get_wiki()
|
|
|
|
Returns the wiki link on wiki mode.
|
|
|
|
=item invoke()
|
|
|
|
Invokes the comparator.
|
|
|
|
=back
|
|
|
|
=head1 TO DO
|
|
|
|
More documentation.
|
|
|
|
Improve the parser for extract configuration.
|
|
|
|
Separate the comparator with the reporters.
|
|
|
|
Add reporter to display HTML.
|
|
|
|
More unit tests.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Fcm::Extract|Fcm::Extract>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
E<169> Crown copyright Met Office. All rights reserved.
|
|
|
|
=cut
|