Add precious lint tooling and tidy the codebase

.github/workflows/build-and-test.yml

@@ -98,11 +98,6 @@ jobs:
       matrix:
         os: ["macos-latest"]
         perl-version:
-          - "5.14"
-          - "5.16"
-          - "5.18"
-          - "5.20"
-          - "5.22"
           - "5.24"
           - "5.26"
           - "5.28"
@@ -146,14 +141,6 @@ jobs:
       matrix:
         os: ["windows-latest"]
         perl-version:
-          # https://github.com/shogo82148/actions-setup-perl/issues/223
-          #- "5.10"
-          #- "5.12"
-          #- "5.14"
-          #- "5.16"
-          #- "5.18"
-          #- "5.20"
-          #- "5.22"
           - "5.24"
           - "5.26"
           - "5.28"

.github/workflows/lint.yml

@@ -0,0 +1,34 @@
+name: lint
+
+on:
+  push:
+    branches:
+      - master
+  pull_request:
+  workflow_dispatch:
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
+
+jobs:
+  precious:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v6
+      - uses: shogo82148/actions-setup-perl@v1
+        with:
+          perl-version: "5.42"
+      - uses: oalders/install-ubi-action@v0.0.6
+        with:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+          projects: |
+            houseabsolute/precious
+            houseabsolute/omegasort
+      - uses: perl-actions/install-with-cpm@v2
+        with:
+          install: |
+            App::perlvars
+            Perl::Tidy
+          sudo: false
+      - run: precious lint --all

lib/HTTP/Daemon.pm

