# ------------------------------------------------------------------------------ # (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 \@files, wiki =E $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 =head1 COPYRIGHT E<169> Crown copyright Met Office. All rights reserved. =cut