mass tidy of modules

lib/TCMS.pm

@@ -6,7 +6,7 @@ use warnings;
 no warnings 'experimental';
 use feature qw{signatures state};
 
-use Clone qw{clone};
+use Clone        qw{clone};
 use Date::Format qw{strftime};
 
 use Sys::Hostname();
@@ -17,11 +17,11 @@ 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;
 use URI();
-use Ref::Util qw{is_coderef is_hashref is_arrayref}; 
+use Ref::Util qw{is_coderef is_hashref is_arrayref};
 
 #Grab our custom routes
 use FindBin::libs;
@@ -72,11 +72,11 @@ sub _app {
     my $start = [gettimeofday];
 
     # Build the routing table
-    state ($conf, $data, %aliases);
+    state( $conf, $data, %aliases );
 
-    $conf  //= Trog::Config::get();
-    $data  //= Trog::Data->new($conf);
-    my %routes = %{_routes($data)};
+    $conf //= Trog::Config::get();
+    $data //= Trog::Data->new($conf);
+    my %routes = %{ _routes($data) };
     %aliases = $data->aliases() unless %aliases;
 
     # XXX this is built progressively across the forks, leading to inconsistent behavior.
@@ -187,7 +187,7 @@ sub _app {
     if ( !exists $routes{$path} ) {
         my @captures;
 
-		# XXX maybe this should all just go into $query?
+        # XXX maybe this should all just go into $query?
         # TODO can optimize by having separate hashes for capture/non-capture routes
         foreach my $pattern ( keys(%routes) ) {
             @captures = $path =~ m/^$pattern$/;
@@ -202,8 +202,8 @@ sub _app {
         }
     }
 
-	# Set the 'data' in the query that the route specifically overrides, which we are also using for the catpured data
-	# This also means you have to validate both of them via parameters if you set that up.
+    # Set the 'data' in the query that the route specifically overrides, which we are also using for the catpured data
+    # This also means you have to validate both of them via parameters if you set that up.
     @{$query}{ keys( %{ $routes{$path}{'data'} } ) } = values( %{ $routes{$path}{'data'} } ) if ref $routes{$path}{'data'} eq 'HASH' && %{ $routes{$path}{'data'} };
 
     # Ensure any short-circuit routes can log the request, and return the server-timing headers properly
@@ -232,10 +232,10 @@ sub _app {
         );
     }
 
-	# If it's a file, just serve it
-    return Trog::FileHandler::serve( $fullpath, "www/$path",  $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "www/$path";
+    # If it's a file, just serve it
+    return Trog::FileHandler::serve( $fullpath, "www/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "www/$path";
 
-	# Figure out if we have a logged in user, so we can serve them user-specific files
+    # Figure out if we have a logged in user, so we can serve them user-specific files
     my $cookies = {};
     if ( $env->{HTTP_COOKIE} ) {
         $cookies = CGI::Cookie->parse( $env->{HTTP_COOKIE} );
@@ -250,7 +250,7 @@ sub _app {
 
     return Trog::FileHandler::serve( $fullpath, "totp/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "totp/$path" && $active_user;
 
-	# Now that we have firmed up the actual routing, let's validate.
+    # Now that we have firmed up the actual routing, let's validate.
     return _forbidden($query) if exists $routes{$path}{auth} && !$active_user;
     return _notfound($query) unless exists $routes{$path} && ref $routes{$path} eq 'HASH' && keys( %{ $routes{$path} } );
     return _badrequest($query) unless grep { $env->{REQUEST_METHOD} eq $_ } ( $routes{$path}{method} || '', 'HEAD' );
@@ -263,28 +263,30 @@ sub _app {
     # Set the urchin parameters if necessary.
     %$Trog::Log::DBI::urchin = map { $_ => delete $query->{$_} } qw{utm_source utm_medium utm_campaign utm_term utm_content};
 
-	# Now that we've parsed the query and know where we want to go, we should murder everything the route does not explicitly want, and validate what it does
-	my $parameters = $routes{$path}{parameters};
-	if ($parameters) {
-		die "invalid route definition for $path: bad parameters" unless is_hashref($parameters);
-		my @known_params = keys(%$parameters);
-		for my $param (@known_params) {
-			die "Invalid route definition for $path: parameter $param must correspond to a validation CODEREF." unless is_coderef($parameters->{$param});
-			# A missing parameter is not necessarily a problem.
-			next unless $query->{$param};
-			# But if we have it, and it's bad, nack it, so that scanners get fail2banned.
-			DEBUG("Rejected $fullpath for bad query param $param");
-			return _badrequest($query) unless $parameters->{$param}->($query->{$param});
-		}
-
-		# Smack down passing of unnecessary fields
-		foreach my $field (keys(%$query)) {
-			next if List::Util::any { $field eq $_ } @known_params;
-			next if List::Util::any { $field eq $_ } qw{start route streaming method fullpath};
-			DEBUG("Rejected $fullpath for query param $field");
-			return _badrequest($query);
-		}
-	}
+    # Now that we've parsed the query and know where we want to go, we should murder everything the route does not explicitly want, and validate what it does
+    my $parameters = $routes{$path}{parameters};
+    if ($parameters) {
+        die "invalid route definition for $path: bad parameters" unless is_hashref($parameters);
+        my @known_params = keys(%$parameters);
+        for my $param (@known_params) {
+            die "Invalid route definition for $path: parameter $param must correspond to a validation CODEREF." unless is_coderef( $parameters->{$param} );
+
+            # A missing parameter is not necessarily a problem.
+            next unless $query->{$param};
+
+            # But if we have it, and it's bad, nack it, so that scanners get fail2banned.
+            DEBUG("Rejected $fullpath for bad query param $param");
+            return _badrequest($query) unless $parameters->{$param}->( $query->{$param} );
+        }
+
+        # Smack down passing of unnecessary fields
+        foreach my $field ( keys(%$query) ) {
+            next if List::Util::any { $field eq $_ } @known_params;
+            next if List::Util::any { $field eq $_ } qw{start route streaming method fullpath};
+            DEBUG("Rejected $fullpath for query param $field");
+            return _badrequest($query);
+        }
+    }
 
     # Let's open up our default route before we bother thinking about routing any harder
     return $routes{default}{callback}->($query) unless -f "config/setup";
@@ -306,8 +308,8 @@ sub _app {
         return _static( $fullpath, $path,     $start, $streaming ) if -f "www/statics/$path";
     }
 
-    $query->{deflate}  = $deflate;
-    $query->{user}     = $active_user;
+    $query->{deflate} = $deflate;
+    $query->{user}    = $active_user;
 
     #Set various things we don't want overridden
     $query->{body}         = '';
@@ -327,6 +329,7 @@ sub _app {
     $query->{to} = URI->new( $query->{to} // '' )->path() || $query->{to} if $query->{to};
 
     DEBUG("DISPATCH $path to $routes{$path}{callback}");
+
     #XXX there is a trick to now use strict refs, but I don't remember it right at the moment
     {
         no strict 'refs';
@@ -344,16 +347,16 @@ sub _app {
 }
 
 #XXX Return a clone of the routing table ref, because code modifies it later
-sub _routes ($data={}) {
+sub _routes ( $data = {} ) {
     state %routes;
-    return clone(\%routes) if %routes;
+    return clone( \%routes ) if %routes;
 
-    if (!$data) {
+    if ( !$data ) {
         my $conf = Trog::Config::get();
-        $data    = Trog::Data->new($conf);
+        $data = Trog::Data->new($conf);
     }
     my %roots = $data->routes();
-    %routes = %Trog::Routes::HTML::routes;
+    %routes                                      = %Trog::Routes::HTML::routes;
     @routes{ keys(%Trog::Routes::JSON::routes) } = values(%Trog::Routes::JSON::routes);
     @routes{ keys(%roots) }                      = values(%roots);
 
@@ -364,7 +367,7 @@ sub _routes ($data={}) {
         callback => \&robots,
     };
 
-    return clone(\%routes);
+    return clone( \%routes );
 }
 
 =head2 robots

lib/Trog/Auth.pm

@@ -79,12 +79,11 @@ Returns the oldest user with the admin ACL.
 
 sub primary_user {
     my $dbh  = _dbh();
-    my $rows = $dbh->selectall_arrayref( "SELECT username FROM user_acl WHERE acl='admin' LIMIT 1", { Slice => {} });
+    my $rows = $dbh->selectall_arrayref( "SELECT username FROM user_acl WHERE acl='admin' LIMIT 1", { Slice => {} } );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]{username};
 }
 
-
 =head2 get_existing_user_data
 
 Fetch existing settings for a user.
@@ -126,6 +125,7 @@ sub username2display ($name) {
 }
 
 sub username2classname ($name) {
+
     # Just return the user's post UUID.
     state $data;
     state $conf;
@@ -133,13 +133,15 @@ sub username2classname ($name) {
     $data //= Trog::Data->new($conf);
 
     state @userposts = $data->get( tags => ['about'], acls => [qw{admin}] );
+
     # Users are always self-authored, you see
 
-    my $user_obj  = List::Util::first { ( $_->{user} || '' ) eq $name } @userposts;
-    my $NNname = $user_obj->{id} || '';
+    my $user_obj = List::Util::first { ( $_->{user} || '' ) eq $name } @userposts;
+    my $NNname   = $user_obj->{id} || '';
     $NNname =~ tr/-/_/;
     return "a_$NNname";
 }
+
 =head2 acls4user(STRING username) = ARRAYREF
 
 Return the list of ACLs belonging to the user.
@@ -215,7 +217,7 @@ sub totp ( $user, $domain ) {
             level         => 'L',
             casesensitive => 1,
             lightcolor    => Imager::Color->new( 255, 255, 255 ),
-            darkcolor     => Imager::Color->new( 0, 0, 0 ),
+            darkcolor     => Imager::Color->new( 0,   0,   0 ),
         );
 
         my $img = $qrcode->plot($uri);
@@ -280,7 +282,7 @@ sub mksession ( $user, $pass, $token ) {
         $totp->{secret} = $secret;
         my $rc = $totp->validate_otp( otp => $token, secret => $secret, tolerance => 3, period => 30, digits => 6 );
         INFO("TOTP Auth failed for user $user") unless $rc;
-        return '' unless $rc;
+        return ''                               unless $rc;
     }
 
     # Issue cookie
@@ -321,7 +323,7 @@ sub useradd ( $user, $displayname, $pass, $acls, $contactemail ) {
     die "No display name set!" unless $displayname;
     die "Username and display name cannot be the same" if $user eq $displayname;
     die "No password set for user!"                    if !$pass && !$hash;
-    die "ACLs must be array" unless is_arrayref($acls);
+    die "ACLs must be array"             unless is_arrayref($acls);
     die "No contact email set for user!" unless $contactemail;
 
     my $dbh = _dbh();

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/DataModule.pm

@@ -50,12 +50,12 @@ sub new ( $class, $config ) {
 }
 
 #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
 
@@ -131,7 +131,7 @@ sub _fixup ( $self, @filtered ) {
 
         $subj->{method} = 'GET' unless exists( $subj->{method} );
 
-        $subj->{user_class} = Trog::Auth::username2classname($subj->{user});
+        $subj->{user_class} = Trog::Auth::username2classname( $subj->{user} );
         $subj
     } @filtered;
 
@@ -139,7 +139,7 @@ sub _fixup ( $self, @filtered ) {
 }
 
 sub _filter_param ( $query, $param, @filtered ) {
-    @filtered = grep { ( $_->{$param} || '') eq $query->{$param} } @filtered;
+    @filtered = grep { ( $_->{$param} || '' ) eq $query->{$param} } @filtered;
     @filtered = _dedup_versions( $query->{version}, @filtered );
     return @filtered;
 }
@@ -152,7 +152,7 @@ sub filter ( $self, $query, @filtered ) {
     # If an ID or title or acl is passed, just get that (and all it's prior versions)
     foreach my $key (qw{id title aclname}) {
         next unless $query->{$key};
-        return _filter_param( $query, $key, @filtered);
+        return _filter_param( $query, $key, @filtered );
     }
 
     @filtered = _dedup_versions( undef, @filtered );
@@ -174,7 +174,7 @@ sub filter ( $self, $query, @filtered ) {
         grep {
             my $t = $_;
             grep { $t eq $_ } @{ $query->{tags} }
-          } @$tags
+        } @$tags
     } @filtered if @{ $query->{tags} };
 
     # Filter posts *matching* the passed exclude_tag(s), if any
@@ -183,7 +183,7 @@ sub filter ( $self, $query, @filtered ) {
         !grep {
             my $t = $_;
             grep { $t eq $_ } @{ $query->{exclude_tags} }
-          } @$tags
+        } @$tags
     } @filtered if @{ $query->{exclude_tags} };
 
     # Filter posts without the proper ACLs
@@ -192,7 +192,7 @@ sub filter ( $self, $query, @filtered ) {
         grep {
             my $t = $_;
             grep { $t eq $_ } @{ $query->{acls} }
-          } @$tags
+        } @$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};
@@ -404,7 +404,7 @@ 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->{preview} = $post->{href} if $post->{app} && $post->{app} eq 'image';
+    $post->{preview}   = $post->{href} if $post->{app} && $post->{app} eq 'image';
     delete $post->{app};
     delete $post->{file};
     delete $post->{preview_file};
@@ -441,9 +441,9 @@ sub _process ($post) {
     $post->{audio_content_type} = Trog::Utils::mime_type("www/$post->{audio_href}") if $post->{audio_href};
     $post->{content_type} ||= 'text/html';
 
-    $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_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} };
 
     return $post;

lib/Trog/Log.pm

@@ -21,11 +21,12 @@ $LOGNAME = $ENV{CUSTOM_LOG} if $ENV{CUSTOM_LOG};
 
 my $LEVEL = $ENV{WWW_VERBOSE} ? 'debug' : 'info';
 
-our ($log, $user);
+our ( $log, $user );
 $Trog::Log::user = 'nobody';
 $Trog::Log::ip   = '0.0.0.0';
 
 sub log_init {
+
     # By default only log requests & warnings.
     # Otherwise emit debug messages.
     my $rotate = Log::Dispatch::FileRotate->new(
@@ -45,9 +46,9 @@ sub log_init {
 
     # Send things like requests in to the stats log
     my $dblog = Trog::Log::DBI->new(
-        name => 'dbi',
+        name      => 'dbi',
         min_level => $LEVEL,
-        dbh  => _dbh(),
+        dbh       => _dbh(),
     );
 
     $log = Log::Dispatch->new();
@@ -63,7 +64,7 @@ sub log_init {
 my $rq;
 
 sub _dbh {
-	return Trog::SQLite::dbh( 'schema/log.schema', "logs/log.db" );
+    return Trog::SQLite::dbh( 'schema/log.schema', "logs/log.db" );
 }
 
 sub is_debug {

lib/Trog/Log/DBI.pm

@@ -5,13 +5,13 @@ use warnings;
 
 use parent qw{Log::Dispatch::DBI};
 
-use Ref::Util qw{is_arrayref};
+use Ref::Util     qw{is_arrayref};
 use Capture::Tiny qw{capture_merged};
 
-use POSIX qw{mktime};
+use POSIX           qw{mktime};
 use POSIX::strptime qw{strptime};
 
-our ($referer, $ua, $urchin);
+our ( $referer, $ua, $urchin );
 
 sub create_statement {
     my $self = shift;
@@ -31,29 +31,30 @@ sub create_statement {
 my %buffer;
 
 sub log_message {
-    my ($self, %params) = @_;
+    my ( $self, %params ) = @_;
 
     # Rip apart the message.  If it's got any extended info, lets grab that too.
     my $msg = $params{message};
     my $message;
-    my ($date, $uuid, $ip, $user, $method, $code, $route) = $msg =~ m!^([\w|\-|:]+) \[INFO\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (\w+) (\d+) (.+)!;
+    my ( $date, $uuid, $ip, $user, $method, $code, $route ) = $msg =~ m!^([\w|\-|:]+) \[INFO\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (\w+) (\d+) (.+)!;
 
     # Otherwise, let's mark it down in the "messages" table.  This will be deferred until the final write.
-    if (!$date) {
-        ($date, $uuid, $ip, $user, $message) = $msg =~ m!^([\w|\-|:]+) \[\w+\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (.+)!;
+    if ( !$date ) {
+        ( $date, $uuid, $ip, $user, $message ) = $msg =~ m!^([\w|\-|:]+) \[\w+\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (.+)!;
 
         $buffer{$uuid} //= [];
-        push(@{$buffer{$uuid}}, $message);
+        push( @{ $buffer{$uuid} }, $message );
         return 1;
     }
 
     # If this is a mangled log, forget it.
     return unless $date && $uuid;
 
-	# 2024-01-20T22:37:41Z
+    # 2024-01-20T22:37:41Z
     # Transform the date into an epoch so we can do math on it
-    my $fmt = "%Y-%m-%dT%H:%M:%SZ";
-    my @cracked = strptime($date, $fmt);
+    my $fmt     = "%Y-%m-%dT%H:%M:%SZ";
+    my @cracked = strptime( $date, $fmt );
+
     #XXX get a dumb warning otherwise
     pop @cracked;
     my $epoch = mktime(@cracked);
@@ -64,20 +65,20 @@ sub log_message {
     $ua      //= 'none';
     $urchin  //= {};
 
-    my $res = $self->{sth}->execute($uuid, $epoch, $ip, $user, $method, $route, $referer, $ua, $code );
+    my $res = $self->{sth}->execute( $uuid, $epoch, $ip, $user, $method, $route, $referer, $ua, $code );
 
     # Dump in the accumulated messages
-    if (is_arrayref($buffer{$uuid}) && @{$buffer{$uuid}}) {
-        $self->{sth2}->bind_param_array(1, $uuid);
-        $self->{sth2}->bind_param_array(2, $buffer{$uuid});
-        $self->{sth2}->execute_array({});
+    if ( is_arrayref( $buffer{$uuid} ) && @{ $buffer{$uuid} } ) {
+        $self->{sth2}->bind_param_array( 1, $uuid );
+        $self->{sth2}->bind_param_array( 2, $buffer{$uuid} );
+        $self->{sth2}->execute_array( {} );
         delete $buffer{$uuid};
 
     }
 
     # Record urchin data if there is any.
-    if (%$urchin && $urchin->{utm_source}) {
-        $self->{sth3}->execute($uuid, $urchin->{utm_source}, $urchin->{utm_medium}, $urchin->{utm_campaign}, $urchin->{utm_term}, $urchin->{utm_content});
+    if ( %$urchin && $urchin->{utm_source} ) {
+        $self->{sth3}->execute( $uuid, $urchin->{utm_source}, $urchin->{utm_medium}, $urchin->{utm_campaign}, $urchin->{utm_term}, $urchin->{utm_content} );
     }
 
     return $res;

lib/Trog/Log/Metrics.pm

@@ -16,7 +16,7 @@ and for reasoning about the various things that it's Urchin-compatible data can
 =cut
 
 sub _dbh {
-	return Trog::SQLite::dbh( 'schema/log.schema', "logs/log.db" );
+    return Trog::SQLite::dbh( 'schema/log.schema', "logs/log.db" );
 }
 
 =head2 requests_per(ENUM period{second,minute,hour,day,month,year}, INTEGER num_periods, [TIME_T before], INTEGER[] @codes)
@@ -36,42 +36,42 @@ Optionally filter by response code(s).
 
 =cut
 
-sub requests_per ($period, $num_periods, $before, @codes) {
+sub requests_per ( $period, $num_periods, $before, @codes ) {
     $before ||= time;
 
-	# Build our periods in seconds.
-	state %period2time = (
-		second => 1,
-		minute => 60,
-		hour   => 3600,
-		day    => 86400,
-		week   => 604800,
-		month  => 2592000,
-		year   => 31356000,
-	);
-
-	my $interval = $period2time{$period};
-	die "Invalid time interval passed." unless $interval;
-
-	my @input;
-	my $whereclause = '';
-	if (@codes) {
-		my $bind = join(',', (map { '?' } @codes));
-		$whereclause = "WHERE code IN ($bind)";
-		push(@input, @codes);
-	}
-	push(@input, $interval, $before, $num_periods);
+    # Build our periods in seconds.
+    state %period2time = (
+        second => 1,
+        minute => 60,
+        hour   => 3600,
+        day    => 86400,
+        week   => 604800,
+        month  => 2592000,
+        year   => 31356000,
+    );
+
+    my $interval = $period2time{$period};
+    die "Invalid time interval passed." unless $interval;
+
+    my @input;
+    my $whereclause = '';
+    if (@codes) {
+        my $bind = join( ',', ( map { '?' } @codes ) );
+        $whereclause = "WHERE code IN ($bind)";
+        push( @input, @codes );
+    }
+    push( @input, $interval, $before, $num_periods );
 
     my $query = "SELECT count(*) FROM all_requests $whereclause GROUP BY date / ? HAVING date < ? LIMIT ?";
 
-    my @results = map { $_->[0] } @{ _dbh()->selectall_arrayref($query, undef, @input) };
-	my $np = @results < $num_periods ? @results : $num_periods;
-	my @labels = reverse map { "$_ $period(s) ago" } (1..$np);
+    my @results = map { $_->[0] } @{ _dbh()->selectall_arrayref( $query, undef, @input ) };
+    my $np      = @results < $num_periods ? @results : $num_periods;
+    my @labels  = reverse map { "$_ $period(s) ago" } ( 1 .. $np );
 
-	return {
-		labels => \@labels,
-		data   => \@results,
-	};
+    return {
+        labels => \@labels,
+        data   => \@results,
+    };
 }
 
 1;

lib/Trog/Renderer.pm

@@ -54,8 +54,8 @@ sub render ( $class, %options ) {
     $renderer = $renderers{$rendertype};
     return _yeet( $renderer, "Renderer for $rendertype is not defined!", %options ) unless $renderer;
     return _yeet( $renderer, "Status code not provided",                 %options ) if !$options{code} && !$options{component};
-    return _yeet( $renderer, "Template data not provided", %options ) unless $options{data};
-    return _yeet( $renderer, "Template not provided",      %options ) unless $options{template};
+    return _yeet( $renderer, "Template data not provided",               %options ) unless $options{data};
+    return _yeet( $renderer, "Template not provided",                    %options ) unless $options{template};
 
     #TODO future - save the components too and then compose them?
     my $skip_save = !$options{component} || !$options{data}{route} || $options{data}{has_query} || $options{data}{user} || ( $options{code} // 0 ) != 200 || Trog::Log::is_debug();

lib/Trog/Renderer/Base.pm

@@ -72,7 +72,7 @@ sub render (%options) {
 
 sub headers ( $options, $body ) {
     my $query   = $options->{data};
-    my $uh      = ref $options->{headers} eq 'HASH' ? $options->{headers} : {};
+    my $uh      = ref $options->{headers} eq 'HASH'      ? $options->{headers}        : {};
     my $ct      = $options->{contenttype} eq 'text/html' ? "text/html; charset=UTF-8" : "$options->{contenttype};";
     my %headers = (
         'Content-Type'           => $ct,
@@ -80,7 +80,7 @@ sub headers ( $options, $body ) {
         'Cache-Control'          => $query->{cachecontrol} // $Trog::Vars::cache_control{revalidate},
         'X-Content-Type-Options' => 'nosniff',
         'Vary'                   => 'Accept-Encoding',
-        'Server-Timing'          => "render;dur=".(tv_interval($query->{start}) * 1000),
+        'Server-Timing'          => "render;dur=" . ( tv_interval( $query->{start} ) * 1000 ),
         %$uh,
     );
 

lib/Trog/Routes/HTML.pm

@@ -150,11 +150,11 @@ our %routes = (
         callback => \&Trog::Routes::HTML::processed,
         noindex  => 1,
     },
-	'/metrics' => {
-		method => 'GET',
-		auth   => 1,
-		callback => \&Trog::Routes::HTML::metrics,
-	},
+    '/metrics' => {
+        method   => 'GET',
+        auth     => 1,
+        callback => \&Trog::Routes::HTML::metrics,
+    },
 
     #TODO transform into posts?
     '/sitemap',
@@ -309,9 +309,9 @@ sub index ( $query, $content = '', $i_styles = [], $i_scripts = [] ) {
             categories   => \@series,
             stylesheets  => \@styles,
             print_styles => \@p_styles,
-			scripts      => $i_scripts,
+            scripts      => $i_scripts,
             show_madeby  => $Theme::show_madeby ? 1 : 0,
-            embed        => $query->{embed} ? 1 : 0,
+            embed        => $query->{embed}     ? 1 : 0,
             embed_video  => $query->{primary_post}{is_video},
             default_tags => $default_tags,
             meta_desc    => $meta_desc,
@@ -371,7 +371,7 @@ sub _build_social_meta ( $query, $title ) {
     my $social = HTML::SocialMeta->new(%sopts);
     $meta_tags = eval { $social->create($card_type) };
     $meta_tags =~ s/content="video"/content="video:other"/mg if $meta_tags;
-    $meta_tags .= $extra_tags if $extra_tags;
+    $meta_tags .= $extra_tags                                if $extra_tags;
 
     print STDERR "WARNING: Theme misconfigured, social media tags will not be included\n$@\n" if $Trog::Themes::theme_dir && !$meta_tags;
     return ( $default_tags, $meta_desc, $meta_tags );
@@ -653,7 +653,7 @@ Renders the configuration page, or redirects you back to the login page.
 =cut
 
 sub config ( $query = {} ) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $query->{failure} //= -1;
@@ -811,7 +811,7 @@ Implements /config/save route.  Saves what little configuration we actually use
 =cut
 
 sub config_save ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $conf->param( 'general.theme',              $query->{theme} )      if defined $query->{theme};
@@ -839,7 +839,7 @@ Clone a theme by copying a directory.
 =cut
 
 sub themeclone ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my ( $theme, $newtheme ) = ( $query->{theme}, $query->{newtheme} );
@@ -863,7 +863,7 @@ Saves posts submitted via the /post pages
 =cut
 
 sub post_save ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my $to = delete $query->{to};
@@ -899,7 +899,7 @@ Saves / updates new users.
 =cut
 
 sub profile ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     # Find the user's post and edit it
@@ -907,12 +907,14 @@ sub profile ($query) {
     $data //= Trog::Data->new($conf);
 
     my @userposts = $data->get( tags => ['about'], acls => [qw{admin}] );
+
     # Users are always self-authored, you see
 
-    my $user_obj  = List::Util::first { ( $_->{user} || '' ) eq $query->{username} } @userposts;
+    my $user_obj = List::Util::first { ( $_->{user} || '' ) eq $query->{username} } @userposts;
 
     if ( $query->{username} ne $user_obj->{user} || $query->{password} || $query->{contact_email} ne $user_obj->{contact_email} || $query->{display_name} ne $user_obj->{display_name} ) {
         my $for_user = Trog::Auth::acls4user( $query->{username} );
+
         #TODO support non-admin users
         my @acls = @$for_user ? @$for_user : qw{admin};
         Trog::Auth::useradd( $query->{username}, $query->{display_name}, $query->{password}, \@acls, $query->{contact_email} );
@@ -925,13 +927,13 @@ sub profile ($query) {
     # Use the display name as the title
     $query->{title} = $query->{display_name};
 
-    my %merged    = (
+    my %merged = (
         %$user_obj,
         %$query,
         $query->{display_name} ? ( local_href => "/users/$query->{display_name}" ) : ( local_href => $user_obj->{local_href} ),
     );
 
-    return post_save(\%merged);
+    return post_save( \%merged );
 }
 
 =head2 post_delete
@@ -941,7 +943,7 @@ deletes posts.
 =cut
 
 sub post_delete ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     state $data;
@@ -1074,7 +1076,7 @@ sub posts ( $query, $direct = 0 ) {
     my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
     push( @{ $query->{user_acls} }, 'public' );
     push( @{ $query->{user_acls} }, 'unlisted' ) if $query->{id};
-    push( @{ $query->{user_acls} }, 'private' ) if $is_admin;
+    push( @{ $query->{user_acls} }, 'private' )  if $is_admin;
     my @posts;
 
     # Discover this user's visibility, so we can make them post in this category by default
@@ -1152,7 +1154,7 @@ sub posts ( $query, $direct = 0 ) {
     $query->{title} ||= @$tags && $query->{domain} ? "$query->{domain} : @$tags" : undef;
 
     #Handle paginator vars
-	$query->{limit} ||= 25;
+    $query->{limit} ||= 25;
     my $limit       = int( $query->{limit} );
     my $now_year    = ( localtime(time) )[5] + 1900;
     my $oldest_year = $now_year - 20;                  #XXX actually find oldest post year
@@ -1280,8 +1282,8 @@ sub _post_helper ( $query, $tags, $acls ) {
     state $data;
     $data //= Trog::Data->new($conf);
 
-	$query->{page} ||= 1;
-	$query->{limit} ||= 25;
+    $query->{page}  ||= 1;
+    $query->{limit} ||= 25;
 
     return $data->get(
         older        => $query->{older},
@@ -1443,8 +1445,8 @@ sub sitemap ($query) {
     @to_map = sort @to_map unless $is_index;
     my $styles = ['sitemap.css'];
 
-    $query->{title}        = "$query->{domain} : Sitemap";
-    $query->{template}     = 'sitemap.tx',
+    $query->{title}    = "$query->{domain} : Sitemap";
+    $query->{template} = 'sitemap.tx',
       $query->{to_map}     = \@to_map,
       $query->{is_index}   = $is_index,
       $query->{route_type} = $route_type,
@@ -1524,7 +1526,7 @@ Basically a thin wrapper around Pod::Html.
 =cut
 
 sub manual ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     require Pod::Html;
@@ -1564,7 +1566,7 @@ sub processed ($query) {
 }
 
 sub metrics ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $query->{failure} //= -1;
@@ -1579,7 +1581,7 @@ sub metrics ($query) {
         },
         undef,
         ['post.css'],
-		['chart.js'],
+        ['chart.js'],
     );
 }
 

lib/Trog/Routes/JSON.pm

@@ -51,10 +51,15 @@ our %routes = (
         robot_name => '/api/auth_change_request/*',
     },
     '/api/requests_per' => {
-        method => 'GET',
-        auth   => 1,
+        method     => 'GET',
+        auth       => 1,
         parameters => {
-            period      => sub { grep { my $valid=$_; List::Util::any { $_ eq $valid } @_ } qw{second minute hour day week month year} },
+            period => sub {
+                grep {
+                    my $valid = $_;
+                    List::Util::any { $_ eq $valid } @_
+                } qw{second minute hour day week month year};
+            },
             num_periods => \&Scalar::Util::looks_like_number,
             before      => \&Scalar::Util::looks_like_number,
             code        => \&Scalar::Util::looks_like_number,
@@ -87,7 +92,7 @@ sub catalog ($query) {
 }
 
 sub webmanifest ($query) {
-    state $headers = { ETag => 'manifest-' . _version() };
+    state $headers  = { ETag => 'manifest-' . _version() };
     state %manifest = (
         "icons" => [
             { "src" => "$theme_dir/img/icon/favicon-32.png",  "type" => "image/png", "sizes" => "32x32" },
@@ -113,11 +118,11 @@ sub process_auth_change_request ($query) {
     );
 }
 
-sub requests_per($query) {
-    my $code = Trog::Utils::coerce_array($query->{code});
+sub requests_per ($query) {
+    my $code = Trog::Utils::coerce_array( $query->{code} );
     return _render(
-        200, undef, 
-        %{Trog::Log::Metrics::requests_per($query->{period}, $query->{num_periods}, $query->{before}, @$code )}
+        200, undef,
+        %{ Trog::Log::Metrics::requests_per( $query->{period}, $query->{num_periods}, $query->{before}, @$code ) }
     );
 }
 

lib/Trog/SQLite.pm

@@ -60,7 +60,8 @@ sub dbh {
     $dbh->{$dbname} = $db;
 
     # Turn on fkeys
-    $db->do("PRAGMA foreign_keys = ON")  or die "Could not enable foreign keys";
+    $db->do("PRAGMA foreign_keys = ON") or die "Could not enable foreign keys";
+
     # Turn on WALmode
     $db->do("PRAGMA journal_mode = WAL") or die "Could not enable WAL mode";
 

lib/Trog/SQLite/TagIndex.pm

@@ -56,7 +56,7 @@ sub tags {
 
 sub add_post ( $post, $data_obj ) {
     my $dbh = _dbh();
-    build_index( $data_obj,  [$post] );
+    build_index( $data_obj, [$post] );
     build_routes( $data_obj, [$post] );
     return 1;
 }

lib/Trog/Utils.pm

@@ -55,18 +55,19 @@ my %extra_types = (
 );
 
 sub mime_type ($file) {
+
     # Use libmagic and if that doesn't work try guessing based on extension.
     my $mt;
     my $mf  = Mojo::File->new($file);
     my $ext = '.' . $mf->extname();
     $mt = Plack::MIME->mime_type($ext) if $ext;
     $mt ||= $extra_types{$ext} if exists $extra_types{$ext};
-    return $mt if $mt;
+    return $mt                 if $mt;
 
     # If all else fails, time for libmagic
     state $magic = File::LibMagic->new;
     my $maybe_ct = $magic->info_from_filename($file);
-    $mt = $maybe_ct->{mime_type} if (is_hashref( $maybe_ct ) && $maybe_ct->{mime_type});
+    $mt = $maybe_ct->{mime_type} if ( is_hashref($maybe_ct) && $maybe_ct->{mime_type} );
 
     return $mt;
 }

lib/Trog/Vars.pm

@@ -97,7 +97,7 @@ Remove unwanted params to keep data slim & secure.
 
 =cut
 
-sub filter ($data, $user_schema={}) {
+sub filter ( $data, $user_schema = {} ) {
     %$user_schema = (
         %schema,
         %$user_schema,
@@ -105,6 +105,7 @@ sub filter ($data, $user_schema={}) {
 
     # Filter all the irrelevant data
     foreach my $key ( keys(%$data) ) {
+
         # We need to have the key in the schema, and it validate.
         delete $data->{$key} unless List::Util::any { ( $_ eq $key ) && ( $user_schema->{$key}->( $data->{$key} ) ) } keys(%$user_schema);
 
@@ -112,7 +113,7 @@ sub filter ($data, $user_schema={}) {
         #print Dumper($data);
 
         # All parameters in the schema are MANDATORY.
-        foreach my $param (keys(%$user_schema)) {
+        foreach my $param ( keys(%$user_schema) ) {
             die "Missing mandatory parameter $param" unless exists $data->{$param};
         }
     }

lib/Trog/Zone.pm

@@ -29,11 +29,11 @@ Like any other post in TCMS it's versioned.
 
 =cut
 
-sub zone($domain, $version=undef) {
+sub zone ( $domain, $version = undef ) {
     my $conf = Trog::Config::get();
     my $data = Trog::Data->new($conf);
 
-    my @zonedata = $data->get( tags => ['zone'], acls => [qw{admin}], title => $domain  );
+    my @zonedata = $data->get( tags => ['zone'], acls => [qw{admin}], title => $domain );
     @zonedata = grep { $_->{version} == $version } @zonedata if defined $version;
     return @zonedata;
 }
@@ -69,7 +69,7 @@ my $spec = {
     acme_challenge => $Trog::Vars::not_ref,
 };
 
-sub addzone($query) {
+sub addzone ($query) {
     my $domain = $query->{title};
     return unless $domain;
     my ($latest) = zone($domain);
@@ -80,57 +80,57 @@ sub addzone($query) {
 
     #XXX TODO make this instead use @records2add, complexity demon BAD
     my $processor = Text::Xslate->new( path => 'www/templates/text' );
-    $query->{data} = $processor->render('zone.tx', $query);
+    $query->{data} = $processor->render( 'zone.tx', $query );
 
     %$latest = (
         %$latest,
-        Trog::Vars::filter($query, $spec),
+        Trog::Vars::filter( $query, $spec ),
     );
 
     $data->add($latest);
 
     #import into pdns
-    my ($ttl, $prio, $disabled) = (300, 0, 0);
+    my ( $ttl, $prio, $disabled ) = ( 300, 0, 0 );
 
-    my $insert_sql = q{insert into records (domain_id, name, type,content,ttl,prio,disabled) select id , ?, ?, ?, ?, ?, ? from domains where name=?};
+    my $insert_sql  = q{insert into records (domain_id, name, type,content,ttl,prio,disabled) select id , ?, ?, ?, ?, ?, ? from domains where name=?};
     my @records2add = (
-        [$query->{title},                    'SOA',  "$query->{title} soa.$query->{title} $query->{version} 10800 3600 604800 10800"],
-        [$query->{title},                    'A',    $query->{ip}   ],
-        [$query->{title},                    'AAAA', $query->{ip6}  ],
-        [$query->{ip_reversed},              'PTR',  $query->{title}],
-        [$query->{ip6_reversed},             'PTR',  $query->{title}],
-        [$query->{title},                    'MX',   "mail.$query->{title}"],
-        ["_smtps._tcp.mail.$query->{title}", 'SRV',  "5 587 ."     ],
-        ["_imaps._tcp.mail.$query->{title}", 'SRV',  "5 993 ."     ],
-        ["_pop3s._tcp.mail.$query->{title}", 'SRV',  "5 995 ."     ],
-        ["_dmarc.$query->{title}",           'TXT',  "v=DMARC1; p=reject; rua=mailto:postmaster\@$query->{title}; ruf=mailto:postmaster\@$query->{title}"],
-        ["mail._domainkey.$query->{title}",  'TXT',  "v=DKIM1; h=sha256; k=rsa; t=y; p=$query->{dkim_pkey}"],
-        [$query->{title},                    'TXT',  "v=spf1 +mx +a +ip4:$query->{ip} +ip6:$query->{ip6} -all"],
-        [$query->{title},                    'TXT',  "google-site-verification=$query->{gsv_string}"],
-        ["_acme-challenge.$query->{title}",  'TXT',  $query->{acme_challenge}],
-        [$query->{title},                    'CAA',  '0 issue "letsencrypt.org"'],
+        [ $query->{title},                    'SOA',  "$query->{title} soa.$query->{title} $query->{version} 10800 3600 604800 10800" ],
+        [ $query->{title},                    'A',    $query->{ip} ],
+        [ $query->{title},                    'AAAA', $query->{ip6} ],
+        [ $query->{ip_reversed},              'PTR',  $query->{title} ],
+        [ $query->{ip6_reversed},             'PTR',  $query->{title} ],
+        [ $query->{title},                    'MX',   "mail.$query->{title}" ],
+        [ "_smtps._tcp.mail.$query->{title}", 'SRV',  "5 587 ." ],
+        [ "_imaps._tcp.mail.$query->{title}", 'SRV',  "5 993 ." ],
+        [ "_pop3s._tcp.mail.$query->{title}", 'SRV',  "5 995 ." ],
+        [ "_dmarc.$query->{title}",           'TXT',  "v=DMARC1; p=reject; rua=mailto:postmaster\@$query->{title}; ruf=mailto:postmaster\@$query->{title}" ],
+        [ "mail._domainkey.$query->{title}",  'TXT',  "v=DKIM1; h=sha256; k=rsa; t=y; p=$query->{dkim_pkey}" ],
+        [ $query->{title},                    'TXT',  "v=spf1 +mx +a +ip4:$query->{ip} +ip6:$query->{ip6} -all" ],
+        [ $query->{title},                    'TXT',  "google-site-verification=$query->{gsv_string}" ],
+        [ "_acme-challenge.$query->{title}",  'TXT',  $query->{acme_challenge} ],
+        [ $query->{title},                    'CAA',  '0 issue "letsencrypt.org"' ],
     );
 
-    push(@records2add, (map { ["$_.$query->{title}", "CNAME", $query->{title}] } @{$query->{cnames}}));
-    push(@records2add, (map { [$query->{title}, 'NS', $_] } @{$query->{nameservers}}));
-    foreach my $subdomain (@{$query->{subdomains}}) {
-        push(@records2add, ["$subdomain->{name}.$query->{title}", 'A',    $subdomain->{ip}]);
-        push(@records2add, ["$subdomain->{name}.$query->{title}", 'AAAA', $subdomain->{ip6}]);
-        push(@records2add, (map { ["$subdomain->{name}.$query->{title}", 'NS', $_] } @{$subdomain->{nameservers}}));
+    push( @records2add, ( map { [ "$_.$query->{title}", "CNAME", $query->{title} ] } @{ $query->{cnames} } ) );
+    push( @records2add, ( map { [ $query->{title}, 'NS', $_ ] } @{ $query->{nameservers} } ) );
+    foreach my $subdomain ( @{ $query->{subdomains} } ) {
+        push( @records2add, [ "$subdomain->{name}.$query->{title}", 'A',    $subdomain->{ip} ] );
+        push( @records2add, [ "$subdomain->{name}.$query->{title}", 'AAAA', $subdomain->{ip6} ] );
+        push( @records2add, ( map { [ "$subdomain->{name}.$query->{title}", 'NS', $_ ] } @{ $subdomain->{nameservers} } ) );
     }
 
     my $dbh = _dbh();
     $dbh->begin_work();
     $dbh->do("DELETE FROM records") or _roll_and_die($dbh);
     foreach my $record (@records2add) {
-        $dbh->do($insert_sql, undef, @$record, $ttl, $prio, $disabled, $query->{title}) or _roll_and_die($dbh);
+        $dbh->do( $insert_sql, undef, @$record, $ttl, $prio, $disabled, $query->{title} ) or _roll_and_die($dbh);
     }
     $dbh->commit() or _roll_and_die($dbh);
 
     return $latest;
 }
 
-sub delzone($domain) {
+sub delzone ($domain) {
     my $conf = Trog::Config::get();
     my $data = Trog::Data->new($conf);
 
@@ -143,7 +143,7 @@ sub _dbh {
     return Trog::SQLite::dbh( undef, "dns/zones.db" );
 }
 
-sub _roll_and_die($dbh) {
+sub _roll_and_die ($dbh) {
     my $err = $dbh->errstr;
     $dbh->rollback();
     die $err;