From 9219ba0f6d0245607bea57c5da3784d4c51f8cf4 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Fri, 21 Nov 2014 15:06:02 +0200 Subject: [PATCH] Add perlcritic release test and fix problems --- MANIFEST | 2 ++ lib/WWW/Search/Torrentz.pm | 19 +++++++++++-------- lib/WWW/Search/Torrentz/Result.pm | 3 +-- t/perlcritic.t | 10 ++++++++++ t/perlcriticrc | 29 +++++++++++++++++++++++++++++ 5 files changed, 53 insertions(+), 10 deletions(-) create mode 100644 t/perlcritic.t create mode 100644 t/perlcriticrc diff --git a/MANIFEST b/MANIFEST index 08bf1f0..715f717 100644 --- 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 diff --git a/lib/WWW/Search/Torrentz.pm b/lib/WWW/Search/Torrentz.pm index e7c7713..356393e 100644 --- a/lib/WWW/Search/Torrentz.pm +++ b/lib/WWW/Search/Torrentz.pm @@ -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 '; 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; } diff --git a/lib/WWW/Search/Torrentz/Result.pm b/lib/WWW/Search/Torrentz/Result.pm index 7f0b5b4..6ab9955 100644 --- a/lib/WWW/Search/Torrentz/Result.pm +++ b/lib/WWW/Search/Torrentz/Result.pm @@ -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 index 0000000..51bad9d --- /dev/null +++ b/t/perlcritic.t @@ -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 index 0000000..5973bef --- /dev/null +++ b/t/perlcriticrc @@ -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 -- 2.30.2