From 5a834e3bf60f7f3ed59f56f65e505658395dcd05 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Sun, 31 May 2020 11:11:39 +0000 Subject: [PATCH 1/6] add critc and tidy files --- t/perlcritic.t | 6 +++++ t/rc/.perlcriticrc | 23 +++++++++++++++++ t/rc/.perltidyrc | 63 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 92 insertions(+) create mode 100644 t/perlcritic.t create mode 100644 t/rc/.perlcriticrc create mode 100644 t/rc/.perltidyrc diff --git a/t/perlcritic.t b/t/perlcritic.t new file mode 100644 index 0000000..37de98d --- /dev/null +++ b/t/perlcritic.t @@ -0,0 +1,6 @@ +if (!require Test::Perl::Critic) { + Test::More::plan(skip_all => "Test::Perl::Critic required for testing PBP compliance"); +} + +Test::Perl::Critic->import(-profile => 't/rc/.perlcriticrc'); +Test::Perl::Critic::all_critic_ok(); diff --git a/t/rc/.perlcriticrc b/t/rc/.perlcriticrc new file mode 100644 index 0000000..0307901 --- /dev/null +++ b/t/rc/.perlcriticrc @@ -0,0 +1,23 @@ +severity = 4 +criticism-fatal = 1 +color = 1 +include = TestingAndDebugging::RequireUseWarnings Subroutines::RequireArgUnpacking TestingAndDebugging::ProhibitNoStrict CodeLayout::RequireTidyCode ErrorHandling::RequireCheckingReturnValueOfEval TestingAndDebugging::RequireUseStrict +exclude = ValuesAndExpressions::ProhibitConstantPragma + +[TestingAndDebugging::RequireUseWarnings] +equivalent_modules=MooseX::Singleton Mojo::Base + +[Subroutines::RequireArgUnpacking] +short_subroutine_statements=3 + +[TestingAndDebugging::ProhibitNoStrict] +allow=refs + +[CodeLayout::RequireTidyCode] +perltidyrc=t/rc/.perltidyrc + +[ErrorHandling::RequireCheckingReturnValueOfEval] +severity=4 + +[TestingAndDebugging::RequireUseStrict] +equivalent_modules=MooseX::Singleton Mojo::Base diff --git a/t/rc/.perltidyrc b/t/rc/.perltidyrc new file mode 100644 index 0000000..3a6cfa1 --- /dev/null +++ b/t/rc/.perltidyrc @@ -0,0 +1,63 @@ +#line length; keep it quite short so that lists of arguments to subs +#are wrapped +--maximum-line-length=150 + +#Cuddled else +-ce + +#Stack Closing Tokens +#http://perltidy.sourceforge.net/stylekey.html#stack_closing_tokens +#"The manual shows how all of these vertical tightness controls may be +#applied independently to each type of non-block opening and opening token." +--stack-closing-tokens + +## Similarly for opening. +--stack-opening-tokens + +#4 char wide tabs instead of spaces for indentation. +-i=4 + +#Horizontal Tightness +#http://perltidy.sourceforge.net/stylekey.html#define_horizontal_tightness +#parentheses if ((my $len_tab = length($tabstr)) > 0) +-pt=2 + +#square brackets $width = $col[$j + $k] - $col[$j]; +-sbt=2 + +#braces $width = $col[$j + $k] - $col[$j]; +-bt=2 + +#block braces map { $_ => -M $_ } grep { /\.deb$/ } +-bbt=0 + +#no space in front of semi-colons in a for loop +--nospace-for-semicolon + +#no outdenting of long quotes +#http://perltidy.sourceforge.net/stylekey.html#outdenting_long_quotes +--no-outdent-long-quotes + +--add-semicolons + +#always break a new line after a semi-colon +--want-break-after=";" + +#all hash key/values on a separate line +--comma-arrow-breakpoints=0 + +#No newlines before comments +-nbbc + +--no-outdent-long-lines + +#do not outdent labels +--no-outdent-labels + +--check-syntax + +--indent-spaced-block-comments + +#4 charachter if its breaks the line +--continuation-indentation=4 + From 877c58167cb7c217109077a39ca842b43b02094d Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Sun, 31 May 2020 11:12:03 +0000 Subject: [PATCH 2/6] add critic --- META.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/META.json b/META.json index 1d09698..93940ee 100644 --- a/META.json +++ b/META.json @@ -37,7 +37,8 @@ "Test::MinimumVersion::Fast" : "0.04", "Test::PAUSE::Permissions" : "0.07", "Test::Pod" : "1.41", - "Test::Spellunker" : "v0.2.7" + "Test::Spellunker" : "v0.2.7", + "Test::Perl::Critic" : "0" } }, "runtime" : { From 0be17997d626569cb17e19dd3450028c864f0bb0 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Sun, 31 May 2020 12:01:06 +0000 Subject: [PATCH 3/6] critic & tidy Plerd --- lib/Plerd.pm | 457 ++++++++++++++++++++++++--------------------------- 1 file changed, 211 insertions(+), 246 deletions(-) diff --git a/lib/Plerd.pm b/lib/Plerd.pm index d749774..c701446 100644 --- a/lib/Plerd.pm +++ b/lib/Plerd.pm @@ -1,5 +1,8 @@ package Plerd; +use strict; +use warnings; + our $VERSION = '1.821'; use Moose; @@ -17,264 +20,262 @@ use Plerd::Tag; use Plerd::WebmentionQueue; has 'path' => ( - is => 'ro', + is => 'ro', isa => 'Str', ); has 'source_path' => ( - is => 'ro', + is => 'ro', isa => 'Str', ); has 'template_path' => ( - is => 'ro', + is => 'ro', isa => 'Str', ); has 'publication_path' => ( - is => 'ro', + is => 'ro', isa => 'Str', ); has 'database_path' => ( - is => 'ro', + is => 'ro', isa => 'Str', ); has 'tags_publication_path' => ( - is => 'ro', - isa => 'Str', + is => 'ro', + isa => 'Str', lazy_build => 1, ); has 'base_uri' => ( - is => 'ro', + is => 'ro', required => 1, - isa => Uri, - coerce => 1, + isa => Uri, + coerce => 1, ); has 'tags_index_uri' => ( - is => 'ro', - isa => Uri, + is => 'ro', + isa => Uri, lazy_build => 1, ); - has 'title' => ( - is => 'ro', + is => 'ro', required => 1, - isa => 'Str', + isa => 'Str', ); has 'author_name' => ( - is => 'ro', + is => 'ro', required => 1, - isa => 'Str', + isa => 'Str', ); has 'author_email' => ( - is => 'ro', + is => 'ro', required => 1, - isa => 'Str', + isa => 'Str', ); has 'twitter_id' => ( - is => 'ro', - isa => 'Maybe[Str]', + is => 'ro', + isa => 'Maybe[Str]', default => undef, ); has 'facebook_id' => ( - is => 'ro', - isa => 'Maybe[Str]', + is => 'ro', + isa => 'Maybe[Str]', default => undef, ); has 'image' => ( - is => 'ro', - isa => Uri, + is => 'ro', + isa => Uri, coerce => 1, ); has 'image_alt' => ( - is => 'ro', - isa => 'Maybe[Str]', + is => 'ro', + isa => 'Maybe[Str]', default => undef, ); has 'recent_posts_maxsize' => ( - is => 'ro', - isa => 'Int', + is => 'ro', + isa => 'Int', default => 10, ); has 'directory' => ( - is => 'ro', - isa => 'Path::Class::Dir', + is => 'ro', + isa => 'Path::Class::Dir', lazy_build => 1, ); has 'source_directory' => ( - is => 'ro', - isa => 'Path::Class::Dir', + is => 'ro', + isa => 'Path::Class::Dir', lazy_build => 1, ); has 'template_directory' => ( - is => 'ro', - isa => 'Path::Class::Dir', + is => 'ro', + isa => 'Path::Class::Dir', lazy_build => 1, ); has 'database_directory' => ( - is => 'ro', - isa => 'Path::Class::Dir', + is => 'ro', + isa => 'Path::Class::Dir', lazy_build => 1, ); has 'publication_directory' => ( - is => 'ro', - isa => 'Path::Class::Dir', + is => 'ro', + isa => 'Path::Class::Dir', lazy_build => 1, ); has 'tags_publication_directory' => ( - is => 'ro', - isa => 'Path::Class::Dir', + is => 'ro', + isa => 'Path::Class::Dir', lazy_build => 1, ); has 'template' => ( - is => 'ro', - isa => 'Template', + is => 'ro', + isa => 'Template', lazy_build => 1, ); has 'post_template_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'archive_template_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'rss_template_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'tags_template_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'jsonfeed_template_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'recent_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'archive_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'rss_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'jsonfeed_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'recent_posts' => ( - is => 'ro', - isa => 'ArrayRef[Plerd::Post]', + is => 'ro', + isa => 'ArrayRef[Plerd::Post]', lazy_build => 1, - clearer => 'clear_recent_posts', + clearer => 'clear_recent_posts', ); has 'datetime_formatter' => ( - is => 'ro', - isa => 'DateTime::Format::W3CDTF', + is => 'ro', + isa => 'DateTime::Format::W3CDTF', default => sub { DateTime::Format::W3CDTF->new }, ); has 'posts' => ( - is => 'ro', - isa => 'ArrayRef[Plerd::Post]', + is => 'ro', + isa => 'ArrayRef[Plerd::Post]', lazy_build => 1, - clearer => 'clear_posts', + clearer => 'clear_posts', ); has 'index_of_post_with_guid' => ( - is => 'ro', - isa => 'HashRef', + is => 'ro', + isa => 'HashRef', lazy_build => 1, - clearer => 'clear_post_index_hash', + clearer => 'clear_post_index_hash', ); has 'index_of_post_with_url' => ( - is => 'ro', - isa => 'HashRef', + is => 'ro', + isa => 'HashRef', lazy_build => 1, - clearer => 'clear_post_url_index_hash', + clearer => 'clear_post_url_index_hash', ); has 'webmention_queue' => ( - is => 'ro', - isa => 'Plerd::WebmentionQueue', + is => 'ro', + isa => 'Plerd::WebmentionQueue', lazy_build => 1, ); has 'has_tags' => ( - is => 'ro', - isa => 'Bool', + is => 'ro', + isa => 'Bool', lazy_build => 1, ); has 'tags_map' => ( - is => 'rw', - isa => 'HashRef', + is => 'rw', + isa => 'HashRef', default => sub { {} }, ); has 'tag_case_conflicts' => ( - is => 'rw', - isa => 'HashRef', + is => 'rw', + isa => 'HashRef', default => sub { {} }, ); sub BUILD { my $self = shift; - unless ( $self->path ) { - for my $subdir_type ( qw( source template publication database ) ) { + unless ($self->path) { + for my $subdir_type (qw( source template publication database )) { try { my $method = "${subdir_type}_directory"; - my $dir = $self->$method; + my $dir = $self->$method; } catch { - die "Can't create a new Plerd object, due to insufficient " - . "configuration: $_"; + die "Can't create a new Plerd object, due to insufficient " . "configuration: $_"; }; } } @@ -285,7 +286,7 @@ sub BUILD { sub publish_all { my $self = shift; - for my $post ( @{ $self->posts } ) { + for my $post (@{$self->posts}) { $post->publish; } @@ -303,8 +304,10 @@ sub publish_all { $self->clear_post_index_hash; $self->clear_post_url_index_hash; - $self->tags_map( {} ); - $self->tag_case_conflicts( {} ); + $self->tags_map({}); + $self->tag_case_conflicts({}); + + return; } # Create a page that lists all available tags with @@ -327,31 +330,33 @@ sub publish_tag_indexes { $self->template->process( $self->tags_template_file->open('<:encoding(utf8)'), { - self_uri => $tag->uri, + self_uri => $tag->uri, is_tags_page => 1, - tags => { $tag->name => $tag->posts }, - plerd => $self, + tags => {$tag->name => $tag->posts}, + plerd => $self, }, $self->tags_publication_file($tag->name)->open('>:encoding(utf8)'), - ) || $self->_throw_template_exception( $self->tags_template_file ); + ) || $self->_throw_template_exception($self->tags_template_file); } # Create the tag index my %simplified_tag_map; for my $tag (values %$tag_map) { - $simplified_tag_map{ $tag->name } = $tag->posts; + $simplified_tag_map{$tag->name} = $tag->posts; } $self->template->process( $self->tags_template_file->open('<:encoding(utf8)'), { - self_uri => $self->tags_index_uri, + self_uri => $self->tags_index_uri, is_tags_index_page => 1, - is_tags_page => 1, - tags => \%simplified_tag_map, - plerd => $self, + is_tags_page => 1, + tags => \%simplified_tag_map, + plerd => $self, }, $self->tags_publication_file->open('>:encoding(utf8)'), - ) || $self->_throw_template_exception( $self->tags_template_file ); + ) || $self->_throw_template_exception($self->tags_template_file); + + return; } @@ -366,41 +371,43 @@ sub publish_recent_page { title => $self->title, }, $self->recent_file->open('>:encoding(utf8)'), - ) || $self->_throw_template_exception( $self->post_template_file ); + ) || $self->_throw_template_exception($self->post_template_file); - my $index_file = - Path::Class::File->new( $self->publication_directory, 'index.html' ); + my $index_file = Path::Class::File->new($self->publication_directory, 'index.html'); symlink $self->recent_file, $index_file; + + return; } sub publish_rss { my $self = shift; - $self->_publish_feed( 'rss' ); + $self->_publish_feed('rss'); + + return; } sub publish_jsonfeed { my $self = shift; - $self->_publish_feed( 'jsonfeed' ); + $self->_publish_feed('jsonfeed'); + + return; } sub post_with_url { - my $self = shift; - my ( $url ) = @_; + my ($self, $url) = @_; - my $index = $self->index_of_post_with_url->{ $url }; - if ( defined $index ) { - return $self->posts->[ $self->index_of_post_with_url->{ $url } ]; - } - else { + my $index = $self->index_of_post_with_url->{$url}; + if (defined $index) { + return $self->posts->[$self->index_of_post_with_url->{$url}]; + } else { return; } } sub _publish_feed { - my $self = shift; - my ( $feed_type ) = @_; + my ($self, $feed_type) = @_; my $template_file_method = "${feed_type}_template_file"; my $file_method = "${feed_type}_file"; @@ -408,19 +415,19 @@ sub _publish_feed { return unless -e $self->$template_file_method; my $formatter = $self->datetime_formatter; - my $timestamp = - $formatter->format_datetime( DateTime->now( time_zone => 'local' ) ) - ; + my $timestamp = $formatter->format_datetime(DateTime->now(time_zone => 'local')); $self->template->process( $self->$template_file_method->open('<:encoding(utf8)'), { - plerd => $self, - posts => $self->recent_posts, + plerd => $self, + posts => $self->recent_posts, timestamp => $timestamp, }, $self->$file_method->open('>:encoding(utf8)'), - ) || $self->_throw_template_exception( $self->$template_file_method ); + ) || $self->_throw_template_exception($self->$template_file_method); + + return; } sub publish_archive_page { @@ -435,152 +442,122 @@ sub publish_archive_page { posts => $posts_ref, }, $self->archive_file->open('>:encoding(utf8)'), - ) || $self->_throw_template_exception( $self->archive_template_file ); + ) || $self->_throw_template_exception($self->archive_template_file); -} + return; +} sub _build_directory { my $self = shift; - if ( defined $self->path ) { - return Path::Class::Dir->new( $self->path ); - } - else { - return undef; + if (defined $self->path) { + return Path::Class::Dir->new($self->path); + } else { + return; } } sub _build_subdirectory { my $self = shift; - my ( $path_method, $subdir_name ) = @_; - - if ( defined $self->$path_method ) { - return Path::Class::Dir->new( $self->$path_method ); - } - elsif ( defined $self->path ) { - return Path::Class::Dir->new( - $self->directory, - $subdir_name, - ); - } - else { - die "Can't build $subdir_name directory! Neither a '$path_method' nor " - . "a 'path' attribute is defined.\n"; + my ($path_method, $subdir_name) = @_; + + if (defined $self->$path_method) { + return Path::Class::Dir->new($self->$path_method); + } elsif (defined $self->path) { + return Path::Class::Dir->new($self->directory, $subdir_name,); + } else { + die "Can't build $subdir_name directory! Neither a '$path_method' nor " . "a 'path' attribute is defined.\n"; } } sub _build_source_directory { my $self = shift; - return $self->_build_subdirectory( 'source_path', 'source' ); + return $self->_build_subdirectory('source_path', 'source'); } sub _build_database_directory { my $self = shift; - return $self->_build_subdirectory( 'database_path', 'db' ); + return $self->_build_subdirectory('database_path', 'db'); } sub _build_publication_directory { my $self = shift; - return $self->_build_subdirectory( 'publication_path', 'docroot' ); + return $self->_build_subdirectory('publication_path', 'docroot'); } sub _build_template_directory { my $self = shift; - return $self->_build_subdirectory( 'template_path', 'templates' ); + return $self->_build_subdirectory('template_path', 'templates'); } sub _build_template { my $self = shift; - return Template->new( { - INCLUDE_PATH => $self->template_directory, - FILTERS => { - json => sub { - my $text = shift; - $text =~ s/"/\\"/g; - $text =~ s/\n/\\n/g; - return $text; + return Template->new({ + INCLUDE_PATH => $self->template_directory, + FILTERS => { + json => sub { + my $text = shift; + $text =~ s/"/\\"/g; + $text =~ s/\n/\\n/g; + return $text; + }, }, - }, - ENCODING => 'utf8', - } ); + ENCODING => 'utf8', + }); } sub _build_post_template_file { my $self = shift; - return Path::Class::File->new( - $self->template_directory, - 'post.tt', - ); + return Path::Class::File->new($self->template_directory, 'post.tt',); } sub _build_rss_template_file { my $self = shift; - return Path::Class::File->new( - $self->template_directory, - 'atom.tt', - ); + return Path::Class::File->new($self->template_directory, 'atom.tt',); } sub _build_jsonfeed_template_file { my $self = shift; - return Path::Class::File->new( - $self->template_directory, - 'jsonfeed.tt', - ); + return Path::Class::File->new($self->template_directory, 'jsonfeed.tt',); } sub _build_archive_template_file { my $self = shift; - return Path::Class::File->new( - $self->template_directory, - 'archive.tt', - ); + return Path::Class::File->new($self->template_directory, 'archive.tt',); } sub _build_recent_file { my $self = shift; - return Path::Class::File->new( - $self->publication_directory, - 'recent.html', - ); + return Path::Class::File->new($self->publication_directory, 'recent.html',); } sub _build_archive_file { my $self = shift; - return Path::Class::File->new( - $self->publication_directory, - 'archive.html', - ); + return Path::Class::File->new($self->publication_directory, 'archive.html',); } sub _build_rss_file { my $self = shift; - return Path::Class::File->new( - $self->publication_directory, - 'atom.xml', - ); + return Path::Class::File->new($self->publication_directory, 'atom.xml',); } sub _build_jsonfeed_file { my $self = shift; - return Path::Class::File->new( - $self->publication_directory, - 'feed.json', - ); + return Path::Class::File->new($self->publication_directory, 'feed.json',); } sub _build_recent_posts { @@ -588,21 +565,20 @@ sub _build_recent_posts { my @recent_posts = (); - for my $post ( @{ $self->posts } ) { + for my $post (@{$self->posts}) { my $did_update = 0; - if ( @recent_posts < $self->recent_posts_maxsize ) { + if (@recent_posts < $self->recent_posts_maxsize) { push @recent_posts, $post; $did_update = 1; - } - elsif ( $post->date > $recent_posts[ -1 ]->date ) { + } elsif ($post->date > $recent_posts[-1]->date) { pop @recent_posts; push @recent_posts, $post; $did_update = 1; } - if ( $did_update ) { + if ($did_update) { @recent_posts = sort { $b->date <=> $a->date } @recent_posts; } } @@ -614,11 +590,9 @@ sub _build_posts { my $self = shift; my @posts = sort { $b->date <=> $a->date } - map { Plerd::Post->new( plerd => $self, source_file => $_ ) } - sort { $a->basename cmp $b->basename } - grep { /\.markdown$|\.md$/ } - $self->source_directory->children - ; + map { Plerd::Post->new(plerd => $self, source_file => $_) } + sort { $a->basename cmp $b->basename } + grep { /\.markdown$|\.md$/ } $self->source_directory->children; return \@posts; } @@ -630,8 +604,8 @@ sub _build_index_of_post_with_guid { my $current_index = 0; - for my $post ( @{ $self->posts } ) { - $index_of_post{ $post->guid } = $current_index++; + for my $post (@{$self->posts}) { + $index_of_post{$post->guid} = $current_index++; } return \%index_of_post; @@ -644,8 +618,8 @@ sub _build_index_of_post_with_url { my $current_index = 0; - for my $post ( @{ $self->posts } ) { - $index_of_post{ $post->uri } = $current_index++; + for my $post (@{$self->posts}) { + $index_of_post{$post->uri} = $current_index++; } return \%index_of_post; @@ -654,48 +628,41 @@ sub _build_index_of_post_with_url { sub _build_webmention_queue { my $self = shift; - return Plerd::WebmentionQueue->new( plerd => $self ); + return Plerd::WebmentionQueue->new(plerd => $self); } sub _throw_template_exception { - my $self = shift; - my ( $template_file ) = @_; + my ($self, $template_file) = @_; my $error = $self->template->error; - die "Publication interrupted due to an error encountered while processing " - . "template file $template_file: $error\n"; + die "Publication interrupted due to an error encountered while processing " . "template file $template_file: $error\n"; } sub generates_post_guids { - carp "generates_post_guids() is deprecated. (Also, it doesn't do anything " - . "anyway.)"; + carp "generates_post_guids() is deprecated. (Also, it doesn't do anything " . "anyway.)"; + + return; } # Tag-related builders & methods sub _build_tags_index_uri { my $self = shift; - return URI->new_abs( - 'tags/', - $self->base_uri, - ); + return URI->new_abs('tags/', $self->base_uri,); } -sub _build_tags_publication_path { 'tags' } +sub _build_tags_publication_path { return 'tags' } sub _build_tags_publication_directory { my $self = shift; - return $self->_build_subdirectory( 'tags_publication_path', 'docroot' ); + return $self->_build_subdirectory('tags_publication_path', 'docroot'); } sub _build_tags_template_file { my $self = shift; - return Path::Class::File->new( - $self->template_directory, - 'tags.tt', - ); + return Path::Class::File->new($self->template_directory, 'tags.tt',); } sub _build_has_tags { @@ -705,8 +672,7 @@ sub _build_has_tags { if (scalar keys %$tags_map) { return 1; - } - else { + } else { return 0; } @@ -718,34 +684,31 @@ sub tags_publication_file { my ($self, $tag) = @_; $tag //= 'index'; - my $file = Path::Class::File->new($self->publication_directory, - $self->tags_publication_directory, - "$tag.html"); + my $file = Path::Class::File->new($self->publication_directory, $self->tags_publication_directory, "$tag.html"); my $dir = $file->parent->stringify; - if ( !-d $dir) { - mkdir $dir || die ("Cannot make directory: '$dir'. Create it manually, please."); + if (!-d $dir) { + mkdir $dir || die("Cannot make directory: '$dir'. Create it manually, please."); } return $file; } sub tag_named { - my ( $self, $tag_name ) = @_; + my ($self, $tag_name) = @_; my $key = lc $tag_name; - my $tag = $self->tags_map->{ $key }; + my $tag = $self->tags_map->{$key}; - if ( $tag ) { - $tag->ponder_new_name( $tag_name ); - } - else { + if ($tag) { + $tag->ponder_new_name($tag_name); + } else { $tag = Plerd::Tag->new( - name => $tag_name, + name => $tag_name, plerd => $self, ); - $self->tags_map->{ $key } = $tag; + $self->tags_map->{$key} = $tag; } return $tag; @@ -758,45 +721,47 @@ sub publish { } sub tag_uri { - my ( $self, $tag_name ) = @_; + my ($self, $tag_name) = @_; - my $tag = $self->tag_named( $tag_name ); + my $tag = $self->tag_named($tag_name); - if ( $tag ) { + if ($tag) { return $tag->uri; - } - else { + } else { return $self->tags_index_uri; } } sub add_tag_case_conflict { - my ( $self, $conflicting_tag, $existing_tag ) = @_; + my ($self, $conflicting_tag, $existing_tag) = @_; return unless $conflicting_tag ne $existing_tag; $self->tag_case_conflicts->{lc $existing_tag}->{$conflicting_tag} = 1; - $self->tag_case_conflicts->{lc $existing_tag}->{$existing_tag} = 1; + $self->tag_case_conflicts->{lc $existing_tag}->{$existing_tag} = 1; + + return; } sub report_tag_case_conflicts { my $self = shift; - unless ( keys %{$self->tag_case_conflicts} ) { + unless (keys %{$self->tag_case_conflicts}) { return; } my $warning = "This blog's tags include the following case-conflicts:\n"; - foreach ( keys %{$self->tag_case_conflicts} ) { + foreach (keys %{$self->tag_case_conflicts}) { my $conflicts = join ', ', sort keys %{$self->tag_case_conflicts->{$_}}; $warning .= "$conflicts\n"; } - $warning .= "This can lead to unexpected behavior, broken links, and other\n" - . "sadnesses and regrets. Please normalize these tags!\n"; + $warning .= "This can lead to unexpected behavior, broken links, and other\n" . "sadnesses and regrets. Please normalize these tags!\n"; warn $warning; + + return; } 1; From b773e3b6dc76cf9e84306c3b70189eb8e1976ed3 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Sun, 31 May 2020 15:02:53 +0000 Subject: [PATCH 4/6] Post.pm tidy & critic --- lib/Plerd/Post.pm | 518 +++++++++++++++++++++------------------------- 1 file changed, 238 insertions(+), 280 deletions(-) diff --git a/lib/Plerd/Post.pm b/lib/Plerd/Post.pm index 7526fb4..0fbac2e 100644 --- a/lib/Plerd/Post.pm +++ b/lib/Plerd/Post.pm @@ -16,233 +16,231 @@ use Plerd::SmartyPants; use Web::Mention; use Readonly; -Readonly my $WPM => 200; # The words-per-minute reading speed to assume +Readonly my $WPM => 200; # The words-per-minute reading speed to assume Readonly my $WEBMENTIONS_STORE_FILENAME => 'webmentions.json'; has 'plerd' => ( - is => 'ro', + is => 'ro', required => 1, - isa => 'Plerd', + isa => 'Plerd', weak_ref => 1, ); has 'source_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', required => 1, - trigger => \&_process_source_file, + trigger => \&_process_source_file, ); has 'publication_file' => ( - is => 'ro', - isa => 'Path::Class::File', + is => 'ro', + isa => 'Path::Class::File', lazy_build => 1, ); has 'title' => ( - is => 'rw', + is => 'rw', isa => 'Str', ); has 'body' => ( - is => 'rw', + is => 'rw', isa => 'Str', ); has 'stripped_body' => ( - is => 'ro', - isa => 'Str', + is => 'ro', + isa => 'Str', lazy_build => 1, ); has 'stripped_title' => ( - is => 'ro', - isa => 'Str', + is => 'ro', + isa => 'Str', lazy_build => 1, ); has 'attributes' => ( - is => 'rw', + is => 'rw', isa => 'HashRef', ); has 'tag_objects' => ( - is => 'rw', - isa => 'ArrayRef', - default => sub {[]} -); + is => 'rw', + isa => 'ArrayRef', + default => sub { [] }); has 'image' => ( - is => 'rw', - isa => 'Maybe[URI]', + is => 'rw', + isa => 'Maybe[URI]', default => undef, ); has 'image_alt' => ( - is => 'rw', - isa => 'Maybe[Str]', + is => 'rw', + isa => 'Maybe[Str]', default => undef, ); has 'description' => ( - is => 'rw', - isa => 'Str', + is => 'rw', + isa => 'Str', default => '', ); has 'date' => ( - is => 'rw', - isa => 'DateTime', - handles => [ qw( - month - month_name - day - year - ymd - hms - ) ], + is => 'rw', + isa => 'DateTime', + handles => [qw( + month + month_name + day + year + ymd + hms + ) + ], trigger => \&_build_utc_date, ); has 'utc_date' => ( - is => 'rw', - isa => 'DateTime', + is => 'rw', + isa => 'DateTime', lazy_build => 1, ); has 'published_filename' => ( - is => 'rw', - isa => 'Str', + is => 'rw', + isa => 'Str', lazy_build => 1, ); has 'uri' => ( - is => 'ro', - isa => 'URI', + is => 'ro', + isa => 'URI', lazy_build => 1, ); has 'guid' => ( - is => 'rw', + is => 'rw', isa => 'Data::GUID', ); has 'updated_timestamp' => ( - is => 'ro', - isa => 'Str', + is => 'ro', + isa => 'Str', lazy_build => 1, ); has 'published_timestamp' => ( - is => 'ro', - isa => 'Str', + is => 'ro', + isa => 'Str', lazy_build => 1, ); has 'newer_post' => ( - is => 'ro', - isa => 'Maybe[Plerd::Post]', + is => 'ro', + isa => 'Maybe[Plerd::Post]', lazy_build => 1, ); has 'older_post' => ( - is => 'ro', - isa => 'Maybe[Plerd::Post]', + is => 'ro', + isa => 'Maybe[Plerd::Post]', lazy_build => 1, ); has 'reading_time' => ( - is => 'ro', - isa => 'Num', + is => 'ro', + isa => 'Num', lazy_build => 1, ); has 'socialmeta' => ( - is => 'ro', - isa => 'Maybe[HTML::SocialMeta]', + is => 'ro', + isa => 'Maybe[HTML::SocialMeta]', lazy_build => 1, ); has 'social_meta_tags' => ( - is => 'ro', - isa => 'Str', + is => 'ro', + isa => 'Str', lazy_build => 1, ); has 'socialmeta_mode' => ( - is => 'rw', - isa => 'Str', + is => 'rw', + isa => 'Str', default => 'summary', ); has 'webmentions_by_source' => ( - is => 'ro', - isa => 'HashRef', + is => 'ro', + isa => 'HashRef', lazy_build => 1, ); has 'likes' => ( - is => 'ro', - isa => 'ArrayRef[Web::Mention]', + is => 'ro', + isa => 'ArrayRef[Web::Mention]', lazy_build => 1, - traits => ['Array'], - handles => { + traits => ['Array'], + handles => { like_count => 'count', }, ); has 'reposts' => ( - is => 'ro', - isa => 'ArrayRef[Web::Mention]', + is => 'ro', + isa => 'ArrayRef[Web::Mention]', lazy_build => 1, - traits => ['Array'], - handles => { + traits => ['Array'], + handles => { repost_count => 'count', }, ); has 'replies' => ( - is => 'ro', - isa => 'ArrayRef[Web::Mention]', - traits => ['Array'], + is => 'ro', + isa => 'ArrayRef[Web::Mention]', + traits => ['Array'], lazy_build => 1, - handles => { + handles => { reply_count => 'count', }, ); has 'quotations' => ( - is => 'ro', - isa => 'ArrayRef[Web::Mention]', - traits => ['Array'], + is => 'ro', + isa => 'ArrayRef[Web::Mention]', + traits => ['Array'], lazy_build => 1, - handles => { + handles => { quotation_count => 'count', }, ); has 'mentions' => ( - is => 'ro', - isa => 'ArrayRef[Web::Mention]', - traits => ['Array'], + is => 'ro', + isa => 'ArrayRef[Web::Mention]', + traits => ['Array'], lazy_build => 1, - handles => { + handles => { mention_count => 'count', - },); + }, +); has 'json' => ( - is => 'ro', - isa => 'JSON', + is => 'ro', + isa => 'JSON', default => sub { JSON->new->convert_blessed }, ); sub _build_publication_file { my $self = shift; - return Path::Class::File->new( - $self->plerd->publication_directory, - $self->published_filename, - ); + return Path::Class::File->new($self->plerd->publication_directory, $self->published_filename,); } sub _build_published_filename { @@ -252,18 +250,17 @@ sub _build_published_filename { # If the source filename already seems Plerdish, just replace its extension. # Else, generate a Plerdish filename based on the post's date and title. - if ( $filename =~ /^(\d\d\d\d)-(\d\d)-(\d\d)/ ) { + if ($filename =~ /^(\d\d\d\d)-(\d\d)-(\d\d)/) { $filename =~ s/\..*$/.html/; - } - else { + } else { $filename = $self->title; - my $stripper = HTML::Strip->new( emit_spaces => 0 ); - $filename = $stripper->parse( $filename ); + my $stripper = HTML::Strip->new(emit_spaces => 0); + $filename = $stripper->parse($filename); $filename =~ s/\s+/-/g; $filename =~ s/--+/-/g; $filename =~ s/[^\w\-]+//g; $filename = lc $filename; - $filename = $self->date->ymd( q{-} ) . q{-} . $filename; + $filename = $self->date->ymd(q{-}) . q{-} . $filename; $filename .= '.html'; } @@ -277,10 +274,7 @@ sub _build_uri { if ($base_uri =~ /[^\/]$/) { $base_uri .= '/'; } - return URI->new_abs( - $self->published_filename, - $base_uri, - ); + return URI->new_abs($self->published_filename, $base_uri,); } sub _build_updated_timestamp { @@ -302,11 +296,11 @@ sub _build_updated_timestamp { sub _build_newer_post { my $self = shift; - my $index = $self->plerd->index_of_post_with_guid->{ $self->guid }; + my $index = $self->plerd->index_of_post_with_guid->{$self->guid}; my $newer_post; - if ( $index - 1 >= 0 ) { - $newer_post = $self->plerd->posts->[ $index - 1 ]; + if ($index - 1 >= 0) { + $newer_post = $self->plerd->posts->[$index - 1]; } return $newer_post; @@ -315,9 +309,9 @@ sub _build_newer_post { sub _build_older_post { my $self = shift; - my $index = $self->plerd->index_of_post_with_guid->{ $self->guid }; + my $index = $self->plerd->index_of_post_with_guid->{$self->guid}; - my $older_post = $self->plerd->posts->[ $index + 1 ]; + my $older_post = $self->plerd->posts->[$index + 1]; return $older_post; } @@ -326,7 +320,7 @@ sub _build_published_timestamp { my $self = shift; my $formatter = DateTime::Format::W3CDTF->new; - my $timestamp = $formatter->format_datetime( $self->date ); + my $timestamp = $formatter->format_datetime($self->date); return $timestamp; } @@ -342,25 +336,25 @@ sub _build_reading_time { my @words = $self->stripped_body =~ /(\w+)\W*/g; - return int ( scalar(@words) / $WPM ) + 1; + return int(scalar(@words) / $WPM) + 1; } sub _build_stripped_body { my $self = shift; - return $self->_strip_html( $self->body ); + return $self->_strip_html($self->body); } sub _build_stripped_title { my $self = shift; - return $self->_strip_html( $self->title ); + return $self->_strip_html($self->title); } sub _strip_html { my ($self, $raw_text) = @_; - my $stripped = HTML::Strip->new->parse( $raw_text ); + my $stripped = HTML::Strip->new->parse($raw_text); # Clean up apparently orphaned punctuation $stripped =~ s{ ([;.,\?\!])}{$1}g; @@ -371,7 +365,7 @@ sub _strip_html { sub _build_socialmeta { my $self = shift; - unless ( $self->image ) { + unless ($self->image) { # Neither this post nor this whole blog defines an image URL. # So, no social meta-tags for this post. return; @@ -388,17 +382,15 @@ sub _build_socialmeta { image_alt => $self->image_alt, ); - $args{ site } = '@' . $args{ site } if $args{ site }; + $args{site} = '@' . $args{site} if $args{site}; my $socialmeta; try { - $socialmeta = HTML::SocialMeta->new( %args ); + $socialmeta = HTML::SocialMeta->new(%args); } catch { - warn "Couldn't build an HTML::SocialMeta object for post " - . $self->source_file->basename - . ": $_\n"; + warn "Couldn't build an HTML::SocialMeta object for post " . $self->source_file->basename . ": $_\n"; }; return $socialmeta; @@ -410,24 +402,19 @@ sub _build_social_meta_tags { my $tags = ''; my %targets = ( - twitter => 'twitter_id', + twitter => 'twitter_id', opengraph => 'facebook_id', ); - if ( $self->socialmeta ) { - for my $target ( keys %targets ) { - my $id_method = $targets{ $target }; - if ( $self->plerd->$id_method ) { + if ($self->socialmeta) { + for my $target (keys %targets) { + my $id_method = $targets{$target}; + if ($self->plerd->$id_method) { try { - $tags .= - $self->socialmeta->$target->create( - $self->socialmeta_mode - ); + $tags .= $self->socialmeta->$target->create($self->socialmeta_mode); } catch { - warn "Couldn't create $target meta tags for " - . $self->source_file->basename - . ": $_\n"; + warn "Couldn't create $target meta tags for " . $self->source_file->basename . ": $_\n"; }; } } @@ -451,72 +438,66 @@ sub _process_source_file { my $fh = $self->source_file->open('<:encoding(utf8)'); my %attributes; my @ordered_attribute_names = qw( title time published_filename guid tags); - while ( my $line = <$fh> ) { + while (my $line = <$fh>) { chomp $line; last unless $line =~ /\S/; my ($key, $value) = $line =~ /^\s*(\w+?)\s*:\s*(.*?)\s*$/; - if ( $key ) { + if ($key) { $key = lc $key; - $attributes{ $key } = $value; - unless ( grep { $_ eq $key } @ordered_attribute_names ) { + $attributes{$key} = $value; + unless (grep { $_ eq $key } @ordered_attribute_names) { push @ordered_attribute_names, $key; } } } - $self->attributes( \%attributes ); + $self->attributes(\%attributes); my $body; - while ( <$fh> ) { + while (<$fh>) { $body .= $_; } close $fh; - if ( $attributes{ title } ) { - $self->title( $attributes{ title } ); - } - else { - die 'Error processing ' . $self->source_file . ': ' - . 'File content does not define a post title.' - ; + if ($attributes{title}) { + $self->title($attributes{title}); + } else { + die 'Error processing ' . $self->source_file . ': ' . 'File content does not define a post title.'; } - $self->body( $body ); + $self->body($body); - foreach ( qw( title body ) ) { - if ( defined( $self->$_ ) ) { - $self->$_( Plerd::SmartyPants::process( markdown( $self->$_ ) ) ); + foreach (qw( title body )) { + if (defined($self->$_)) { + $self->$_(Plerd::SmartyPants::process(markdown($self->$_))); } } # Strip unnecessary

