Gregor hat vor längerer Zeit das Modul Test::Perl::Critic::Progressive und ich vor kurzem das Modul PPI vorgestellt. In diesem Blogpost zeige ich, wie man mit PPI Perl::Critic-Regeln umsetzen kann, die dann in den Tests verwendet werden.
Nachdem ich eine Anwendung programmiert hatte, hat Gregor den Code angeschaut. Dabei ist er über dieses Stück Code gestolpert und meinte, es sähe schräg
aus:
my ($doc) = grep{
$_->{virtual_path} eq $virt_path
}@{ $app_config->{docs} || [] };
Für mich ist das völlig normal, ich nutze das häufiger. Aber ich gebe zu, dass man das schöner schreiben könnte.
Da man in diesem Beispiel nur an dem ersten Treffer
interessiert ist, könnte man statt des grep die Funktion first aus dem Modul List::Util nutzen. Damit würde es dann schon so aussehen:
my $doc = first {
$_->{virtual_path} eq $virt_path
}@{ $app_config->{docs} || [] };
Natürlich muss man am Anfang noch das Modul laden. Der Unterschied ist nur klein, aber für Einsteiger vielleicht doch einfacher, weil man hier nicht auf den Kontext achten muss. Beim grep gibt es unterschiedliche Ergebnisse, je nachdem ob man das Ergebnis in Skalar- oder im Listenkontext nutzt – einfach mal dieses Skript bei perlbanjo.com ausführen...
Das nächste was man schöner schreiben könnte, ist die Dereferenzierung der Arrayreferenz:
@{ $app_config->{docs} || [] }
Seit der Version 5.20 gibt es das (bis 5.24 experimentelle) Feature postderef . Da sieht die Schreibweise dann etwas schöner aus:
$app_config->{docs}->@*
Auch hier muss man am Anfang des Codes noch etwas einfügen, aber der Lesefluss ist in meinen Augen deutlich besser. Zum Schluss noch ein Leerzeichen zwischen das schließende
des }greps und der Dereferenzierung. Insgesamt wäre es dann
my $doc = first {
$_->{virtual_path} eq $virt_path
} $app_config->{docs}->@*;
Nachdem wir geklärt haben, welchen Code wir beanstanden wollen, und wie er schlussendlich aussehen soll, können wir uns an die Umsetzung der Regeln machen.
In meinen Augen liefert PPI::Dumper einen sehr guten Einstiegspunkt. Einfach den unerwünschten
Code in allen möglichen Fassungen in den __DATA__-Bereich des Skriptes packen und ausführen. Damit sieht man, welche PPI-Knoten es gibt und an welchen man ansetzen muss. Der Dump des Perl Document Object Model (POM) in unserem Beispiel sieht auszugsweise folgendermaßen aus:
PPI::Document
PPI::Token::Whitespace '\n'
PPI::Statement::Variable
PPI::Token::Word 'my'
PPI::Token::Whitespace ' '
PPI::Token::Symbol '@list'
PPI::Token::Whitespace ' '
PPI::Token::Operator '='
PPI::Token::Whitespace ' '
PPI::Token::Word 'grep'
PPI::Token::Whitespace ' '
PPI::Structure::Block { ... }
Bei jeder Perl::Critic-Regel muss man angeben, auf welchen Knoten die Regel angewandt werden soll. In diesem Fall ist das immer ein Knoten vom Typ PPI::Token::Word.
Gehen wir einen Teil nach dem anderen durch. Zuerst wollen wir first statt grep nutzen, wenn auf der linken Seite nur eine einelementige Liste angegeben ist.
Die passenden Beispiele dazu sind:
my @list = grep { ausdruck() } @liste; # grep ok
my $list = grep { ausdruck() } @liste; # grep ok
my ($list) = grep { ausdruck() } @liste; # grep not ok
my ($list, $second) = grep { ausdruck() } @liste; # grep ok
if( grep{ ausdruck() }@liste ) { # grep ok
}
# ggf. noch weitere Beispiele
Wenn wir uns den Dump anschauen, merken wir folgendes:
Vergleiche Varianten der Variablenliste:
PPI::Token::Whitespace '\n'
PPI::Statement::Variable
PPI::Token::Word 'my'
PPI::Token::Whitespace ' '
PPI::Structure::List ( ... )
PPI::Statement::Expression
PPI::Token::Symbol '$list'
# vs
PPI::Statement::Variable
PPI::Token::Word 'my'
PPI::Token::Whitespace ' '
PPI::Structure::List ( ... )
PPI::Statement::Expression
PPI::Token::Symbol '$list'
PPI::Token::Operator ','
PPI::Token::Whitespace ' '
PPI::Token::Symbol '$second'
Es muss also eine Liste mit genau einem PPI::Token::Symbol sein, dessen Sigil ein $ ist.
Schauen wir uns das Grundgerüst für eine Perl::Critic-Regel an:
package Perl::Critic::Policy::PerlAcademy::ProhibitGrepToGetFirstFoundElement;
# ABSTRACT: Use List::Utils 'first' instead of grep if you want to get the first found element
use 5.006001;
use strict;
use warnings;
use Readonly;
use Perl::Critic::Utils qw{ :severities };
use base 'Perl::Critic::Policy';
our $VERSION = '2.02';
#-----------------------------------------------------------------------------
Readonly::Scalar my $DESC => q{Use List::Utils 'first' instead of grep if you want to get the first found element};
Readonly::Scalar my $EXPL => [ ];
#-----------------------------------------------------------------------------
sub default_severity { return $SEVERITY_MEDIUM }
sub default_themes { return qw<perl_academy> }
sub applies_to {
return qw<
PPI::Token::Word
>;
}
Das kann so 1:1 kopiert werden. Der Paketnamen muss angepasst werden sowie die Beschreibungen.
Bei der default_severity muss man sich überlegen, wie wichtig einem diese Regel ist. Regeln können in sogenannte Themes eingeteilt werden.
Mit applies_to legt man eine Liste von Klassennamen fest, auf deren Objekte die Regel angewandt wird. Wir haben oben festgestellt, dass wir auf PPI::Token::Word-Objekte reagieren müssen.
Ob die Regel eingehalten wird, wird dann in der Methode violates geprüft. Ist alles ok, wird undef zurückgegeben, ansonsten ein Objekt, das die Regelmissachtung beschreibt:
sub violates {
my ( $self, $elem, $doc ) = @_;
# ... code zur pruefung der regel ...
return $self->violation( $DESC, $EXPL, $elem );
}
Neben dem Objekt der Regel selbst bekommt man das Element (hier ein Objekt von PPI::Token::Word) und das PPI::Document-Objekt übergeben.
Als erstes prüfen wir, ob es ein grep-Befehl ist:
# other statements than grep aren't catched
return if $elem->content ne 'grep';
Dann interessieren wir uns nur für das grep, wenn das Ergebnis nicht in einer Variablen gespeichert wird. Dazu müssen wir in der Hierarchie des POM eine Stufe nach oben gehen:
my $parent = $elem->parent;
# grep in boolean or void context isn't checked
return if !$parent->isa('PPI::Statement::Variable');
Und bei den Variablen muss eine Liste gegeben sein
my $list = first{ $_->isa('PPI::Structure::List') } $parent->schildren;
return if !$list;
Die Liste darf nur ein Element haben und das muss ein Scalar sein.
my $symbols = $list->find('PPI::Token::Symbol');
return if !$symbols;
return if 1 != @{ $symbols };
return if '$' ne substr $symbols->[0], 0, 1;
Sollte das alles zutreffen, ist das ein Regelverstoß:
return $self->violation( $DESC, $EXPL, $elem );
Diese gesamte Regel ist mittlerweile auch auf CPAN bei meinen Regeln – und zwar als Perl::Critic::Policy::Reneeb::ProhibitGrepToGetFirstFoundElement – zu finden.
Die beiden anderen Punkte zum schöneren
Code umzusetzen bleibt dem geneigten Leser überlassen.
Permalink: /2020-12-01-perl-critic-regeln-erstellen