Add perlcritic release test and fix problems
authorMarius Gavrilescu <marius@ieval.ro>
Fri, 21 Nov 2014 13:06:02 +0000 (15:06 +0200)
committerMarius Gavrilescu <marius@ieval.ro>
Fri, 21 Nov 2014 13:06:02 +0000 (15:06 +0200)
MANIFEST
lib/WWW/Search/Torrentz.pm
lib/WWW/Search/Torrentz/Result.pm
t/perlcritic.t [new file with mode: 0644]
t/perlcriticrc [new file with mode: 0644]

index 08bf1f0422b647bfc3aa27a16012a0e3e68dae8e..715f7175abe67d1262a98ffb6a0e858c22bf0e14 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4,5 +4,7 @@ MANIFEST
 README
 t/WWW-Search-Torrentz.t
 t/WWW-Search-Torrentz-Result.t
+t/perlcritic.t
+t/perlcriticrc
 lib/WWW/Search/Torrentz.pm
 lib/WWW/Search/Torrentz/Result.pm
index e7c77137d96d4469fdf466c55eaab483ab6d90b8..356393e55a31c58b998f23b65d4b4c8110e5b31d 100644 (file)
@@ -5,15 +5,18 @@ use strict;
 use warnings;
 no if $] >= 5.018, warnings => 'experimental::smartmatch';
 use parent qw/WWW::Search/;
+use re '/s';
 
 our $VERSION = '0.001002';
 our $MAINTAINER = 'Marius Gavrilescu <marius@ieval.ro>';
 
 use WWW::Search::Torrentz::Result;
 
+sub debug { say STDERR @_ } ## no critic (RequireCheckedSyscalls)
+
 sub gui_query{ shift->native_query(@_) }
 
-sub _native_setup_search{
+sub _native_setup_search{ ## no critic (ProhibitUnusedPrivateSubroutines)
        my ($self, $native_query, $options) = @_;
        $self->agent_email('marius@ieval.ro');
        $options //= {};
@@ -23,9 +26,9 @@ sub _native_setup_search{
        $self->user_agent->delay(2/60);
 }
 
-sub fullint ($) { int (shift =~ y/0-9//cdr) }
+sub fullint ($) { int (shift =~ y/0-9//cdr) } ## no critic (ProhibitSubroutinePrototypes)
 
-sub _parse_tree{
+sub _parse_tree{ ## no critic (ProhibitUnusedPrivateSubroutines)
        my ($self, $tree) = @_;
        my $found = 0;
 
@@ -41,13 +44,13 @@ sub _parse_tree{
                next unless defined $a;
 
                my $infohash = substr $a->attr('href'), 1;
-               next unless $infohash =~ m,^[a-f0-9]{40}$,;
+               next unless $infohash =~ /^[a-f0-9]{40}$/;
                my $title = $a->as_text;
                my ($verified, $age, $size, $seeders, $leechers);
                $verified = 0;
                for my $span ($node->find('span')) {
                        given($span->attr('class')){
-                               $verified = int ($span->as_text =~ m,^\d+,) when 'v';
+                               $verified = int ($span->as_text =~ /^\d+/) when 'v';
                                $age = $span->as_text when 'a';
                                $size = $span->as_text when 's';
                                $seeders = fullint $span->as_text when 'u';
@@ -56,16 +59,16 @@ sub _parse_tree{
                }
 
                push @{$self->{cache}}, WWW::Search::Torrentz::Result->new(infohash => $infohash, title => $title, verified => $verified, age => $age, size => $size, seeders => $seeders, leechers => $leechers, ua => $self->user_agent);
-               say STDERR "infohash => $infohash, title => $title, verified => $verified, age => $age, size => $size, seeders => $seeders, leechers => $leechers" if $self->{search_debug};
+               debug "infohash => $infohash, title => $title, verified => $verified, age => $age, size => $size, seeders => $seeders, leechers => $leechers" if $self->{search_debug};
                $found++;
        }
 
        my $url = $tree->look_down(rel => 'next');
        if (defined $url) {
-               my $prev = $self->{_prev_url} =~ s,/[^/]+$,,r;
+               my $prev = $self->{_prev_url} =~ s{/[^/]+$}{}r;
                $self->{_next_url} = $prev . $url->attr('href')
        }
-       say STDERR "Found: $found" if $self->{search_debug};
+       debug "Found: $found" if $self->{search_debug};
        return $found;
 }
 
index 7f0b5b402864ae1418793f0e5f7e75ae164786cb..6ab9955661d0f730f5d39b68cada984f0cea01ce 100644 (file)
@@ -15,8 +15,7 @@ sub new{
        my $self = $class->SUPER::new(@_);
        $self->{parsed} = 0;
 
-       no strict 'refs';
-       $self->$_($args{$_}) for qw/title verified age size seeders leechers infohash/;
+       $self->_elem($_ => $args{$_}) for qw/title verified age size seeders leechers infohash/;
        $self->{ua} = $args{ua};
        $self->add_url("https://torrentz.eu/$args{infohash}");
        $self
diff --git a/t/perlcritic.t b/t/perlcritic.t
new file mode 100644 (file)
index 0000000..51bad9d
--- /dev/null
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+use v5.14;
+use warnings;
+
+use Test::More;
+
+BEGIN { plan skip_all => '$ENV{RELEASE_TESTING} is false' unless $ENV{RELEASE_TESTING} }
+use Test::Perl::Critic -profile => 't/perlcriticrc';
+
+all_critic_ok
diff --git a/t/perlcriticrc b/t/perlcriticrc
new file mode 100644 (file)
index 0000000..5973bef
--- /dev/null
@@ -0,0 +1,29 @@
+severity = 1
+
+[-CodeLayout::RequireTidyCode]
+[-ControlStructures::ProhibitPostfixControls]
+[-ControlStructures::ProhibitUnlessBlocks]
+[-Documentation::PodSpelling]
+[-Documentation::RequirePodLinksIncludeText]
+[-InputOutput::RequireBracedFileHandleWithPrint]
+[-RegularExpressions::ProhibitEnumeratedClasses]
+[-RegularExpressions::RequireLineBoundaryMatching]
+[-Subroutines::RequireFinalReturn]
+[-ValuesAndExpressions::ProhibitConstantPragma]
+[-ValuesAndExpressions::ProhibitEmptyQuotes]
+[-ValuesAndExpressions::ProhibitMagicNumbers]
+[-ValuesAndExpressions::ProhibitNoisyQuotes]
+[-Variables::ProhibitLocalVars]
+[-Variables::ProhibitPackageVars]
+[-Variables::ProhibitPunctuationVars]
+
+[RegularExpressions::RequireExtendedFormatting]
+minimum_regex_length_to_complain_about = 20
+
+[Documentation::RequirePodSections]
+lib_sections = NAME | SYNOPSIS | DESCRIPTION | AUTHOR | COPYRIGHT AND LICENSE
+script_sections = NAME | SYNOPSIS | DESCRIPTION | AUTHOR | COPYRIGHT AND LICENSE
+
+[Subroutines::RequireArgUnpacking]
+short_subroutine_statements = 5
+allow_subscripts = 1
This page took 0.016982 seconds and 4 git commands to generate.