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; diff --git a/lib/Plerd/SmartyPants.pm b/lib/Plerd/SmartyPants.pm index f8b7982..dbbfcba 100644 --- a/lib/Plerd/SmartyPants.pm +++ b/lib/Plerd/SmartyPants.pm @@ -25,16 +25,13 @@ Do the bulk of the conversion work. =cut sub process { - shift if ( $_[0] eq __PACKAGE__ ); # oops, called in OOP fashion. - - # Paramaters: - my $text = shift; # text to be parsed + my ($text, $attr) = @_; + die("Can't be called in OOP context!") if $text eq __PACKAGE__; # value of the smart_quotes="" attribute. Default to 'everything on' - my $attr = shift || '1'; - + $attr //= 1; # Options to specify which transformations to make: - my ( $do_quotes, $do_backticks, $do_dashes, $do_ellipses, $do_stupefy ); + my ($do_quotes, $do_backticks, $do_dashes, $do_ellipses, $do_stupefy); # should we translate " entities into normal quotes? my $convert_quot = 0; @@ -54,51 +51,46 @@ sub process { # e : ellipses # w : convert " entities to " for Dreamweaver users - if ( $attr eq "0" ) { + if ($attr eq "0") { # Do nothing. return $text; - } - elsif ( $attr eq "1" ) { + } elsif ($attr eq "1") { # Do everything, turn all options on. $do_quotes = 1; $do_backticks = 1; $do_dashes = 1; $do_ellipses = 1; - } - elsif ( $attr eq "2" ) { + } elsif ($attr eq "2") { # Do everything, turn all options on, use old school dash shorthand. $do_quotes = 1; $do_backticks = 1; $do_dashes = 2; $do_ellipses = 1; - } - elsif ( $attr eq "3" ) { + } elsif ($attr eq "3") { # Do everything, turn all options on, use inverted old school dash shorthand. $do_quotes = 1; $do_backticks = 1; $do_dashes = 3; $do_ellipses = 1; - } - elsif ( $attr eq "-1" ) { + } elsif ($attr eq "-1") { # Special "stupefy" mode. $do_stupefy = 1; - } - else { - my @chars = split( //, $attr ); + } else { + my @chars = split(//, $attr); foreach my $c (@chars) { - if ( $c eq "q" ) { $do_quotes = 1; } - elsif ( $c eq "b" ) { $do_backticks = 1; } - elsif ( $c eq "B" ) { $do_backticks = 2; } - elsif ( $c eq "d" ) { $do_dashes = 1; } - elsif ( $c eq "D" ) { $do_dashes = 2; } - elsif ( $c eq "i" ) { $do_dashes = 3; } - elsif ( $c eq "e" ) { $do_ellipses = 1; } - elsif ( $c eq "w" ) { $convert_quot = 1; } + if ($c eq "q") { $do_quotes = 1; } + elsif ($c eq "b") { $do_backticks = 1; } + elsif ($c eq "B") { $do_backticks = 2; } + elsif ($c eq "d") { $do_dashes = 1; } + elsif ($c eq "D") { $do_dashes = 2; } + elsif ($c eq "i") { $do_dashes = 3; } + elsif ($c eq "e") { $do_ellipses = 1; } + elsif ($c eq "w") { $convert_quot = 1; } else { # Unknown attribute option, ignore. @@ -106,7 +98,8 @@ sub process { } } - my $tokens ||= _tokenize($text); + my $tokens; + $tokens ||= _tokenize($text); my $result = ''; my $in_pre = 0; # Keep track of when we're inside
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/criticall.t b/t/criticall.t
new file mode 100644
index 0000000..9a3adbf
--- /dev/null
+++ b/t/criticall.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/.criticallrc');
+Test::Perl::Critic::all_critic_ok();
diff --git a/t/rc/.criticallrc b/t/rc/.criticallrc
new file mode 100644
index 0000000..e8bcfe6
--- /dev/null
+++ b/t/rc/.criticallrc
@@ -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/.tidyallrc
+
+[ErrorHandling::RequireCheckingReturnValueOfEval]
+severity=4
+
+[TestingAndDebugging::RequireUseStrict]
+equivalent_modules=MooseX::Singleton Mojo::Base
diff --git a/t/rc/.tidyallrc b/t/rc/.tidyallrc
new file mode 100644
index 0000000..e5b5832
--- /dev/null
+++ b/t/rc/.tidyallrc
@@ -0,0 +1,63 @@
+#line length;
+#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
+