tags that the markdown processor just added to the title. my $stripped_title = $self->title; $stripped_title =~ s{\s*}{}g; - $self->title( $stripped_title ); + $self->title($stripped_title); # Check and tune attributes used to render social-media metatags. - if ( $attributes{ description } ) { - $self->description( $attributes{ description } ); - } - else { + if ($attributes{description}) { + $self->description($attributes{description}); + } else { my $body = $self->stripped_body; - my ( $description ) = $body =~ /^\s*(.*)\n/; - $self->description( $description || '' ); + my ($description) = $body =~ /^\s*(.*)\n/; + $self->description($description || ''); } - if ( $attributes{ image } ) { - $self->image( URI->new( $attributes{ image } ) ); - $self->image_alt( $attributes{ image_alt } || '' ); - $self->socialmeta_mode( 'featured_image' ); - } - else { - $self->image( $self->plerd->image ); - $self->image_alt( $self->plerd->image_alt || '' ); + if ($attributes{image}) { + $self->image(URI->new($attributes{image})); + $self->image_alt($attributes{image_alt} || ''); + $self->socialmeta_mode('featured_image'); + } else { + $self->image($self->plerd->image); + $self->image_alt($self->plerd->image_alt || ''); } # Note whether the filename asserts the post's publication date. - my ( $filename_year, $filename_month, $filename_day ) = - $self->source_file->basename =~ /^(\d\d\d\d)-(\d\d)-(\d\d)/; + my ($filename_year, $filename_month, $filename_day) = $self->source_file->basename =~ /^(\d\d\d\d)-(\d\d)-(\d\d)/; # Set the post's date, using these rules: # * If the post has a time attribute in W3 format, use that @@ -524,92 +505,87 @@ sub _process_source_file { # and also add a time attribute to the file. # * Else use right now, and also add a time attribute to the file. my $attributes_need_to_be_written_out = 0; - if ( $attributes{ time } ) { - eval { - $self->date( - $self->plerd->datetime_formatter->parse_datetime( $attributes{ time } ) - ); - $self->date->set_time_zone( 'local' ); + if ($attributes{time}) { + my $eval = eval { + $self->date($self->plerd->datetime_formatter->parse_datetime($attributes{time})); + $self->date->set_time_zone('local'); + 1; }; - unless ( $self->date ) { - die 'Error processing ' . $self->source_file . ': ' - . 'The "time" attribute is not in W3C format.' - ; + unless ($self->date && $eval) { + die 'Error processing ' . $self->source_file . ': ' . 'The "time" attribute is not in W3C format.'; } - } - else { + } else { my $publication_dt; - if ( $filename_year ) { + if ($filename_year) { # The post specifies its day in the filename, but we still don't have a # publication hour. # If the filename's date is today (locally), use the current time. # Otherwise, use midnight of the provided date. - my $now = DateTime->now( time_zone => 'local' ); - my $ymd = $now->ymd( q{-} ); - if ( $self->source_file->basename =~ /^$ymd/ ) { + my $now = DateTime->now(time_zone => 'local'); + my $ymd = $now->ymd(q{-}); + if ($self->source_file->basename =~ /^$ymd/) { $publication_dt = $now; - } - else { + } else { $publication_dt = DateTime->new( - year => $filename_year, - month => $filename_month, - day => $filename_day, + year => $filename_year, + month => $filename_month, + day => $filename_day, time_zone => 'local', ); } - } - else { + } else { # The file doesn't name the time, *and* the file doesn't contain the date # in metadata (or else we wouldn't be here), so we'll just use right-now. - $publication_dt = DateTime->now( time_zone => 'local' ); + $publication_dt = DateTime->now(time_zone => 'local'); } - $self->date( $publication_dt ); + $self->date($publication_dt); - my $date_string = - $self->plerd->datetime_formatter->format_datetime( $publication_dt ); + my $date_string = $self->plerd->datetime_formatter->format_datetime($publication_dt); - $attributes{ time } = $date_string; + $attributes{time} = $date_string; $attributes_need_to_be_written_out = 1; } - if ( $attributes{ tags } ) { - my @tag_names = split /\s*,\s*/, $attributes{ tags }; + if ($attributes{tags}) { + my @tag_names = split /\s*,\s*/, $attributes{tags}; for my $tag_name (@tag_names) { - my $tag = $self->plerd->tag_named( $tag_name ); - $tag->add_post( $self ); - push @{ $self->tag_objects }, $tag; + my $tag = $self->plerd->tag_named($tag_name); + $tag->add_post($self); + push @{$self->tag_objects}, $tag; } } - if ( $attributes{ published_filename } ) { - $self->published_filename( $attributes{ published_filename } ); - } - else { - $attributes{ published_filename } = $self->published_filename; + if ($attributes{published_filename}) { + $self->published_filename($attributes{published_filename}); + } else { + $attributes{published_filename} = $self->published_filename; $attributes_need_to_be_written_out = 1; } - if ( $attributes{ guid } ) { - $self->guid( Data::GUID->from_string( $attributes{ guid } ) ); - } - else { - $attributes{ guid } = Data::GUID->new; - $self->guid( $attributes{ guid } ); + if ($attributes{guid}) { + $self->guid(Data::GUID->from_string($attributes{guid})); + } else { + $attributes{guid} = Data::GUID->new; + $self->guid($attributes{guid}); $attributes_need_to_be_written_out = 1; } - if ( $attributes_need_to_be_written_out ) { + if ($attributes_need_to_be_written_out) { my $new_content = ''; - for my $attribute_name ( @ordered_attribute_names ) { - if (defined $attributes{ $attribute_name } ) { + for my $attribute_name (@ordered_attribute_names) { + if (defined $attributes{$attribute_name}) { $new_content .= "$attribute_name: $attributes{ $attribute_name }\n"; } } $new_content .= "\n$body\n"; - $self->source_file->spew( iomode=>'>:encoding(utf8)', $new_content ); + $self->source_file->spew( + iomode => '>:encoding(utf8)', + $new_content + ); } + return; } sub publish { @@ -619,22 +595,23 @@ sub publish { my $stripped_title = $self->title; $stripped_title =~ s{}{}g; - my $html_fh = $self->publication_file->openw; + my $html_fh = $self->publication_file->openw; my $template_fh = $self->plerd->post_template_file->openr; - foreach( $html_fh, $template_fh ) { - $_->binmode(':utf8'); + foreach ($html_fh, $template_fh) { + $_->binmode(':utf8'); } $self->plerd->template->process( $template_fh, { - plerd => $self->plerd, - posts => [ $self ], - title => $stripped_title, + plerd => $self->plerd, + posts => [$self], + title => $stripped_title, context_post => $self, }, - $html_fh, - ) || $self->plerd->_throw_template_exception( $self->plerd->post_template_file ); + $html_fh, + ) || $self->plerd->_throw_template_exception($self->plerd->post_template_file); + return; } sub send_webmentions { @@ -642,20 +619,20 @@ sub send_webmentions { my @wms = Web::Mention->new_from_html( source => $self->uri, - html => $self->body, + html => $self->body, ); my %report = ( - attempts => 0, + attempts => 0, delivered => 0, - sent => 0, + sent => 0, ); - foreach ( @wms ) { + foreach (@wms) { $report{attempts}++; - if ( $_->send ) { + if ($_->send) { $report{delivered}++; } - if ( $_->endpoint ) { + if ($_->endpoint) { $report{sent}++; } } @@ -664,101 +641,84 @@ sub send_webmentions { } sub add_webmention { - my $self = shift; - my ( $webmention ) = @_; + my ($self, $webmention) = @_; - $self->webmentions_by_source->{ $webmention->source } = $webmention; + $self->webmentions_by_source->{$webmention->source} = $webmention; $self->serialize_webmentions; + + return; } sub update_webmention { - return add_webmention( @_ ); + my ($self, $webmention) = @_; + return $self->add_webmention($webmention); } sub delete_webmention { - my $self = shift; - my ( $webmention ) = @_; + my ($self, $webmention) = @_; - delete $self->webmentions_by_source->{ $webmention->source }; + delete $self->webmentions_by_source->{$webmention->source}; $self->serialize_webmentions; + return; } sub serialize_webmentions { my $self = shift; - $self->_store( $WEBMENTIONS_STORE_FILENAME, $self->webmentions_by_source ); + $self->_store($WEBMENTIONS_STORE_FILENAME, $self->webmentions_by_source); + return; } sub ordered_webmentions { my $self = shift; - return sort - {$a->time_published <=> $b->time_published } - values( %{ $self->webmentions_by_source } ) - ; + my $ret = sort { $a->time_published <=> $b->time_published } values(%{$self->webmentions_by_source}); + return $ret; } sub webmention_count { my $self = shift; - return scalar keys %{ $self->webmentions_by_source }; + return scalar keys %{$self->webmentions_by_source}; } sub _build_webmentions_by_source { my $self = shift; - my $webmentions_ref = - $self->_retrieve( - $WEBMENTIONS_STORE_FILENAME, - ) - || {} - ; + my $webmentions_ref = $self->_retrieve($WEBMENTIONS_STORE_FILENAME,) + || {}; - for my $source_url ( keys( %{ $webmentions_ref } ) ) { - my $webmention = Web::Mention->FROM_JSON( - $webmentions_ref->{ $source_url } - ); - $webmentions_ref->{ $source_url } = $webmention; + for my $source_url (keys(%{$webmentions_ref})) { + my $webmention = Web::Mention->FROM_JSON($webmentions_ref->{$source_url}); + $webmentions_ref->{$source_url} = $webmention; } return $webmentions_ref; } sub _store { - my $self = shift; - my ($filename, $data_ref) = @_; + my ($self, $filename, $data_ref) = @_; - my $post_dir = Path::Class::Dir->new( - $self->plerd->database_directory, - $self->guid, - ); + my $post_dir = Path::Class::Dir->new($self->plerd->database_directory, $self->guid,); - unless ( -e $post_dir ) { + unless (-e $post_dir) { $post_dir->mkpath; } - my $file = Path::Class::File->new( - $post_dir, - $filename, - ); - $file->spew( $self->json->utf8->encode( $data_ref ) ); + my $file = Path::Class::File->new($post_dir, $filename,); + $file->spew($self->json->utf8->encode($data_ref)); + return; } sub _retrieve { - my $self = shift; - my ($filename) = @_; + my ($self, $filename) = @_; - my $file = Path::Class::File->new( - $self->plerd->database_directory, - $self->guid, - $filename, - ); + my $file = Path::Class::File->new($self->plerd->database_directory, $self->guid, $filename,); - if ( -e $file ) { - return $self->json->utf8->decode( $file->slurp ); - } - else { - return undef; + if (-e $file) { + return $self->json->utf8->decode($file->slurp); + } else { + return; } } @@ -766,51 +726,49 @@ sub _build_utc_date { my $self = shift; my $dt = $self->date->clone; - $dt->set_time_zone( 'UTC' ); + $dt->set_time_zone('UTC'); return $dt; } sub _build_likes { my $self = shift; - return $self->_grep_webmentions( 'like' ); + return $self->_grep_webmentions('like'); } sub _build_mentions { my $self = shift; - return $self->_grep_webmentions( 'mention' ); + return $self->_grep_webmentions('mention'); } sub _build_replies { my $self = shift; - return $self->_grep_webmentions( 'reply' ); + return $self->_grep_webmentions('reply'); } sub _build_quotations { my $self = shift; - return $self->_grep_webmentions( 'quotation' ); + return $self->_grep_webmentions('quotation'); } sub _build_reposts { my $self = shift; - return $self->_grep_webmentions( 'repost' ); + return $self->_grep_webmentions('repost'); } sub _grep_webmentions { - my ( $self, $webmention_type ) = @_; - return [ - grep { $_->type eq $webmention_type } $self->ordered_webmentions - ]; + my ($self, $webmention_type) = @_; + return [grep { $_->type eq $webmention_type } $self->ordered_webmentions]; } sub tags { my $self = shift; - return [ map { $_->name } @{ $self->tag_objects } ]; + return [map { $_->name } @{$self->tag_objects}]; } 1; From 91b8c1888814a3c3481a02fdb619d5f98761cf8e Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Sun, 31 May 2020 16:57:00 +0000 Subject: [PATCH 5/6] cleanup all packages tidy & critic --- bin/plerdall | 43 +++---- bin/plerdwatcher | 123 +++++++++---------- lib/Plerd/Init.pm | 95 +++++++-------- lib/Plerd/SmartyPants.pm | 174 ++++++++++++--------------- lib/Plerd/Tag.pm | 40 +++--- lib/Plerd/Util.pm | 29 ++--- lib/Plerd/WebmentionQueue.pm | 61 +++++----- t/{perlcritic.t => criticall.t} | 2 +- t/rc/{.perlcriticrc => .criticallrc} | 2 +- t/rc/{.perltidyrc => .tidyallrc} | 2 +- 10 files changed, 259 insertions(+), 312 deletions(-) rename t/{perlcritic.t => criticall.t} (72%) rename t/rc/{.perlcriticrc => .criticallrc} (96%) rename t/rc/{.perltidyrc => .tidyallrc} (95%) diff --git a/bin/plerdall b/bin/plerdall index a5c7241..71b4e6a 100755 --- a/bin/plerdall +++ b/bin/plerdall @@ -6,7 +6,7 @@ use strict; use FindBin; use lib "$FindBin::Bin/../lib", -; + ; use Getopt::Long; @@ -34,34 +34,31 @@ GetOptions( 'init:s' => \$init_path, ); -if ( defined $init_path ) { +if (defined $init_path) { my $is_using_default = 0; - unless ( length $init_path ) { - $init_path = Path::Class::Dir->new( - cwd, - $DEFAULT_INIT_PATH, - )->stringify; + unless (length $init_path) { + $init_path = Path::Class::Dir->new(cwd, $DEFAULT_INIT_PATH,)->stringify; $is_using_default = 1; } - my $messages = Plerd::Init::initialize( $init_path, $is_using_default ); - print wrap( q{}, q{}, @$messages ); + my $messages = Plerd::Init::initialize($init_path, $is_using_default); + print wrap(q{}, q{}, @$messages); print "\n"; exit; } -my $config_ref = Plerd::Util::read_config_file( $config_file ); +my $config_ref = Plerd::Util::read_config_file($config_file); -foreach (qw( base_uri image ) ) { - unless ( ref $config_ref->{ $_ } ) { - $config_ref->{ $_ } = URI->new ( $config_ref->{ $_ } ); +foreach (qw( base_uri image )) { + unless (ref $config_ref->{$_}) { + $config_ref->{$_} = URI->new($config_ref->{$_}); } } -my $plerd = Plerd->new( $config_ref ); +my $plerd = Plerd->new($config_ref); -if ( $rebuild_webmentions ) { - for my $post ( @{ $plerd->posts } ) { - for my $wm ( values %{$post->webmentions_by_source} ) { +if ($rebuild_webmentions) { + for my $post (@{$plerd->posts}) { + for my $wm (values %{$post->webmentions_by_source}) { $wm->verify; sleep 1; } @@ -70,27 +67,25 @@ if ( $rebuild_webmentions ) { } my $new_webmentions_were_added; -if ( $process_webmentions ) { +if ($process_webmentions) { $new_webmentions_were_added = $plerd->webmention_queue->process; } # Proceed to republish all posts (and possibly send out webmentions) only if # we're run without the "process-webmentions" flag, or we are processing # received webmentions and found some new ones to publish. -unless ( $new_webmentions_were_added or !$process_webmentions ) { +unless ($new_webmentions_were_added || !$process_webmentions) { exit; } $plerd->publish_all; -if ( $webmention_enabled ) { +if ($webmention_enabled) { print "Sending webmentions for all posts!\n"; - for my $post ( @{ $plerd->posts } ) { + for my $post (@{$plerd->posts}) { print $post->source_file . "...\n"; my $report = $post->send_webmentions; - print "$report->{attempts} attempts, " - . "$report->{sent} sent, " - . "$report->{delivered} delivered.\n"; + print "$report->{attempts} attempts, " . "$report->{sent} sent, " . "$report->{delivered} delivered.\n"; } } diff --git a/bin/plerdwatcher b/bin/plerdwatcher index bea095f..c06cebf 100755 --- a/bin/plerdwatcher +++ b/bin/plerdwatcher @@ -6,7 +6,7 @@ use strict; use FindBin; use lib "$FindBin::Bin/../lib", -; + ; use File::ChangeNotify; use Path::Class::File; @@ -25,7 +25,7 @@ use Plerd; use Plerd::Util; my $webmention_enabled = 0; -my $webmention_port = 0; +my $webmention_port = 0; my $config_file; my $ssl_cert; my $ssl_key; @@ -38,9 +38,8 @@ GetOptions( ); if ($ssl_cert || $ssl_key) { - unless ( $ssl_cert && $ssl_key ) { - die "Can't start $0: You must define both ssl-cert and ssl-key, " - . "if you define either of them.\n"; + unless ($ssl_cert && $ssl_key) { + die "Can't start $0: You must define both ssl-cert and ssl-key, " . "if you define either of them.\n"; } unless (-r $ssl_cert) { die "Can't start $0: No readable ssl-cert file at $ssl_cert.\n"; @@ -51,27 +50,21 @@ if ($ssl_cert || $ssl_key) { } my $webserver_pid; -$SIG{TERM} = \&handle_term_signal; +local $SIG{TERM} = \&handle_term_signal; $ENV{MOJO_MODE} ||= 'production'; -my $config_ref = Plerd::Util::read_config_file( $config_file ); +my $config_ref = Plerd::Util::read_config_file($config_file); -for my $dir_type ( qw( run log ) ) { - unless ( $config_ref->{ "${dir_type}_path" } ) { - if ( $config_ref->{ path } ) { - $config_ref->{ "${dir_type}_path" } = - Path::Class::File->new( - $config_ref->{path}, - $dir_type, - )->stringify; - } - else { - $config_ref->{ "${dir_type}_path" } = - "$FindBin::Bin/../$dir_type"; +for my $dir_type (qw( run log )) { + unless ($config_ref->{"${dir_type}_path"}) { + if ($config_ref->{path}) { + $config_ref->{"${dir_type}_path"} = Path::Class::File->new($config_ref->{path}, $dir_type,)->stringify; + } else { + $config_ref->{"${dir_type}_path"} = "$FindBin::Bin/../$dir_type"; } } - my $dir = $config_ref->{ "${dir_type}_path" }; + my $dir = $config_ref->{"${dir_type}_path"}; mkdir $dir unless -e $dir; unless (-w $dir) { die "Can't start $0: I don't have write permission to $dir_type " @@ -85,19 +78,19 @@ $App::Daemon::pidfile = "$$config_ref{run_path}/plerdwatcher.pid"; daemonize(); -foreach (qw( base_uri image ) ) { - unless ( ref $config_ref->{ $_ } ) { - $config_ref->{ $_ } = URI->new ( $config_ref->{ $_ } ); +foreach (qw( base_uri image )) { + unless (ref $config_ref->{$_}) { + $config_ref->{$_} = URI->new($config_ref->{$_}); } } my $plerd; my $watcher; try { - $plerd = Plerd->new( $config_ref ); + $plerd = Plerd->new($config_ref); - $watcher = File::ChangeNotify->instantiate_watcher ( - directories => [ $plerd->source_directory . '' ], + $watcher = File::ChangeNotify->instantiate_watcher( + directories => [$plerd->source_directory . ''], filter => qr/\.(md|markdown)$/, ); } @@ -110,57 +103,65 @@ post '/' => sub { my $webmention; try { - $webmention = Web::Mention->new_from_request ( $c ); + $webmention = Web::Mention->new_from_request($c); } catch { - $c->render( status => $BAD_REQUEST, text => "Malformed webmention: $_" ); + $c->render( + status => $BAD_REQUEST, + text => "Malformed webmention: $_" + ); }; return unless $webmention; # If the list of blog source files has changed, force a lazy rebuild of # the plerd object's internal database of posts before continuing. - if ( $watcher->new_events ) { + if ($watcher->new_events) { $plerd->clear_posts; $plerd->clear_post_url_index_hash; } - my $post = $plerd->post_with_url( $webmention->target ); - unless ( $post ) { - $c->render( status => $BAD_REQUEST, text => "Unrecognized target URL." ); + my $post = $plerd->post_with_url($webmention->target); + unless ($post) { + $c->render( + status => $BAD_REQUEST, + text => "Unrecognized target URL." + ); return; } - my $success_text = "Webmention accepted, and queued for verification and " - . "processing. Thank you!"; + my $success_text = "Webmention accepted, and queued for verification and " . "processing. Thank you!"; - my $return_link_url = $c->param( 'target' ); + my $return_link_url = $c->param('target'); my $return_link_text = 'Return to ' . $plerd->title . '.'; $success_text .= qq{ $return_link_text}; - $c->render( status => $ACCEPTED, text => $success_text ); + $c->render( + status => $ACCEPTED, + text => $success_text + ); - $plerd->webmention_queue->add_webmention( $webmention ); + $plerd->webmention_queue->add_webmention($webmention); }; get '/' => sub { my $c = shift; - $c->render( status => $OK, text => 'OK (listening for webmentions)' ); + $c->render( + status => $OK, + text => 'OK (listening for webmentions)' + ); }; -if ( $webmention_port ) { +if ($webmention_port) { $webserver_pid = fork; - unless ( $webserver_pid ) { - app->log->path( "$$config_ref{log_path}/plerdweb.log" ); + unless ($webserver_pid) { + app->log->path("$$config_ref{log_path}/plerdweb.log"); my $listen_uri; - if ( $ssl_cert ) { - $listen_uri = - "https://*:$webmention_port?cert=$ssl_cert&key=$ssl_key"; - } - else { - $listen_uri = - "http://*:$webmention_port"; + if ($ssl_cert) { + $listen_uri = "https://*:$webmention_port?cert=$ssl_cert&key=$ssl_key"; + } else { + $listen_uri = "http://*:$webmention_port"; } app->start( @@ -170,28 +171,22 @@ if ( $webmention_port ) { } } -while ( my @events = $watcher->wait_for_events ) { - if ( @events ) { +while (my @events = $watcher->wait_for_events) { + if (@events) { try { $plerd->publish_all; - for my $event ( @events ) { - if ( - ( - ( $event->type eq 'create' ) - or ( $event->type eq 'modify' ) - ) - and $webmention_enabled - ) { - my $file = Path::Class::File->new( $event->path ); + for my $event (@events) { + if ((($event->type eq 'create') or ($event->type eq 'modify')) + and $webmention_enabled) + { + my $file = Path::Class::File->new($event->path); my $post = Plerd::Post->new( source_file => $file, - plerd => $plerd, + plerd => $plerd, ); INFO "Sending webmentions for $file..."; my $report = $post->send_webmentions; - INFO "$report->{attempts} attempts, " - . "$report->{sent} sent, " - . "$report->{delivered} delivered."; + INFO "$report->{attempts} attempts, " . "$report->{sent} sent, " . "$report->{delivered} delivered."; } } } @@ -202,7 +197,7 @@ while ( my @events = $watcher->wait_for_events ) { } sub handle_term_signal { - kill ('KILL', $webserver_pid) if $webserver_pid; + kill('KILL', $webserver_pid) if $webserver_pid; exit; } diff --git a/lib/Plerd/Init.pm b/lib/Plerd/Init.pm index 164c23b..a2dca50 100644 --- a/lib/Plerd/Init.pm +++ b/lib/Plerd/Init.pm @@ -10,47 +10,37 @@ use Try::Tiny; my %file_content; -sub initialize ( $$ ) { +# Check https://metacpan.org/pod/Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes +sub initialize ( $$ ) { ## no critic my ($init_path, $is_using_default) = @_; my @messages; - my $dir = Path::Class::Dir->new( $init_path )->absolute; + my $dir = Path::Class::Dir->new($init_path)->absolute; - if ( $is_using_default ) { - push @messages, - "No directory provided, so using default location ($dir).\n" + if ($is_using_default) { + push @messages, "No directory provided, so using default location ($dir).\n"; } if (-e $dir) { unless (-d $dir) { - return [ - @messages, - "$dir exists, but it's not a directory!\nExiting." - ]; + return [@messages, "$dir exists, but it's not a directory!\nExiting."]; } - if ( $dir->children ) { - return [ - @messages, - "$dir exists, but it's not empty!\nExiting." - ]; + if ($dir->children) { + return [@messages, "$dir exists, but it's not empty!\nExiting."]; } - } - else { + } else { unless (mkdir $dir) { - return [ - @messages, - "Cannot create $dir: $!" - ]; + return [@messages, "Cannot create $dir: $!"]; } } - my $success = populate_directory( $dir, \@messages ); + my $success = populate_directory($dir, \@messages); - if ( $success ) { - my $config_file = Path::Class::File->new( $dir, 'plerd.conf' ); + if ($success) { + my $config_file = Path::Class::File->new($dir, 'plerd.conf'); push @messages, - "I have created and populated a new Plerd working directory at " + "I have created and populated a new Plerd working directory at " . "$dir. Your next step involves updating the configuration file " . "at $config_file.\n" . "For full documentation, links to mailing lists, and other stuff, " @@ -59,36 +49,35 @@ sub initialize ( $$ ) { return \@messages; } -sub populate_directory ( $$ ) { - my ( $dir, $messages ) = @_; +sub populate_directory ( $$ ) { ## no critic + my ($dir, $messages) = @_; - my %file_content = file_content( $dir ); + my %file_content = file_content($dir); try { - foreach ( qw( docroot source templates log run db conf ) ) { - my $subdir = Path::Class::Dir->new( $dir, $_ ); + foreach (qw( docroot source templates log run db conf )) { + my $subdir = Path::Class::Dir->new($dir, $_); mkdir $subdir or die "Can't create subdir $subdir: $!"; } - foreach ( qw( archive atom jsonfeed post wrapper tags ) ) { - my $template = Path::Class::File->new( - $dir, 'templates', "$_.tt", - ); - $template->spew( iomode=>'>:encoding(utf8)', $file_content{ $_ } ); + foreach (qw( archive atom jsonfeed post wrapper tags )) { + my $template = Path::Class::File->new($dir, 'templates', "$_.tt",); + $template->spew( + iomode => '>:encoding(utf8)', + $file_content{$_}); } - my $config = Path::Class::File->new( - $dir, 'conf', 'plerd.conf', - ); + my $config = Path::Class::File->new($dir, 'conf', 'plerd.conf',); - $config->spew( iomode=>'>:encoding(utf8)', $file_content{ config } ); + $config->spew( + iomode => '>:encoding(utf8)', + $file_content{config}); } catch { push @$messages, $_; - push @$messages, "I am cowardly declining to clean up $dir. You might " - . "need to empty or remove it yourself before trying " - . "this command again."; + push @$messages, + "I am cowardly declining to clean up $dir. You might " . "need to empty or remove it yourself before trying " . "this command again."; push @$messages, "Exiting."; return 0; }; @@ -97,10 +86,10 @@ sub populate_directory ( $$ ) { } -sub file_content ( $ ) { -my ( $dir ) = @_; -%file_content = ( -archive => < < @@ -127,7 +116,7 @@ archive => < < < @@ -155,7 +144,7 @@ atom => < EOF -jsonfeed => < < < < < < EOF -wrapper => < < @@ -428,7 +417,7 @@ wrapper => < EOF -config => <<"EOF", + config => <<"EOF", # This is a configuration file for a single Plerd-based blog! # # Update the values below to best suit your blogging needs. After that, @@ -501,7 +490,7 @@ image_alt: "My Cool Blog's logo -- a photograph of Fido, the author's gray tabby # run_path: /tmp/plerd/run # log_path: /var/log/plerd/ EOF -tags => < < < or tags. @@ -118,18 +111,17 @@ sub process { # character quote tokens correctly. foreach my $cur_token (@$tokens) { - if ( $cur_token->[0] eq "tag" ) { + if ($cur_token->[0] eq "tag") { # Don't mess with quotes inside tags. $result .= $cur_token->[1]; - if ( $cur_token->[1] =~ m/$tags_to_skip/ ) { + if ($cur_token->[1] =~ m/$tags_to_skip/) { $in_pre = defined $1 && $1 eq '/' ? 0 : 1; } - } - else { + } else { my $t = $cur_token->[1]; - my $last_char = substr( $t, -1 ); # Remember last char of this token before processing. - if ( !$in_pre ) { + my $last_char = substr($t, -1); # Remember last char of this token before processing. + if (!$in_pre) { $t = ProcessEscapes($t); if ($convert_quot) { @@ -137,9 +129,9 @@ sub process { } if ($do_dashes) { - $t = EducateDashes($t) if ( $do_dashes == 1 ); - $t = EducateDashesOldSchool($t) if ( $do_dashes == 2 ); - $t = EducateDashesOldSchoolInverted($t) if ( $do_dashes == 3 ); + $t = EducateDashes($t) if ($do_dashes == 1); + $t = EducateDashesOldSchool($t) if ($do_dashes == 2); + $t = EducateDashesOldSchoolInverted($t) if ($do_dashes == 3); } $t = EducateEllipses($t) if $do_ellipses; @@ -147,31 +139,27 @@ sub process { # Notes: backticks need to be processed before quotes. if ($do_backticks) { $t = EducateBackticks($t); - $t = EducateSingleBackticks($t) if ( $do_backticks == 2 ); + $t = EducateSingleBackticks($t) if ($do_backticks == 2); } if ($do_quotes) { - if ( $t eq q/'/ ) { + if ($t eq q/'/) { # Special case: single-character ' token - if ( $prev_token_last_char =~ m/\S/ ) { + if ($prev_token_last_char =~ m/\S/) { $t = "’"; - } - else { + } else { $t = "‘"; } - } - elsif ( $t eq q/"/ ) { + } elsif ($t eq q/"/) { # Special case: single-character " token - if ( $prev_token_last_char =~ m/\S/ ) { + if ($prev_token_last_char =~ m/\S/) { $t = "”"; - } - else { + } else { $t = "“"; } - } - else { + } else { # Normal case: $t = EducateQuotes($t); @@ -202,17 +190,15 @@ sub SmartQuotes { my $do_backticks; # should we educate ``backticks'' -style quotes? - if ( $attr == 0 ) { + if ($attr == 0) { # do nothing; return $text; - } - elsif ( $attr == 2 ) { + } elsif ($attr == 2) { # smarten ``backticks'' -style quotes $do_backticks = 1; - } - else { + } else { $do_backticks = 0; } @@ -220,12 +206,13 @@ sub SmartQuotes { # an HTML tag. Add a space to give the quote education algorithm a bit of # context, so that it can guess correctly that it's a closing quote: my $add_extra_space = 0; - if ( $text =~ m/>['"]\z/ ) { + if ($text =~ m/>['"]\z/) { $add_extra_space = 1; # Remember, so we can trim the extra space later. $text .= " "; } - my $tokens ||= _tokenize($text); + my $tokens; + $tokens ||= _tokenize($text); my $result = ''; my $in_pre = 0; # Keep track of when we're inside 

 or  tags
 