@@ -52,7 +52,7 @@ sub url {
     $host = "::1"       if $host eq "::";
     $host = "[$host]"   if $self->sockdomain == Socket::AF_INET6;
 
-    my $url = $self->_default_scheme . "://" . $host;
+    my $url  = $self->_default_scheme . "://" . $host;
     my $port = $self->sockport;
     $url .= ":$port" if $port != $self->_default_port;
     $url .= "/";
@@ -85,9 +85,9 @@ our $DEBUG;
 use HTTP::Request  ();
 use HTTP::Response ();
 use HTTP::Status;
-use HTTP::Date qw(time2str);
+use HTTP::Date      qw(time2str);
 use LWP::MediaTypes qw(guess_media_type);
-use Carp ();
+use Carp            ();
 
 # "\r\n" is not portable
 my $CRLF     = "\015\012";
@@ -141,7 +141,7 @@ READ_HEADER:
     }
     if ($buf !~ s/^(\S+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012//) {
         ${*$self}{'httpd_client_proto'} = _http_version("HTTP/1.0");
-        $self->send_error(400);                # BAD_REQUEST
+        $self->send_error(400);    # BAD_REQUEST
         $self->reason("Bad request line: $buf");
         return;
     }
@@ -153,7 +153,7 @@ READ_HEADER:
     my $r = HTTP::Request->new($method, $uri);
     $r->protocol($proto);
     ${*$self}{'httpd_client_proto'} = $proto = _http_version($proto);
-    ${*$self}{'httpd_head'} = ($method eq "HEAD");
+    ${*$self}{'httpd_head'}         = ($method eq "HEAD");
 
     if ($proto >= $HTTP_1_0) {
 
@@ -227,7 +227,7 @@ READ_HEADER:
                 last CHUNK if $size == 0;
 
                 my $missing = $size - length($buf) + 2;    # 2=CRLF at chunk end
-                     # must read until we have a complete chunk
+                    # must read until we have a complete chunk
                 while ($missing > 0) {
                     print STDERR "Need $missing more bytes\n" if $DEBUG;
                     my $n = $self->_need_more($buf, $timeout, $fdset);
@@ -294,16 +294,19 @@ READ_HEADER:
         # section 3.3.3 -- Message Body Length
 
         # split and clean up Content-Length ', ' separated string
-        my @vals = map {my $str = $_; $str =~ s/^\s+//; $str =~ s/\s+$//; $str }
+        my @vals
+            = map { my $str = $_; $str =~ s/^\s+//; $str =~ s/\s+$//; $str }
             split ',', $ct_len;
+
         # check that they are all numbers (RFC: Content-Length = 1*DIGIT)
-        my @nums = grep { /^[0-9]+$/} @vals;
+        my @nums = grep {/^[0-9]+$/} @vals;
         unless (@vals == @nums) {
             my $reason = "Content-Length value must be an unsigned integer";
             $self->send_error(400, $reason);
             $self->reason($reason);
             return;
         }
+
         # check they are all the same
         my $ct_len = shift @nums;
         foreach (@nums) {
@@ -313,6 +316,7 @@ READ_HEADER:
             $self->reason($reason);
             return;
         }
+
         # ensure we have now a fixed header, with only 1 value
         $r->header('Content-Length' => $ct_len);
 
@@ -333,7 +337,9 @@ READ_HEADER:
             $buf = '';
         }
     }
-    elsif ($ct_type && $ct_type =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*("?)(\w+)\1/i) {
+    elsif ($ct_type
+        && $ct_type =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*("?)(\w+)\1/i)
+    {
 
         # Handle multipart content type
         my $boundary = "$CRLF--$2--";
@@ -424,7 +430,7 @@ sub send_status_line {
     return if $self->antique_client;
     $status  ||= RC_OK;
     $message ||= status_message($status) || "";
-    $proto   ||= $HTTP::Daemon::PROTO || "HTTP/1.1";
+    $proto   ||= $HTTP::Daemon::PROTO    || "HTTP/1.1";
     print $self "$proto $status $message$CRLF";
 }
 
@@ -566,12 +572,12 @@ sub send_file_response {
         sysopen(F, $file, 0) or return $self->send_error(RC_FORBIDDEN);
         binmode(F);
         my ($mime_type, $file_enc) = guess_media_type($file);
-        my ($size, $mtime) = (stat _)[7, 9];
+        my ($size,      $mtime)    = (stat _)[7, 9];
         unless ($self->antique_client) {
             $self->send_basic_header;
             print $self "Content-Type: $mime_type$CRLF";
             print $self "Content-Encoding: $file_enc$CRLF" if $file_enc;
-            print $self "Content-Length: $size$CRLF" if $size;
+            print $self "Content-Length: $size$CRLF"       if $size;
             print $self "Last-Modified: ", time2str($mtime), "$CRLF" if $mtime;
             print $self $CRLF;
         }

precious.toml

@@ -0,0 +1,23 @@
+[commands.perltidy]
+type    = "both"
+include = ["**/*.{pl,pm,t,psgi}"]
+cmd     = ["perltidy", "--profile=$PRECIOUS_ROOT/.perltidyrc"]
+lint-flags = ["--assert-tidy", "--no-standard-output", "--outfile=/dev/null"]
+tidy-flags = ["--backup-and-modify-in-place", "--backup-file-extension=/"]
+ok-exit-codes = [0]
+lint-failure-exit-codes = [2]
+
+[commands.perlvars]
+type    = "lint"
+include = ["**/*.pm"]
+cmd     = ["perlvars"]
+ok-exit-codes = [0]
+lint-failure-exit-codes = [1]
+
+[commands.omegasort-gitignore]
+type    = "both"
+include = [".gitignore"]
+cmd     = ["omegasort", "--sort", "path", "--unique"]
+lint-flags = ["--check"]
+ok-exit-codes = [0]
+lint-failure-exit-codes = [1]

scripts/pre-commit

@@ -0,0 +1,40 @@
+#!/bin/sh
+# Pre-commit hook: enforce `precious lint` on staged files and
+# block direct commits to the default branch.
+#
+# Install (run once per clone):
+#   scripts/pre-commit --init
+
+set -eu
+
+if [ "${1:-}" = "--init" ]; then
+    repo_root=$(git rev-parse --show-toplevel)
+    hook_path="$repo_root/.git/hooks/pre-commit"
+    target="../../scripts/pre-commit"
+    if [ -e "$hook_path" ] && [ ! -L "$hook_path" ]; then
+        echo "ERROR: $hook_path exists and is not a symlink." >&2
+        echo "Move or remove it, then re-run scripts/pre-commit --init." >&2
+        exit 1
+    fi
+    chmod +x "$repo_root/scripts/pre-commit"
+    ln -sf "$target" "$hook_path"
+    echo "Installed pre-commit hook: $hook_path -> $target"
+    exit 0
+fi
+
+# Block direct commits to the default branch.
+default_branch="master"
+branch=$(git symbolic-ref --short HEAD 2>/dev/null || true)
+if [ "$branch" = "$default_branch" ]; then
+    echo "ERROR: Direct commits to '$default_branch' branch are not allowed." >&2
+    echo "Please create a feature branch instead:" >&2
+    echo "  git checkout -b feature/your-feature-name" >&2
+    exit 1
+fi
+
+# Run precious lint on staged files
+if ! precious lint -q --staged; then
+    echo "pre-commit hook failed: precious lint found issues with staged files" >&2
+    echo "Please run 'precious tidy -q --staged' and try again" >&2
+    exit 1
+fi

t/basic.t

@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::Needs { 'LWP::UserAgent' => '6.37' };
+use Test::Needs {'LWP::UserAgent' => '6.37'};
 
 use Test::More tests => 45;
 use lib 't/lib';
@@ -12,7 +12,7 @@ use File::Temp qw(tempfile);
 use MIME::Base64;
 
 my $daemon = TestServer::BasicTests->new;
-my $base = $daemon->start;
+my $base   = $daemon->start;
 
 note "Will access HTTP server at $base\n";
 
@@ -30,7 +30,7 @@ $req->header(X_Foo => "Bar");
 $res = $ua->request($req);
 
 ok($res->is_error);
-is($res->code,    404);
+is($res->code, 404);
 like($res->message, qr/not\s+found/i);
 
 # we also expect a few headers
@@ -61,20 +61,20 @@ ok($res->is_success);
 is($res->code,    200);
 is($res->message, "OK");
 
-$_      = $res->content;
+$_ = $res->content;
 my @accept = /^Accept:\s*(.*)/mg;
 
-like($_,      qr/^From:\s*gisle\@aas\.no\n/m);
-like($_,      qr/^Host:/m);
+like($_, qr/^From:\s*gisle\@aas\.no\n/m);
+like($_, qr/^Host:/m);
 is(scalar @accept, 3);
-like($_,      qr/^Accept:\s*text\/html/m);
-like($_,      qr/^Accept:\s*text\/plain/m);
-like($_,      qr/^Accept:\s*image\/\*/m);
-like($_,      qr/^If-Modified-Since:\s*\w{3},\s+\d+/m);
-like($_,      qr/^Long-Text:\s*This.*broken between/m);
-like($_,      qr/^Foo-Bar:\s*1\n/m);
-like($_,      qr/^X-Foo:\s*Bar\n/m);
-like($_,      qr/^User-Agent:\s*Mozilla\/0.01/m);
+like($_, qr/^Accept:\s*text\/html/m);
+like($_, qr/^Accept:\s*text\/plain/m);
+like($_, qr/^Accept:\s*image\/\*/m);
+like($_, qr/^If-Modified-Since:\s*\w{3},\s+\d+/m);
+like($_, qr/^Long-Text:\s*This.*broken between/m);
+like($_, qr/^Foo-Bar:\s*1\n/m);
+like($_, qr/^X-Foo:\s*Bar\n/m);
+like($_, qr/^User-Agent:\s*Mozilla\/0.01/m);
 
 # Try it with the higher level 'get' interface
 $res = $ua->get(
@@ -86,14 +86,15 @@ $res = $ua->get(
 );
 
 #$res->dump;
-is($res->code,    200);
+is($res->code, 200);
 like($res->content, qr/^From: gisle\@aas.no$/m);
 
 #----------------------------------------------------------------
 note "Send file...\n";
 
 {
-    my ($fh, $filename) = tempfile( 'http-daemon-test-XXXXXX', TMPDIR => 1, SUFFIX => '.html' );
+    my ($fh, $filename)
+        = tempfile('http-daemon-test-XXXXXX', TMPDIR => 1, SUFFIX => '.html');
     binmode $fh;
     print $fh <<"EOT";
 <html><title>En pr\xF8ve</title>
@@ -103,7 +104,8 @@ er sikkert nok i massevis.
 EOT
     close $fh;
 
-    $req = HTTP::Request->new(GET => $daemon->url("/file", { file => $filename }));
+    $req
+        = HTTP::Request->new(GET => $daemon->url("/file", {file => $filename}));
     $res = $ua->request($req);
 
     #print $res->as_string;
@@ -112,7 +114,7 @@ EOT
     is($res->content_type,   'text/html');
     is($res->content_length, 147);
     is($res->title,          "En pr\xF8ve");
-    like($res->content,      qr/\xE5 v\xE6re/);
+    like($res->content, qr/\xE5 v\xE6re/);
 
     unlink $filename;
 
@@ -162,6 +164,7 @@ is($res->code, 401);
 $auth = MIME::Base64::encode("user:passwd");
 
 $req->header(Authorization => 'Basic ' . $auth);
+
 # Then illegal credentials
 $res = $ua->request($req);
 is($res->code, 401);
@@ -211,5 +214,5 @@ note "Terminating server...\n";
 $req = HTTP::Request->new(GET => $daemon->url("/quit"));
 $res = $ua->request($req);
 
-is($res->code,    503);
+is($res->code, 503);
 like($res->content, qr/Bye, bye/);

t/chunked.t

@@ -94,19 +94,17 @@ use IO::Socket::IP;
 plan tests => scalar @TESTS;
 
 my $daemon = TestServer::Reflect->new;
-my $url = $daemon->start;
+my $url    = $daemon->start;
 
 my $addr = $url->host;
 my $port = $url->port;
 
 for my $test (@TESTS) {
-    my $raw  = $test->{raw};
+    my $raw = $test->{raw};
     $raw =~ s/\r?\n/$CRLF/mg;
 
-    my $sock = IO::Socket::IP->new(
-        PeerAddr => $addr,
-        PeerPort => $port,
-    ) or die;
+    my $sock = IO::Socket::IP->new(PeerAddr => $addr, PeerPort => $port,)
+        or die;
 
     print $sock $raw;