@@ -, +, @@ --- QohA/File.pm | 40 +++++++++++++++++++ QohA/File/Perl.pm | 11 +----- QohA/File/Specific/Kohastructure.pm | 12 ++---- QohA/File/Specific/OpacCss.pm | 12 ++---- QohA/File/Specific/Sysprefs.pm | 12 ++---- QohA/File/Template.pm | 10 +---- QohA/File/XML.pm | 12 ++---- QohA/File/YAML.pm | 12 ++---- QohA/Files.pm | 78 +++++++++++-------------------------- QohA/Git.pm | 14 +++---- QohA/Report.pm | 3 -- TODO | 5 --- koha-qa.pl | 13 ++----- t/Perl.t | 30 ++++++++++---- 14 files changed, 112 insertions(+), 152 deletions(-) --- a/QohA/File.pm +++ a/QohA/File.pm @@ -5,6 +5,7 @@ use Moo; use File::Basename; use Cwd 'abs_path'; use IPC::Cmd qw( run ); +use QohA::Report; has 'path' => ( is => 'ro', @@ -28,6 +29,15 @@ has 'pass' => ( is => 'rw', default => sub{0}, ); +has 'report' => ( + is => 'rw', + default => sub { + QohA::Report->new(); + }, +); +has 'git_statuses' => ( + is => 'rw', +); sub _build_filename { my ($self) = @_; @@ -40,9 +50,23 @@ sub _build_abspath { return $abs_path; } +sub run_checks { + my ($self, $cnt) = @_; + + my $r; + + # Check git manipulations + $r = $self->check_git_manipulation(); + $self->add_to_report('git manipulation', $r); + + $self->pass($self->pass + 1); +} + sub check_forbidden_patterns { my ($self, $cnt, $patterns) = @_; + return 0 unless -e $self->path; + # For the first pass, I don't want to launch any test. return 1 if $self->pass == 0; @@ -115,6 +139,22 @@ sub check_spelling { : 1; } +sub check_git_manipulation { + my ($self) = @_; + + return 1 if $self->pass == 0; + + my @errors; + + if ( $self->{git_statuses} =~ m|A| and $self->{git_statuses} =~ m|D| ) { + push @errors, "The file has been added and deleted in the same patchset"; + } + + return @errors + ? \@errors + : 1; +} + sub add_to_report { my ($self, $name, $error) = @_; $self->report->add( --- a/QohA/File/Perl.pm +++ a/QohA/File/Perl.pm @@ -13,19 +13,11 @@ use IPC::Cmd qw[can_run run]; use Cwd qw( abs_path ); use QohA::Git; -use QohA::Report; our $pc_rc = dirname( abs_path( $INC{'QohA/File/Perl.pm'} ) ) . '/../../perlcriticrc'; die "Koha's $pc_rc file is missing..." unless ( -e $pc_rc ); -has 'report' => ( - is => 'rw', - default => sub { - QohA::Report->new( {type => 'perl'} ); - }, -); - sub run_checks { my ($self, $cnt) = @_; @@ -51,8 +43,7 @@ sub run_checks { $r = $self->check_spelling(); $self->SUPER::add_to_report('spelling', $r); - - $self->pass($self->pass + 1); + return $self->SUPER::run_checks($cnt); } sub check_critic { --- a/QohA/File/Specific/Kohastructure.pm +++ a/QohA/File/Specific/Kohastructure.pm @@ -2,20 +2,14 @@ package QohA::File::Specific::Kohastructure; use Modern::Perl; use Moo; -use QohA::Report; extends 'QohA::File'; -has 'report' => ( - is => 'rw', - default => sub { - QohA::Report->new( {type => 'specific'} ); - }, -); - sub run_checks { - my ($self) = @_; + my ($self, $cnt) = @_; my @r = $self->check_charset_collate(); $self->SUPER::add_to_report('charset_collate', \@r); + + return $self->SUPER::run_checks($cnt); } sub check_charset_collate { --- a/QohA/File/Specific/OpacCss.pm +++ a/QohA/File/Specific/OpacCss.pm @@ -5,20 +5,14 @@ use Moo; use IPC::Cmd qw[run]; use File::Basename; use File::Temp qw[tempfile]; -use QohA::Report; extends 'QohA::File'; -has 'report' => ( - is => 'rw', - default => sub { - QohA::Report->new( {type => 'specific'} ); - }, -); - sub run_checks { - my ($self) = @_; + my ($self, $cnt) = @_; my @r = $self->check_css_less_sync(); $self->SUPER::add_to_report('css_and_less_in_sync', \@r); + + return $self->SUPER::run_checks($cnt); } sub check_css_less_sync { --- a/QohA/File/Specific/Sysprefs.pm +++ a/QohA/File/Specific/Sysprefs.pm @@ -2,20 +2,14 @@ package QohA::File::Specific::Sysprefs; use Modern::Perl; use Moo; -use QohA::Report; extends 'QohA::File'; -has 'report' => ( - is => 'rw', - default => sub { - QohA::Report->new( {type => 'specific'} ); - }, -); - sub run_checks { - my ($self) = @_; + my ($self, $cnt) = @_; my @r = $self->check_sysprefs_order(); $self->SUPER::add_to_report('sysprefs_order', \@r); + + return $self->SUPER::run_checks($cnt); } sub check_sysprefs_order { --- a/QohA/File/Template.pm +++ a/QohA/File/Template.pm @@ -8,17 +8,9 @@ extends 'QohA::File'; use IPC::Cmd qw[can_run run]; use File::Spec; -use QohA::Report; use C4::TTParser; use Template; -has 'report' => ( - is => 'rw', - default => sub { - QohA::Report->new( {type => 'template'} ); - }, -); - sub run_checks { my ($self, $cnt) = @_; my $r; @@ -38,7 +30,7 @@ sub run_checks { $r = $self->check_spelling(); $self->SUPER::add_to_report('spelling', $r); - $self->pass($self->pass + 1); + return $self->SUPER::run_checks($cnt); } sub check_tt_valid { --- a/QohA/File/XML.pm +++ a/QohA/File/XML.pm @@ -4,20 +4,14 @@ use Modern::Perl; use Moo; use XML::LibXML; -use QohA::Report; extends 'QohA::File'; -has 'report' => ( - is => 'rw', - default => sub { - QohA::Report->new( {type => 'xml'} ); - }, -); - sub run_checks { - my ($self) = @_; + my ($self, $cnt) = @_; my @r = $self->check_parse_xml(); $self->SUPER::add_to_report('xml_valid', \@r); + + return $self->SUPER::run_checks($cnt); } sub check_parse_xml { --- a/QohA/File/YAML.pm +++ a/QohA/File/YAML.pm @@ -4,20 +4,14 @@ use Modern::Perl; use Moo; use YAML; -use QohA::Report; extends 'QohA::File'; -has 'report' => ( - is => 'rw', - default => sub { - QohA::Report->new( {type => 'yaml'} ); - }, -); - sub run_checks { - my ($self) = @_; + my ($self, $cnt) = @_; my @r = $self->check_parse_yaml(); $self->SUPER::add_to_report('yaml_valid', \@r); + + return $self->SUPER::run_checks($cnt); } sub check_parse_yaml { --- a/QohA/Files.pm +++ a/QohA/Files.pm @@ -4,6 +4,7 @@ use Moo; use Modern::Perl; use List::MoreUtils qw(uniq); +use QohA::File; use QohA::File::XML; use QohA::File::Perl; use QohA::File::Template; @@ -19,64 +20,31 @@ has 'files' => ( sub BUILD { my ( $self, $param ) = @_; my @files = @{$param->{files}}; - @files = uniq @files; $self->files([]); - for my $file ( @files ) { - push @{ $self->files }, QohA::File::XML->new(path => $file) - if $file =~ qr/\.xml$|\.xsl$|\.xslt$/i; - push @{ $self->files }, QohA::File::Perl->new(path => $file) - if $file =~ qr/\.pl$|\.pm$|\.t$/i; - push @{ $self->files }, QohA::File::Template->new(path => $file) - if $file =~ qr/\.tt$|\.inc$/i; - push @{ $self->files }, QohA::File::YAML->new(path => $file) - if $file =~ qr/\.yml$|\.yaml$/i; - push @{ $self->files }, QohA::File::Specific::Sysprefs->new(path => $file) - if $file =~ qr/sysprefs\.sql$/; - push @{ $self->files }, QohA::File::Specific::Kohastructure->new(path => $file) - if $file =~ qr/kohastructure\.sql$/; - push @{ $self->files }, QohA::File::Specific::OpacCss->new(path => $file) - if $file =~ qr/opac\.css$|opac\.less$/; - } -} - -sub filter { - my ($self, $params) = @_; - my $file_types = $params->{extension} // []; - my $file_names = $params->{name} // []; - - die "QohA::Files::filter > Bad call: extension and name params cannot be filled together" - if scalar( @$file_types ) and scalar( @$file_names ); - my @wanted_files; - - for my $type ( @$file_types ) { - for my $f ( @{$self->files} ) { - if ( $type =~ /perl/ ) { - push @wanted_files, $f - if ref $f eq 'QohA::File::Perl'; - } - elsif ( $type =~ /xml/ ) { - push @wanted_files, $f - if ref $f eq 'QohA::File::XML'; - } - elsif ( $type =~ /tt/ ) { - push @wanted_files, $f - if ref $f eq 'QohA::File::Template'; - } - elsif ( $type =~ /yaml/ ) { - push @wanted_files, $f - if ref $f eq 'QohA::File::YAML'; - } + for my $f ( @files ) { + my $filepath = $f->{filepath}; + my $file; + if ( $filepath =~ qr/\.xml$|\.xsl$|\.xslt$/i ) { + $file = QohA::File::XML->new(path => $filepath); + } elsif ( $filepath =~ qr/\.pl$|\.pm$|\.t$/i ) { + $file = QohA::File::Perl->new(path => $filepath); + } elsif ( $filepath =~ qr/\.tt$|\.inc$/i ) { + $file = QohA::File::Template->new(path => $filepath); + } elsif ( $filepath =~ qr/\.yml$|\.yaml$/i ) { + $file = QohA::File::YAML->new(path => $filepath); + } elsif ( $filepath =~ qr/sysprefs\.sql$/ ) { + $file = QohA::File::Specific::Sysprefs->new(path => $filepath); + } elsif ( $filepath =~ qr/kohastructure\.sql$/ ) { + $file = QohA::File::Specific::Kohastructure->new(path => $filepath); + } elsif ( $filepath =~ qr/opac\.css$|opac\.less$/ ) { + $file = QohA::File::Specific::OpacCss->new(path => $filepath); + } elsif ( $f->{statuses} =~ m|A| and $f->{statuses} =~ m|D| ) { + $file = QohA::File->new(path => $filepath); } + next unless $file; + $file->git_statuses( $f->{statuses} ); + push @{ $self->files}, $file; } - - if ( @$file_names ) { - for my $f ( @{$self->files} ) { - push @wanted_files, $f - if grep { $_ eq $f->filename } @$file_names; - } - } - - return @wanted_files; } 1; --- a/QohA/Git.pm +++ a/QohA/Git.pm @@ -11,24 +11,22 @@ has 'branchname' => ( ); # this sub returns all modified files, for testing on -# and ignores deleted or moved files sub log { my ($self, $cnt) = @_; - #skip deleted files.. - my @r = qx{git log --oneline --numstat --diff-filter='ACMRTUXB' -$cnt}; - my @r1; + my @r = qx{git log --oneline --name-status -$cnt}; + my $files = {}; - # oops, lets strip out deleted or moved files, from selection foreach my $rr ( @r ) { chomp $rr; my @cols = split '\t', $rr ; # ignore lines that are commit shas, not filename - next if not defined $cols[2]; - push @r1, $cols[2]; + next if not defined $cols[1]; + $files->{$cols[1]} .= $cols[0]; } - return \@r1 ; + + return [ map { { filepath => $_, statuses => $files->{$_} } } keys %$files ]; } sub diff_log { --- a/QohA/Report.pm +++ a/QohA/Report.pm @@ -4,9 +4,6 @@ use Modern::Perl; use Moo; use List::Compare; -has 'type' => ( - is => 'ro', -); has 'file' => ( is => 'rw', ); --- a/TODO +++ a/TODO @@ -1,5 +0,0 @@ -Bugs: -- When a patch just removes files, the $git->log method does not return the -right list of files. We don't want to retrieve deleted files so we don't want -to add the 'D' filter. Maybe should we add a new test for testing this special -case. (i.e. bug 10459) --- a/koha-qa.pl +++ a/koha-qa.pl @@ -60,21 +60,14 @@ eval { print QohA::Git::log_as_string($num_of_commits); - my $modified_files = QohA::Files->new( { files => $git->log($num_of_commits) } ); + my $log_files = $git->log($num_of_commits); + my $modified_files = QohA::Files->new( { files => $log_files } ); $git->delete_branch( 'qa-prev-commit' ); $git->create_and_change_branch( 'qa-prev-commit' ); $git->reset_hard_prev( $num_of_commits ); - my @files = ( - $modified_files->filter( { extension => [ qw< perl tt xml yaml > ] } ), - $modified_files->filter( { name => [ qw< sysprefs.sql > ] } ), - $modified_files->filter( { name => [ qw< kohastructure.sql > ] } ), - $modified_files->filter( { name => [ qw< opac.css > ] } ), - $modified_files->filter( { name => [ qw< opac.less > ] } ), - ); - - + my @files = @{ $modified_files->files }; my $i = 1; say "Processing files before patches"; for my $f ( @files ) { --- a/t/Perl.t +++ a/t/Perl.t @@ -38,18 +38,14 @@ eval { $CWD = $git_repo; my $qoha_git = QohA::Git->new(); - my $modified_files = QohA::Files->new( { files => $qoha_git->log($num_of_commits) } ); - + my $log_files = $qoha_git->log($num_of_commits); + my $modified_files = QohA::Files->new( { files => $log_files } ); $qoha_git->delete_branch( 'qa-prev-commit_t' ); $qoha_git->create_and_change_branch( 'qa-prev-commit_t' ); $qoha_git->reset_hard_prev( $num_of_commits ); - my @files = ( - $modified_files->filter( { extension => [ qw< perl tt xml yaml > ] } ), - $modified_files->filter( { name => [ qw< sysprefs.sql > ] } ), - $modified_files->filter( { name => [ qw< kohastructure.sql > ] } ), - ); + my @files = @{ $modified_files->files }; for my $f ( @files ) { $f->run_checks(); } @@ -114,11 +110,13 @@ eval { EOL my $r_v1_expected = <