Mass Tidy

.perltidyrc

@@ -0,0 +1,8 @@
+-l=400
+-i=4
+-dt=4
+-it=4
+-bar
+-nsfs
+-nolq
+--break-at-old-comma-breakpoint

lib/TCMS.pm

@@ -17,7 +17,7 @@ use DateTime::Format::HTTP();
 use CGI::Cookie ();
 use File::Basename();
 use IO::Compress::Gzip();
-use Time::HiRes qw{gettimeofday tv_interval};
+use Time::HiRes      qw{gettimeofday tv_interval};
 use HTTP::Parser::XS qw{HEADERS_AS_HASHREF};
 use List::Util;
 
@@ -36,13 +36,13 @@ use Trog::Vars;
 
 # Import the routes
 
-my $conf = Trog::Config::get();
-my $data = Trog::Data->new($conf);
+my $conf  = Trog::Config::get();
+my $data  = Trog::Data->new($conf);
 my %roots = $data->routes();
 
 my %routes = %Trog::Routes::HTML::routes;
-@routes{keys(%Trog::Routes::JSON::routes)} = values(%Trog::Routes::JSON::routes);
-@routes{keys(%roots)} = values(%roots);
+@routes{ keys(%Trog::Routes::JSON::routes) } = values(%Trog::Routes::JSON::routes);
+@routes{ keys(%roots) }                      = values(%roots);
 
 my %aliases = $data->aliases();
 