@@ -237,44 +224,39 @@ sub SmartQuotes {
                                       # character quote tokens correctly.
 
     foreach my $cur_token (@$tokens) {
-        if ( $cur_token->[0] eq "tag" ) {
+        if ($cur_token->[0] eq "tag") {
 
             # Don't mess with quotes inside tags
             $result .= $cur_token->[1];
-            if ( $cur_token->[1] =~ m/$tags_to_skip/ ) {
+            if ($cur_token->[1] =~ m/$tags_to_skip/) {
                 $in_pre = defined $1 && $1 eq '/' ? 0 : 1;
             }
-        }
-        else {
+        } else {
             my $t = $cur_token->[1];
-            my $last_char = substr( $t, -1 );    # Remember last char of this token before processing.
-            if ( !$in_pre ) {
+            my $last_char = substr($t, -1);    # Remember last char of this token before processing.
+            if (!$in_pre) {
                 $t = ProcessEscapes($t);
                 if ($do_backticks) {
                     $t = EducateBackticks($t);
                 }
 
-                if ( $t eq q/'/ ) {
+                if ($t eq q/'/) {
 
                     # Special case: single-character ' token
-                    if ( $prev_token_last_char =~ m/\S/ ) {
+                    if ($prev_token_last_char =~ m/\S/) {
                         $t = "’";
-                    }
-                    else {
+                    } else {
                         $t = "‘";
                     }
-                }
-                elsif ( $t eq q/"/ ) {
+                } elsif ($t eq q/"/) {
 
                     # Special case: single-character " token
-                    if ( $prev_token_last_char =~ m/\S/ ) {
+                    if ($prev_token_last_char =~ m/\S/) {
                         $t = "”";
-                    }
-                    else {
+                    } else {
                         $t = "“";
                     }
-                }
-                else {
+                } else {
 
                     # Normal case:
                     $t = EducateQuotes($t);
@@ -301,23 +283,21 @@ Call the individual dash conversion to entities functions.
 sub SmartDashes {
 
     # Paramaters:
-    my $text = shift;          # text to be parsed
-    my $attr = shift;          # value of the smart_dashes="" attribute
+    my $text = shift;    # text to be parsed
+    my $attr = shift;    # value of the smart_dashes="" attribute
 
     # reference to the subroutine to use for dash education, default to EducateDashes:
     my $dash_sub_ref = \&EducateDashes;
 
-    if ( $attr == 0 ) {
+    if ($attr == 0) {
 
         # do nothing;
         return $text;
-    }
-    elsif ( $attr == 2 ) {
+    } elsif ($attr == 2) {
 
         # use old smart dash shortcuts, "--" for en, "---" for em
         $dash_sub_ref = \&EducateDashesOldSchool;
-    }
-    elsif ( $attr == 3 ) {
+    } elsif ($attr == 3) {
 
         # inverse of 2, "--" for em, "---" for en
         $dash_sub_ref = \&EducateDashesOldSchoolInverted;
@@ -329,17 +309,16 @@ sub SmartDashes {
     my $result = '';
     my $in_pre = 0;    # Keep track of when we're inside 
 or  tags
     foreach my $cur_token (@$tokens) {
-        if ( $cur_token->[0] eq "tag" ) {
+        if ($cur_token->[0] eq "tag") {
 
             # Don't mess with quotes inside tags
             $result .= $cur_token->[1];
-            if ( $cur_token->[1] =~ m/$tags_to_skip/ ) {
+            if ($cur_token->[1] =~ m/$tags_to_skip/) {
                 $in_pre = defined $1 && $1 eq '/' ? 0 : 1;
             }
-        }
-        else {
+        } else {
             my $t = $cur_token->[1];
-            if ( !$in_pre ) {
+            if (!$in_pre) {
                 $t = ProcessEscapes($t);
                 $t = $dash_sub_ref->($t);
             }
@@ -361,7 +340,7 @@ sub SmartEllipses {
     my $text = shift;    # text to be parsed
     my $attr = shift;    # value of the smart_ellipses="" attribute
 
-    if ( $attr == 0 ) {
+    if ($attr == 0) {
 
         # do nothing;
         return $text;
@@ -373,17 +352,16 @@ sub SmartEllipses {
     my $result = '';
     my $in_pre = 0;      # Keep track of when we're inside 
 or  tags
     foreach my $cur_token (@$tokens) {
-        if ( $cur_token->[0] eq "tag" ) {
+        if ($cur_token->[0] eq "tag") {
 
             # Don't mess with quotes inside tags
             $result .= $cur_token->[1];
-            if ( $cur_token->[1] =~ m/$tags_to_skip/ ) {
+            if ($cur_token->[1] =~ m/$tags_to_skip/) {
                 $in_pre = defined $1 && $1 eq '/' ? 0 : 1;
             }
-        }
-        else {
+        } else {
             my $t = $cur_token->[1];
-            if ( !$in_pre ) {
+            if (!$in_pre) {
                 $t = ProcessEscapes($t);
                 $t = EducateEllipses($t);
             }
@@ -432,7 +410,7 @@ sub EducateQuotes {
     #     substitution below trips it. The best thing to do would involve
     #     substituting with e.g. {$1 // q[] . q[']}e, but that would require
     #     Perl 5.10 or above and I'm not prepared to require that just yet.
-    no warnings 'uninitialized';
+    no warnings 'uninitialized';    ## no critic
 
     # Single closing quotes:
     s {
@@ -652,18 +630,18 @@ sub _tokenize {
     # pattern to match balanced nested <> pairs, up to two levels deep:
     my $nested_angles = qr/<(?:[^<>]|<[^<>]*>)*>/;
 
-    while ( $str =~ m/($nested_angles)/gs ) {
+    while ($str =~ m/($nested_angles)/gs) {
         my $whole_tag = $1;
         my $sec_start = pos $str;
         my $tag_start = $sec_start - length $whole_tag;
-        if ( $pos < $tag_start ) {
-            push @tokens, [ 'text', substr( $str, $pos, $tag_start - $pos ) ];
+        if ($pos < $tag_start) {
+            push @tokens, ['text', substr($str, $pos, $tag_start - $pos)];
         }
-        push @tokens, [ 'tag', $whole_tag ];
+        push @tokens, ['tag', $whole_tag];
         $pos = pos $str;
     }
-    push @tokens, [ 'text', substr( $str, $pos, $len - $pos ) ] if $pos < $len;
-    \@tokens;
+    push @tokens, ['text', substr($str, $pos, $len - $pos)] if $pos < $len;
+    return \@tokens;
 }
 
 1;
diff --git a/lib/Plerd/Tag.pm b/lib/Plerd/Tag.pm
index 1be22af..8b43470 100644
--- a/lib/Plerd/Tag.pm
+++ b/lib/Plerd/Tag.pm
@@ -4,27 +4,27 @@ use Moose;
 use URI;
 
 has 'plerd' => (
-    is => 'ro',
+    is       => 'ro',
     required => 1,
-    isa => 'Plerd',
+    isa      => 'Plerd',
     weak_ref => 1,
 );
 
 has 'posts' => (
-    is => 'ro',
-    isa => 'ArrayRef[Plerd::Post]',
+    is      => 'ro',
+    isa     => 'ArrayRef[Plerd::Post]',
     default => sub { [] },
 );
 
 has 'name' => (
-    is => 'rw',
-    isa => 'Str',
+    is       => 'rw',
+    isa      => 'Str',
     required => 1,
 );
 
 has 'uri' => (
-    is => 'ro',
-    isa => 'URI',
+    is         => 'ro',
+    isa        => 'URI',
     lazy_build => 1,
 );
 
@@ -32,9 +32,9 @@ sub add_post {
     my ($self, $post) = @_;
 
     my $added = 0;
-    if ( @{$self->posts} ) {
-        for (my $index = 0; $index <= @{$self->posts} - 1; $index++ ) {
-            if ( $self->posts->[$index]->date < $post->date ) {
+    if (@{$self->posts}) {
+        for (my $index = 0; $index <= @{$self->posts} - 1; $index++) {
+            if ($self->posts->[$index]->date < $post->date) {
                 splice @{$self->posts}, $index, 0, $post;
                 $added = 1;
                 last;
@@ -45,6 +45,7 @@ sub add_post {
     unless ($added) {
         push @{$self->posts}, $post;
     }
+    return;
 }
 
 sub ponder_new_name {
@@ -52,25 +53,22 @@ sub ponder_new_name {
 
     my $current_name = $self->name;
 
-    if ( $current_name eq $new_name ) {
+    if ($current_name eq $new_name) {
         return;
-    }
-    else {
-        $self->plerd->add_tag_case_conflict( $new_name, $current_name );
-        if ( not ($current_name =~ /[[:upper:]]/) ) {
-            $self->name( $new_name );
+    } else {
+        $self->plerd->add_tag_case_conflict($new_name, $current_name);
+        if (not($current_name =~ /[[:upper:]]/)) {
+            $self->name($new_name);
 
         }
     }
+    return;
 }
 
 sub _build_uri {
     my $self = shift;
 
-    return URI->new_abs(
-        'tags/' . $self->name . '.html',
-        $self->plerd->base_uri,
-    );
+    return URI->new_abs('tags/' . $self->name . '.html', $self->plerd->base_uri,);
 }
 
 1;
diff --git a/lib/Plerd/Util.pm b/lib/Plerd/Util.pm
index 3eff5c7..cf581bc 100644
--- a/lib/Plerd/Util.pm
+++ b/lib/Plerd/Util.pm
@@ -15,27 +15,22 @@ use Path::Class::File;
 #                   needed, then try to parse it as YAML and return the
 #                   resulting data structure.
 sub read_config_file {
-    my ( $config_file ) = @_;
+    my ($config_file) = @_;
 
-    unless ( defined $config_file ) {
+    unless (defined $config_file) {
         # As fallback config locations, try ./plerd.conf, conf/plerd.conf,
         # ~/.plerd, then (for historical reasons) $bin/../conf/plerd.conf.
         # Then give up.
-        my $local_file = Path::Class::File->new( getcwd, 'plerd.conf' );
-        my $nearby_file = Path::Class::File->new( getcwd, 'conf', 'plerd.conf' );
-        my $dotfile = Path::Class::File->new( File::HomeDir->my_home, '.plerd' );
-        foreach (
-            $local_file,
-            $nearby_file,
-            $dotfile,
-            "$FindBin::Bin/../conf/plerd.conf",
-        ) {
-            if ( -r $_ ) {
+        my $local_file  = Path::Class::File->new(getcwd,                 'plerd.conf');
+        my $nearby_file = Path::Class::File->new(getcwd,                 'conf', 'plerd.conf');
+        my $dotfile     = Path::Class::File->new(File::HomeDir->my_home, '.plerd');
+        foreach ($local_file, $nearby_file, $dotfile, "$FindBin::Bin/../conf/plerd.conf",) {
+            if (-r $_) {
                 $config_file = $_;
                 last;
             }
         }
-        unless ( defined $config_file ) {
+        unless (defined $config_file) {
             die "Can't start $0: I can't find a Plerd config file in "
                 . "$local_file, $nearby_file, $dotfile, or in "
                 . "$FindBin::Bin/../conf/plerd.conf, and "
@@ -45,16 +40,16 @@ sub read_config_file {
 
     my $config_ref;
     try {
-        $config_ref = LoadFile( $config_file );
+        $config_ref = LoadFile($config_file);
     }
     catch {
-        if ( -r $config_file ) {
+        if (-r $config_file) {
             die "Can't start $0: Can't read config file at $config_file: $_\n";
-        }
-        else {
+        } else {
             die "Can't start $0: No readable config file found at $config_file.\n";
         }
     };
+    return;
 }
 
 1;
diff --git a/lib/Plerd/WebmentionQueue.pm b/lib/Plerd/WebmentionQueue.pm
index 11e4c91..f8334de 100644
--- a/lib/Plerd/WebmentionQueue.pm
+++ b/lib/Plerd/WebmentionQueue.pm
@@ -13,15 +13,15 @@ use Readonly;
 Readonly my $DEFAULT_DIR_NAME => 'webmention_inbox';
 
 has 'plerd' => (
-    is => 'ro',
+    is       => 'ro',
     required => 1,
-    isa => 'Plerd',
+    isa      => 'Plerd',
     weak_ref => 1,
 );
 
 has 'directory' => (
-    is => 'ro',
-    isa => 'Path::Class::Dir',
+    is         => 'ro',
+    isa        => 'Path::Class::Dir',
     lazy_build => 1,
 );
 
@@ -30,18 +30,17 @@ sub process () {
 
     my $return_value = 0;
 
-    for my $wm ( $self->all_webmentions ) {
-        my $post = $self->plerd->post_with_url( $wm->target );
-        if ( $wm->is_verified ) {
-            $post->add_webmention( $wm );
-	    $return_value = 1;
-        }
-        else {
+    for my $wm ($self->all_webmentions) {
+        my $post = $self->plerd->post_with_url($wm->target);
+        if ($wm->is_verified) {
+            $post->add_webmention($wm);
+            $return_value = 1;
+        } else {
             # It's possible that the post has this webmention from earlier,
             # and we've received an intentionally invalid update of it, due
             # to e.g. the source getting updated and removing a citation.
             # To cover that case, we ask the post to delete this mention.
-            $post->delete_webmention( $wm );
+            $post->delete_webmention($wm);
         }
     }
 
@@ -50,35 +49,34 @@ sub process () {
     return $return_value;
 }
 
-sub add_webmention ( $ ) {
-    my $self = shift;
+sub add_webmention ( $ ) {    ## no critic
+    my ($self, $wm) = @_;
 
-    my ( $wm ) = @_;
-    unless ( blessed($wm) && $wm->isa( "Web::Mention" ) ) {
+    unless (blessed($wm) && $wm->isa("Web::Mention")) {
         croak "Not a Web::Mention object!";
     }
 
-    my $json = JSON->new->utf8->convert_blessed->encode( $wm );
+    my $json = JSON->new->utf8->convert_blessed->encode($wm);
 
-    my $file = Path::Class::File->new(
-        $self->directory,
-        Data::GUID->new,
-    );
+    my $file = Path::Class::File->new($self->directory, Data::GUID->new,);
 
-    $file->spew(iomode => '>:encoding(UTF-8)', $json );
+    $file->spew(
+        iomode => '>:encoding(UTF-8)',
+        $json
+    );
 }
 
 sub all_webmentions () {
     my $self = shift;
 
     my @wms;
-    for my $file ( $self->directory->children(no_hidden=>1) ) {
+    for my $file ($self->directory->children(no_hidden => 1)) {
         try {
-            push @wms, Web::Mention->FROM_JSON( decode_json( $file->slurp(iomode => '<:encoding(UTF-8)')) );
+            push @wms, Web::Mention->FROM_JSON(decode_json($file->slurp(iomode => '<:encoding(UTF-8)')));
         }
-	catch {
-	    die "Failed to deserialize the webmention at $file: $_\n";
-	};
+        catch {
+            die "Failed to deserialize the webmention at $file: $_\n";
+        };
     }
 
     return @wms;
@@ -87,18 +85,17 @@ sub all_webmentions () {
 sub clear_webmentions () {
     my $self = shift;
 
-    for my $file ( $self->directory->children(no_hidden=>1) ) {
+    for my $file ($self->directory->children(no_hidden => 1)) {
         $file->remove;
     }
+
+    return;
 }
 
 sub _build_directory {
     my $self = shift;
 
-    my $dir = Path::Class::Dir->new(
-        $self->plerd->database_directory,
-        $DEFAULT_DIR_NAME,
-    );
+    my $dir = Path::Class::Dir->new($self->plerd->database_directory, $DEFAULT_DIR_NAME,);
 
     unless (-e $dir) {
         mkdir $dir;
diff --git a/t/perlcritic.t b/t/criticall.t
similarity index 72%
rename from t/perlcritic.t
rename to t/criticall.t
index 37de98d..9a3adbf 100644
--- a/t/perlcritic.t
+++ b/t/criticall.t
@@ -2,5 +2,5 @@ if (!require Test::Perl::Critic) {
     Test::More::plan(skip_all => "Test::Perl::Critic required for testing PBP compliance");
 }
 
-Test::Perl::Critic->import(-profile => 't/rc/.perlcriticrc');
+Test::Perl::Critic->import(-profile => 't/rc/.criticallrc');
 Test::Perl::Critic::all_critic_ok();
diff --git a/t/rc/.perlcriticrc b/t/rc/.criticallrc
similarity index 96%
rename from t/rc/.perlcriticrc
rename to t/rc/.criticallrc
index 0307901..e8bcfe6 100644
--- a/t/rc/.perlcriticrc
+++ b/t/rc/.criticallrc
@@ -14,7 +14,7 @@ short_subroutine_statements=3
 allow=refs
 
 [CodeLayout::RequireTidyCode]
-perltidyrc=t/rc/.perltidyrc
+perltidyrc=t/rc/.tidyallrc
 
 [ErrorHandling::RequireCheckingReturnValueOfEval]
 severity=4
diff --git a/t/rc/.perltidyrc b/t/rc/.tidyallrc
similarity index 95%
rename from t/rc/.perltidyrc
rename to t/rc/.tidyallrc
index 3a6cfa1..e5b5832 100644
--- a/t/rc/.perltidyrc
+++ b/t/rc/.tidyallrc
@@ -1,4 +1,4 @@
-#line length; keep it quite short so that lists of arguments to subs
+#line length;
 #are wrapped
 --maximum-line-length=150
 

From 51285dfd5759df1056c05a53e52429296708eeef Mon Sep 17 00:00:00 2001
From: Ubuntu 
Date: Sat, 6 Jun 2020 06:54:36 +0000
Subject: [PATCH 6/6] solves #32