@@ -70,23 +70,24 @@ If a path passed is not a defined route (or regex route), but exists as a file u
 =cut
 
 sub app {
+
     # Start the server timing clock
     my $start = [gettimeofday];
 
     my $env = shift;
 
-    return _toolong() if length($env->{REQUEST_URI}) > 2048;
+    return _toolong() if length( $env->{REQUEST_URI} ) > 2048;
 
     # Check eTags.  If we don't know about it, just assume it's good and lazily fill the cache
     # XXX yes, this allows cache poisoning...but only for logged in users!
-    if ($env->{HTTP_IF_NONE_MATCH}) {
-        return [304, [], ['']] if $env->{HTTP_IF_NONE_MATCH} eq ($etags{$env->{REQUEST_URI}} || '');
-        $etags{$env->{REQUEST_URI}} = $env->{HTTP_IF_NONE_MATCH} unless exists $etags{$env->{REQUEST_URI}};
+    if ( $env->{HTTP_IF_NONE_MATCH} ) {
+        return [ 304, [], [''] ] if $env->{HTTP_IF_NONE_MATCH} eq ( $etags{ $env->{REQUEST_URI} } || '' );
+        $etags{ $env->{REQUEST_URI} } = $env->{HTTP_IF_NONE_MATCH} unless exists $etags{ $env->{REQUEST_URI} };
     }
 
     my $last_fetch = 0;
-    if ($env->{HTTP_IF_MODIFIED_SINCE}) {
-        $last_fetch = DateTime::Format::HTTP->parse_datetime($env->{HTTP_IF_MODIFIED_SINCE})->epoch();
+    if ( $env->{HTTP_IF_MODIFIED_SINCE} ) {
+        $last_fetch = DateTime::Format::HTTP->parse_datetime( $env->{HTTP_IF_MODIFIED_SINCE} )->epoch();
     }
 
     #XXX Don't use statics anything that has a search query
@@ -95,22 +96,22 @@ sub app {
     my $has_query = !!$env->{QUERY_STRING};
 
     my $query = {};
-    $query = URL::Encode::url_params_mixed($env->{QUERY_STRING}) if $env->{QUERY_STRING};
+    $query = URL::Encode::url_params_mixed( $env->{QUERY_STRING} ) if $env->{QUERY_STRING};
 
     #Actually parse the POSTDATA and dump it into the QUERY object if this is a POST
-    if ($env->{REQUEST_METHOD} eq 'POST') {
+    if ( $env->{REQUEST_METHOD} eq 'POST' ) {
 
         my $body = HTTP::Body->new( $env->{CONTENT_TYPE}, $env->{CONTENT_LENGTH} );
-        while ( $env->{'psgi.input'}->read(my $buf, $CHUNK_SIZE) ) {
+        while ( $env->{'psgi.input'}->read( my $buf, $CHUNK_SIZE ) ) {
             $body->add($buf);
         }
 
-        @$query{keys(%{$body->param})}  = values(%{$body->param});
-        @$query{keys(%{$body->upload})} = values(%{$body->upload});
+        @$query{ keys( %{ $body->param } ) }  = values( %{ $body->param } );
+        @$query{ keys( %{ $body->upload } ) } = values( %{ $body->upload } );
     }
 
     # Grab the list of ACLs we want to add to a post, if any.
-    $query->{acls} = [$query->{acls}] if ($query->{acls} && ref $query->{acls} ne 'ARRAY');
+    $query->{acls} = [ $query->{acls} ] if ( $query->{acls} && ref $query->{acls} ne 'ARRAY' );
 
     my $path = $env->{PATH_INFO};
     $path = '/index' if $path eq '/';
@@ -122,7 +123,7 @@ sub app {
     my $alist = $env->{HTTP_ACCEPT_ENCODING} || '';
     $alist =~ s/\s//g;
     my @accept_encodings;
-    @accept_encodings = split(/,/, $alist);
+    @accept_encodings = split( /,/, $alist );
     my $deflate = grep { 'gzip' eq $_ } @accept_encodings;
 
     # Collapse multiple slashes in the path
@@ -132,23 +133,23 @@ sub app {
     return $routes{default}{callback}->($query) unless -f "config/setup";
 
     my $cookies = {};
-    if ($env->{HTTP_COOKIE}) {
-        $cookies = CGI::Cookie->parse($env->{HTTP_COOKIE});
+    if ( $env->{HTTP_COOKIE} ) {
+        $cookies = CGI::Cookie->parse( $env->{HTTP_COOKIE} );
     }
 
     my $active_user = '';
-    if (exists $cookies->{tcmslogin}) {
-         $active_user = Trog::Auth::session2user($cookies->{tcmslogin}->value);
+    if ( exists $cookies->{tcmslogin} ) {
+        $active_user = Trog::Auth::session2user( $cookies->{tcmslogin}->value );
     }
     $query->{user_acls} = [];
     $query->{user_acls} = Trog::Auth::acls4user($active_user) // [] if $active_user;
 
     # Filter out passed ACLs which are naughty
-    my $is_admin = grep { $_ eq 'admin' } @{$query->{user_acls}};
-    @{$query->{acls}} = grep { $_ ne 'admin' } @{$query->{acls}} unless $is_admin;
+    my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    @{ $query->{acls} } = grep { $_ ne 'admin' } @{ $query->{acls} } unless $is_admin;
 
     # Disallow any paths that are naughty ( starman auto-removes .. up-traversal)
-    if (index($path,'/templates') == 0 || index($path, '/statics') == 0 || $path =~ m/.*(\.psgi|\.pm)$/i ) {
+    if ( index( $path, '/templates' ) == 0 || index( $path, '/statics' ) == 0 || $path =~ m/.*(\.psgi|\.pm)$/i ) {
         return _forbidden($query);
     }
 
@@ -158,9 +159,9 @@ sub app {
     # If we have a static render, just use it instead (These will ALWAYS be correct, data saves invalidate this)
     # TODO: make this key on admin INSTEAD of active user when we add non-admin users.
     $query->{start} = $start;
-    if (!$active_user && !$has_query) {
-        return _static("$path.z",$start, $streaming) if -f "www/statics/$path.z" && $deflate;
-        return _static($path,$start, $streaming) if -f "www/statics/$path";
+    if ( !$active_user && !$has_query ) {
+        return _static( "$path.z", $start, $streaming ) if -f "www/statics/$path.z" && $deflate;
+        return _static( $path,     $start, $streaming ) if -f "www/statics/$path";
     }
 
     # Handle HTTP range/streaming requests
@@ -169,24 +170,28 @@ sub app {
     my @ranges;
     if ($range) {
         $range =~ s/bytes=//g;
-        push(@ranges, map {
-            [split(/-/, $_)];
-            #$tuples[1] //= $tuples[0] + $CHUNK_SIZE;
-            #\@tuples
-        } split(/,/, $range) );
+        push(
+            @ranges,
+            map {
+                [ split( /-/, $_ ) ];
+
+                #$tuples[1] //= $tuples[0] + $CHUNK_SIZE;
+                #\@tuples
+            } split( /,/, $range )
+        );
     }
 
-    return _serve("www/$path", $start, $streaming, \@ranges, $last_fetch, $deflate) if -f "www/$path";
-	return _serve("totp/$path", $start, $streaming, \@ranges, $last_fetch, $deflate) if -f "totp/$path" && $active_user;
+    return _serve( "www/$path",  $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "www/$path";
+    return _serve( "totp/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "totp/$path" && $active_user;
 
     #Handle regex/capture routes
-    if (!exists $routes{$path}) {
+    if ( !exists $routes{$path} ) {
         my @captures;
-        foreach my $pattern (keys(%routes)) {
+        foreach my $pattern ( keys(%routes) ) {
             @captures = $path =~ m/^$pattern$/;
             if (@captures) {
                 $path = $pattern;
-                foreach my $field (@{$routes{$path}{captures}}) {
+                foreach my $field ( @{ $routes{$path}{captures} } ) {
                     $routes{$path}{data} //= {};
                     $routes{$path}{data}{$field} = shift @captures;
                 }
@@ -199,10 +204,10 @@ sub app {
     $query->{user}    = $active_user;
 
     return _forbidden($query) if $routes{$path}{auth} && !$active_user;
-    return _notfound($query) unless exists $routes{$path};
-    return _badrequest($query) unless grep { $env->{REQUEST_METHOD} eq $_ } ($routes{$path}{method} || '','HEAD');
+    return _notfound($query)   unless exists $routes{$path};
+    return _badrequest($query) unless grep { $env->{REQUEST_METHOD} eq $_ } ( $routes{$path}{method} || '', 'HEAD' );
 
-    @{$query}{keys(%{$routes{$path}{'data'}})} = values(%{$routes{$path}{'data'}}) if ref $routes{$path}{'data'} eq 'HASH' && %{$routes{$path}{'data'}};
+    @{$query}{ keys( %{ $routes{$path}{'data'} } ) } = values( %{ $routes{$path}{'data'} } ) if ref $routes{$path}{'data'} eq 'HASH' && %{ $routes{$path}{'data'} };
 
     #Set various things we don't want overridden
     $query->{body}         = '';
@@ -219,19 +224,20 @@ sub app {
     {
         no strict 'refs';
         my $output = $routes{$path}{callback}->($query);
+
         # Append server-timing headers
         my $tot = tv_interval($start) * 1000;
-        push(@{$output->[1]}, 'Server-Timing' => "app;dur=$tot");
+        push( @{ $output->[1] }, 'Server-Timing' => "app;dur=$tot" );
         return $output;
     }
-};
+}
 
-sub _generic($type, $query) {
-    return _static("$type.z",$query->{start}, $query->{streaming}) if -f "www/statics/$type.z";
-    return _static($type, $query->{start}, $query->{streaming}) if -f "www/statics/$type";
+sub _generic ( $type, $query ) {
+    return _static( "$type.z", $query->{start}, $query->{streaming} ) if -f "www/statics/$type.z";
+    return _static( $type,     $query->{start}, $query->{streaming} ) if -f "www/statics/$type";
     my %lookup = (
-        notfound => \&Trog::Routes::HTML::notfound,
-        forbidden => \&Trog::Routes::HTML::forbidden,
+        notfound   => \&Trog::Routes::HTML::notfound,
+        forbidden  => \&Trog::Routes::HTML::forbidden,
         badrequest => \&Trog::Routes::HTML::badrequest,
         toolong    => \&Trog::Routes::HTML::toolong,
     );
@@ -239,38 +245,39 @@ sub _generic($type, $query) {
 }
 
 sub _notfound ($query) {
-    return _generic('notfound', $query);
+    return _generic( 'notfound', $query );
 }
 
-sub _forbidden($query) {
-    return _generic('forbidden', $query);
+sub _forbidden ($query) {
+    return _generic( 'forbidden', $query );
 }
 
-sub _badrequest($query) {
-    return _generic('badrequest', $query);
+sub _badrequest ($query) {
+    return _generic( 'badrequest', $query );
 }
 
 sub _toolong() {
-    return _generic('toolong', {});
+    return _generic( 'toolong', {} );
 }
 
-sub _static($path,$start,$streaming,$last_fetch=0) {
+sub _static ( $path, $start, $streaming, $last_fetch = 0 ) {
 
     # XXX because of psgi I can't just vomit the file directly
-    if (open(my $fh, '<', "www/statics/$path")) {
+    if ( open( my $fh, '<', "www/statics/$path" ) ) {
         my $headers = '';
+
         # NOTE: this is relying on while advancing the file pointer
         while (<$fh>) {
             last if $_ eq "\n";
             $headers .= $_;
         }
-        my(undef, undef, $status, undef, $headers_parsed) = HTTP::Parser::XS::parse_http_response("$headers\n", HEADERS_AS_HASHREF);
+        my ( undef, undef, $status, undef, $headers_parsed ) = HTTP::Parser::XS::parse_http_response( "$headers\n", HEADERS_AS_HASHREF );
 
         #XXX need to put this into the file itself
-        my $mt = (stat($fh))[9];
-        my @gm = gmtime($mt);
+        my $mt         = ( stat($fh) )[9];
+        my @gm         = gmtime($mt);
         my $now_string = strftime( "%a, %d %b %Y %H:%M:%S GMT", @gm );
-        my $code = $mt > $last_fetch ? $status : 304;
+        my $code       = $mt > $last_fetch ? $status : 304;
         $headers_parsed->{"Last-Modified"} = $now_string;
 
         # Append server-timing headers
@@ -284,44 +291,48 @@ sub _static($path,$start,$streaming,$last_fetch=0) {
 
         return sub {
             my $responder = shift;
+
             #push(@headers, 'Content-Length' => $sz);
-            my $writer = $responder->([ $code, [%$headers_parsed]]);
-            while ( $fh->read( my $buf, $CHUNK_SIZE) ) {
+            my $writer = $responder->( [ $code, [%$headers_parsed] ] );
+            while ( $fh->read( my $buf, $CHUNK_SIZE ) ) {
                 $writer->write($buf);
             }
             close $fh;
             $writer->close;
-        } if $streaming;
+          }
+          if $streaming;
 
-        return [$code, [%$headers_parsed], $fh];
+        return [ $code, [%$headers_parsed], $fh ];
     }
-    return [ 403, ['Content-Type' => $Trog::Vars::content_types{plain}], ["STAY OUT YOU RED MENACE"]];
+    return [ 403, [ 'Content-Type' => $Trog::Vars::content_types{plain} ], ["STAY OUT YOU RED MENACE"] ];
 }
 
-sub _range ($fh, $ranges, $sz, %headers) {
+sub _range ( $fh, $ranges, $sz, %headers ) {
+
     # Set mode
-    my $primary_ct = "Content-Type: $headers{'Content-type'}";
+    my $primary_ct   = "Content-Type: $headers{'Content-type'}";
     my $is_multipart = scalar(@$ranges) > 1;
-    if ( $is_multipart ) {
+    if ($is_multipart) {
         $headers{'Content-type'} = "multipart/byteranges; boundary=$CHUNK_SEP";
     }
     my $code = 206;
 
     my $fc = '';
+
     # Calculate the content-length up-front.  We have to fix unspecified lengths first, and reject bad requests.
     foreach my $range (@$ranges) {
-        $range->[1] //= $sz-1;
-        return [416, [%headers], ["Requested range not satisfiable"]] if $range->[0] > $sz || $range->[0] < 0 || $range->[1] < 0 || $range->[0] > $range->[1];
+        $range->[1] //= $sz - 1;
+        return [ 416, [%headers], ["Requested range not satisfiable"] ] if $range->[0] > $sz || $range->[0] < 0 || $range->[1] < 0 || $range->[0] > $range->[1];
     }
-    $headers{'Content-Length'} = List::Util::sum(map { my $arr=$_; $arr->[1]+1, -$arr->[0] } @$ranges);
+    $headers{'Content-Length'} = List::Util::sum( map { my $arr = $_; $arr->[1] + 1, -$arr->[0] } @$ranges );
 
     #XXX Add the entity header lengths to the value - should hash-ify this to DRY
     if ($is_multipart) {
         foreach my $range (@$ranges) {
-            $headers{'Content-Length'} += length("$fc--$CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n" );
+            $headers{'Content-Length'} += length("$fc--$CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n");
             $fc = "\n";
         }
-        $headers{'Content-Length'} += length( "\n--$CHUNK_SEP\--\n" );
+        $headers{'Content-Length'} += length("\n--$CHUNK_SEP\--\n");
         $fc = '';
     }
 
@@ -331,76 +342,79 @@ sub _range ($fh, $ranges, $sz, %headers) {
 
         foreach my $range (@$ranges) {
             $headers{'Content-Range'} = "bytes $range->[0]-$range->[1]/$sz" unless $is_multipart;
-            $writer //= $responder->([ $code, [%headers]]);
-            $writer->write( "$fc--$CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n" ) if $is_multipart;
+            $writer //= $responder->( [ $code, [%headers] ] );
+            $writer->write("$fc--$CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n") if $is_multipart;
             $fc = "\n";
 
-            my $len = List::Util::min($sz,$range->[1]+1) - $range->[0];
+            my $len = List::Util::min( $sz, $range->[1] + 1 ) - $range->[0];
 
-            $fh->seek( $range->[0], 0);
+            $fh->seek( $range->[0], 0 );
             while ($len) {
-                $fh->read(my $buf, List::Util::min($len,$CHUNK_SIZE) );
+                $fh->read( my $buf, List::Util::min( $len, $CHUNK_SIZE ) );
                 $writer->write($buf);
 
                 # Adjust for amount written
-                $len = List::Util::max($len - $CHUNK_SIZE, 0);
+                $len = List::Util::max( $len - $CHUNK_SIZE, 0 );
             }
         }
         $fh->close();
-        $writer->write( "\n--$CHUNK_SEP\--\n" ) if $is_multipart;
+        $writer->write("\n--$CHUNK_SEP\--\n") if $is_multipart;
         $writer->close;
     };
 }
 
-sub _serve ($path, $start, $streaming, $ranges, $last_fetch=0, $deflate=0) {
-    my $mf = Mojo::File->new($path);
-    my $ext = '.'.$mf->extname();
+sub _serve ( $path, $start, $streaming, $ranges, $last_fetch = 0, $deflate = 0 ) {
+    my $mf  = Mojo::File->new($path);
+    my $ext = '.' . $mf->extname();
     my $ft;
     if ($ext) {
         $ft = Plack::MIME->mime_type($ext) if $ext;
-        $ft ||= $extra_types{$ext} if exists $extra_types{$ext};
+        $ft ||= $extra_types{$ext}         if exists $extra_types{$ext};
     }
     $ft ||= $Trog::Vars::content_types{plain};
 
-    my $ct = 'Content-type';
-    my @headers = ($ct => $ft);
+    my $ct      = 'Content-type';
+    my @headers = ( $ct => $ft );
+
     #TODO use static Cache-Control for everything but JS/CSS?
-    push(@headers,'Cache-control' => $Trog::Vars::cache_control{revalidate});
+    push( @headers, 'Cache-control' => $Trog::Vars::cache_control{revalidate} );
 
-    push(@headers,'Accept-Ranges' => 'bytes');
+    push( @headers, 'Accept-Ranges' => 'bytes' );
 
-    my $mt = (stat($path))[9];
-    my $sz = (stat(_))[7];
-    my @gm = gmtime($mt);
+    my $mt         = ( stat($path) )[9];
+    my $sz         = ( stat(_) )[7];
+    my @gm         = gmtime($mt);
     my $now_string = strftime( "%a, %d %b %Y %H:%M:%S GMT", @gm );
-    my $code = $mt > $last_fetch ? 200 : 304;
+    my $code       = $mt > $last_fetch ? 200 : 304;
 
-    push(@headers, "Last-Modified" => $now_string);
-    push(@headers, 'Vary' => 'Accept-Encoding');
+    push( @headers, "Last-Modified" => $now_string );
+    push( @headers, 'Vary'          => 'Accept-Encoding' );
 
-    if (open(my $fh, '<', $path)) {
-        return _range($fh, $ranges, $sz, @headers) if @$ranges && $streaming;
+    if ( open( my $fh, '<', $path ) ) {
+        return _range( $fh, $ranges, $sz, @headers ) if @$ranges && $streaming;
 
         # Transfer-encoding: chunked
         return sub {
             my $responder = shift;
-            push(@headers, 'Content-Length' => $sz);
-            my $writer = $responder->([ $code, \@headers]);
-            while ( $fh->read( my $buf, $CHUNK_SIZE) ) {
+            push( @headers, 'Content-Length' => $sz );
+            my $writer = $responder->( [ $code, \@headers ] );
+            while ( $fh->read( my $buf, $CHUNK_SIZE ) ) {
                 $writer->write($buf);
             }
             close $fh;
             $writer->close;
-        } if $streaming && $sz > $CHUNK_SIZE;
+          }
+          if $streaming && $sz > $CHUNK_SIZE;
 
         #Return data in the event the caller does not support deflate
-        if (!$deflate) {
+        if ( !$deflate ) {
             push( @headers, "Content-Length" => $sz );
+
             # Append server-timing headers
             my $tot = tv_interval($start) * 1000;
-            push(@headers, 'Server-Timing' => "file;dur=$tot");
+            push( @headers, 'Server-Timing' => "file;dur=$tot" );
 
-            return [ $code, \@headers, $fh];
+            return [ $code, \@headers, $fh ];
         }
 
         #Compress everything less than 1MB
@@ -412,12 +426,12 @@ sub _serve ($path, $start, $streaming, $ranges, $last_fetch=0, $deflate=0) {
 
         # Append server-timing headers
         my $tot = tv_interval($start) * 1000;
-        push(@headers, 'Server-Timing' => "file;dur=$tot");
+        push( @headers, 'Server-Timing' => "file;dur=$tot" );
 
-        return [ $code, \@headers, [$dfh]];
+        return [ $code, \@headers, [$dfh] ];
     }
 
-    return [ 403, [$ct => $Trog::Vars::content_types{plain}], ["STAY OUT YOU RED MENACE"]];
+    return [ 403, [ $ct => $Trog::Vars::content_types{plain} ], ["STAY OUT YOU RED MENACE"] ];
 }
 
 1;

lib/Trog/Auth.pm

@@ -31,8 +31,8 @@ Returns empty string on no active session.
 =cut
 
 sub session2user ($sessid) {
-    my $dbh = _dbh();
-    my $rows = $dbh->selectall_arrayref("SELECT name FROM sess_user WHERE session=?",{ Slice => {} }, $sessid);
+    my $dbh  = _dbh();
+    my $rows = $dbh->selectall_arrayref( "SELECT name FROM sess_user WHERE session=?", { Slice => {} }, $sessid );
     return '' unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]->{name};
 }
@@ -46,9 +46,9 @@ The 'admin' ACL is the only special one, as it allows for authoring posts, confi
 
 =cut
 
-sub acls4user($username) {
-    my $dbh = _dbh();
-    my $records = $dbh->selectall_arrayref("SELECT acl FROM user_acl WHERE username = ?", { Slice => {} }, $username);
+sub acls4user ($username) {
+    my $dbh     = _dbh();
+    my $records = $dbh->selectall_arrayref( "SELECT acl FROM user_acl WHERE username = ?", { Slice => {} }, $username );
     return () unless ref $records eq 'ARRAY' && @$records;
     my @acls = map { $_->{acl} } @$records;
     return \@acls;
@@ -61,67 +61,69 @@ Returns a QR code and URI for pasting into authenticator apps.
 
 =cut
 
-sub totp($user, $domain) {
-	my $totp = _totp();
-	my $dbh  = _dbh();
+sub totp ( $user, $domain ) {
+    my $totp = _totp();
+    my $dbh  = _dbh();
 
-	my $failure = 0;
-	my $message = "TOTP Secret generated successfully.";
+    my $failure = 0;
+    my $message = "TOTP Secret generated successfully.";
 
-	# Make sure we re-generate the same one in case the user forgot.
-	my $secret;
-    my $worked = $dbh->selectall_arrayref("SELECT totp_secret FROM user WHERE name = ?", { Slice => {} }, $user);
-    if ( ref $worked eq 'ARRAY' && @$worked) {
-    	$secret = $worked->[0]{totp_secret};
-	}
-	$failure = -1 if $secret;
+    # Make sure we re-generate the same one in case the user forgot.
+    my $secret;
+    my $worked = $dbh->selectall_arrayref( "SELECT totp_secret FROM user WHERE name = ?", { Slice => {} }, $user );
+    if ( ref $worked eq 'ARRAY' && @$worked ) {
+        $secret = $worked->[0]{totp_secret};
+    }
+    $failure = -1 if $secret;
+
+    my $uri = $totp->generate_otp(
+        user   => "$user\@$domain",
+        issuer => $domain,
 
-	my $uri = $totp->generate_otp(
-		user   => "$user\@$domain",
-		issuer => $domain,
         #XXX verifier apps will only do 30s :(
-		period => 30,
-		$secret ? ( secret => $secret ) : (),
-	);
-
-	if (!$secret) {
-		$secret = $totp->secret();
-		$dbh->do("UPDATE user SET totp_secret=? WHERE name=?", undef, $secret, $user) or return (undef, undef, 1, "Failed to store TOTP secret.");
-	}
-
-	# This is subsequently served via authenticated _serve() in TCMS.pm
-	my $qr = "$user\@$domain.bmp";
-	if (!-f "totp/$qr") {
-		my $qrcode = Imager::QRCode->new(
-			  size          => 4,
-			  margin        => 3,
-			  level         => 'L',
-			  casesensitive => 1,
-			  lightcolor    => Imager::Color->new(255, 255, 255),
-			  darkcolor     => Imager::Color->new(0, 0, 0),
-		);
-
-		my $img = $qrcode->plot($uri);
-		$img->write(file => "totp/$qr", type => "bmp") or return(undef, undef, 1, "Could not write totp/$qr: ".$img->errstr);
-	}
-	return ($uri, $qr, $failure, $message);
+        period => 30,
+        $secret ? ( secret => $secret ) : (),
+    );
+
+    if ( !$secret ) {
+        $secret = $totp->secret();
+        $dbh->do( "UPDATE user SET totp_secret=? WHERE name=?", undef, $secret, $user ) or return ( undef, undef, 1, "Failed to store TOTP secret." );
+    }
+
+    # This is subsequently served via authenticated _serve() in TCMS.pm
+    my $qr = "$user\@$domain.bmp";
+    if ( !-f "totp/$qr" ) {
+        my $qrcode = Imager::QRCode->new(
+            size          => 4,
+            margin        => 3,
+            level         => 'L',
+            casesensitive => 1,
+            lightcolor    => Imager::Color->new( 255, 255, 255 ),
+            darkcolor     => Imager::Color->new( 0,   0,   0 ),
+        );
+
+        my $img = $qrcode->plot($uri);
+        $img->write( file => "totp/$qr", type => "bmp" ) or return ( undef, undef, 1, "Could not write totp/$qr: " . $img->errstr );
+    }
+    return ( $uri, $qr, $failure, $message );
 }
 
 sub _totp {
     state $totp;
-    if (!$totp) {
-        my $cfg = Trog::Config->get();
+    if ( !$totp ) {
+        my $cfg           = Trog::Config->get();
         my $global_secret = $cfg->param('totp.secret');
         die "Global secret must be set in tCMS configuration totp section!" unless $global_secret;
         $totp = Authen::TOTP->new( secret => $global_secret );
         die "Cannot instantiate TOTP client!" unless $totp;
     }
-	return $totp;
+    return $totp;
 }
 
 sub clear_totp {
     my $dbh = _dbh();
     $dbh->do("UPDATE user SET totp_secret=null") or die "Could not clear user TOTP secrets";
+
     #TODO notify users this has happened
 }
 
@@ -133,29 +135,29 @@ Returns a session ID, or blank string in the event the user does not exist or in
 
 =cut
 
-sub mksession ($user, $pass, $token) {
+sub mksession ( $user, $pass, $token ) {
     my $dbh  = _dbh();
-	my $totp = _totp();
+    my $totp = _totp();
 
     # Check the password
-    my $records = $dbh->selectall_arrayref("SELECT salt FROM user WHERE name = ?", { Slice => {} }, $user);
+    my $records = $dbh->selectall_arrayref( "SELECT salt FROM user WHERE name = ?", { Slice => {} }, $user );
     return '' unless ref $records eq 'ARRAY' && @$records;
-    my $salt = $records->[0]->{salt};
-    my $hash = sha256($pass.$salt);
-    my $worked = $dbh->selectall_arrayref("SELECT name, totp_secret FROM user WHERE hash=? AND name = ?", { Slice => {} }, $hash, $user);
+    my $salt   = $records->[0]->{salt};
+    my $hash   = sha256( $pass . $salt );
+    my $worked = $dbh->selectall_arrayref( "SELECT name, totp_secret FROM user WHERE hash=? AND name = ?", { Slice => {} }, $hash, $user );
     return '' unless ref $worked eq 'ARRAY' && @$worked;
-    my $uid = $worked->[0]{name};
+    my $uid    = $worked->[0]{name};
     my $secret = $worked->[0]{totp_secret};
 
     # Validate the 2FA Token.  If we have no secret, allow login so they can see their QR code, and subsequently re-auth.
     if ($secret) {
-        my $rc   = $totp->validate_otp(otp => $token, secret => $secret, tolerance => 1, period => 30);
+        my $rc = $totp->validate_otp( otp => $token, secret => $secret, tolerance => 1, period => 30 );
         return '' unless $rc;
     }
 
     # Issue cookie
-    my $uuid = create_uuid_as_string(UUID_V1, UUID_NS_DNS);
-    $dbh->do("INSERT OR REPLACE INTO session (id,username) VALUES (?,?)", undef, $uuid, $uid) or return '';
+    my $uuid = create_uuid_as_string( UUID_V1, UUID_NS_DNS );
+    $dbh->do( "INSERT OR REPLACE INTO session (id,username) VALUES (?,?)", undef, $uuid, $uid ) or return '';
     return $uuid;
 }
 
@@ -167,7 +169,7 @@ Delete the provided user's session from the auth db.
 
 sub killsession ($user) {
     my $dbh = _dbh();
-    $dbh->do("DELETE FROM session WHERE username=?",undef,$user);
+    $dbh->do( "DELETE FROM session WHERE username=?", undef, $user );
     return 1;
 }
 
@@ -179,16 +181,16 @@ Returns True or False (likely false when user already exists).
 
 =cut
 
-sub useradd ($user, $pass, $acls) {
-    my $dbh = _dbh();
+sub useradd ( $user, $pass, $acls ) {
+    my $dbh  = _dbh();
     my $salt = create_uuid();
-    my $hash = sha256($pass.$salt);
-    my $res =  $dbh->do("INSERT OR REPLACE INTO user (name,salt,hash) VALUES (?,?,?)", undef, $user, $salt, $hash);
+    my $hash = sha256( $pass . $salt );
+    my $res  = $dbh->do( "INSERT OR REPLACE INTO user (name,salt,hash) VALUES (?,?,?)", undef, $user, $salt, $hash );
     return unless $res && ref $acls eq 'ARRAY';
 
     #XXX this is clearly not normalized with an ACL mapping table, will be an issue with large number of users
     foreach my $acl (@$acls) {
-        return unless $dbh->do("INSERT OR REPLACE INTO user_acl (username,acl) VALUES (?,?)", undef, $user, $acl);
+        return unless $dbh->do( "INSERT OR REPLACE INTO user_acl (username,acl) VALUES (?,?)", undef, $user, $acl );
     }
     return 1;
 }
@@ -197,7 +199,7 @@ sub useradd ($user, $pass, $acls) {
 sub _dbh {
     my $file   = 'schema/auth.schema';
     my $dbname = "config/auth.db";
-    return Trog::SQLite::dbh($file,$dbname);
+    return Trog::SQLite::dbh( $file, $dbname );
 }
 
 1;

lib/Trog/Config.pm

@@ -21,9 +21,9 @@ our $home_cfg = "config/main.cfg";
 
 sub get {
     state $cf;
-    return $cf if $cf;
+    return $cf                           if $cf;
     $cf = Config::Simple->new($home_cfg) if -f $home_cfg;
-    return $cf if $cf;
+    return $cf                           if $cf;
     $cf = Config::Simple->new('config/default.cfg');
     return $cf;
 }

lib/Trog/Data.pm

@@ -18,9 +18,9 @@ Returns a new Trog::Data::* class appropriate to what is configured in the Trog:
 
 =cut
 
-sub new( $class, $config ) {
-    my $module = "Trog::Data::".$config->param('general.data_model');
-    my $req = $module;
+sub new ( $class, $config ) {
+    my $module = "Trog::Data::" . $config->param('general.data_model');
+    my $req    = $module;
     $req =~ s/::/\//g;
     require "$req.pm";
     return $module->new($config);

lib/Trog/Data/DUMMY.pm

@@ -25,9 +25,9 @@ sub help { 'https://perldoc.perl.org/functions/quotemeta.html' }
 
 our $posts;
 
-sub read ($self, $query={}) {
-    if ( !-f $datastore) {
-        open(my $fh, '>', $datastore);
+sub read ( $self, $query = {} ) {
+    if ( !-f $datastore ) {
+        open( my $fh, '>', $datastore );
         print $fh '[]';
         close $fh;
     }
@@ -45,25 +45,26 @@ sub count ($self) {
     return scalar(@$posts);
 }
 
-sub write($self,$data,$overwrite=0) {
+sub write ( $self, $data, $overwrite = 0 ) {
     my $orig = [];
     if ($overwrite) {
         $orig = $data;
-    } else {
+    }
+    else {
         $orig = $self->read();
-        push(@$orig,@$data);
+        push( @$orig, @$data );
     }
-    open(my $fh, '>', $datastore) or confess;
+    open( my $fh, '>', $datastore ) or confess;
     print $fh JSON::MaybeXS::encode_json($orig);
     close $fh;
 }
 
-sub delete($self, @posts) {
+sub delete ( $self, @posts ) {
     my $example_posts = $self->read();
     foreach my $update (@posts) {
         @$example_posts = grep { $_->{id} ne $update->{id} } @$example_posts;
     }
-    $self->write($example_posts,1);
+    $self->write( $example_posts, 1 );
 
     # Gorilla cache invalidation
     Path::Tiny::path('www/statics')->remove_tree;
@@ -71,8 +72,8 @@ sub delete($self, @posts) {
     return 0;
 }
 
-sub tags($self) {
-    return (uniq map { @{$_->{tags}} } @$posts);
+sub tags ($self) {
+    return ( uniq map { @{ $_->{tags} } } @$posts );
 }
 
 1;

lib/Trog/Data/FlatFile.pm

@@ -29,31 +29,35 @@ You can only post once per second due to it storing each post as a file named af
 
 =cut
 
-our $parser = JSON::MaybeXS->new( utf8 => 1);
+our $parser = JSON::MaybeXS->new( utf8 => 1 );
 
 # Initialize the list of posts by tag for all known tags.
 # This is because the list won't ever change between HUPs
 our @tags = Trog::SQLite::TagIndex::tags();
 our %posts_by_tag;
 
-sub read ($self, $query={}) {
+sub read ( $self, $query = {} ) {
     $query->{limit} //= 25;
 
     #Optimize direct ID
     my @index;
-    if ($query->{id}) {
+    if ( $query->{id} ) {
         @index = ("$datastore/$query->{id}");
-    } else {
+    }
+    else {
         # Remove tags which we don't care about and sort to keep memoized memory usage down
-        @{$query->{tags}} = sort grep { my $t = $_; grep { $t eq $_ } @tags } @{$query->{tags}};
-        my $tagkey = join('&',@{$query->{tags}});
+        @{ $query->{tags} } = sort grep {
+            my $t = $_;
+            grep { $t eq $_ } @tags
+        } @{ $query->{tags} };
+        my $tagkey = join( '&', @{ $query->{tags} } );
 
         # Check against memoizer
         $posts_by_tag{$tagkey} //= [];
-        @index = @{$posts_by_tag{$tagkey}} if @{$posts_by_tag{$tagkey}};
+        @index = @{ $posts_by_tag{$tagkey} } if @{ $posts_by_tag{$tagkey} };
 
-        if (!@index && -f 'data/posts.db') {
-            @index = map { "$datastore/$_" } Trog::SQLite::TagIndex::posts_for_tags(@{$query->{tags}});
+        if ( !@index && -f 'data/posts.db' ) {
+            @index = map { "$datastore/$_" } Trog::SQLite::TagIndex::posts_for_tags( @{ $query->{tags} } );
             $posts_by_tag{$tagkey} = \@index;
         }
         @index = $self->_index() unless @index;
@@ -63,27 +67,28 @@ sub read ($self, $query={}) {
     foreach my $item (@index) {
         next unless -f $item;
         my $slurped = eval { File::Slurper::read_text($item) };
-        if (!$slurped) {
+        if ( !$slurped ) {
             print "Failed to Read $item:\n$@\n";
             next;
         }
-        my $parsed  = eval { $parser->decode($slurped) };
-        if (!$parsed) {
+        my $parsed = eval { $parser->decode($slurped) };
+        if ( !$parsed ) {
+
             # Try and read it in binary in case it was encoded incorrectly the first time
-	    $slurped = eval { File::Slurper::read_binary($item) };
-	    $parsed  = eval { $parser->decode($slurped) };
-	    if (!$parsed) {
+            $slurped = eval { File::Slurper::read_binary($item) };
+            $parsed  = eval { $parser->decode($slurped) };
+            if ( !$parsed ) {
                 print "JSON Decode error on $item:\n$@\n";
                 next;
             }
         }
 
         #XXX this imposes an inefficiency in itself, get() will filter uselessly again here
-        my @filtered = $query->{raw} ? @$parsed : $self->filter($query,@$parsed);
+        my @filtered = $query->{raw} ? @$parsed : $self->filter( $query, @$parsed );
 
-        push(@items,@filtered) if @filtered;
-        next if $query->{limit} == 0; # 0 = unlimited
-        last if scalar(@items) == $query->{limit};
+        push( @items, @filtered ) if @filtered;
+        next                      if $query->{limit} == 0;                # 0 = unlimited
+        last                      if scalar(@items) == $query->{limit};
     }
 
     return \@items;
@@ -91,7 +96,7 @@ sub read ($self, $query={}) {
 
 sub _index ($self) {
     confess "Can't find datastore in $datastore !" unless -d $datastore;
-    opendir(my $dh, $datastore) or confess;
+    opendir( my $dh, $datastore ) or confess;
     my @index = grep { -f } map { "$datastore/$_" } readdir $dh;
     closedir $dh;
     return sort { $b cmp $a } @index;
@@ -105,23 +110,23 @@ sub aliases ($self) {
     return Trog::SQLite::TagIndex::aliases();
 }
 
-sub write($self,$data) {
+sub write ( $self, $data ) {
     foreach my $post (@$data) {
-        my $file = "$datastore/$post->{id}";
+        my $file   = "$datastore/$post->{id}";
         my $update = [$post];
-        if (-f $file) {
+        if ( -f $file ) {
             my $slurped = File::Slurper::read_binary($file);
             my $parsed  = $parser->decode($slurped);
 
-            $update = [(@$parsed, $post)];
+            $update = [ ( @$parsed, $post ) ];
         }
 
         mkdir $datastore;
-        open(my $fh, '>', $file) or confess "Could not open $file";
+        open( my $fh, '>', $file ) or confess "Could not open $file";
         print $fh $parser->encode($update);
         close $fh;
 
-        Trog::SQLite::TagIndex::add_post($post,$self);
+        Trog::SQLite::TagIndex::add_post( $post, $self );
     }
 }
 
@@ -130,7 +135,7 @@ sub count ($self) {
     return scalar(@index);
 }
 
-sub delete($self, @posts) {
+sub delete ( $self, @posts ) {
     foreach my $update (@posts) {
         unlink "$datastore/$update->{id}" or confess;
         Trog::SQLite::TagIndex::remove_post($update);
@@ -142,7 +147,7 @@ sub delete($self, @posts) {
     return 0;
 }
 
-sub tags($self) {
+sub tags ($self) {
     return Trog::SQLite::TagIndex::tags();
 }
 

lib/Trog/DataModule.pm

@@ -40,18 +40,18 @@ Try not to do expensive things here.
 
 =cut
 
-sub new ($class, $config) {
+sub new ( $class, $config ) {
     $config = $config->vars();
-    return bless($config, $class);
+    return bless( $config, $class );
 }
 
 #It is required that subclasses implement this
-sub lang  ($self) { ... }
-sub help  ($self) { ... }
-sub read  ($self,$query={}) { ... }
-sub write ($self) { ... }
-sub count ($self) { ... }
-sub tags  ($self) { ... }
+sub lang  ($self)                { ... }
+sub help  ($self)                { ... }
+sub read  ( $self, $query = {} ) { ... }
+sub write ($self)                { ... }
+sub count ($self)                { ... }
+sub tags  ($self)                { ... }
 
 =head1 METHODS
 
@@ -80,18 +80,19 @@ As implemented, this takes the data as a given and filters in post.
 
 =cut
 
-sub get ($self, %request) {
+sub get ( $self, %request ) {
 
-    my $posts = $self->read(\%request);
+    my $posts = $self->read( \%request );
     return @$posts if $request{raw};
 
-    my @filtered = $self->filter(\%request, @$posts);
+    my @filtered = $self->filter( \%request, @$posts );
     @filtered = $self->_fixup(@filtered);
-    @filtered = $self->paginate(\%request,@filtered);
+    @filtered = $self->paginate( \%request, @filtered );
     return @filtered;
 }
 
-sub _fixup ($self, @filtered) {
+sub _fixup ( $self, @filtered ) {
+
     # urlencode spaces in filenames
     @filtered = map {
         my $subj = $_;
@@ -101,17 +102,17 @@ sub _fixup ($self, @filtered) {
         }
 
         #XXX Add dynamic routing data for posts which don't have them (/posts/$id) and (/users/$user)
-        my $is_user_page = grep { $_ eq 'about' } @{$subj->{tags}};
-        if (!exists $subj->{local_href}) {
+        my $is_user_page = grep { $_ eq 'about' } @{ $subj->{tags} };
+        if ( !exists $subj->{local_href} ) {
             $subj->{local_href} = "/posts/$subj->{id}";
             $subj->{local_href} = "/users/$subj->{user}" if $is_user_page;
         }
-        if (!exists $subj->{callback}) {
+        if ( !exists $subj->{callback} ) {
             $subj->{callback} = "Trog::Routes::HTML::posts";
             $subj->{callback} = "Trog::Routes::HTML::users" if $is_user_page;
         }
 
-        $subj->{method} = 'GET' unless exists($subj->{method});
+        $subj->{method} = 'GET' unless exists( $subj->{method} );
 
         $subj
     } @filtered;
@@ -119,49 +120,58 @@ sub _fixup ($self, @filtered) {
     return @filtered;
 }
 
-sub filter ($self, $query, @filtered) {
-    $query->{acls} //= [];
-    $query->{tags} //=[];
+sub filter ( $self, $query, @filtered ) {
+    $query->{acls}         //= [];
+    $query->{tags}         //= [];
     $query->{exclude_tags} //= [];
 
     # If an ID is passed, just get that (and all it's prior versions)
-    if ($query->{id}) {
+    if ( $query->{id} ) {
         @filtered = grep { $_->{id} eq $query->{id} } @filtered;
-        @filtered = _dedup_versions($query->{version}, @filtered);
+        @filtered = _dedup_versions( $query->{version}, @filtered );
         return @filtered;
     }
 
     # XXX aclname and id are essentially serving the same purpose, should unify
-    if ($query->{aclname}) {
-        @filtered = grep { ($_->{aclname} || '') eq $query->{aclname} } @filtered;
-        @filtered = _dedup_versions($query->{version}, @filtered);
+    if ( $query->{aclname} ) {
+        @filtered = grep { ( $_->{aclname} || '' ) eq $query->{aclname} } @filtered;
+        @filtered = _dedup_versions( $query->{version}, @filtered );
         return @filtered;
     }
 
-    @filtered = _dedup_versions(undef, @filtered);
+    @filtered = _dedup_versions( undef, @filtered );
 
     #Filter out posts which are too old
     #Coerce older into numeric
-    $query->{older} =~ s/[^0-9]//g if $query->{older};
+    $query->{older} =~ s/[^0-9]//g                                 if $query->{older};
     @filtered = grep { $_->{created} < $query->{older} } @filtered if $query->{older};
 
     # Filter posts not matching the passed tag(s), if any
     @filtered = grep {
         my $tags = $_->{tags};
-        grep { my $t = $_; grep { $t eq $_ } @{$query->{tags}} } @$tags
-    } @filtered if @{$query->{tags}};
+        grep {
+            my $t = $_;
+            grep { $t eq $_ } @{ $query->{tags} }
+        } @$tags
+    } @filtered if @{ $query->{tags} };
 
     # Filter posts *matching* the passed exclude_tag(s), if any
     @filtered = grep {
         my $tags = $_->{tags};
-        !grep { my $t = $_; grep { $t eq $_ } @{$query->{exclude_tags}} } @$tags
-    } @filtered if @{$query->{exclude_tags}};
+        !grep {
+            my $t = $_;
+            grep { $t eq $_ } @{ $query->{exclude_tags} }
+        } @$tags
+    } @filtered if @{ $query->{exclude_tags} };
 
     # Filter posts without the proper ACLs
     @filtered = grep {
         my $tags = $_->{tags};
-        grep { my $t = $_; grep { $t eq $_ } @{$query->{acls}} } @$tags
-    } @filtered unless grep { $_ eq 'admin' } @{$query->{acls}};
+        grep {
+            my $t = $_;
+            grep { $t eq $_ } @{ $query->{acls} }
+        } @$tags
+    } @filtered unless grep { $_ eq 'admin' } @{ $query->{acls} };
 
     @filtered = grep { $_->{title} =~ m/\Q$query->{like}\E/i || $_->{data} =~ m/\Q$query->{like}\E/i } @filtered if $query->{like};
 
@@ -170,18 +180,18 @@ sub filter ($self, $query, @filtered) {
     return @filtered;
 }
 
-sub paginate ($self, $query, @filtered) {
-    my $offset = int($query->{limit} // 25);
-    $offset = @filtered < $offset ? @filtered : $offset;
-    @filtered = splice(@filtered, ( int($query->{page}) -1) * $offset, $offset) if $query->{page} && $query->{limit};
+sub paginate ( $self, $query, @filtered ) {
+    my $offset = int( $query->{limit} // 25 );
+    $offset   = @filtered < $offset ? @filtered : $offset;
+    @filtered = splice( @filtered, ( int( $query->{page} ) - 1 ) * $offset, $offset ) if $query->{page} && $query->{limit};
     return @filtered;
 }
 
-sub _dedup_versions ($version=-1, @posts) {
+sub _dedup_versions ( $version = -1, @posts ) {
 
     #ASSUMPTION made here - if we pass version this is direct ID query
-    if (defined $version) {
-        my $version_max = List::Util::max(map { $_->{version} } @posts);
+    if ( defined $version ) {
+        my $version_max = List::Util::max( map { $_->{version} } @posts );
 
         return map {
             $_->{version_max} //= $version_max;
@@ -189,13 +199,14 @@ sub _dedup_versions ($version=-1, @posts) {
         } grep { $_->{version} eq $version } @posts;
     }
 
-    my @uniqids = List::Util::uniq(map { $_->{id} } @posts);
+    my @uniqids = List::Util::uniq( map { $_->{id} } @posts );
     my %posts_deduped;
     for my $id (@uniqids) {
-        my @ofid = sort { $b->{version} <=> $a->{version} } grep { $_->{id} eq $id } @posts;
-        my $version_max = List::Util::max(map { $_->{version } } @ofid);
+        my @ofid        = sort { $b->{version} <=> $a->{version} } grep { $_->{id} eq $id } @posts;
+        my $version_max = List::Util::max( map { $_->{version} } @ofid );
         $posts_deduped{$id} = $ofid[0];
         $posts_deduped{$id}{version_max} = $version_max;
+
         # Show orig creation date, and original author.
         # XXX this doesn't show the mtime correctly for whatever reason, so I'm omitting it from the interface
         $posts_deduped{$id}{modified} = $ofid[0]{created};
@@ -225,33 +236,35 @@ You probably won't want to override this.
 
 =cut
 
-sub add ($self, @posts) {
+sub add ( $self, @posts ) {
     my @to_write;
 
     foreach my $post (@posts) {
-        $post->{id} //= UUID::Tiny::create_uuid_as_string(UUID::Tiny::UUID_V1, UUID::Tiny::UUID_NS_DNS);
+        $post->{id}      //= UUID::Tiny::create_uuid_as_string( UUID::Tiny::UUID_V1, UUID::Tiny::UUID_NS_DNS );
         $post->{aliases} //= [];
-        $post->{aliases} = [$post->{aliases}] unless ref $post->{aliases} eq 'ARRAY';
+        $post->{aliases} = [ $post->{aliases} ] unless ref $post->{aliases} eq 'ARRAY';
+
+        if ( $post->{aclname} ) {
 
-        if ($post->{aclname}) {
             # Then this is a series
             $post->{local_href} //= "/$post->{aclname}";
-            push(@{$post->{aliases}}, "/posts/$post->{id}", "/series/$post->{id}" );
+            push( @{ $post->{aliases} }, "/posts/$post->{id}", "/series/$post->{id}" );
         }
 
-        $post->{callback}   //= 'Trog::Routes::HTML::posts';
+        $post->{callback} //= 'Trog::Routes::HTML::posts';
+
         # If this is a user creation post, add in the /user/ route
-        if ($post->{callback} eq 'Trog::Routes::HTML::users') {
+        if ( $post->{callback} eq 'Trog::Routes::HTML::users' ) {
             $post->{local_href} = "/users/$post->{user}";
         }
 
         $post->{local_href} //= "/posts/$post->{id}";
         $post->{method}     //= 'GET';
-        $post->{created}    = time();
+        $post->{created} = time();
         my @existing_posts = $self->get( id => $post->{id} );
         if (@existing_posts) {
             my $existing_post = $existing_posts[0];
-            $post->{version}  = $existing_post->{version};
+            $post->{version} = $existing_post->{version};
             $post->{version}++;
         }
         $post->{version} //= 0;
@@ -260,10 +273,10 @@ sub add ($self, @posts) {
 
         push @to_write, $post;
     }
-    $self->write(\@to_write);
+    $self->write( \@to_write );
 
     #hup the parent to refresh the routing table IFF we aren't in an interactive session, such as migrate.pl
-    if (!$ENV{NOHUP}) {
+    if ( !$ENV{NOHUP} ) {
         my $parent = getppid;
         kill 'HUP', $parent;
     }
@@ -278,9 +291,9 @@ sub add ($self, @posts) {
 # Not actually a subprocess, kek
 sub _process ($post) {
 
-    $post->{href}      = _handle_upload($post->{file}, $post->{id})             if $post->{file};
-    $post->{preview}   = _handle_upload($post->{preview_file}, $post->{id})     if $post->{preview_file};
-    $post->{wallpaper} = _handle_upload($post->{wallpaper_file}, $post->{id})   if $post->{wallpaper_file};
+    $post->{href}      = _handle_upload( $post->{file},           $post->{id} ) if $post->{file};
+    $post->{preview}   = _handle_upload( $post->{preview_file},   $post->{id} ) if $post->{preview_file};
+    $post->{wallpaper} = _handle_upload( $post->{wallpaper_file}, $post->{id} ) if $post->{wallpaper_file};
     $post->{preview}   = $post->{href} if $post->{app} && $post->{app} eq 'image';
     delete $post->{app};
     delete $post->{file};
@@ -294,35 +307,38 @@ sub _process ($post) {
     # Handle acls/tags
     $post->{tags} //= [];
     $post->{acls} //= [];
-    @{$post->{tags}} = grep { my $subj = $_; !grep { $_ eq $subj} qw{public private unlisted} } @{$post->{tags}};
-    push(@{$post->{tags}}, @{$post->{acls}}) if $post->{visibility} eq 'private';
+    @{ $post->{tags} } = grep {
+        my $subj = $_;
+        !grep { $_ eq $subj } qw{public private unlisted}
+    } @{ $post->{tags} };
+    push( @{ $post->{tags} }, @{ $post->{acls} } ) if $post->{visibility} eq 'private';
     delete $post->{acls};
-    push(@{$post->{tags}}, $post->{visibility});
+    push( @{ $post->{tags} }, $post->{visibility} );
 
     # Add the 'series' tag if we are in a series, restrict to relevant acl
-    if ($post->{series}) {
-        push(@{$post->{tags}}, 'series');
-        push(@{$post->{tags}}, $post->{series});
+    if ( $post->{series} ) {
+        push( @{ $post->{tags} }, 'series' );
+        push( @{ $post->{tags} }, $post->{series} );
     }
 
     #Filter adding the same acl twice
-    @{$post->{tags}}    = List::Util::uniq(@{$post->{tags}});
-    @{$post->{aliases}} = List::Util::uniq(@{$post->{aliases}});
+    @{ $post->{tags} }    = List::Util::uniq( @{ $post->{tags} } );
+    @{ $post->{aliases} } = List::Util::uniq( @{ $post->{aliases} } );
 
     # Handle multimedia content types
-    if ($post->{href}) {
-        my $mf = Mojo::File->new("www/$post->{href}");
-        my $ext = '.'.$mf->extname();
+    if ( $post->{href} ) {
+        my $mf  = Mojo::File->new("www/$post->{href}");
+        my $ext = '.' . $mf->extname();
         $post->{content_type} = Plack::MIME->mime_type($ext) if $ext;
     }
-    if ($post->{video_href}) {
-        my $mf = Mojo::File->new("www/$post->{video_href}");
-        my $ext = '.'.$mf->extname();
+    if ( $post->{video_href} ) {
+        my $mf  = Mojo::File->new("www/$post->{video_href}");
+        my $ext = '.' . $mf->extname();
         $post->{video_content_type} = Plack::MIME->mime_type($ext) if $ext;
     }
-    if ($post->{audio_href}) {
-        my $mf = Mojo::File->new("www/$post->{audio_href}");
-        my $ext = '.'.$mf->extname();
+    if ( $post->{audio_href} ) {
+        my $mf  = Mojo::File->new("www/$post->{audio_href}");
+        my $ext = '.' . $mf->extname();
         $post->{audio_content_type} = Plack::MIME->mime_type($ext) if $ext;
     }
     $post->{content_type} ||= 'text/html';
@@ -330,15 +346,15 @@ sub _process ($post) {
     $post->{is_video}   = 1 if $post->{content_type} =~ m/^video\//;
     $post->{is_audio}   = 1 if $post->{content_type} =~ m/^audio\//;
     $post->{is_image}   = 1 if $post->{content_type} =~ m/^image\//;
-    $post->{is_profile} = 1 if grep { $_ eq 'about' } @{$post->{tags}};
+    $post->{is_profile} = 1 if grep { $_ eq 'about' } @{ $post->{tags} };
 
     return $post;
 }
 
-sub _handle_upload ($file, $uuid) {
-    my $f = $file->{tempname};
+sub _handle_upload ( $file, $uuid ) {
+    my $f       = $file->{tempname};
     my $newname = "$uuid.$file->{filename}";
-    File::Copy::move($f, "www/assets/$newname");
+    File::Copy::move( $f, "www/assets/$newname" );
     return "/assets/$newname";
 }
 
@@ -360,8 +376,8 @@ You should override this for performance reasons, as it's just a wrapper around
 
 =cut
 
-sub routes($self) {
-    my %routes = map { $_->{local_href} => { method => $_->{method}, callback => \&{$_->{callback}} } } ($self->get( limit => 0, acls => ['admin'] ));
+sub routes ($self) {
+    my %routes = map { $_->{local_href} => { method => $_->{method}, callback => \&{ $_->{callback} } } } ( $self->get( limit => 0, acls => ['admin'] ) );
     return %routes;
 }
 
@@ -372,11 +388,11 @@ You should override this for performance reasons, as it's just a wrapper around
 
 =cut
 
-sub aliases($self) {
+sub aliases ($self) {
     my @posts = $self->get( limit => 0, acls => ['admin'] );
     my %aliases;
     foreach my $post (@posts) {
-        @aliases{@{$post->{aliases}}} = $post->{local_href};
+        @aliases{ @{ $post->{aliases} } } = $post->{local_href};
     }
     return %aliases;
 }

lib/Trog/Routes/JSON.pm

@@ -14,7 +14,7 @@ my $conf = Trog::Config::get();
 
 # TODO de-duplicate this, it's shared in html
 my $theme_dir = '';
-$theme_dir = "themes/".$conf->param('general.theme') if $conf->param('general.theme') && -d "www/themes/".$conf->param('general.theme');
+$theme_dir = "themes/" . $conf->param('general.theme') if $conf->param('general.theme') && -d "www/themes/" . $conf->param('general.theme');
 
 our %routes = (
     '/api/catalog' => {
@@ -23,9 +23,9 @@ our %routes = (
         parameters => [],
     },
     '/api/webmanifest' => {
-        method         => 'GET',
-        callback       => \&webmanifest,
-        parameters     => [],
+        method     => 'GET',
+        callback   => \&webmanifest,
+        parameters => [],
     },
     '/api/version' => {
         method     => 'GET',
@@ -35,9 +35,9 @@ our %routes = (
 );
 
 # Clone / redact for catalog
-my $cloned = clone(\%routes);
-foreach my $r (keys(%$cloned)) {
-    delete $cloned->{$r}{callback}
+my $cloned = clone( \%routes );
+foreach my $r ( keys(%$cloned) ) {
+    delete $cloned->{$r}{callback};
 }
 
 my $enc = JSON::MaybeXS->new( utf8 => 1 );
@@ -48,24 +48,24 @@ sub _version () {
 }
 
 sub version ($query) {
-    state $ret = [200, ['Content-type' => "application/json", ETag => 'version-'._version()],[_version()]];
+    state $ret = [ 200, [ 'Content-type' => "application/json", ETag => 'version-' . _version() ], [ _version() ] ];
     return $ret;
 }
 
 sub catalog ($query) {
-    state $ret = [200, ['Content-type' => "application/json", ETag => 'catalog-'._version()], [$enc->encode($cloned)]];
+    state $ret = [ 200, [ 'Content-type' => "application/json", ETag => 'catalog-' . _version() ], [ $enc->encode($cloned) ] ];
     return $ret;
 }
 
 sub webmanifest ($query) {
-    state $headers = ['Content-type' => "application/json", ETag => 'manifest-'._version()];
+    state $headers  = [ 'Content-type' => "application/json", ETag => 'manifest-' . _version() ];
     state %manifest = (
         "icons" => [
             { "src" => "$theme_dir/img/icon/favicon-192.png", "type" => "image/png", "sizes" => "192x192" },
             { "src" => "$theme_dir/img/icon/favicon-512.png", "type" => "image/png", "sizes" => "512x512" },
         ],
     );
-    state $content = $enc->encode(\%manifest);
+    state $content = $enc->encode( \%manifest );
 
     return [ 200, $headers, [$content] ];
 }

lib/Trog/SQLite.pm

@@ -37,13 +37,14 @@ Be careful when first calling, the standard fork-safety concerns with sqlite app
 =cut
 
 my $dbh = {};
+
 # Ensure the db schema is OK, and give us a handle
 sub dbh {
-    my ($schema,$dbname) = @_;
+    my ( $schema, $dbname ) = @_;
     return $dbh->{$schema} if $dbh->{$schema};
     File::Touch::touch($dbname) unless -f $dbname;
     my $qq = File::Slurper::read_text($schema);
-    my $db = DBI->connect("dbi:SQLite:dbname=$dbname","","");
+    my $db = DBI->connect( "dbi:SQLite:dbname=$dbname", "", "" );
     $db->{sqlite_allow_multiple_statements} = 1;
     $db->do($qq) or die "Could not ensure database consistency";
     $db->{sqlite_allow_multiple_statements} = 0;
@@ -76,29 +77,29 @@ Batch your values to whatever is appropriate given your available heap.
 
 =cut
 
-
-sub bulk_insert ($dbh, $table, $keys, $ACTION='IGNORE', @values) {
+sub bulk_insert ( $dbh, $table, $keys, $ACTION = 'IGNORE', @values ) {
     die "unsupported insert action $ACTION" unless any { $ACTION eq $_ } qw{ROLLBACK ABORT FAIL IGNORE REPLACE};
 
     die "keys must be nonempty ARRAYREF" unless ref $keys eq 'ARRAY' && @$keys;
     die "#Values must be a multiple of #keys" if @values % @$keys;
 
-    my ($smt,$query) = ('','');
+    my ( $smt, $query ) = ( '', '' );
     while (@values) {
+
         #Must have even multiple of #keys, so floor divide and chop remainder
         my $nkeys = scalar(@$keys);
         my $limit = floor( 999 / $nkeys );
-        $limit = $limit - ( $limit % $nkeys);
-        $smt = '' if scalar(@values) < $limit;
-        my @params = splice(@values,0,$limit);
-        if (!$smt) {
+        $limit = $limit - ( $limit % $nkeys );
+        $smt   = '' if scalar(@values) < $limit;
+        my @params = splice( @values, 0, $limit );
+        if ( !$smt ) {
             my @value_tuples;
             my @huh = map { '?' } @params;
             while (@huh) {
-                push(@value_tuples, "(".join(',',(splice(@huh,0,$nkeys))).")");
+                push( @value_tuples, "(" . join( ',', ( splice( @huh, 0, $nkeys ) ) ) . ")" );
             }
-            $query = "INSERT OR $ACTION INTO $table (".join(',',@$keys).") VALUES ".join(',',@value_tuples);
-            $smt = $dbh->prepare($query);
+            $query = "INSERT OR $ACTION INTO $table (" . join( ',', @$keys ) . ") VALUES " . join( ',', @value_tuples );
+            $smt   = $dbh->prepare($query);
         }
         $smt->execute(@params);
     }

lib/Trog/SQLite/TagIndex.pm

@@ -21,16 +21,16 @@ Also used to retrieve cached routes from posts.
 =cut
 
 sub posts_for_tags (@tags) {
-    my $dbh = _dbh();
-    my $clause = @tags ? "WHERE tag IN (".join(',' ,(map {'?'} @tags)).")" : '';
-    my $rows = $dbh->selectall_arrayref("SELECT DISTINCT id FROM posts $clause ORDER BY created DESC",{ Slice => {} }, @tags);
+    my $dbh    = _dbh();
+    my $clause = @tags ? "WHERE tag IN (" . join( ',', ( map { '?' } @tags ) ) . ")" : '';
+    my $rows   = $dbh->selectall_arrayref( "SELECT DISTINCT id FROM posts $clause ORDER BY created DESC", { Slice => {} }, @tags );
     return () unless ref $rows eq 'ARRAY' && @$rows;
     return map { $_->{id} } @$rows;
 }
 
 sub routes {
-    my $dbh = _dbh();
-    my $rows = $dbh->selectall_arrayref("SELECT id, route, method, callback FROM all_routes",{ Slice => {} });
+    my $dbh  = _dbh();
+    my $rows = $dbh->selectall_arrayref( "SELECT id, route, method, callback FROM all_routes", { Slice => {} } );
     return () unless ref $rows eq 'ARRAY' && @$rows;
 
     my %routes = map { $_->{route} => $_ } @$rows;
@@ -38,24 +38,24 @@ sub routes {
 }
 
 sub aliases {
-    my $dbh = _dbh();
-    my $rows = $dbh->selectall_arrayref("SELECT actual,alias FROM aliases", { Slice => {} });
+    my $dbh  = _dbh();
+    my $rows = $dbh->selectall_arrayref( "SELECT actual,alias FROM aliases", { Slice => {} } );
     return () unless ref $rows eq 'ARRAY' && @$rows;
     my %aliases = map { $_->{alias} => $_->{actual} } @$rows;
     return %aliases;
 }
 
 sub tags {
-    my $dbh = _dbh();
-    my $rows = $dbh->selectall_arrayref("SELECT name FROM tag", { Slice => {} });
+    my $dbh  = _dbh();
+    my $rows = $dbh->selectall_arrayref( "SELECT name FROM tag", { Slice => {} } );
     return () unless ref $rows eq 'ARRAY' && @$rows;
     return map { $_->{name} } @$rows;
 }
 
-sub add_post ($post,$data_obj) {
+sub add_post ( $post, $data_obj ) {
     my $dbh = _dbh();
-    build_index($data_obj,[$post]);
-    build_routes($data_obj,[$post]);
+    build_index( $data_obj, [$post] );
+    build_routes( $data_obj, [$post] );
     return 1;
 }
 
@@ -63,7 +63,7 @@ sub remove_post ($post) {
     my $dbh = _dbh();
 
     # Deleting the post will cascade to the post index & primary route, which cascades to the aliases
-    $dbh->do("DELETE FROM post WHERE uuid=?", undef, $post->{id});
+    $dbh->do( "DELETE FROM post WHERE uuid=?", undef, $post->{id} );
 
     # Now that we've wasted the routes and post, let's reap any dangling tags or callbacks.
     # We won't ever reap methods, because they're just HTTP methods in an enum table.
@@ -72,71 +72,78 @@ sub remove_post ($post) {
     return 1;
 }
 
-sub build_index($data_obj,$posts=[]) {
+sub build_index ( $data_obj, $posts = [] ) {
     my $dbh = _dbh();
-    $posts = $data_obj->read({ limit => 0, acls => ['admin'] }) unless @$posts;
+    $posts = $data_obj->read( { limit => 0, acls => ['admin'] } ) unless @$posts;
 
     # First, slap in the UUIDs
     my @uuids = map { $_->{id} } @$posts;
-    Trog::SQLite::bulk_insert($dbh,'post',['uuid'],'IGNORE', @uuids);
-    my $pids = _id_for_uuid($dbh,@uuids);
+    Trog::SQLite::bulk_insert( $dbh, 'post', ['uuid'], 'IGNORE', @uuids );
+    my $pids = _id_for_uuid( $dbh, @uuids );
     foreach my $post (@$posts) {
-        $post->{post_id} = $pids->{$post->{id}}{id};
+        $post->{post_id} = $pids->{ $post->{id} }{id};
     }
 
     # Slap in the tags, plus the aclname in the event this is a series
-    my @tags = uniq map { @{$_->{tags}}, $_->{aclname} } @$posts;
-    Trog::SQLite::bulk_insert($dbh,'tag', ['name'], 'IGNORE', @tags);
+    my @tags = uniq map { @{ $_->{tags} }, $_->{aclname} } @$posts;
+    Trog::SQLite::bulk_insert( $dbh, 'tag', ['name'], 'IGNORE', @tags );
+
     #TODO restrict query to only the specific tags we care about
-    my $t = $dbh->selectall_hashref("SELECT id,name FROM tag", 'name');
-    foreach my $k (keys(%$t)) { $t->{$k} = $t->{$k}->{id} };
+    my $t = $dbh->selectall_hashref( "SELECT id,name FROM tag", 'name' );
+    foreach my $k ( keys(%$t) ) { $t->{$k} = $t->{$k}->{id} }
 
     # Finally, index the posts
-    Trog::SQLite::bulk_insert($dbh,'posts_index',[qw{post_id post_time tag_id}], 'IGNORE', map {
-        my $subj = $_;
-        map { ( $subj->{post_id}, $subj->{created}, $t->{$_} ) } @{$subj->{tags}}
-    } @$posts );
+    Trog::SQLite::bulk_insert(
+        $dbh,
+        'posts_index',
+        [qw{post_id post_time tag_id}],
+        'IGNORE',
+        map {
+            my $subj = $_;
+            map { ( $subj->{post_id}, $subj->{created}, $t->{$_} ) } @{ $subj->{tags} }
+        } @$posts
+    );
 }
 
-sub _id_for_uuid($dbh,@uuids) {
-    my $bind = join(',', (map { '?' } @uuids));
-    Trog::SQLite::bulk_insert($dbh,'post',['uuid'],'IGNORE', @uuids);
-    return $dbh->selectall_hashref("SELECT id,uuid FROM post WHERE uuid IN ($bind)", 'uuid', {}, @uuids);
+sub _id_for_uuid ( $dbh, @uuids ) {
+    my $bind = join( ',', ( map { '?' } @uuids ) );
+    Trog::SQLite::bulk_insert( $dbh, 'post', ['uuid'], 'IGNORE', @uuids );
+    return $dbh->selectall_hashref( "SELECT id,uuid FROM post WHERE uuid IN ($bind)", 'uuid', {}, @uuids );
 }
 
 # It is important we use get() instead of read() because of incomplete data.
-sub build_routes($data_obj,$posts=[]) {
+sub build_routes ( $data_obj, $posts = [] ) {
     my $dbh = _dbh();
     @$posts = $data_obj->get( limit => 0, acls => ['admin'] ) unless @$posts;
 
     my @uuids = map { $_->{id} } @$posts;
-    my $pids = _id_for_uuid($dbh,@uuids);
+    my $pids  = _id_for_uuid( $dbh, @uuids );
     foreach my $post (@$posts) {
-        $post->{post_id} = $pids->{$post->{id}}{id};
+        $post->{post_id} = $pids->{ $post->{id} }{id};
     }
 
     # Ensure the callbacks we need are installed
-    Trog::SQLite::bulk_insert($dbh,'callbacks', [qw{callback}], 'IGNORE', (uniq map { $_->{callback} } @$posts) );
+    Trog::SQLite::bulk_insert( $dbh, 'callbacks', [qw{callback}], 'IGNORE', ( uniq map { $_->{callback} } @$posts ) );
 
-    my $m = $dbh->selectall_hashref("SELECT id, method FROM methods", 'method');
-    foreach my $k (keys(%$m)) { $m->{$k} = $m->{$k}->{id} };
-    my $c = $dbh->selectall_hashref("SELECT id, callback FROM callbacks", 'callback');
-    foreach my $k (keys(%$c)) { $c->{$k} = $c->{$k}->{id} };
+    my $m = $dbh->selectall_hashref( "SELECT id, method FROM methods", 'method' );
+    foreach my $k ( keys(%$m) ) { $m->{$k} = $m->{$k}->{id} }
+    my $c = $dbh->selectall_hashref( "SELECT id, callback FROM callbacks", 'callback' );
+    foreach my $k ( keys(%$c) ) { $c->{$k} = $c->{$k}->{id} }
     @$posts = map {
-        $_->{method_id}   = $m->{$_->{method}};
-        $_->{callback_id} = $c->{$_->{callback}};
+        $_->{method_id}   = $m->{ $_->{method} };
+        $_->{callback_id} = $c->{ $_->{callback} };
         $_
     } @$posts;
 
-    my @routes = map { ($_->{post_id}, $_->{local_href}, $_->{method_id}, $_->{callback_id} ) } @$posts;
-    Trog::SQLite::bulk_insert($dbh,'routes', [qw{post_id route method_id callback_id}], 'IGNORE', @routes);
+    my @routes = map { ( $_->{post_id}, $_->{local_href}, $_->{method_id}, $_->{callback_id} ) } @$posts;
+    Trog::SQLite::bulk_insert( $dbh, 'routes', [qw{post_id route method_id callback_id}], 'IGNORE', @routes );
 
     # Now, compile the post aliases
     my %routes_actual = routes();
     foreach my $post (@$posts) {
-        next unless (ref $post->{aliases} eq 'ARRAY') && @{$post->{aliases}};
+        next unless ( ref $post->{aliases} eq 'ARRAY' ) && @{ $post->{aliases} };
         my $route = $post->{local_href};
-        Trog::SQLite::bulk_insert($dbh, 'post_aliases', [qw{route_id alias}], 'IGNORE', map { ($routes_actual{$route}{id}, $_) } @{$post->{aliases}} );
+        Trog::SQLite::bulk_insert( $dbh, 'post_aliases', [qw{route_id alias}], 'IGNORE', map { ( $routes_actual{$route}{id}, $_ ) } @{ $post->{aliases} } );
     }
 }
 
@@ -144,7 +151,7 @@ sub build_routes($data_obj,$posts=[]) {
 sub _dbh {
     my $file   = 'schema/flatfile.schema';
     my $dbname = "data/posts.db";
-    return Trog::SQLite::dbh($file,$dbname);
+    return Trog::SQLite::dbh( $file, $dbname );
 }
 
 1;