Преглед изворни кода

Build with Dist::Zilla, and hold the code to the 5.040 profile

The distribution is meant for CPAN, and Makefile.PL could not get it there:
its PREREQ_PM was a list that bin/deps2hash.sh printed for pasting in, and
nothing stopped it going stale.  dist.ini now builds the release, and
[AutoPrereqs] reads the prerequisites from the code.  It reads only files
with perl on the shebang line, so bin/tpsgi's Devel::NYTProf is named in
prereqs.yml.  Git::GatherDir replaces GatherDir because a checkout of this
is also a running installation, with one site's state under log/, run/,
prof/ and www/.

Readme.md becomes the POD of TPSGI.pm, which [ReadmeAnyFromPod] turns
back into README.md, so there is one copy of that text.

Every module, program and test now says use 5.040, with fatal warnings
and use re '/aa', and passes the strict profile.  The changes that are
more than flags on a regex:

- A router's pattern is matched with none of this file's default flags.
  Under use re '/aa', \w in a route would stop matching letters outside
  ASCII.  t/TPSGI.t pins that, and a space and a dot as well.
- Private subs are lexical, or public and documented where a test or a
  subclass needs them: _build_log is build_log, _app is respond, _range
  is serve_ranges.  route() takes the request as named arguments.
  serve(), static() and stream_raw_http() keep their positional
  arguments, because routers call them that way.
- The -f tests are -e, or !-d where a directory is what is excluded.
- serve() links the static copy and treats EEXIST as done, rather than
  checking for the file first.  cgi() dies when the CGI will not start,
  where it read from a handle that was never opened.
- generic_route is found with can(), which needs no symbolic reference.
- t/ loads lib/ with FindBin::libs, and t/watch.t mocks with
  Test::MockModule rather than a local glob.

CodeLayout::RequireASCII is off although the floor is 5.040, because a
contributor's name in the generated POD is not ASCII.  bin/tpsgi keeps
#!bin/tarbaby, which RequireSheBang now allows, because running that
file is how the server starts.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
troglodyne-bot пре 6 дана
родитељ
комит
e647ad3b63
30 измењених фајлова са 2532 додато и 680 уклоњено
  1. 12 0
      .gitignore
  2. 1 0
      .mailmap
  3. 273 0
      .perlcriticrc
  4. 302 0
      .pod_stopwords
  5. 57 0
      .preferred_modules.ini
  6. 76 0
      .tests-covering-map.pl
  7. 131 0
      CLAUDE.md
  8. 4 0
      Changes
  9. 21 0
      LICENSE
  10. 0 59
      Makefile.PL
  11. 603 0
      README.md
  12. 0 237
      Readme.md
  13. 0 7
      bin/deps2hash.sh
  14. 28 12
      bin/tarbaby
  15. 10 9
      bin/tpsgi
  16. 21 6
      bin/tpsgi-config
  17. 26 25
      call.pl
  18. 159 0
      dist.ini
  19. 33 0
      git-hooks/post-commit
  20. 210 0
      git-hooks/pre-commit
  21. 6 3
      lib/Plack/Handler/TPSGI.pm
  22. 326 183
      lib/TPSGI.pm
  23. 8 3
      lib/TPSGI/Server.pm
  24. 29 37
      lib/TPSGI/Startup.pm
  25. 9 0
      prereqs.yml
  26. 20 15
      t/TPSGI-Server.t
  27. 44 23
      t/TPSGI.t
  28. 12 13
      t/loggers.t
  29. 45 48
      t/watch.t
  30. 66 0
      weaver.ini

+ 12 - 0
.gitignore

@@ -8,3 +8,15 @@ perl5/
 service/tpsgi.service*
 Makefile
 MYMETA*
+*.swp
+*.swo
+*.swn
+
+# Build leavings
+pm_to_blib
+blib/
+cover_db/
+.build
+# At the root, where dzil build leaves them.  Unanchored, the pattern also
+# hides a test named after the distribution, such as t/TPSGI-Server.t.
+/TPSGI-*

+ 1 - 0
.mailmap

@@ -0,0 +1 @@
+George S. Baugh <george@troglodyne.net>

+ 273 - 0
.perlcriticrc

@@ -0,0 +1,273 @@
+# Troglodyne perlcritic policy, for a distribution that declares use 5.040 or
+# later.
+#
+# There are two of these.  This one is for code that runs on a perl you control,
+# and perlcriticrc.compat is for code that runs on whatever perl is already
+# installed.  The packaging-perl skill asks which you are writing before it
+# copies one, because the answer decides more than this file: it decides the
+# use line in every module and test, and perl: in prereqs.yml.
+#
+# The difference between the two is five policies.  A modern perl refuses what
+# they report, so naming them here would buy nothing:
+#
+#   TestingAndDebugging::RequireUseStrict       strict is on from 5.012
+#   Objects::ProhibitIndirectSyntax             no indirect from 5.036
+#   InputOutput::ProhibitBarewordFileHandles    no bareword_filehandles from
+#   InputOutput::ProhibitBarewordDirHandles       5.038
+#   Modules::RequireEndWithOne                  module_true from 5.038
+#
+# One more goes the same way at 5.042, and is named below because this file
+# assumes only 5.040.  Delete it once your floor is 5.041 or later, which
+# selects the 5.042 bundle:
+#
+#   Variables::ProhibitPerl4PackageNames        no apostrophe as a package
+#                                                 separator from 5.042
+#
+# CodeLayout::RequireASCII, which the template also names until 5.042, is off
+# here.  See below for why.
+severity  = 1
+only      = 1
+force     = 0
+verbose   = 1
+criticism-fatal = 1
+color     = 1
+allow-unsafe = 1
+# Usability
+[Modules::RequirePerlVersion]
+[Documentation::RequirePod]
+# Security
+[ValuesAndExpressions::PreventSQLInjection]
+# CodeLayout::RequireASCII is off, though the floor is 5.040.  It also applies
+# to POD, and the contributors that [Git::Contributors] lists include a name
+# that is not ASCII.  Spelling somebody's name wrong is not a code standard.
+[RegularExpressions::RequireDefault]
+strict = 1
+[RegularExpressions::PreventUselessMetacharacterEscapes]
+# PEBCAK catches
+[BuiltinFunctions::ProhibitDeleteOnArrays]
+[Subroutines::ProhibitAmbiguousFunctionCalls]
+[ValuesAndExpressions::ProhibitSingleArgArraySlice]
+[ValuesAndExpressions::ProhibitDefinedBeforeLength]
+[Variables::ProhibitUselessVarClearing]
+[Subroutines::ProhibitTailRecursion]
+[Bangs::ProhibitUselessRegexModifiers]
+[Bangs::ProhibitCommentedOutCode]
+[Tics::ProhibitUseBase]
+[Plicease::ProhibitLeadingZeros]
+[RegularExpressions::ProhibitEmptyAlternatives]
+[ValuesAndExpressions::UnexpandedSpecialLiteral]
+[CodeLayout::ProhibitIfIfSameLine]
+[ValuesAndExpressions::ConstantBeforeLt]
+[ValuesAndExpressions::ProhibitDuplicateHashKeys]
+# any access checks are necessarily a TOCTOU waiting to happen
+[ValuesAndExpressions::ProhibitFiletest_f]
+[ValuesAndExpressions::ProhibitFiletest_rwxRWX]
+# Bikeshed
+[CognitiveComplexity::ProhibitExcessCognitiveComplexity]
+warn_level = 40
+info_level = 30
+[Variables::ProhibitUselessInitialization]
+[PreferredModules]
+config = .preferred_modules.ini
+# bin/tpsgi is the PSGI application, and starts the server that runs it when it
+# is run itself, from the top of the installation.
+[logicLAB::RequireSheBang]
+formats = #!/usr/bin/env perl || #!bin/tarbaby
+# Performance
+[logicLAB::ProhibitShellDispatch]
+[ProhibitPipeOpen]
+[Performance::ProhibitRegexForSimpleSubstring]
+[RegularExpressions::ProhibitRegexToStripAffix]
+[RegularExpressions::ProhibitRegexToChomp]
+[BuiltinFunctions::ProhibitChainingSameListSub]
+[RegularExpressions::ProhibitRegexForStringEquality]
+[Subroutines::ProhibitUnderscorePrivateSubs]
+[Subroutines::ProhibitSingleUseLexicalSubs]
+[ValuesAndExpressions::ProhibitLiteralArithmetic]
+[BuiltinFunctions::ProhibitIndirectBooleanGrep]
+# What ProhibitMutatingListFunctions reports, which this replaces, and a block
+# that changes $_ through a sub that it calls.
+[ControlStructures::ProhibitMutatingListFunctionsStricter]
+# An if, elsif, else or unless whose block holds no statement, a comment
+# being none.  Loops are left alone, because a loop condition can do the work.
+[ControlStructures::ProhibitEmptyConditionalBlocks]
+# A sub that returns the result of a syscall or an eval, called where nothing
+# looks at the result.  The same functions as RequireCheckedSyscalls below.
+[ErrorHandling::RequireCheckedIndirectResults]
+exclude_functions = print
+[ProhibitUseLib]
+[ProhibitUsageSubs]
+[RequireQwForLiteralLists]
+[ProhibitNoWarningsRedefine]
+[RequireFatalWarnings]
+[ProhibitUnusedImports]
+# Modules imported for a side effect rather than for a symbol, which the policy
+# cannot see.  `re` is here because every file says `use re '/aa'`.  Add your
+# own: IO::Prompter installs prompt() from a custom import rather than @EXPORT,
+# and anything loaded by name from a string is invisible the same way.
+# Test2::Plugin::NoWarnings fails a test that warns, and imports nothing.
+allow = re Test2::Plugin::NoWarnings
+# Off in a distribution that is only a library: it counts calls from bin/ and
+# lib/, and every sub a library exists to offer is called from neither -- a
+# module with one public sub and no bin/ reports that sub, which is the policy
+# working correctly and saying nothing.  Turn it on for a distribution that also
+# ships programs, and add the authordep line to dist.ini when you do.
+#
+# allow_subs then lists the subs that are called in a way it cannot see: named
+# in a string and called as $obj->$name, handed to something else that calls
+# them, or called only from a directory it does not read.  Name each one and say
+# which, so the next person can tell an exemption from an oversight.
+#
+# [ProhibitUnusedDefinitions]
+# allow_subs =
+# A sub that only one subclass uses, and a sub that two subclasses define where
+# the class above them defines none.  It reads bin/ and lib/ through
+# Perl::Critic::Distribution, as ProhibitUnusedDefinitions does, so the two
+# share one parse.  A library whose subclasses live in other distributions
+# names in allow_subs each hook that only one of its own subclasses uses.
+[ProhibitMisplacedMethods]
+[ProhibitPrintSTDERR]
+[InputOutput::ProhibitRepeatedPrints]
+# Perl::Critic's own policies.  only = 1 loads nothing that is not named, so
+# each of these has to be, and the ones that are absent are absent on purpose.
+#
+# Not here, because something above already does the job better:
+#   CodeLayout::ProhibitQuotedWordLists         RequireQwForLiteralLists
+#   ControlStructures::ProhibitCascadingIfElse  CognitiveComplexity, which
+#   ControlStructures::ProhibitDeepNests          scores nesting and every
+#   Subroutines::ProhibitExcessComplexity         break in flow, where these
+#                                                 count branches
+#   ControlStructures::ProhibitMutatingListFunctions
+#                                               ProhibitMutatingListFunctionsStricter,
+#                                                 which reports all of it, and
+#                                                 a sub that the block calls
+#   InputOutput::ProhibitBacktickOperators      logicLAB::ProhibitShellDispatch
+#   Modules::ProhibitEvilModules                PreferredModules
+#   Subroutines::ProhibitUnusedPrivateSubroutines  ProhibitUnusedDefinitions,
+#                                                 which counts calls from bin/
+#                                                 and lib/, private or not
+#   TestingAndDebugging::RequireUseWarnings     RequireFatalWarnings
+#   ValuesAndExpressions::ProhibitLeadingZeros  Plicease::ProhibitLeadingZeros
+#   Modules::RequireVersionVar                  [PkgVersion] in dist.ini
+#   ErrorHandling::RequireCarping               die with context, and
+#                                                 Carp::Always for the trace
+#
+# Nor the five the language enforces under this file's floor.  The header says
+# which they are, and perlcriticrc.compat is where they live.
+#
+# Documentation::RequirePodSections is out as well: the sections it asks for are
+# the ones Pod::Weaver writes at build, and weaver.ini names them AUTHORS and
+# COPYRIGHT AND LICENSE where the policy wants AUTHOR and LICENSE AND COPYRIGHT.
+[BuiltinFunctions::ProhibitBooleanGrep]
+[BuiltinFunctions::ProhibitLvalueSubstr]
+[BuiltinFunctions::ProhibitReverseSortBlock]
+[BuiltinFunctions::ProhibitShiftRef]
+[BuiltinFunctions::ProhibitSleepViaSelect]
+[BuiltinFunctions::ProhibitStringyEval]
+[BuiltinFunctions::ProhibitStringySplit]
+[BuiltinFunctions::ProhibitUniversalCan]
+[BuiltinFunctions::ProhibitUniversalIsa]
+[BuiltinFunctions::ProhibitVoidGrep]
+[BuiltinFunctions::ProhibitVoidMap]
+[BuiltinFunctions::RequireBlockGrep]
+[BuiltinFunctions::RequireBlockMap]
+[BuiltinFunctions::RequireGlobFunction]
+[BuiltinFunctions::RequireSimpleSortBlock]
+[ClassHierarchies::ProhibitAutoloading]
+[ClassHierarchies::ProhibitExplicitISA]
+[ClassHierarchies::ProhibitOneArgBless]
+[CodeLayout::ProhibitHardTabs]
+[CodeLayout::ProhibitTrailingWhitespace]
+[CodeLayout::RequireConsistentNewlines]
+# [CodeLayout::RequireTidyCode] is off on purpose.  git-hooks/pre-commit runs
+# perltidy over every staged Perl file before it runs this profile, so every
+# commit is tidy whatever this policy would say.  In an editor, the policy only
+# repeated that, and ran perltidy over the whole file on every check.
+[CodeLayout::RequireTrailingCommas]
+[ControlStructures::ProhibitLabelsWithSpecialBlockNames]
+[ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions]
+[ControlStructures::ProhibitUnreachableCode]
+[ControlStructures::ProhibitUntilBlocks]
+[ControlStructures::ProhibitYadaOperator]
+[Documentation::PodSpelling]
+spell_command = aspell --lang=en_US list
+stop_words_file = .pod_stopwords
+[Documentation::RequirePackageMatchesPodName]
+[ErrorHandling::RequireCheckingReturnValueOfEval]
+[InputOutput::ProhibitExplicitStdin]
+[InputOutput::ProhibitInteractiveTest]
+[InputOutput::ProhibitJoinedReadline]
+[InputOutput::ProhibitOneArgSelect]
+[InputOutput::ProhibitReadlineInForLoop]
+[InputOutput::ProhibitTwoArgOpen]
+[InputOutput::RequireBracedFileHandleWithPrint]
+[InputOutput::RequireBriefOpen]
+[InputOutput::RequireCheckedOpen]
+[InputOutput::RequireCheckedSyscalls]
+exclude_functions = print
+[InputOutput::RequireEncodingWithUTF8Layer]
+[Miscellanea::ProhibitFormats]
+[Miscellanea::ProhibitTies]
+[Miscellanea::ProhibitUnrestrictedNoCritic]
+[Miscellanea::ProhibitUselessNoCritic]
+[Modules::ProhibitAutomaticExportation]
+[Modules::ProhibitConditionalUseStatements]
+[Modules::RequireBarewordIncludes]
+[Modules::RequireFilenameMatchesPackage]
+[Modules::RequireNoMatchVarsWithUseEnglish]
+[NamingConventions::Capitalization]
+[RegularExpressions::ProhibitCaptureWithoutTest]
+[RegularExpressions::ProhibitComplexRegexes]
+[RegularExpressions::ProhibitEnumeratedClasses]
+[RegularExpressions::ProhibitFixedStringMatches]
+[RegularExpressions::ProhibitSingleCharAlternation]
+[RegularExpressions::ProhibitUnusedCapture]
+[RegularExpressions::RequireBracesForMultiline]
+[RegularExpressions::RequireDotMatchAnything]
+[RegularExpressions::RequireExtendedFormatting]
+[Subroutines::ProhibitAmpersandSigils]
+[Subroutines::ProhibitBuiltinHomonyms]
+[Subroutines::ProhibitManyArgs]
+[Subroutines::ProhibitNestedSubs]
+[Subroutines::ProhibitReturnSort]
+[Subroutines::ProhibitSubroutinePrototypes]
+[Subroutines::ProtectPrivateSubs]
+[Subroutines::RequireArgUnpacking]
+[Subroutines::RequireFinalReturn]
+[TestingAndDebugging::ProhibitProlongedStrictureOverride]
+[TestingAndDebugging::RequireTestLabels]
+[ValuesAndExpressions::ProhibitCommaSeparatedStatements]
+[ValuesAndExpressions::ProhibitComplexVersion]
+[ValuesAndExpressions::ProhibitEscapedCharacters]
+[ValuesAndExpressions::ProhibitLongChainsOfMethodCalls]
+[ValuesAndExpressions::ProhibitMismatchedOperators]
+[ValuesAndExpressions::ProhibitMixedBooleanOperators]
+[ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters]
+[ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator]
+[ValuesAndExpressions::ProhibitVersionStrings]
+[ValuesAndExpressions::RequireConstantVersion]
+[ValuesAndExpressions::RequireQuotedHeredocTerminator]
+[ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
+[Variables::ProhibitAugmentedAssignmentInDeclaration]
+[Variables::ProhibitConditionalDeclarations]
+# Variables::ProhibitEvilVariables is not listed: it declines to load until it
+# is given variables to prohibit, and nobody has named any.
+[Variables::ProhibitLocalVars]
+[Variables::ProhibitMatchVars]
+# Drop this one at 5.041 and later, with RequireASCII above.
+[Variables::ProhibitPerl4PackageNames]
+[Variables::ProhibitReusedNames]
+# Stricter than the core ProhibitUnusedVariables, which reports only a bare
+# `my $x;` and misses a variable that is assigned and never read.
+[Variables::ProhibitUnusedVarsStricter]
+# A method takes the arguments of its interface, whether it reads them or not.
+allow_unused_subroutine_arguments = 1
+# Anything that returns a guard, which does its work by being held to the end of
+# its scope: a mock, a mocked file, a change of directory, a lock.
+# allow_if_computed_by = Test::MockModule->new Test::MockFile->file
+[Variables::ProtectPrivateVars]
+[Variables::RequireLexicalLoopIterators]
+[Variables::RequireLocalizedPunctuationVars]
+[Variables::RequireNegativeIndices]
+# Extensions to perl -c
+[CompileTime]

+ 302 - 0
.pod_stopwords

@@ -0,0 +1,302 @@
+# Words Documentation::PodSpelling takes as spelled right, named in .perlcriticrc.
+# aspell is asked for American English, which is what the POD here is written in,
+# so what is left is vocabulary no dictionary has -- commands, daemons, file and
+# option names, module names -- and the pieces of a token aspell splits at a
+# digit, like the IPv of IPv4.  A misspelling does not belong here: fix it.
+#
+# One word per line, sorted without regard to case, so that adding one is a
+# one-line diff and nobody has to read the whole file to decide whether it is
+# already in it.
+#
+# Put each part of your own name and of the copyright holder's in here, one per
+# line.  PodSpelling reads the AUTHORS and COPYRIGHT sections that Pod::Weaver
+# generates, and a surname is in no dictionary.  The licence words below are
+# from the text weaver.ini puts in the COPYRIGHT section of every module.
+
+accessor
+ACL
+addon
+AIO
+apache
+API
+arg
+args
+argv
+arrayref
+auth
+autodetect
+autodetected
+autodetecting
+autodetects
+autogen
+autoreload
+autorestart
+backend
+backends
+BackPAN
+backtick
+badrequest
+basename
+bashrc
+Baugh
+BOOL
+bugtracker
+cetera
+cgi
+CGIs
+checksummed
+checksumming
+CHECKSUMS
+checksums
+chmod
+chmodded
+chmodding
+chmods
+chown
+chowned
+chowning
+chowns
+chroot
+chrooted
+chrooting
+chroots
+CIDR
+CIDRs
+CLI
+codename
+coderef
+config
+configs
+CPAN
+cpanm
+CPUs
+CRIT
+cron
+crons
+CVE
+DDL
+decrypts
+dedupe
+deduplicate
+deduplicated
+deduplicates
+deduplicating
+dep
+deps
+dev
+DHCP
+dir
+distro
+distros
+DKIM
+DMARC
+DN
+DNS
+dotfiles
+dryrun
+DSN
+dzil
+ECDSA
+EMERG
+ENV
+env
+et
+filehandle
+filesystem
+filesystems
+filetest
+formatter
+formatters
+FQDN
+George
+GiB
+GraphQL
+greppable
+harakiri
+hardcode
+hardcoded
+hardcodes
+hardcoding
+hashref
+heredoc
+homedir
+hostname
+hotplug
+HTTPS
+HUP
+HUPed
+HUPs
+IMAP
+INI
+ini
+init
+inode
+inotify
+IPs
+IPv
+JSON
+keypair
+keyspace
+KiB
+LDAP
+LDAPS
+LDIF
+libdir
+lifecycle
+LLC
+lookups
+loopback
+lowercased
+lowercases
+lowercasing
+LTS
+MACs
+makefile
+makefiles
+memoize
+memoized
+memoizes
+memoizing
+MERCHANTABILITY
+MetaCPAN
+MiB
+misconfigure
+misconfigured
+misconfigures
+misconfiguring
+mistyped
+mtime
+MX
+nameserver
+nameservers
+namespace
+nginx
+NIC
+NONINFRINGEMENT
+notfound
+NTP
+OAuth
+ok
+OOM
+overcommit
+overcommits
+overcommitted
+overcommitting
+pageload
+passwordless
+PCI
+PCIe
+PEM
+perl
+perlcritic
+perls
+perltidy
+PKI
+plackup
+plaintext
+POSIX
+pragmas
+preflight
+privs
+proxied
+proxying
+PSGI
+psgi
+psgix
+ramdisk
+readdir
+recurse
+recursed
+recurses
+recursing
+refaddr
+regenerable
+renderer
+repo
+repos
+RPC
+RSA
+rsync
+rsynced
+rsyncing
+rsyncs
+ruleset
+runtime
+scaffolded
+scp
+sftp
+SHA
+SMTP
+SRV
+sshd
+SSL
+Starman
+starman
+stdin
+stdout
+Subclasses
+subclasses
+subdir
+subdirectory
+sublicense
+subnet
+substring
+subtest
+sudo
+symlink
+symlinked
+symlinking
+symlinks
+sysctl
+syslog
+systemctl
+systemd
+tarbaby
+tCMS
+TCP
+teardown
+tempfile
+templated
+templating
+timestamp
+TLD
+TLDs
+TLS
+TODO
+toolchain
+toolong
+TPM
+TPSGI
+tPSGI
+tpsgi
+Troglodyne
+TXT
+udev
+UDP
+UI
+UID
+umask
+uncached
+unconfigured
+undef
+undefine
+undefines
+undefining
+unlink
+unlinked
+unlinking
+unlinks
+URI
+URIs
+UUID
+validator
+vhost
+vhosts
+VM
+VMs
+VPN
+VPNs
+WAL
+watchlist
+whitespace
+YAML

+ 57 - 0
.preferred_modules.ini

@@ -0,0 +1,57 @@
+[JSON]
+[JSON::PP]
+[JSON::XS]
+prefer = Cpanel::JSON::XS
+reason = "Use a correct & fast JSON parser"
+
+[YAML]
+[YAML::PP]
+[YAML::Syck]
+prefer = YAML::XS
+reason = "Use a correct & fast YAML parser"
+
+[Sereal]
+[Storable]
+prefer = Cpanel::JSON::XS
+reason = "JSON/YAML is preferred serialization format"
+
+[File::Slurper]
+prefer = File::Slurper::Temp
+for = write_binary write_text
+reason = "Avoid mangling files with concurrent writes"
+
+[constant]
+prefer = Readonly
+reason = "A Readonly variable interpolates, has a sigil to find it by, and refuses an assignment at run time"
+
+[perl/rand]
+prefer = Crypt::PRNG
+reason = builtin rand() insecure
+
+[perl/sleep]
+prefer = Time::HiRes
+reason = "The builtin sleeps whole seconds, so a poll interval cannot be shorter than a second"
+
+[perl/time]
+prefer = Time::HiRes
+reason = "The builtin counts whole seconds, so time + N can end anywhere from N - 1 to N seconds later"
+
+[perl/alarm]
+prefer = Time::HiRes
+reason = "The builtin takes whole seconds, so it cannot time out sooner than a second"
+
+[perl/readdir]
+reason="Use File::Find::find() instead"
+
+[Term::ReadKey]
+[IO::Prompt]
+[IO::Prompt::Tiny]
+[Term::Prompt]
+[Prompt::Timeout]
+prefer = IO::Prompter
+reason = "One way to ask for input; it suppresses echo and copes with not having a terminal"
+
+[MIME::Base32::XS]
+[Encode::Base2N]
+prefer = MIME::Base32
+reason = "MIME::Base32::XS corrupts the heap and pads its output, and Encode::Base2N needs a C++ build that cpm cannot install"

+ 76 - 0
.tests-covering-map.pl

@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
+
+=head1 NAME
+
+.tests-covering-map.pl - which tests reach the files that no test loads, for
+tests-covering
+
+=head1 DESCRIPTION
+
+git-hooks/pre-commit asks tests-covering which tests a commit can break.
+tests-covering follows the Perl that each test loads, and asks this map about
+every other file in the diff.  See "THE MAP" in L<Perl::Tests::Covering>.
+
+The map answers C<q{}>, which is C<NO_TESTS>, for the files of a distribution
+that C<prove -l t/> never reads:
+
+=over
+
+=item Documentation
+
+Markdown, POD in F<.pod> files outside F<lib/>, F<Changes>, F<LICENSE> and
+F<README>.
+
+=item The build and the release
+
+F<dist.ini>, F<weaver.ini>, F<prereqs.yml> and F<prereqs.json>, F<MANIFEST.SKIP>
+and F<cpanfile>.  C<dzil> reads them, and C<dzil test> checks what they build.
+
+=item The tools and the hooks
+
+The C<perltidy> and C<perlcritic> configuration and the files that it reads,
+F<.mailmap>, F<.gitignore>, F<.gitattributes>, this map, F<git-hooks/> and
+F<.github/>.
+
+=item The author tests
+
+F<xt/>, which the hooks do not run.
+
+=item The programs that no test runs
+
+F<call.pl>, the shell scripts in F<bin/> and F<service/>, and the unit template
+in F<service/>.
+
+=back
+
+Anything else, it leaves unexplained, and the hook then runs every test.  A
+file that a test reads without loading it, such as a template or a fixture,
+wants a rule here that names the tests that read it.
+
+=cut
+
+# Read by the tools, by dzil or by people, and by no test.
+my %NO_TESTS = map { $_ => 1 } qw{
+  Changes LICENSE README README.md
+  dist.ini weaver.ini prereqs.yml prereqs.json MANIFEST.SKIP cpanfile
+  .perltidyrc .perlcriticrc .perlcriticrc.compat .pod_stopwords .preferred_modules.ini .preferred_binaries.ini
+  .mailmap .gitignore .gitattributes .tests-covering-map.pl
+  call.pl bin/build_service bin/scan_log_for_warnings.sh
+};
+
+return sub {
+    my ($path) = @_;
+
+    return q{} if $NO_TESTS{$path};
+    return q{} if $path =~ m{\A(?:git-hooks|[.]github|xt)/}sx;
+    return q{} if $path =~ m{[.]md\z}sx;
+    return q{} if $path =~ m{[.]pod\z}sx && $path !~ m{\Alib/}sx;
+
+    # The service's shell script and unit template, which no test runs.
+    return q{} if $path =~ m{\Aservice/}sx;
+
+    return;
+};

+ 131 - 0
CLAUDE.md

@@ -0,0 +1,131 @@
+# CLAUDE.md
+
+This file is the procedure for work in this repository.  The POD and the files
+named below say what the code is and how it is written.
+
+TPSGI is a PSGI server on Starman that runs CGIs and serves static files from
+`www/`, and answers routes from the router modules that `~/.tpsgi.ini` names.
+Read `lib/TPSGI.pm` first, which handles every request, then
+`lib/TPSGI/Startup.pm`, which `bin/tarbaby` loads before it forks, and
+`lib/TPSGI/Server.pm`, which changes how a worker retires on a HUP.
+
+## Read the code before you change it
+
+Before you answer a question about the code here, look for something in it, or
+edit it, invoke `perl-slop:reading-perl`.
+
+Most of the code here is older than the conversation about it.  A line that
+looks pointless is usually the scar of something that went wrong once.  The
+reason is in the commit, not in the file.  So read before the first edit, not
+after the tests fail.
+
+The same pass asks whether the code that you want to write is already here,
+under a name that you did not search for.  Two subs that do one job are a
+defect, whichever one is better.
+
+## What perl this runs on
+
+Every module and every test says `use 5.040`, and `perl:` in
+`prereqs.yml` says the same.  `.perlcriticrc` depends on it.  The header of
+that file names the policies that this version of perl makes unnecessary.  So
+if you raise or lower the floor, change the profile as well as the `use` lines.
+
+## Where it is written down
+
+| | |
+|---|---|
+| `perldoc TPSGI` | what this is for and how a caller uses it |
+| `.perlcriticrc` | the policies, which are the house style made enforceable |
+| `Changes` | what changed and when, per release |
+| `dist.ini` | the build, and what has to be installed to run it |
+| `perldoc bin/tarbaby` | how the server starts, and how autoreload works |
+| `service/tpsgi.sh`, `bin/build_service` | how a production installation runs, and where its vault key comes from |
+| `t/TPSGI-Server.t` | what Net::Server does on a HUP, which `TPSGI::Server` depends on |
+
+## Finishing a changeset
+
+Before you commit, apply these skills in this order:
+
+1. `perl-slop:data-perl`: make sure that the data is defined, coerced,
+   validated and scoped in the way that perl expects.
+2. `perl-slop:testing-perl`: make sure that each behavior that you added or
+   changed has a test, and that the test is the right kind.
+3. `perl-slop:reviewing-perl`: read the whole diff back against it.  This pass
+   finds a second copy of something that the library already does.  It also
+   finds a call out to the shell, and a comment that belongs in the commit
+   message.
+
+Then run `podchecker` on each changed file.  Run `perl -Ilib -c` on each
+changed script that no test loads, because the tests do not compile it.
+
+The pre-commit hook does the rest.  It tidies the Perl that you staged, runs
+perlcritic on it, and runs the tests that the commit can break, which
+`tests-covering` chooses.  The post-commit hook keeps the records of
+`tests-covering` up to date, in the background.  If a step fails, the hook stops the
+commit and prints the reason.  Do not run `perltidy` or `perlcritic` yourself,
+and do not run the tests to decide whether a change is ready to commit.
+
+The hook names each test that failed.  Its output does not say why.  If a test
+fails, run that file yourself with `-v`, and read the output:
+
+```
+prove -lv t/<file>.t
+```
+
+Do the same to see a new test fail before you fix what it tests.
+
+In each clone that you commit from, install both hooks once.  Git does not
+install them for you, and without the hooks the tree drifts from its style:
+
+```
+cp git-hooks/pre-commit git-hooks/post-commit .git/hooks/
+```
+
+A file that no test loads, such as a fixture, gets its tests from
+`.tests-covering-map.pl`.  A path that the map cannot place runs every test.
+If a commit runs every test but does not touch everything, the map probably
+needs a rule.  Add the rule in the same change, and name the tests that read
+the file.
+
+## When something is slow
+
+Use `perl-slop:profiling-perl`.  Measure before you conclude anything, and
+measure again after a change.  "It is just slow" is not a finding.  A line
+number and a percentage is a finding.
+
+## Releasing
+
+`perl-slop:packaging-perl` made this distribution, and it explains what
+`dist.ini` means.  It also lists the problems that stop `dzil release` with no
+clear error.  Read it before the first release, not during it.
+
+```
+dzil authordeps --missing | cpanm --notest
+dzil build && dzil test --release
+```
+
+## Commits and pull requests
+
+Make a branch.  Do not commit to the default branch.
+
+A commit message here says what was wrong and why the change fixes it.  Write
+it in prose and in the imperative mood.  Name the behavior, not the diff, for
+example "Ask the pool whether it takes O_DIRECT, rather than guessing from its
+name".  The message has a job.  `perl-slop:reading-perl` describes a person who
+finds your line with `git blame` two years from now.  The message is the only
+thing that can still tell that person why.  For the same reason, the why goes
+in the message and not in a comment.
+
+After you make sure that something works, say what you ran and what it said.
+A claim that the tests pass needs the line that shows them passing.  A claim
+about your own work needs its evidence too, such as the URL from `gh pr
+create` or the sha from `git push`.  A PR number that nobody can open is worse
+than no number.
+
+If the code of a branch depends on another branch, stack it on that branch.
+If only a test of it depends on the other branch, do not stack it.  A change
+whose tests need a fix from somebody else is still an independent change.
+Open it against the default branch, and say in the description what must
+merge first.  A stacked branch merges into its base, whatever that base is.
+If the base reached the default branch by another route, the stacked change
+reaches nowhere, and nothing says so.

+ 4 - 0
Changes

@@ -0,0 +1,4 @@
+Revision history for TPSGI
+
+0.001 2026-10-23 TEODESIAN
+    - Initial Release

+ 21 - 0
LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2026 Troglodyne LLC
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

+ 0 - 59
Makefile.PL

@@ -1,59 +0,0 @@
-use strict;
-use warnings;
-
-use ExtUtils::MakeMaker;
-
-WriteMakefile(
-    VERSION   => '0.01',
-    META_MERGE        => {
-    "meta-spec" => { version => 2 },
-        resources => {
-            repository => {
-                type => 'git',
-                url  => 'git@github.com:Troglodyne-Internet-Widgets/tpsgi.git',
-                web  => 'https://github.com/Troglodyne-Internet-Widgets/tpsgi',
-            },
-        },
-    },
-    PREREQ_PM => {
-        "Carp::Always" => "0",
-        "CGI::Emulate::PSGI" => "0",
-        "Config::Simple" => "0",
-        "Cwd" => "0",
-        "Data::Dumper" => "0",
-        "Date::Format" => "0",
-        "DateTime::Format::HTTP" => "0",
-        "Devel::NYTProf" => "0",
-        "File::Basename" => "0",
-        "File::Copy" => "0",
-        "File::Find" => "0",
-        "File::Path" => "0",
-        "File::Touch" => "0",
-        "FindBin::libs" => "0",
-        "HTTP::Body" => "0",
-        "HTTP::Parser::XS" => "0",
-        "IO::Compress::Gzip" => "0",
-        "Linux::Perl::inotify" => "0",
-        "List::Util" => "0",
-        "Log::Dispatch" => "0",
-        "Module::Runtime" => "0",
-        "Log::Dispatch::FileRotate" => "0",
-        "Log::Dispatch::Screen" => "0",
-        "Mojo::File" => "0",
-        "Plack" => "0",
-        "Plack::MIME" => "0",
-        "POSIX" => "0",
-        "Scalar::Util" => "0",
-        "Starman" => "0",
-        "Sys::Hostname" => "0",
-        "URL::Encode" => "0",
-        "UUID" => "0",
-    },
-    TEST_REQUIRES => {
-        "File::Temp" => "0",
-        "Test2::V0"  => "0",
-        "Test2::Plugin::NoWarnings" => "0",
-        "Test::MockModule"          => "0",
-    },
-    test => {TESTS => 't/*.t'}
-);

+ 603 - 0
README.md

@@ -0,0 +1,603 @@
+# NAME
+
+TPSGI - Abstraction layer around starman to become a general purpose HTTP server & static renderer.
+
+# VERSION
+
+version 0.001
+
+# SYNOPSIS
+
+A router module, which `routers` in `~/.tpsgi.ini` names:
+
+```perl
+package My::Routes;
+
+our @routes = (
+    '/hello' => {
+        method    => 'GET',
+        callbacks => { 'text/html' => \&hello },
+    },
+);
+
+sub hello {
+    my ( $tpsgi, $query ) = @_;
+    return [ 200, [ 'Content-Type' => 'text/html' ], ['Hello world'] ];
+}
+```
+
+# DESCRIPTION
+
+Start it with the Starman options you want, from the directory it is installed
+in:
+
+```
+bin/tpsgi ... [starman args]
+```
+
+A PSGI server built to migrate old mod\_perl/apache stacks onto psgi, and that powers tCMS.
+
+Will execute any executable file (chmod +x) in www/ as CGI, and otherwise host any static file therein.
+
+The idea here is as a bridge between old and new which allows you to modernize at your own pace, gradually turning CGIs into routes.
+
+The other idea is that we don't want to add any extra abstraction if we don't have to, while gently guiding into better practices.
+Shops used to having full control over the HTTP response should continue to do so, rather than being locked into one framework or another.
+This allows them to continue doing whatever funky thing they have been doing, like COMET, et cetera.
+The best way to do that is to expect raw PSGI to be output.
+
+## request\_id($regenerate) = STRING
+
+The UUID of the request being answered, which every log line carries.  A true
+$regenerate makes a new one, which app() does as each request comes in.
+
+## log() = Log::Dispatch
+
+The process's Log::Dispatch, made by build\_log() the first time it is asked
+for.
+
+## build\_log() = Log::Dispatch
+
+A new Log::Dispatch from the options: the rotated file at `log_name`, the
+screen, and each class that `loggers` names, which is loaded by name.  log()
+keeps the first one this makes.
+
+## DEBUG, INFO, NOTE, WARN, ERROR, CRIT, ALERT, EMERG, FATAL($message)
+
+Log $message at that level, stamped with the time, the worker, the request and
+the user.  FATAL logs at the emergency level and then dies with the line.
+
+## new(%options)
+
+Load the routers and build the routing table.  It dies unless it runs as
+`user`, and `http_user` and `tpsgi_dir` are set.  get\_config() returns the
+options, and among them are:
+
+```
+custom_log
+verbose
+routers
+loggers
+auth
+```
+
+## indices() = ARRAYREF
+
+The directory index files, in the order they are tried: the `indices` option,
+then `index.html`, `index.htm` and `index.cgi`.
+
+## routes() = ARRAYREF
+
+The routing table: each route's pattern, then its definition, for every router
+in the order they were loaded.
+
+## serve($fullpath, $path, $start, $streaming, $ranges, $last\_fetch, $deflate)
+
+Serve a file, with options to stream and cache the output.
+
+## serve\_ranges($fh, $ranges, %args) = PSGI response
+
+Answer a Range request from $fh with a 206, or a 416 when a range is outside
+the file.  $ranges is what parse\_ranges() returns, and %args is `size`, the
+size of the file, `headers`, a HASH reference of the response headers so far,
+and `fullpath`, the URL for the log.  More than one range is answered as
+multipart/byteranges.
+
+## redirect, redirect\_permanent, see\_also
+
+Redirects to the provided page.
+
+## ok
+
+Return a generic HTTP 200 OK
+
+## notfound, forbidden, badrequest, toolong, error, unavailable
+
+If you need to return these HTTP errors, return these within a route:
+
+```perl
+sub route {
+    my ($self, $query) = @_;
+    ...
+    return $self->notfound($query);
+}
+```
+
+## app($env) = PSGI response
+
+The PSGI application: respond() to the request, or answer it with error() when
+that dies.
+
+## cannot\_start($error, $env, %options) = ARRAYREF
+
+What to answer with when new() died, so there is no object to answer with.
+Usually a router that would not load: a missing module, a syntax error.
+
+The error goes to psgi.errors, and to the log by way of a stand-in built from
+the same options, so it lands in the same places a request's own errors do.  If
+building the log is what failed -- a logger that will not load -- psgi.errors
+is all there is, and the answer is still a 500 rather than a second exception.
+
+The answer is a page of our own, not the router's error page: the router is
+what failed.  With TPSGI\_DEBUG set it carries the error itself, trace and all,
+for the same reason the error pages add one; without, it says nothing a visitor
+could use to map the installation.
+
+The worker retires once it has answered, on a server that offers
+psgix.harakiri, which Starman does.  A router that died while it compiled
+leaves its file in %INC as a failure, and every later require of it in this
+process says only "Attempt to reload ... aborted" -- so a load that failed
+once, to a race or a lock, would otherwise fail for every request the worker
+ever serves.  A fresh worker tries again from nothing.
+
+## respond($env) = PSGI response
+
+Answer one request: from a route when one matches, by running a CGI when the
+file under `www/` is executable, and otherwise by serving the file.
+
+## mangle\_filename($path) = STRING
+
+$path, lowercased on the systems whose filesystems ignore case.
+
+## parse\_ranges($env) = LIST
+
+The byte ranges of the request's Range header, as ARRAY references of start
+and end.  An end that the header leaves out is undef.  If-Range without Range
+asks for the whole file.
+
+## appears\_executable($path) = BOOL
+
+Whether $path is a CGI to run rather than a file to serve: it is executable,
+and it has no extension or one of `cgi`, `sh`, `exe`, `pl`, `php` and `py`.
+
+## route($route, $env, %request) = PSGI response
+
+Run the callback of $route that answers the request's content type, with the
+query that extract\_query() builds.  respond() calls it, with %request holding
+`fullpath`, `path`, `start`, `last_fetch`, `deflate`, `domain` and
+`port`.
+
+## extract\_query($path, $route, $env) = HASHREF
+
+The query a route's callback is given: the query string, then the POST body,
+then the route's captures and its `data`, each over the last.  When the route
+names `parameters`, a parameter that fails its validator, or one it does not
+name, gets a badrequest() instead.
+
+## cgi($env, $fullpath, $file\_actual, $last\_fetch) = PSGI response
+
+Run $file\_actual as a CGI.  Read until we are done with headers, then pass off
+the filehandle to PSGI for streaming.
+
+## stream\_raw\_cgi($cgi)
+
+Run the perl file $cgi in this process, as a CGI: its STDIN is the request body,
+and what it prints goes to the client.  The worker exits when it is done.
+
+Use when you just have a .cgi file you want to run without pipe-open.
+XXX this is extraordinarily unsafe, inefficient and kills workers.
+XXX it also has an 'apache-ism' of just assigning the HTTP status line for you.
+But sometimes you have to bite the bullet and do this to migrate stuff effectively.
+
+## stream\_raw\_psgi($response, $query)
+
+Write the PSGI $response straight to the client's socket, close it, then run
+the callbacks that add\_post\_close\_callback() queued.  route() does this when
+there are any.  The worker exits when it is done.
+
+## stream\_raw\_http($query, $last\_fetch, $to\_fork, $callback, $error\_handler)
+
+Answer with a 200 whose headers and body a forked child prints: $to\_fork runs
+in the child with the client's socket selected, and then $error\_handler, when
+there is one.  Once the child exits and the socket is closed, $callback runs.
+The worker exits when it is done.
+
+## extract\_headers($fh, $last\_fetch)
+
+Extract the headers from a filehandle.  Set the 'Last Modified' header appropriately based on the output of \`stat\` on the filehandle.
+
+Returns a code and parsed headers hash.  Code will be 304 if the file hasn't changed since $last\_fetch, otherwise will be the code in the parsed headers.
+
+## static($fullpath, $path, $start, $streaming, $last\_fetch) = PSGI response
+
+Answer with the static render of $path that save\_render() made, headers and
+all, or forbidden() when there is none.
+
+## get\_config() = HASH
+
+TPSGI::Startup::get\_config(): `~/.tpsgi.ini`, over the defaults.
+
+## checkpoint($query, $name)
+
+Mark the time as $name, for the Server-Timing header that
+build\_server\_timing() makes.
+
+## build\_server\_timing($query) = STRING
+
+A Server-Timing header value: how long each checkpoint() took after the one
+before it, and the total since the request started.
+
+## add\_post\_close\_callback()
+
+Add a thing to do after closing stdout; useful for housekeeping that doesn't need to hold up pageload.
+
+## signal\_restart\_parent()
+
+Instruct tPSGI to reload after closing stdout.
+
+## save\_render($path, $extension, $body)
+
+Save a static render of the page.
+Good to queue after closing stdout.
+
+Passed file extension slapped on the end of the path.
+You can then serve them as statics with an appropriately done try\_files block in nginx.
+
+## invalidate\_render($path, $extension)
+
+Remove an existing static render of a path.
+
+## invalidate\_renders($extension)
+
+Remove all existing static renders with the provided extension.
+Useful when it's not easy to figure out what to re-render due to including templates in other templates, etc.
+
+## watch\_for\_changes(@dirs)
+
+TPSGI::Startup::watch\_for\_changes(), which watches the .pm files under @dirs for
+autoreload.  A function, not a method.
+
+## add\_watch($path, $callback, %options)
+
+Add an arbitrary file or directory to the inotify watchlist, along with a
+callback to run when it changes.  Returns the inotify watch descriptor.
+
+The callback is invoked as:
+
+```
+$callback->( $tpsgi, $change );
+```
+
+...where $change is a HASH reference describing what happened:
+
+```perl
+path    => full path of the thing which changed
+watched => the path the watch was registered against
+events  => ARRAY reference of event names, e.g. [ 'MODIFY' ]
+name    => entry within a watched directory, if the watch was on a directory
+wd      => inotify watch descriptor
+mask    => raw inotify event mask
+```
+
+Which makes the common case - blowing away a static render because the thing it
+was generated from changed - look like:
+
+```perl
+$tpsgi->add_watch( "data/posts.json", sub {
+    my ( $tpsgi, $change ) = @_;
+    $tpsgi->invalidate_renders('html');
+});
+```
+
+%options are passed through to TPSGI::Startup::add\_watch, so you may also pass
+'events' (defaults to CREATE, MODIFY, DELETE and MOVE) and 'key' (an explicit
+dedupe key for the callback).
+
+Some caveats worth knowing about:
+
+- Watches live in the inotify instance tarbaby sets up before forking, and
+are therefore shared by every worker.  Whichever worker notices a change first
+consumes it for all of them, so register the same callbacks in every worker
+(declare them in your router module, which every worker loads) and make sure
+they're safe to run in any worker.
+- Changes are only noticed when a request comes in, since nothing is
+sitting in a select loop over the inotify FD.  Renders are invalidated promptly
+in practice, but not instantly.
+- Watching a directory rather than a single file is more robust, as
+watching a file which is later replaced wholesale (the usual write-tempfile-then-
+rename dance) only survives because we re-establish the watch afterwards.  If
+the file is deleted and not immediately recreated, the watch is gone for good.
+
+## remove\_watch($path)
+
+Drop a path, and any callbacks registered against it, from the watchlist.
+
+## handle\_changes
+
+Drain the inotify queue, running the callbacks registered for whatever changed,
+and restart tPSGI if any of the relevant libdir files changed (assuming
+autoreload is on).  Powers both the autorestart feature and app-registered
+watches.
+
+## restart\_if\_changes
+
+Deprecated alias for handle\_changes().
+
+# CONFIGURATION
+
+Obeys ~/.tpsgi.ini -- this is what will control all the custom aspects mentioned below:
+
+```perl
+verbose     : Whether to print all log messages or not
+custom_log  : Custom location for default (rotated) log
+routers     : Router module(s), separate with comma.  Relative to TPSGI install dir.
+indices     : Dirindex files.  In addition to index.html, index.htm, index.cgi
+loggers     : Logger module(s), separate with comma.  Each is a Log::Dispatch::Output class.  tPSGI loads it by name, so it can live beside a router
+auth        : Authentication module
+domain      : Domain name of the application, used by things like service files
+basedir     : Directory you want to chdir into on startup. Relative to TPSGI install dir.  Default '.'
+user        : Who to run as
+http_user   : Who's proxying this application (used for statics)
+autoreload  : Whether or not to automatically reload the application when library files change. Default 0.
+```
+
+You can run bin/tpsgi-config to get any config value needed by scripts.
+
+We wrap starman with a custom script, `bin/tarbaby` that implements Plack::Loader::Reload far less dangerously.
+It only reloads the code relevant to tPSGI and your application itself.
+All the CPAN deps should be updated out-of-band and the service manually restarted, as this is far more fraught.
+
+# CUSTOM ROUTING
+
+All passed routing modules will be required, and combined to form a routing table so you have an analogue to rewrite rules.
+
+Routing Modules look like so:
+
+```perl
+our @routes = (
+    '/foo/(\w+)/save' => {
+        method    => 'GET',
+        callbacks => { # Run these subroutines to execute the appropriate handler given the content-type.  Expects normal PSGI output.
+            'text/html'        => \&render,
+            'application/json' => \&dump,
+        },
+        noindex   => 0, # Explicitly exclude this in robots.txt
+        nomap     => 0, # Don't put this in the sitemap
+        acls      => ['admin'], # Route requires both authentication by auth handler and the auth'd user to have the provided ACLs.
+        data      => { baz => 'throb' }, # Arbitrary data to inject into the GET/POST data hashref
+        captures  => ['name','parameter'], # Name parameters of the capture groups in the route key.  Suppose we want /foo/don/keys here.
+        static    => 1, # Whether we can save a static render of this
+        invalidates => ['/foo/(\w+)'], # Static renders which are invalidated by this route returning a successful response code.
+    },
+    ...
+);
+```
+
+Note that this is an array, as we want this to preserve order. Fat commas are used to hint that this is in fact a tuple.
+
+Router callbacks are passed the TPSGI object and the raw query, which means you can do:
+
+```perl
+sub route {
+    my ($self, $query) = @_;
+    $self->INFO("whatever");
+    $self->ERROR("eeee");
+    $self->DEBUG("blah");
+
+    # Either from the GET or POST data, POST is preferred when both are present.
+    my $param = $query->{param};
+
+    my %headers = ...;
+
+    return [200, \%headers, ["Hello world"]]
+}
+```
+
+# WATCHING FILES FOR CHANGES
+
+tPSGI already watches your library directories with inotify so that it can reload itself when your
+code changes.  Your application can put arbitrary files and directories onto that same watchlist,
+along with a callback to run when they change.  The usual reason to want this is throwing away a
+static render because the thing it was generated from changed underneath it.
+
+Routing modules declare these the same way they declare routes:
+
+```perl
+our %watches = (
+    # A bare coderef is the common case: run this when the path changes.
+    'data/posts.json' => sub {
+        my ($tpsgi, $change) = @_;
+        $tpsgi->invalidate_renders('html');
+    },
+
+    # Or spell it out if you want to be picky about which events you care about.
+    'www/assets' => {
+        callback => \&asset_changed,
+        events   => [qw{CREATE MOVE}],
+    },
+);
+```
+
+...or register them at runtime with `$tpsgi->add_watch($path, $callback, %options)`, and drop them
+again with `$tpsgi->remove_watch($path)`.
+
+Callbacks are passed the TPSGI object and a hashref describing what happened:
+
+```perl
+sub asset_changed {
+    my ($tpsgi, $change) = @_;
+
+    $change->{path};    # full path of the thing which changed
+    $change->{watched}; # the path the watch was registered against
+    $change->{events};  # arrayref of event names, e.g. ['MODIFY']
+
+    $tpsgi->invalidate_render($change->{path}, 'html');
+}
+```
+
+A few things worth knowing:
+
+- Watches are shared by every worker, so whichever worker notices a change first consumes it for all
+of them.  Declare your watches in your routing module (which every worker loads) rather than from
+inside a single route, and make the callbacks safe to run in any worker.
+- Nothing sits in a select loop over the inotify descriptor, so changes are noticed when the next
+request comes in.  Prompt, but not instant.
+- Watching the containing directory is more robust than watching a single file.  Watches on files
+which get replaced wholesale (write a tempfile, rename over the target) are re-established
+afterwards, but a file which is deleted and not recreated takes its watch with it.
+
+# CUSTOM AUTHENTICATION HANDLING
+
+The (optional) Authentication handler can be passed, and look like so:
+
+```perl
+package Auth::Handler;
+
+# Is user who they say they are
+sub authenticate {
+    my (%auth_payload) = @_;
+    ...
+    return ($session_cookie);
+}
+
+# is the user authorized to do $thing
+sub authorized {
+    my ($user, $priv) = @_;
+    ...
+    return 1 || 0;
+}
+
+# Available ACLs
+sub acls {
+    ...
+    return %acls;
+}
+
+# Dump acls for user
+sub acls_for_user {
+    my $user = shift;
+    ...
+    return %acls;
+}
+
+# What is the user for this session token
+sub user_for_session {
+    my $session = shift;
+    ...
+    return $user;
+}
+```
+
+In the event that auth or route handlers are found, these events will be noted in the startup log.
+
+# LOGGING
+
+By default we have two log handlers...which you can augment with your own, based on Log::Dispatch.
+
+The first default is to print ERROR and worse to the STDOUT of the PSGI server.
+The other is to emit INFO or better to logs/tpsgi.log
+
+Pass your own dispatch subclasses and watch it go whir.
+
+# SERVICE CONFIGURATION
+
+Proper operation of this as a production service requires some things:
+
+1. You have a user which has this repository as their home directory.
+2. You run the shell script, tpsgi.sh in service/ to run this as a service.
+3. You set the username and the domain name of the service in .tpsgi.ini
+4. You set your PATH appropriately to pick up on things like custom perls in a .bashrc
+5. You set the group of your reverse proxy application in .tpsgi.ini (the http\_user variable)
+
+run service/tpsgi.sh as root and you should be set supposing the above is true.
+
+In general the operation is like so:
+
+1. nginx (or whatever) looks for a sock file owned $USER:$WEB\_GROUP, and reverse proxies to this
+2. tpsgi is actively listening on this sock file.
+
+Generally you'll just run bin/build\_service and then systemctl start $domain.
+It's configured to start as root, then drop privs thanks to Net::Server's capabilities inherited in starman.
+
+## Secrets the application needs
+
+An application often needs a key or a password that has no business living in
+its own checkout, where it would go into every backup alongside whatever it
+protects.  bin/build\_service makes one and puts it in systemd's credential
+store; the unit imports it and service/tpsgi.sh hands it on.
+
+You do not have to do anything for this.  build\_service writes
+`/etc/credstore.encrypted/tpsgi-vault` if it is not there already, encrypted
+with `systemd-creds --with-key=auto`: sealed to the TPM when the machine has a
+usable one, and to the host key when it does not.  It says which you got, since
+that is the difference between a stolen disk being useless and a stolen disk
+being a stolen key.  An existing key is left alone.
+
+systemd decrypts it into a ramdisk at `/run/credentials/$service` that only this
+service can read.  Nothing breaks if it is not there: `ImportCredential=` is
+quiet about a credential that does not exist, so an installation whose
+application wants no secrets starts normally.
+
+The workers are chrooted into the application directory and that ramdisk is
+outside it, so service/tpsgi.sh reads the credential before the chroot happens
+and exports it -- `tpsgi-vault` becomes `TPSGI_VAULT_KEY`.  An application taking
+one is expected to read it out of its environment as it starts and delete it
+there and then, so that nothing it forks afterwards inherits it.
+
+It is named for tPSGI rather than for whatever is being served, because this is
+tPSGI's unit and one service is one application in one directory.
+
+The key is not backed up and cannot be recovered.  That is deliberate: it lives
+and dies with the machine, so that it is never sitting in the same backup as the
+data it protects.  Rebuilding the host means whatever was sealed under it is
+gone and gets stored again.
+
+# BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+[https://github.com/Troglodyne-Internet-Widgets/tPSGI/issues](https://github.com/Troglodyne-Internet-Widgets/tPSGI/issues)
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+# AUTHORS
+
+Current Maintainers:
+
+- George S. Baugh <george@troglodyne.net>
+
+# CONTRIBUTORS
+
+- Andy Baugh <andy@troglodyne.net>
+- Kōan <morpheus@troglodyne.net>
+
+# COPYRIGHT AND LICENSE
+
+Copyright (c) 2026 Troglodyne LLC
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

+ 0 - 237
Readme.md

@@ -1,237 +0,0 @@
-# tPSGI
-
-```
-tpsgi ... [starman args]
-```
-
-A PSGI server built to migrate old mod\_perl/apache stacks onto psgi, and that powers tCMS.
-
-Will execute any executable file (chmod +x) in www/ as CGI, and otherwise host any static file therein.
-
-The idea here is as a bridge between old and new which allows you to modernize at your own pace, gradually turning CGIs into routes.
-
-The other idea is that we don't want to add any extra abstraction if we don't have to, while gently guiding into better practices.
-Shops used to having full control over the HTTP response should continue to do so, rather than being locked into one framework or another.
-This allows them to continue doing whatever funky thing they have been doing, like COMET, et cetera.
-The best way to do that is to expect raw PSGI to be output.
-
-## Configuration
-
-Obeys ~/.tpsgi.ini -- this is what will control all the custom aspects mentioned below:
-
-    verbose     : Whether to print all log messages or not
-    custom_log  : Custom location for default (rotated) log
-    routers     : Router module(s), separate with comma.  Relative to TPSGI install dir.
-    indices     : Dirindex files.  In addition to index.html, index.htm, index.cgi
-    loggers     : Logger module(s), separate with comma.  Each is a Log::Dispatch::Output class.  tPSGI loads it by name, so it can live beside a router
-    auth        : Authentication module
-    domain      : Domain name of the application, used by things like service files
-    basedir     : Directory you want to chdir into on startup. Relative to TPSGI install dir.  Default '.'
-    user        : Who to run as
-    http_user   : Who's proxying this application (used for statics)
-    autoreload  : Whether or not to automatically reload the application when library files change. Default 0.
-
-You can run bin/tpsgi-config to get any config value needed by scripts.
-
-We wrap starman with a custom script, `bin/tarbaby` that implements Plack::Loader::Reload far less dangerously.
-It only reloads the code relevant to tPSGI and your application itself.
-All the CPAN deps should be updated out-of-band and the service manually restarted, as this is far more fraught.
-
-## Custom routing
-
-All passed routing modules will be required, and combined to form a routing table so you have an analogue to rewrite rules.
-
-Routing Modules look like so:
-```
-our @routes = (
-    '/foo/(\w+)/save' => {
-        method    => 'GET',
-        callbacks => { # Run these subroutines to execute the appropriate handler given the content-type.  Expects normal PSGI output.
-            'text/html'        => \&render,
-            'application/json' => \&dump,
-        },
-        noindex   => 0, # Explicitly exclude this in robots.txt
-        nomap     => 0, # Don't put this in the sitemap
-        acls      => ['admin'], # Route requires both authentication by auth handler and the auth'd user to have the provided ACLs.
-        data      => { baz => 'throb' }, # Arbitrary data to inject into the GET/POST data hashref
-        captures  => ['name','parameter'], # Name parameters of the capture groups in the route key.  Suppose we want /foo/don/keys here.
-        static    => 1, # Whether we can save a static render of this
-        invalidates => ['/foo/(\w+)'], # Static renders which are invalidated by this route returning a successful response code.
-    },
-    ...
-);
-```
-Note that this is an array, as we want this to preserve order. Fat commas are used to hint that this is in fact a tuple.
-
-Router callbacks are passed the TPSGI object and the raw query, which means you can do:
-
-    sub route {
-        my ($self, $query) = @_;
-        $self->INFO("whatever");
-        $self->ERROR("eeee");
-        $self->DEBUG("blah");
-
-        # Either from the GET or POST data, POST is preferred when both are present.
-        my $param = $query->{param};
-
-        my %headers = ...;
-
-        return [200, \%headers, ["Hello world"]]
-    }
-
-## Watching files for changes
-
-tPSGI already watches your library directories with inotify so that it can reload itself when your
-code changes.  Your application can put arbitrary files and directories onto that same watchlist,
-along with a callback to run when they change.  The usual reason to want this is throwing away a
-static render because the thing it was generated from changed underneath it.
-
-Routing modules declare these the same way they declare routes:
-
-```
-our %watches = (
-    # A bare coderef is the common case: run this when the path changes.
-    'data/posts.json' => sub {
-        my ($tpsgi, $change) = @_;
-        $tpsgi->invalidate_renders('html');
-    },
-
-    # Or spell it out if you want to be picky about which events you care about.
-    'www/assets' => {
-        callback => \&asset_changed,
-        events   => [qw{CREATE MOVE}],
-    },
-);
-```
-
-...or register them at runtime with `$tpsgi->add_watch($path, $callback, %options)`, and drop them
-again with `$tpsgi->remove_watch($path)`.
-
-Callbacks are passed the TPSGI object and a hashref describing what happened:
-
-    sub asset_changed {
-        my ($tpsgi, $change) = @_;
-
-        $change->{path};    # full path of the thing which changed
-        $change->{watched}; # the path the watch was registered against
-        $change->{events};  # arrayref of event names, e.g. ['MODIFY']
-
-        $tpsgi->invalidate_render($change->{path}, 'html');
-    }
-
-A few things worth knowing:
-
-* Watches are shared by every worker, so whichever worker notices a change first consumes it for all
-  of them.  Declare your watches in your routing module (which every worker loads) rather than from
-  inside a single route, and make the callbacks safe to run in any worker.
-* Nothing sits in a select loop over the inotify descriptor, so changes are noticed when the next
-  request comes in.  Prompt, but not instant.
-* Watching the containing directory is more robust than watching a single file.  Watches on files
-  which get replaced wholesale (write a tempfile, rename over the target) are re-established
-  afterwards, but a file which is deleted and not recreated takes its watch with it.
-
-## Custom Authentication handling
-
-The (optional) Authentication handler can be passed, and look like so:
-
-```
-package Auth::Handler;
-
-# Is user who they say they are
-sub authenticate {
-    my (%auth_payload) = @_;
-    ...
-    return ($session_cookie);
-}
-
-# is the user authorized to do $thing
-sub authorized {
-    my ($user, $priv) = @_;
-    ...
-    return 1 || 0;
-}
-
-# Available ACLs
-sub acls {
-    ...
-    return %acls;
-}
-
-# Dump acls for user
-sub acls_for_user {
-    my $user = shift;
-    ...
-    return %acls;
-}
-
-# What is the user for this session token
-sub user_for_session {
-    my $session = shift;
-    ...
-    return $user;
-}
-```
-
-In the event that auth or route handlers are found, these events will be noted in the startup log.
-
-## Logging
-
-By default we have two log handlers...which you can augment with your own, based on Log::Dispatch.
-
-The first default is to print ERROR and worse to the STDOUT of the PSGI server.
-The other is to emit INFO or better to logs/tpsgi.log
-
-Pass your own dispatch subclasses and watch it go whir.
-
-## Service configuration
-
-Proper operation of this as a production service requires some things:
-
-0. You have a user which has this reposity as their home directory.
-1. You run the shell script, tpsgi.sh in service/ to run this as a service.
-2. You set the username and the domain name of the service in .tpsgi.ini
-3. You set your PATH appropriately to pick up on things like custom perls in a .bashrc
-4. You set the group of your reverse proxy application in .tpsgi.ini (the http\_user variable)
-
-run service/tpsgi.sh as root and you should be set supposing the above is true.
-
-In general the operation is like so:
-
-1. nginx (or whatever) looks for a sock file owned $USER:$WEB\_GROUP, and reverse proxies to this
-2. tpsgi is actively listening on this sock file.
-
-Generally you'll just run bin/build\_service and then systemctl start $domain.
-It's configured to start as root, then drop privs thanks to Net::Server's capabilities inherited in starman.
-
-### Secrets the application needs
-
-An application often needs a key or a password that has no business living in
-its own checkout, where it would go into every backup alongside whatever it
-protects.  bin/build\_service makes one and puts it in systemd's credential
-store; the unit imports it and service/tpsgi.sh hands it on.
-
-You do not have to do anything for this.  build\_service writes
-`/etc/credstore.encrypted/tpsgi-vault` if it is not there already, encrypted
-with `systemd-creds --with-key=auto`: sealed to the TPM when the machine has a
-usable one, and to the host key when it does not.  It says which you got, since
-that is the difference between a stolen disk being useless and a stolen disk
-being a stolen key.  An existing key is left alone.
-
-systemd decrypts it into a ramdisk at `/run/credentials/$service` that only this
-service can read.  Nothing breaks if it is not there: `ImportCredential=` is
-quiet about a credential that does not exist, so an installation whose
-application wants no secrets starts normally.
-
-The workers are chrooted into the application directory and that ramdisk is
-outside it, so service/tpsgi.sh reads the credential before the chroot happens
-and exports it -- `tpsgi-vault` becomes `TPSGI_VAULT_KEY`.  An application taking
-one is expected to read it out of its environment as it starts and delete it
-there and then, so that nothing it forks afterwards inherits it.
-
-It is named for tPSGI rather than for whatever is being served, because this is
-tPSGI's unit and one service is one application in one directory.
-
-The key is not backed up and cannot be recovered.  That is deliberate: it lives
-and dies with the machine, so that it is never sitting in the same backup as the
-data it protects.  Rebuilding the host means whatever was sealed under it is
-gone and gets stored again.

+ 0 - 7
bin/deps2hash.sh

@@ -1,7 +0,0 @@
-#!/bin/sh
-# Because I am LAZY
-echo "PREREQ_PM => {"
-git grep -P 'use \S+;' | sed -e 's/^.*:use //g;s/[(|)|;]//g' | grep -vP 'strict|warnings' | sort | uniq | sed -e 's/\(.*\)/"\1"/;s/$/ => "0",/'
-echo '"Devel::NYTProf" => "0",'
-echo 'Starman => "0",'
-echo "}"

+ 28 - 12
bin/tarbaby

@@ -1,8 +1,11 @@
 #!/usr/bin/env perl
 
-# Minor modifications to starman to support autoreload of code without Plack::Loader::Restarter.
+# PODNAME: tarbaby
+# ABSTRACT: starman, with the autoreload that tPSGI does without Plack::Loader::Restarter
 
-use strict;
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use FindBin::libs;
 use Plack::Runner;
@@ -10,36 +13,49 @@ use Plack::Runner;
 use File::Basename qw{dirname};
 use TPSGI::Startup;
 
+=head1 USAGE
+
+    tarbaby [--preload-app] [starman options] bin/tpsgi
+
+Starman, run as plackup would run it, with the server that
+L<Plack::Handler::TPSGI> provides.  Before it forks, it sets up inotify watches
+on F<lib/> and on the directory of each router, so that a worker notices a
+changed module and restarts the server, when C<autoreload> is on.  The workers
+load the application when they start, unless C<--preload-app> is passed.
+
+=cut
+
 sub version {
     require Starman;
     print "Starman $Starman::VERSION\n";
+    return;
 }
 
 # Setup the watcher for changes
 # This has to be setup at global server start rather than app start per worker.
 # This is preferable to using -R (Plack::Loader::Restarter, see notes in orig starman)
 my %options = TPSGI::Startup::get_config();
-my @dirs = ("$options{tpsgi_dir}/lib");
-foreach my $route (@{$options{routers}}) {
-    push(@dirs, dirname("$options{tpsgi_dir}/$route"));
+my @dirs    = ("$options{tpsgi_dir}/lib");
+foreach my $route ( @{ $options{routers} } ) {
+    push( @dirs, dirname("$options{tpsgi_dir}/$route") );
 }
 TPSGI::Startup::watch_for_changes(@dirs);
 
 my $preload_app;
 require Getopt::Long;
-Getopt::Long::Configure("no_ignore_case", "no_auto_abbrev", "pass_through");
+Getopt::Long::Configure(qw{no_ignore_case no_auto_abbrev pass_through});
 Getopt::Long::GetOptions(
-    "preload-app"      => \$preload_app,
+    "preload-app" => \$preload_app,
 );
 
-my @args = (server => 'TPSGI', env => 'deployment', version_cb => \&version);
-if (!$preload_app) {
-        push @args, 'loader' => 'Delayed';
+my @args = ( server => 'TPSGI', env => 'deployment', version_cb => \&version );
+if ( !$preload_app ) {
+    push @args, 'loader' => 'Delayed';
 }
-my @argv = @ARGV;
+my @argv   = @ARGV;
 my $runner = Plack::Runner->new(@args);
 $runner->parse_options(@argv);
 
-$runner->set_options(argv => \@argv);
+$runner->set_options( argv => \@argv );
 $runner->run;
 

+ 10 - 9
bin/tpsgi

@@ -1,11 +1,12 @@
 #!bin/tarbaby
 
-#ABSTRACT: PSGI application which simplifies migrating legacy/cgi applications to PSGI, but also has advanced features for normal psgi apps
+# PODNAME: tpsgi
+# ABSTRACT: PSGI application which simplifies migrating legacy/cgi applications to PSGI, but also has advanced features for normal psgi apps
 
-use strict;
-use warnings;
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
-use Cwd;
 use FindBin::libs;
 use File::Basename qw{dirname};
 
@@ -39,17 +40,17 @@ This is why the various paths asked for are relative to the tPSGI install dir.
 sub main {
     my (@args) = @_;
 
-    my %options = TPSGI::get_config();
-    foreach my $route (@{$options{routers}}) {
+    my %config = TPSGI::get_config();
+    foreach my $route ( @{ $config{routers} } ) {
         my $libdir = dirname($route);
-        push(@INC, $libdir);
+        push( @INC, $libdir );
     }
 
-    return %options;
+    return %config;
 }
 
 our $app = sub {
-    umask 0022;
+    umask 0o022;
 
     # Change your dir into whatever basedir you need to be in
     chdir("$options{tpsgi_dir}/$options{basedir}") or die "Can't chdir into $options{tpsgi_dir}/$options{'basedir'}: $!";

+ 21 - 6
bin/tpsgi-config

@@ -1,30 +1,45 @@
 #!/usr/bin/env perl
 
+# PODNAME: tpsgi-config
+# ABSTRACT: Print a value from the tPSGI configuration, for shell scripts
+
 package TPSGI::ConfigTool;
 
-use strict;
-use warnings;
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use FindBin::libs;
 use Getopt::Long qw{GetOptionsFromArray};
 
 use TPSGI;
 
+=head1 USAGE
+
+    tpsgi-config --KEY
+
+Print the value of KEY in F<~/.tpsgi.ini>, or its default, one line for each
+value when it has several.  The keys are the ones that L<TPSGI> documents, and
+C<log_dir> and C<log_name>, which are made from them.  It dies when no key is
+passed.
+
+=cut
+
 sub main {
     my @args = @_;
 
     my %config = TPSGI::get_config();
 
     my @params = keys(%config);
-    my (%def, %options);
+    my ( %def, %options );
     @def{@params} = map { \$options{$_} } @params;
 
-    GetOptionsFromArray(\@args, %def);
+    GetOptionsFromArray( \@args, %def );
 
-    foreach my $param (keys(%def)) {
+    foreach my $param ( keys(%def) ) {
         next unless $options{$param};
         my @to_print;
-        @to_print = ref $config{$param} eq 'ARRAY' ? @{$config{$param}}: $config{$param};
+        @to_print = ref $config{$param} eq 'ARRAY' ? @{ $config{$param} } : $config{$param};
         foreach my $line (@to_print) {
             print "$line\n";
         }

+ 26 - 25
call.pl

@@ -1,8 +1,9 @@
 #!/usr/bin/env perl
 # Use to call specific routes with the same configuration your website has
 
-use strict;
-use warnings;
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use Data::Dumper;
 use FindBin::libs;
@@ -25,7 +26,7 @@ my %env = (
     REQUEST_METHOD => $ARGV[0],
     PATH_INFO      => $ARGV[1],
     QUERY_STRING   => $ARGV[2],
-    REQUEST_URI    => "http://$host/".$ARGV[1],
+    REQUEST_URI    => "http://$host/" . $ARGV[1],
     HTTP_HOST      => $host,
     HTTP_COOKIE    => $ARGV[3],
     'psgi.errors'  => *STDERR,
@@ -33,16 +34,18 @@ my %env = (
 );
 
 sub emit_error {
-    my $env = shift;
-    return $env->{'psgi.errors'}->print(shift) if $env->{'psgi.errors'};
-    print $@;
+    my ( $env, $err ) = @_;
+    return $env->{'psgi.errors'}->print($err) if $env->{'psgi.errors'};
+    print $err;
+    return;
 }
 
 my %cfg;
 our $app = sub {
+
     # Allow re-run
     if (%cfg) {
-        chdir($cfg{tpsgi_dir}) || warn "Can't chdir to $cfg{tpsgi_dir}: $_";
+        chdir( $cfg{tpsgi_dir} ) || warn "Can't chdir to $cfg{tpsgi_dir}: $_";
     }
 
     %cfg = TPSGI::get_config();
@@ -51,7 +54,7 @@ our $app = sub {
     $cfg{verbose} = 1;
 
     # Change your dir into whatever basedir you need to be in
-    chdir($cfg{'basedir'}) || warn "Can't chdir to $cfg{'basedir'}: $_";
+    chdir( $cfg{'basedir'} ) || warn "Can't chdir to $cfg{'basedir'}: $_";
 
     # If we have manually set the NYTPROF var, use it and don't try to control
     # When to stop or start it.
@@ -64,51 +67,49 @@ our $app = sub {
 
     return eval { $self->app(@_) } || do {
         my $env = shift;
-        emit_error($env, $@);
+        emit_error( $env, $@ );
 
         # Redact the stack trace past line 1, it usually has things which should not be shown
         $self->{cur_query}->{message} = $@;
-        $self->{cur_query}->{message} =~ s/\n.*//g if $self->{cur_query}->{message};
-        return $self->error($self->{cur_query});
+        $self->{cur_query}->{message} =~ s/\n.*//gxs if $self->{cur_query}->{message};
+        return $self->error( $self->{cur_query} );
     };
 };
 
 sub stream_to_stdout {
     my ($input) = @_;
     my ( $code, $headers ) = @$input;
-    print "RC: $code\n";
-    print "Headers:\n";
-    print Dumper($headers);
+    print "RC: $code\n", "Headers:\n", Dumper($headers);
     return \*STDOUT;
 }
 
-my $limit = $ARGV[4] || 1;
+my $limit         = $ARGV[4] || 1;
 my $max_redirects = $ARGV[5] || 6;
-my $redirects=0;
+my $redirects     = 0;
 
 for ( 1 .. $limit ) {
-    LOOP:
+  LOOP:
     my $out = $app->( \%env );
 
-    if (ref $out eq 'CODE') {
-        $out->(\&stream_to_stdout);
+    if ( ref $out eq 'CODE' ) {
+        $out->( \&stream_to_stdout );
         next;
     }
-    if (ref $out eq 'ARRAY') {
+    if ( ref $out eq 'ARRAY' ) {
+
         # Might be a redirect, so check
-        my $rc = $out->[0];
-        my %hdr = @{$out->[1]};
-        my $to = $hdr{Location};
+        my %hdr = @{ $out->[1] };
+        my $to  = $hdr{Location};
         if ($to) {
             $env{REQUEST_URI} = "http://$host/$to";
             $env{PATH_INFO}   = $to;
             $redirects++;
-            die "Max redirects reached!" unless $redirects < $max_redirects;
+            die "Max redirects reached!" if $redirects >= $max_redirects;
             goto LOOP;
         }
 
         print $out->[2][0];
         next;
     }
-    die "Weird return:\n".Dumper($out);
+    die "Weird return:\n" . Dumper($out);
 }

+ 159 - 0
dist.ini

@@ -0,0 +1,159 @@
+name = TPSGI
+version = 0.001
+author = George S. Baugh <george@troglodyne.net>
+license = MIT
+copyright_holder = Troglodyne LLC
+copyright_year = 2026
+
+; Simpler than doing include_dotfiles, and due to other dzil brain damage
+[Run::BeforeBuild]
+run = rm -rf .build/*
+[Run::Test]
+run = cp $(git rev-parse --show-toplevel)/.perltidyrc            .perltidyrc
+run = cp $(git rev-parse --show-toplevel)/.perlcriticrc          .perlcriticrc
+run = cp $(git rev-parse --show-toplevel)/.preferred_modules.ini .preferred_modules.ini
+run = cp $(git rev-parse --show-toplevel)/.pod_stopwords         .pod_stopwords
+run = cp $(git rev-parse --show-toplevel)/LICENSE                LICENSE
+run = echo .perltidyrc >> MANIFEST
+run = echo .perlcriticrc >> MANIFEST
+run = echo .preferred_modules.ini >> MANIFEST
+run = echo .pod_stopwords >> MANIFEST
+; Only what git tracks.  A working checkout of this is also a running
+; installation, with log/, run/, prof/ and www/ full of one site's state, and
+; GatherDir would ship all of it.
+[Git::GatherDir]
+exclude_match    = cover_db/.+
+; The hooks are for people working on this, not for anyone installing it.
+exclude_match    = git-hooks/.+
+exclude_filename = LICENSE
+[MetaYAML]
+[MetaJSON]
+[License]
+[Readme]
+[InstallGuide]
+[ExtraTests]
+[ExecDir]
+[ShareDir]
+[MakeMaker]
+[Manifest]
+[PruneFiles]
+[PruneCruft]
+[ManifestSkip]
+[Git::Check]
+    allow_dirty = dist.ini
+    allow_dirty = Changes
+[Git::Commit / Release_Commit]
+    allow_dirty = dist.ini
+    allow_dirty = Changes
+    add_files_in = /
+    commit_msg = %v%n%n%c
+[Git::Tag]
+    tag_format = %v
+    tag_message = %v
+[Git::Push]
+[TestRelease]
+[ConfirmRelease]
+[UploadToCPAN]
+[MetaMergeFile]
+; Reads prereqs.yml or prereqs.json and no other name: its filename option
+; takes a list, and a single value from dist.ini arrives as a string it refuses.
+[PrereqsFile]
+[MetaNoIndex]
+    directory = t
+[MetaProvides::Package]
+    inherit_version = 0
+
+[AutoPrereqs]
+; package NAME VERSION rather than a $VERSION line, which PkgVersion would put
+; above use strict, where RequireUseStrict in the compat profile reports it.
+; Needs 5.012, and neither profile allows a floor below 5.014.
+[PkgVersion]
+use_package = 1
+
+[PodWeaver]
+[Git::Contributors]
+
+[@TestingMania]
+critic_config = .perlcriticrc
+changelog = Changes
+disable = Test::Portability
+
+[CheckMetaResources]
+[CheckPrereqsIndexed]
+[CheckChangesHasContent]
+
+[GithubMeta]
+issues = 1
+user = Troglodyne-Internet-Widgets
+
+; README.md is generated from the main module's POD.  Do not write one by hand:
+; you will end up with two, they will disagree, and on a case-insensitive
+; checkout only one of them exists at all.
+[ReadmeAnyFromPod]
+type = gfm
+filename = README.md
+location = root
+
+; `dzil authordeps` doesn't know about the Pod Weaver dependencies:
+; authordep Pod::Weaver::Section::Contributors = 0
+; authordep Pod::Weaver::Plugin::Encoding = 0
+; authordep Pod::Weaver::Section::SeeAlso = 0
+; authordep Pod::Weaver::Section::GenerateSection = 0
+; authordep Pod::Elemental::Transformer::List = 0
+
+; Nor about what the hooks in git-hooks/ run: tests-covering chooses the tests
+; that a commit can break.
+; authordep Perl::Tests::Covering = 0.002
+
+; Nor are the perl-critic deps included...
+; authordep Perl::Critic::Policy::Modules::RequirePerlVersion  = 0
+; authordep Perl::Critic::Policy::Documentation::RequirePod  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::PreventSQLInjection  = 0
+; authordep Perl::Critic::Policy::RegularExpressions::RequireDefault  = 0
+; authordep Perl::Critic::Policy::BuiltinFunctions::ProhibitDeleteOnArrays  = 0
+; authordep Perl::Critic::Policy::Subroutines::ProhibitAmbiguousFunctionCalls  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::ProhibitSingleArgArraySlice  = 0
+; authordep Perl::Critic::Policy::Bangs::ProhibitUselessRegexModifiers  = 0
+; authordep Perl::Critic::Policy::Bangs::ProhibitCommentedOutCode  = 0
+; authordep Perl::Critic::Policy::Tics::ProhibitUseBase  = 0
+; authordep Perl::Critic::Policy::Plicease::ProhibitLeadingZeros  = 0
+; authordep Perl::Critic::Policy::RegularExpressions::ProhibitEmptyAlternatives  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::UnexpandedSpecialLiteral  = 0
+; authordep Perl::Critic::Policy::CodeLayout::ProhibitIfIfSameLine  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::ProhibitDuplicateHashKeys  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::ProhibitFiletest_f  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::ProhibitFiletest_rwxRWX  = 0
+; authordep Perl::Critic::Policy::CognitiveComplexity::ProhibitExcessCognitiveComplexity  = 0
+; authordep Perl::Critic::Policy::Variables::ProhibitUselessInitialization  = 0
+; authordep Perl::Critic::Policy::PreferredModules  = 0
+; authordep Perl::Critic::Policy::logicLAB::RequireSheBang  = 0
+; authordep Perl::Critic::Policy::logicLAB::ProhibitShellDispatch  = 0
+; authordep Perl::Critic::Policy::Performance::ProhibitRegexForSimpleSubstring  = 0
+; authordep Perl::Critic::Policy::RegularExpressions::ProhibitRegexToStripAffix  = 0
+; authordep Perl::Critic::Policy::RegularExpressions::ProhibitRegexToChomp  = 0
+; authordep Perl::Critic::Policy::BuiltinFunctions::ProhibitChainingSameListSub  = 0
+; authordep Perl::Critic::Policy::RegularExpressions::ProhibitRegexForStringEquality  = 0
+; authordep Perl::Critic::Policy::Subroutines::ProhibitUnderscorePrivateSubs  = 0
+; authordep Perl::Critic::Policy::Subroutines::ProhibitSingleUseLexicalSubs  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::ProhibitLiteralArithmetic  = 0
+; authordep Perl::Critic::Policy::BuiltinFunctions::ProhibitIndirectBooleanGrep  = 0
+; authordep Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctionsStricter  = 0
+; authordep Perl::Critic::Policy::ControlStructures::ProhibitEmptyConditionalBlocks  = 0
+; authordep Perl::Critic::Policy::ErrorHandling::RequireCheckedIndirectResults  = 0
+; authordep Perl::Critic::Policy::CompileTime  = 0
+; authordep Perl::Critic::Policy::ProhibitPipeOpen  = 0
+; authordep Perl::Critic::Policy::ProhibitUseLib  = 0
+; authordep Perl::Critic::Policy::ProhibitUsageSubs  = 0
+; authordep Perl::Critic::Policy::RequireQwForLiteralLists  = 0
+; authordep Perl::Critic::Policy::ProhibitNoWarningsRedefine  = 0
+; authordep Perl::Critic::Policy::RequireFatalWarnings  = 0
+; authordep Perl::Critic::Policy::ProhibitUnusedImports  = 0
+; authordep Perl::Critic::Policy::ProhibitMisplacedMethods  = 0
+; authordep Perl::Critic::Policy::ProhibitPrintSTDERR  = 0
+; authordep Perl::Critic::Policy::InputOutput::ProhibitRepeatedPrints  = 0
+; authordep Perl::Critic::Policy::ValuesAndExpressions::ProhibitDefinedBeforeLength  = 0
+; authordep Perl::Critic::Policy::Variables::ProhibitUselessVarClearing  = 0.001
+; authordep Perl::Critic::Policy::Subroutines::ProhibitTailRecursion  = 0.001
+; authordep Perl::Critic::Policy::RegularExpressions::PreventUselessMetacharacterEscapes  = 0
+; authordep Perl::Critic::Policy::Variables::ProhibitUnusedVarsStricter  = 0

+ 33 - 0
git-hooks/post-commit

@@ -0,0 +1,33 @@
+#!/bin/sh
+
+# Bring the records of tests-covering up to the commit just made.
+#
+# git-hooks/pre-commit chooses tests by reading a diff against these records,
+# and a diff describes the files as they were before the change.  So after each
+# commit the records must describe that commit, or the next choice falls back
+# to every test that loaded a changed file, and grows coarser with each commit.
+#
+# In the background, because it runs each stale test under Devel::Cover, and a
+# full refresh takes much longer than a commit should.  Run it by hand to catch
+# up.  It runs the tests the way the pre-commit hook does, with lib/ on the
+# path and nothing else set, so that the records describe the same runs.
+#
+# Install it: cp git-hooks/pre-commit git-hooks/post-commit .git/hooks/
+
+command -v tests-covering >/dev/null 2>&1 || exit 0
+
+# Not while a rebase, or a cherry-pick or revert of several commits, applies
+# them.  git runs this hook for each commit that it applies, and each refresh
+# runs every stale test under Devel::Cover.  A refresh brings the records up to
+# the working tree, however many commits it missed, so the next commit after
+# the rebase catches them up.
+for state in rebase-merge rebase-apply sequencer; do
+    [ -d "$(git rev-parse --git-path "$state")" ] && exit 0
+done
+
+# Without the GIT_ variables that git sets for this hook, for the reason the
+# pre-commit hook gives: the refresh runs the tests, and a test that runs git
+# in a repository of its own would otherwise work in this one.
+unset $(env | sed -n 's/^\(GIT_[A-Za-z0-9_]*\)=.*/\1/p')
+
+tests-covering --refresh --jobs "$(nproc 2>/dev/null || echo 1)" >/dev/null 2>&1 &

+ 210 - 0
git-hooks/pre-commit

@@ -0,0 +1,210 @@
+#!/bin/sh
+
+# Tidy staged Perl, judge it against .perlcriticrc, then run the tests, before
+# any of it lands.
+#
+# There is a .perltidyrc, and a tree stays tidy to it only if something makes it.
+# Left to people, it does not: tidying a file you are changing three lines of
+# buries the change in a hundred lines of reformatting, so the reasonable thing
+# is to skip it, and the tree drifts until a mass tidy is the only way back.
+# One commit's worth at a time is small enough that nobody has to weigh it up.
+#
+# perlcritic is here for the other half of that. `dzil test` runs the profile
+# too, through [@TestingMania], but that is the pass you run before a release --
+# by which point the objection is twenty commits old and the person who can
+# answer it has moved on. Here it is about the diff in front of you.
+#
+# There is one profile, .perlcriticrc, and which one that is was decided when
+# this distribution was scaffolded: the packaging-perl skill asks which perl you
+# are targeting and copies the matching profile to that name. So the hook needs
+# no opinion about versions -- the file it reads is already the right one, and
+# changing your floor means replacing that file rather than editing this.
+#
+# Install it: cp git-hooks/pre-commit .git/hooks/
+#
+# A file qualifies three ways:
+#   - a .pm, .pl or .t extension
+#   - a .PL extension, which is how a Makefile.PL gets covered
+#   - executable with perl on its shebang line, which is how the extensionless
+#     scripts in bin/ get covered
+#
+# .t is in there because test files are often not executable, and the shebang
+# rule alone would then tidy whichever ones happen to be and let the rest drift.
+#
+# Both passes read the working tree rather than the index, so a file staged in
+# part is judged whole. That is deliberate: perltidy rewrites the file on disk
+# and the hook stages what it wrote, so the working copy is what lands anyway,
+# and two passes disagreeing about which bytes they looked at would be worse to
+# own than this.
+#
+# Both run from the top of the working tree, which is where git runs a hook and
+# the only place they work at all: the profile names .preferred_modules.ini and
+# .pod_stopwords by relative path.
+
+# Redirect output to stderr.
+exec 1>&2
+
+# ACMR so that a file deleted in this commit is not handed to perltidy, which
+# would fail on a path that is no longer there.
+staged=$(git diff --cached --name-only --diff-filter=ACMR)
+
+lib_files=''
+test_files=''
+for file in $staged
+do
+    test -f "$file" || continue
+
+    is_perl=''
+    case "$file" in
+        *.pm|*.pl|*.PL|*.t)
+            is_perl=1
+            ;;
+    esac
+
+    if [ -z "$is_perl" ] && test -x "$file" && head -n 1 "$file" | grep -Eq '^#!.*perl'
+    then
+        is_perl=1
+    fi
+
+    test -n "$is_perl" || continue
+
+    # Whether a file is perl at all, and then which list it goes in.  One case
+    # statement doing both would file t/00-load.t under whichever arm it reached
+    # first, and the .t rule is above the path rule.
+    case "$file" in
+        t/*) test_files="$test_files $file" ;;
+        *)   lib_files="$lib_files $file" ;;
+    esac
+done
+
+# For the tidy pass, which does not care which list a file came from.  The
+# emptiness tests below concatenate the two without a space instead: with one,
+# "no perl staged at all" would be a string holding a space, which is not empty.
+all_files="$lib_files $test_files"
+
+# Quoted here, because a bare [ $all_files ] is a syntax error the moment there
+# is more than one file -- which would stop the hook working in exactly the
+# commits that need it most.  Unquoted below, because there the word splitting is
+# what turns one string into an argument list.
+if [ -z "$lib_files$test_files" ]
+then
+    :
+elif command -v perltidy >/dev/null 2>&1
+then
+    echo "Auto-tidying perl changes..."
+
+    # -bext='/' makes perltidy delete the backup it would otherwise leave
+    # sitting next to the file as <name>.bak.
+    perltidy -b -bext='/' $all_files || {
+        echo "pre-commit: perltidy failed, leaving the commit alone."
+        exit 1
+    }
+
+    git update-index --add $all_files
+    echo "Done."
+else
+    echo "pre-commit: perltidy is not on PATH, skipping the tidy pass."
+fi
+
+# After the tidy pass and never before.  The tidy pass rewrites these files and
+# stages what it wrote, so what critic has to judge is the bytes that will land
+# rather than the ones you saved -- and if you ever turn [CodeLayout::
+# RequireTidyCode] back on, running it first would fail the commit over the one
+# thing the hook had already set out to fix by itself.
+#
+# Three branches rather than two conditions and one else.  Staging nothing the
+# profile judges -- a commit of documentation, say -- is not the same thing as
+# having no perlcritic to judge it with, and one else says the second whenever
+# the first is true.
+if [ -z "$lib_files$test_files" ]
+then
+    echo "Nothing staged that the profile judges."
+elif command -v perlcritic >/dev/null 2>&1
+then
+    echo "Running perlcritic..."
+
+    # Both passes run even when the first has already failed, so one commit
+    # shows every objection rather than one list's worth at a time.
+    critic_failed=''
+
+    if [ -n "$lib_files" ]
+    then
+        perlcritic --profile .perlcriticrc $lib_files || critic_failed=1
+    fi
+
+    # The same profile for t/, less one policy.  A test is not a module: nobody
+    # runs perldoc on it, so requiring POD of it asks for a page no reader will
+    # ever open.  Everything else in the profile still judges it, which is more
+    # than a release does -- all_critic_ok() reads lib/ and not t/, so this hook
+    # is the only thing that looks at a test file at all.
+    if [ -n "$test_files" ]
+    then
+        perlcritic --profile .perlcriticrc --exclude Documentation::RequirePod $test_files || critic_failed=1
+    fi
+
+    if [ -n "$critic_failed" ]
+    then
+        echo
+        echo "pre-commit: perlcritic refused the above.  Either fix them, or say"
+        echo "why with a '## no critic (Policy::Name)' and the reason beside it."
+        echo "To commit without these checks at all: git commit --no-verify"
+        exit 1
+    fi
+
+    echo "Done."
+else
+    # Skipped rather than fatal, for the same reason the tidy pass is: a machine
+    # without perlcritic can still commit, and `dzil test` will not let the
+    # distribution be released without one.
+    echo "pre-commit: perlcritic is not on PATH, skipping the critic pass."
+fi
+
+# Last, because the tests read the files that the tidy pass wrote.  Whatever is
+# staged, and not only Perl: a change to a share/ file or a fixture breaks a
+# test as surely as a change to a module does.  -l for lib/, as `dzil test`
+# finds it.
+#
+# Without the GIT_ variables that git sets for this hook.  It sets
+# GIT_INDEX_FILE, and GIT_DIR too in a worktree, and git obeys them over -C.  So
+# a test that runs git in a repository of its own would add, commit and write
+# config in this one.  In a subshell, because the git commands of this hook need
+# them: under git commit -a, GIT_INDEX_FILE names the index being committed.
+run_tests() {
+    (
+        unset $(env | sed -n 's/^\(GIT_[A-Za-z0-9_]*\)=.*/\1/p')
+        prove -lm -j8 "$@"
+    ) || {
+        echo "pre-commit: the tests above failed.  To see why, run each failing file"
+        echo "on its own:  prove -lv t/<file>.t"
+        echo "To commit without these checks at all: git commit --no-verify"
+        exit 1
+    }
+}
+
+test -d t || exit 0
+
+# Without tests-covering, every test, because nothing here knows which tests a
+# change can reach.
+if ! command -v tests-covering >/dev/null 2>&1
+then
+    echo "Running every test, because tests-covering is not on PATH; install Perl::Tests::Covering..."
+    run_tests t/
+    exit 0
+fi
+
+# tests-covering chooses the tests that ran a line the diff changes, from the
+# records that git-hooks/post-commit keeps up to date.  It asks
+# .tests-covering-map.pl about each file that no test loads, and the map names
+# the files that no test reads, such as dist.ini.  --unexplained all runs every
+# test for a file that neither can place, such as a fixture.  --full-index,
+# because it matches each file to its records by the blob id on the index line
+# of the diff, and an abbreviated id matches nothing.
+tests=$(git diff --cached --full-index | tests-covering --diff --unexplained all) || exit 1
+if [ -z "$tests" ]
+then
+    echo "No test ran a line that this commit changes."
+    exit 0
+fi
+
+echo "Running the tests that ran what this commit changes..."
+run_tests $tests

+ 6 - 3
lib/Plack/Handler/TPSGI.pm

@@ -1,7 +1,10 @@
 package Plack::Handler::TPSGI;
 
-use strict;
-use warnings;
+# ABSTRACT: Plack::Handler::Starman, running TPSGI::Server
+
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use parent qw{Plack::Handler::Starman};
 
@@ -24,7 +27,7 @@ sub run {
 
     my %nsa;
     foreach my $key ( keys %$self ) {
-        ( my $name = $key ) =~ s/^net_server_// or next;
+        ( my $name = $key ) =~ s/^net_server_//xs or next;
         $nsa{$name} = $self->{$key};
     }
     $self->{net_server_args} = \%nsa if %nsa;

Разлика између датотеке није приказан због своје велике величине
+ 326 - 183
lib/TPSGI.pm


+ 8 - 3
lib/TPSGI/Server.pm

@@ -1,7 +1,10 @@
 package TPSGI::Server;
 
-use strict;
-use warnings;
+# ABSTRACT: Starman::Server, with workers that answer the connection they took before a HUP retires them
+
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use parent qw{Starman::Server};
 
@@ -41,7 +44,9 @@ sub child_init_hook {
     $self->SUPER::child_init_hook(@_);
 
     my $prop = $self->{server};
-    $SIG{HUP} = sub {
+
+    # For the life of the worker, so not localized.
+    $SIG{HUP} = sub {    ## no critic (RequireLocalizedPunctuationVars)
         $prop->{SigHUPed} = 1;
 
         # Makes Net::Server's accept() return rather than retry, so a worker

+ 29 - 37
lib/TPSGI/Startup.pm

@@ -1,15 +1,19 @@
 package TPSGI::Startup;
 
+# ABSTRACT: What bin/tarbaby needs before TPSGI is loaded: the configuration, and the inotify watches
+
 # Lightweight startup helpers used by bin/tarbaby before the full TPSGI.pm
 # is loaded into workers.  Keeping these separate means updating TPSGI.pm
 # doesn't require restarting tarbaby to pick up get_config / inotify changes.
 
-use strict;
-use warnings;
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use Cwd;
 use File::Basename qw{dirname};
 use File::Find;
+use List::Util   qw{first};
 use Scalar::Util qw{refaddr};
 use Linux::Perl::inotify;
 use Config::Simple;
@@ -29,7 +33,7 @@ our $watching = 0;
 our @DEFAULT_EVENTS = qw{CREATE MODIFY DELETE MOVE};
 
 # Bit => name for every event we can actually be handed back by read().
-my %EVENT_NAMES = map { Linux::Perl::inotify->EVENT_NUMBER()->{$_} => $_ } qw{
+my %EVENT_NAMES = map { Linux::Perl::inotify::->EVENT_NUMBER()->{$_} => $_ } qw{
   ACCESS MODIFY ATTRIB CLOSE_WRITE CLOSE_NOWRITE OPEN
   MOVED_FROM MOVED_TO CREATE DELETE DELETE_SELF MOVE_SELF
   UNMOUNT Q_OVERFLOW IGNORED ISDIR
@@ -58,7 +62,7 @@ sub get_config {
         autoreload => 0,
     );
     my $config_file = "$ENV{HOME}/.tpsgi.ini";
-    if ( -f $config_file ) {
+    if ( -e $config_file ) {
         my $conf = Config::Simple->new($config_file);
         my %config;
         %config = %{ $conf->param( -block => 'default' ) } if $conf;
@@ -100,7 +104,18 @@ sub watch_for_changes {
     return if $watching;
     $watching = 1;
 
-    my @to_watch = _readdir(@dirs);
+    my @to_watch = @dirs;
+    File::Find::find(
+        {
+            wanted => sub {
+                my $object = $_;
+                push( @to_watch, $object ) if ( !-d $object && $object =~ m/[.]pm$/xs );
+            },
+            no_chdir => 1,
+            bydepth  => 1,
+        },
+        @dirs
+    );
 
     foreach my $f2watch (@to_watch) {
         print "Watching $f2watch for changes\n";
@@ -148,11 +163,11 @@ sub add_watch {
     my (%args) = @_;
 
     my $path = $args{path};
-    die "add_watch: path is required" unless defined $path && length $path;
+    die "add_watch: path is required"                  if ( $path // '' ) eq '';
     die "add_watch: callback must be a CODE reference" if defined $args{callback} && ref $args{callback} ne 'CODE';
     die "add_watch: events must be an ARRAY reference" if defined $args{events}   && ref $args{events} ne 'ARRAY';
 
-    $inotify //= Linux::Perl::inotify->new( flags => [qw{NONBLOCK}] );
+    $inotify //= Linux::Perl::inotify::->new( flags => [qw{NONBLOCK}] );
 
     my $events = $args{events} || [@DEFAULT_EVENTS];
     my $wd     = $watched{$path};
@@ -181,8 +196,10 @@ sub add_watch {
     $watch->{restart} ||= $args{restart} ? 1 : 0;
 
     if ( $args{callback} ) {
-        my $key      = defined $args{key} ? $args{key} : refaddr( $args{callback} );
-        my $existing = _find_callback( $watch, $key );
+        my $key = defined $args{key} ? $args{key} : refaddr( $args{callback} );
+
+        # Callbacks are kept in an array so that they fire in registration order.
+        my $existing = first { $_->{key} eq $key } @{ $watch->{callbacks} };
         if ($existing) {
             $existing->{code} = $args{callback};
         }
@@ -194,15 +211,6 @@ sub add_watch {
     return $wd;
 }
 
-# Callbacks are kept in an array so that they fire in registration order.
-sub _find_callback {
-    my ( $watch, $key ) = @_;
-    foreach my $cb ( @{ $watch->{callbacks} } ) {
-        return $cb if $cb->{key} eq $key;
-    }
-    return undef;
-}
-
 =head2 is_watched($path)
 
 Whether the passed path is already on the watchlist.
@@ -230,7 +238,7 @@ sub remove_watch {
     @wds = grep { $_ != $wd } @wds;
 
     # The watch may already be gone (deleted file), so don't blow up over it.
-    eval { $inotify->remove($wd) };
+    eval { $inotify->remove($wd) };    ## no critic (RequireCheckingReturnValueOfEval)
 
     return 1;
 }
@@ -315,11 +323,11 @@ sub pending_changes {
     foreach my $event ( $inotify->read() ) {
         my $watch   = $watches{ $event->{wd} };
         my $watched = $watch ? $watch->{path} : '';
-        $watched =~ s|/+$||;
+        $watched =~ s{/+$}{}xs;
 
         # Directory watches tell us the entry which changed, file watches don't.
         my $path = $watched;
-        $path = length($watched) ? "$watched/$event->{name}" : $event->{name} if $event->{name};
+        $path = $watched ne '' ? "$watched/$event->{name}" : $event->{name} if $event->{name};
 
         push(
             @changes,
@@ -336,20 +344,4 @@ sub pending_changes {
     return @changes;
 }
 
-sub _readdir {
-    my @dirs = @_;
-    File::Find::find(
-        {
-            wanted => sub {
-                my $object = $_;
-                push( @dirs, $object ) if ( -f $object && $object =~ m/\.pm$/ );
-            },
-            no_chdir => 1,
-            bydepth  => 1,
-        },
-        @dirs
-    );
-    return @dirs;
-}
-
 1;

+ 9 - 0
prereqs.yml

@@ -0,0 +1,9 @@
+# Read by [PrereqsFile] in dist.ini, for prerequisites [AutoPrereqs] cannot find
+# in the code.  The perl floor is here as well as on the use line of every file,
+# so the metadata states it even where one file leaves that line out.
+runtime:
+  requires:
+    perl: '5.040'
+    # bin/tpsgi loads it in each worker, by a require that AutoPrereqs does not
+    # read, because that file's shebang is bin/tarbaby rather than perl.
+    Devel::NYTProf: '0'

+ 20 - 15
t/TPSGI-Server.t

@@ -1,18 +1,22 @@
-use strict;
-use warnings;
+#!/usr/bin/env perl
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use Test2::V0;
 use Test2::Plugin::NoWarnings;
 
-use Cwd            qw{abs_path};
-use File::Basename qw{dirname};
 use Test::MockModule;
+use Time::HiRes ();
 
-use lib dirname( abs_path(__FILE__) ) . '/../lib';
+use FindBin::libs;
 
 ok( require TPSGI::Server, 'TPSGI::Server loads' ) or bail_out("Can't find SUT");
 
-sub server { return bless( { server => {@_} }, 'TPSGI::Server' ) }
+sub server {
+    my (%server) = @_;
+    return bless( { server => \%server }, 'TPSGI::Server' );
+}
 
 subtest 'child_init_hook' => sub {
     my $starman = Test::MockModule->new('Starman::Server');
@@ -49,6 +53,7 @@ subtest 'every connection is answered while the parent is HUPed' => sub {
     skip_all('RELEASE_TESTING not set') unless $ENV{RELEASE_TESTING};
 
     require File::Temp;
+    require Mojo::File;
     require IO::Socket::UNIX;
     require Plack::Handler::TPSGI;
 
@@ -57,14 +62,13 @@ subtest 'every connection is answered while the parent is HUPed' => sub {
 
     my $server = fork() // die "fork: $!";
     if ( !$server ) {
-        close(STDERR);
-        Plack::Handler::TPSGI->new( listen => [$sock], workers => 5, pid => "$dir/pid", keepalive => 0 )
-          ->run( sub { [ 200, [ 'Content-Type' => 'text/plain' ], ['ok'] ] } );
+        close(STDERR) or die "Cannot close STDERR: $!";
+        Plack::Handler::TPSGI->new( listen => [$sock], workers => 5, pid => "$dir/pid", keepalive => 0 )->run( sub { [ 200, [ 'Content-Type' => 'text/plain' ], ['ok'] ] } );
         exit 0;
     }
-    for ( 1 .. 100 ) { last if -S $sock && -s "$dir/pid"; select( undef, undef, undef, 0.1 ) }
+    for ( 1 .. 100 ) { last if -S $sock && -s "$dir/pid"; Time::HiRes::sleep(0.1) }
     ok( -S $sock, 'the server is listening' ) or return;
-    my $parent = do { open( my $fh, '<', "$dir/pid" ) or die $!; local $/; <$fh> };
+    my $parent = Mojo::File->new("$dir/pid")->slurp;
     chomp $parent;
 
     # Four clients, each counting the requests that got no answer.
@@ -74,16 +78,17 @@ subtest 'every connection is answered while the parent is HUPed' => sub {
             my $bad = 0;
             for ( 1 .. 1500 ) {
                 my $c = IO::Socket::UNIX->new( Peer => $sock ) or do { $bad++; next };
-                print $c "GET / HTTP/1.0\r\n\r\n";
-                my $got = do { local $/; <$c> } // '';
-                $bad++ unless $got =~ m{^HTTP/1\.\d 200}a;
+                print {$c} "GET / HTTP/1.0\r\n\r\n";
+                my $got = do { local $/; <$c> }
+                  // '';
+                $bad++ unless $got =~ m{^HTTP/1[.]\d[ ]200}xs;
             }
             exit( $bad > 255 ? 255 : $bad );
         }
         $pid
     } 1 .. 4;
 
-    for ( 1 .. 60 ) { kill( 'HUP', $parent ); select( undef, undef, undef, 0.05 ) }
+    for ( 1 .. 60 ) { kill( 'HUP', $parent ); Time::HiRes::sleep(0.05) }
 
     my $unanswered = 0;
     foreach my $pid (@clients) { waitpid( $pid, 0 ); $unanswered += $? >> 8 }

+ 44 - 23
t/TPSGI.t

@@ -1,15 +1,15 @@
-use strict;
-use warnings;
+#!/usr/bin/env perl
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use Test2::V0;
 use Test2::Plugin::NoWarnings;
 
-use Cwd            qw{abs_path};
-use File::Temp     qw{tempdir};
-use File::Basename qw{dirname};
+use File::Temp qw{tempdir};
 use Test::MockModule;
 
-use lib dirname( abs_path(__FILE__) ) . '/../lib';
+use FindBin::libs;
 
 use TPSGI;
 
@@ -33,7 +33,7 @@ package Test::Logger::Capture {
         return;
     }
 }
-$INC{'Test/Logger/Capture.pm'} = __FILE__;
+local $INC{'Test/Logger/Capture.pm'} = __FILE__;
 
 my $dir     = tempdir( CLEANUP => 1 );
 my %options = (
@@ -44,7 +44,9 @@ my %options = (
 );
 
 sub fake_env {
-    open( my $errors, '>', \my $written ) or die "Cannot open a scalar: $!";
+
+    # The fake psgi.errors, which the caller keeps open.
+    open( my $errors, '>', \my $written ) or die "Cannot open a scalar: $!";    ## no critic (RequireBriefOpen)
     return ( { 'psgi.errors' => $errors }, \$written );
 }
 
@@ -54,11 +56,12 @@ sub fake_env {
 subtest 'cannot_start, when building the log is what failed' => sub {
     my ( $env, $written ) = fake_env();
     my $res;
-    ok( lives { $res = TPSGI::cannot_start( "Could not load Bogus.pm!\n", $env, %options, loggers => ['Bogus::Logger::That::Is::Not'] ) },
-        'a logger that will not load does not turn the 500 into an exception' )
-      or note $@;
+    ok(
+        lives { $res = TPSGI::cannot_start( "Could not load Bogus.pm!\n", $env, %options, loggers => ['Bogus::Logger::That::Is::Not'] ) },
+        'a logger that will not load does not turn the 500 into an exception'
+    ) or note $@;
     is( $res->[0], 500, 'it still answers 500' );
-    like( $$written, qr/Could not load Bogus\.pm/, 'and psgi.errors still gets the reason' );
+    like( $$written, qr/Could[ ]not[ ]load[ ]Bogus\.pm/xs, 'and psgi.errors still gets the reason' );
 };
 
 subtest 'cannot_start' => sub {
@@ -67,19 +70,20 @@ subtest 'cannot_start' => sub {
 
     my $res = TPSGI::cannot_start( "Could not load Bogus.pm!\nCan't locate Bogus/Dep.pm in \@INC\n", $env, %options );
     is( $res->[0], 500, 'answers 500' );
-    like( $$written,                       qr/Can't locate Bogus\/Dep\.pm/,                     'psgi.errors gets the whole reason' );
-    like( \@Test::Logger::Capture::lines, bag { item qr/Could not start: Could not load Bogus\.pm!\nCan't locate/; etc() }, 'and so does the log' );
+    like( $$written, qr/Can't[ ]locate[ ]Bogus\/Dep\.pm/xs, 'psgi.errors gets the whole reason' );
+    my $reason = qr/Could[ ]not[ ]load[ ]Bogus[.]pm!/xs;
+    like( \@Test::Logger::Capture::lines, bag { item qr/Could[ ]not[ ]start:[ ]$reason\nCan't[ ]locate/xs; etc() }, 'and so does the log' );
 
     ok( lives { TPSGI::cannot_start( "no env\n", undef, %options ) }, 'a missing env is not a second failure' ) or note $@;
 };
 
 subtest 'cannot_start retires the worker' => sub {
-    my ( $env ) = fake_env();
+    my ($env) = fake_env();
     $env->{'psgix.harakiri'} = 1;
     TPSGI::cannot_start( "Could not load Bogus.pm!\n", $env, %options );
     ok( $env->{'psgix.harakiri.commit'}, 'a server that can retire the worker is told to' );
 
-    ( $env ) = fake_env();
+    ($env) = fake_env();
     TPSGI::cannot_start( "Could not load Bogus.pm!\n", $env, %options );
     ok( !exists $env->{'psgix.harakiri.commit'}, 'a server that cannot is not asked to' );
 };
@@ -90,13 +94,14 @@ subtest 'cannot_start answers with a page' => sub {
     my $res  = TPSGI::cannot_start( $error, ( fake_env() )[0], %options );
     my %head = @{ $res->[1] };
     is( $head{'Content-type'}, 'text/html', 'in HTML' );
-    like( $res->[2][0], qr/<h1>Internal Server Error<\/h1>/, 'saying what happened' );
-    unlike( $res->[2][0], qr/Bogus/, 'and, without TPSGI_DEBUG, not why' );
+    like( $res->[2][0], qr/<h1>Internal[ ]Server[ ]Error<\/h1>/xs, 'saying what happened' );
+    unlike( $res->[2][0], qr/Bogus/xs, 'and, without TPSGI_DEBUG, not why' );
 
     local $TPSGI::debug = 1;
     $res = TPSGI::cannot_start( $error, ( fake_env() )[0], %options );
-    like( $res->[2][0], qr/Can't locate &#60;Bogus\/Dep\.pm&#62; in \@INC &#38; &#34;elsewhere&#34;/, 'with TPSGI_DEBUG, the error, escaped' );
-    unlike( $res->[2][0], qr/<Bogus/, 'none of it read as markup' );
+    my $escaped = q{Can't locate &#60;Bogus/Dep.pm&#62; in @INC &#38; &#34;elsewhere&#34;};
+    like( $res->[2][0], qr/\Q$escaped\E/xs, 'with TPSGI_DEBUG, the error, escaped' );
+    unlike( $res->[2][0], qr/<Bogus/xs, 'none of it read as markup' );
 };
 
 subtest 'app, when the request dies' => sub {
@@ -104,14 +109,30 @@ subtest 'app, when the request dies' => sub {
     my ( $env, $written ) = fake_env();
 
     my $mock = Test::MockModule->new( 'TPSGI', no_auto => 1 );
-    $mock->redefine( _app => sub { die "Can't locate Bogus/Dep.pm in \@INC\n" } );
+    $mock->redefine( respond => sub { die "Can't locate Bogus/Dep.pm in \@INC\n" } );
 
     my $tpsgi = bless( { %options, ip => '0.0.0.0' }, 'TPSGI' );
     my $res   = $tpsgi->app($env);
 
     is( $res->[0], 500, 'answers 500' );
-    like( $$written,                       qr/Can't locate Bogus\/Dep\.pm/,                                'psgi.errors gets the reason' );
-    like( \@Test::Logger::Capture::lines, bag { item qr/Request failed: Can't locate Bogus\/Dep\.pm/; etc() }, 'and so does the log, not just that a 500 happened' );
+    like( $$written,                      qr/Can't[ ]locate[ ]Bogus\/Dep\.pm/xs,                                         'psgi.errors gets the reason' );
+    like( \@Test::Logger::Capture::lines, bag { item qr/Request[ ]failed:[ ]Can't[ ]locate[ ]Bogus\/Dep\.pm/xs; etc() }, 'and so does the log, not just that a 500 happened' );
+};
+
+# A router's pattern is matched as the router wrote it, whatever flags this
+# distribution's own regexes carry.
+subtest 'extract_query' => sub {
+    my $tpsgi = bless( { %options, ip => '0.0.0.0' }, 'TPSGI' );
+    my $env   = { REQUEST_METHOD => 'GET' };
+
+    my $query = $tpsgi->extract_query( "/post/caf\N{LATIN SMALL LETTER E WITH ACUTE}", { pattern => '/post/(\w+)', captures => ['slug'] }, $env );
+    is( $query->{slug}, "caf\N{LATIN SMALL LETTER E WITH ACUTE}", 'a \\w in a route matches a letter outside ASCII' );
+
+    $query = $tpsgi->extract_query( '/a b/c', { pattern => '/a b/(\w+)', captures => ['name'] }, $env );
+    is( $query->{name}, 'c', 'and a space in a route is a space' );
+
+    $query = $tpsgi->extract_query( "/note/x\ny", { pattern => '/note/(.+)', captures => ['text'] }, $env );
+    is( $query->{text}, undef, 'and a dot does not match a newline' );
 };
 
 done_testing();

+ 12 - 13
t/loggers.t

@@ -1,17 +1,18 @@
-use strict;
-use warnings;
+#!/usr/bin/env perl
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use Test2::V0;
 use Test2::Plugin::NoWarnings;
 
-use Cwd            qw{abs_path};
-use File::Path     qw{make_path};
-use File::Temp     qw{tempdir};
-use File::Basename qw{dirname};
+use File::Path qw{make_path};
+use File::Temp qw{tempdir};
+use Mojo::File ();
 
-use lib dirname( abs_path(__FILE__) ) . '/../lib';
+use FindBin::libs;
 
-use TPSGI;
+ok( require TPSGI, 'TPSGI loads' ) or bail_out("Can't find SUT");
 
 # A logger named in the configuration is a class that nothing has loaded yet.
 # An application ships it beside its router, and TPSGI logs its first line
@@ -20,8 +21,7 @@ my $dir = tempdir( CLEANUP => 1 );
 my $lib = "$dir/lib";
 make_path("$lib/Test/Logger");
 
-open( my $fh, '>', "$lib/Test/Logger/Capture.pm" ) or die "Cannot write the test logger: $!";
-print $fh <<'LOGGER';
+Mojo::File->new("$lib/Test/Logger/Capture.pm")->spew(<<'LOGGER');
 package Test::Logger::Capture;
 use strict;
 use warnings;
@@ -46,7 +46,6 @@ sub log_message {
 
 1;
 LOGGER
-close($fh);
 
 push( @INC, $lib );
 
@@ -66,10 +65,10 @@ ok( lives { $tpsgi->log }, 'a logger class that nothing loaded is loaded by name
 no warnings 'once';
 is( $Test::Logger::Capture::given{log_dir},   $dir,   'it is handed the log directory' );
 is( $Test::Logger::Capture::given{min_level}, 'info', 'and the level' );
-like( \@Test::Logger::Capture::lines, [qr/Opening Log/], 'and it receives the lines that the file gets' );
+like( \@Test::Logger::Capture::lines, [qr/Opening[ ]Log/xs], 'and it receives the lines that the file gets' );
 
 # The name becomes a path to load, so only a module name is one.
 my $refusing = bless( { %$tpsgi, loggers => ['../../etc/passwd'] }, 'TPSGI' );
-like( dies { TPSGI::_build_log($refusing) }, qr/not a module name/, 'a logger that is not a module name is refused' );
+like( dies { $refusing->build_log }, qr/not[ ]a[ ]module[ ]name/xs, 'a logger that is not a module name is refused' );
 
 done_testing();

+ 45 - 48
t/watch.t

@@ -1,14 +1,15 @@
-use strict;
-use warnings;
+#!/usr/bin/env perl
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aa';
 
 use Test2::V0;
 
-use Cwd            qw{abs_path};
-use File::Path     qw{make_path remove_tree};
-use File::Temp     qw{tempdir};
-use File::Basename qw{dirname};
+use File::Path qw{make_path remove_tree};
+use File::Temp qw{tempdir};
+use Test::MockModule;
 
-use lib dirname( abs_path(__FILE__) ) . '/../lib';
+use FindBin::libs;
 
 use TPSGI::Startup;
 use TPSGI;
@@ -31,17 +32,11 @@ my $tpsgi = bless(
     'TPSGI'
 );
 
-# Give the kernel a moment to queue events, then drain.
-sub changes {
-    select( undef, undef, undef, 0.1 );
-    return TPSGI::Startup::pending_changes();
-}
-
 subtest 'watching a file with a callback' => sub {
     my $file = "$tmp/subject.txt";
     open( my $fh, '>', $file ) or die $!;
-    print $fh "initial\n";
-    close $fh;
+    print {$fh} "initial\n";
+    close($fh) or die "Cannot close: $!";
 
     my @fired;
     my $wd = $tpsgi->add_watch( $file, sub { my ( $t, $change ) = @_; push( @fired, $change ) } );
@@ -49,8 +44,8 @@ subtest 'watching a file with a callback' => sub {
     ok( TPSGI::Startup::is_watched($file), "path is now watched" );
 
     open( $fh, '>>', $file ) or die $!;
-    print $fh "more\n";
-    close $fh;
+    print {$fh} "more\n";
+    close($fh) or die "Cannot close: $!";
 
     $tpsgi->handle_changes();
 
@@ -63,8 +58,8 @@ subtest 'watching a file with a callback' => sub {
 
     @fired = ();
     open( $fh, '>>', $file ) or die $!;
-    print $fh "even more\n";
-    close $fh;
+    print {$fh} "even more\n";
+    close($fh) or die "Cannot close: $!";
     $tpsgi->handle_changes();
     is( scalar(@fired), 0, "removed watches no longer fire" );
 };
@@ -72,10 +67,12 @@ subtest 'watching a file with a callback' => sub {
 subtest 'registering the same callback repeatedly is idempotent' => sub {
     my $file = "$tmp/idempotent.txt";
     open( my $fh, '>', $file ) or die $!;
-    close $fh;
+    close($fh)                 or die "Cannot close: $!";
 
     my @fired;
-    my $cb = sub { push( @fired, $_[1] ) };
+
+    # One reference, registered five times: that is the case being tested.
+    my $cb = sub { push( @fired, $_[1] ) };    ## no critic (ProhibitSingleUseLexicalSubs)
 
     # new() runs per request, so routers re-register their watches constantly.
     $tpsgi->add_watch( $file, $cb ) for 1 .. 5;
@@ -84,8 +81,8 @@ subtest 'registering the same callback repeatedly is idempotent' => sub {
     is( scalar( @{ $TPSGI::Startup::watches{$wd}{callbacks} } ), 1, "callback registered exactly once" );
 
     open( $fh, '>>', $file ) or die $!;
-    print $fh "poke\n";
-    close $fh;
+    print {$fh} "poke\n";
+    close($fh) or die "Cannot close: $!";
     $tpsgi->handle_changes();
 
     is( scalar(@fired), 1, "and it only fires once" );
@@ -96,15 +93,15 @@ subtest 'registering the same callback repeatedly is idempotent' => sub {
 subtest 'distinct callbacks on one path both fire, in order' => sub {
     my $file = "$tmp/multi.txt";
     open( my $fh, '>', $file ) or die $!;
-    close $fh;
+    close($fh)                 or die "Cannot close: $!";
 
     my @fired;
     $tpsgi->add_watch( $file, sub { push( @fired, 'first' ) } );
     $tpsgi->add_watch( $file, sub { push( @fired, 'second' ) } );
 
     open( $fh, '>>', $file ) or die $!;
-    print $fh "poke\n";
-    close $fh;
+    print {$fh} "poke\n";
+    close($fh) or die "Cannot close: $!";
     $tpsgi->handle_changes();
 
     is( \@fired, [qw{first second}], "both callbacks fired in registration order" );
@@ -120,7 +117,7 @@ subtest 'watching a directory reports the entries which changed' => sub {
     $tpsgi->add_watch( $dir, sub { push( @fired, $_[1] ) } );
 
     open( my $fh, '>', "$dir/created.txt" ) or die $!;
-    close $fh;
+    close($fh)                              or die "Cannot close: $!";
     $tpsgi->handle_changes();
 
     ok( scalar(@fired), "got at least one change for the directory" );
@@ -134,16 +131,16 @@ subtest 'watching a directory reports the entries which changed' => sub {
 subtest 'watches survive a file being replaced wholesale' => sub {
     my $file = "$tmp/renamed.txt";
     open( my $fh, '>', $file ) or die $!;
-    print $fh "one\n";
-    close $fh;
+    print {$fh} "one\n";
+    close($fh) or die "Cannot close: $!";
 
     my @fired;
-    my $original_wd = $tpsgi->add_watch( $file, sub { push( @fired, $_[1] ) } );
+    $tpsgi->add_watch( $file, sub { push( @fired, $_[1] ) } );
 
     # The write-a-tempfile-then-rename-over-it dance, which kills the old watch.
     open( $fh, '>', "$tmp/renamed.tmp" ) or die $!;
-    print $fh "two\n";
-    close $fh;
+    print {$fh} "two\n";
+    close($fh)                          or die "Cannot close: $!";
     rename( "$tmp/renamed.tmp", $file ) or die $!;
 
     $tpsgi->handle_changes();
@@ -155,8 +152,8 @@ subtest 'watches survive a file being replaced wholesale' => sub {
 
     @fired = ();
     open( $fh, '>>', $file ) or die $!;
-    print $fh "three\n";
-    close $fh;
+    print {$fh} "three\n";
+    close($fh) or die "Cannot close: $!";
     $tpsgi->handle_changes();
     is( scalar(@fired), 1, "and still fires for changes to the new inode" );
 
@@ -166,15 +163,15 @@ subtest 'watches survive a file being replaced wholesale' => sub {
 subtest 'a dying callback does not take out the request' => sub {
     my $file = "$tmp/exploding.txt";
     open( my $fh, '>', $file ) or die $!;
-    close $fh;
+    close($fh)                 or die "Cannot close: $!";
 
     my @fired;
     $tpsgi->add_watch( $file, sub { die "nope\n" },          key => 'boom' );
     $tpsgi->add_watch( $file, sub { push( @fired, 'ran' ) }, key => 'fine' );
 
     open( $fh, '>>', $file ) or die $!;
-    print $fh "poke\n";
-    close $fh;
+    print {$fh} "poke\n";
+    close($fh) or die "Cannot close: $!";
 
     ok( lives { $tpsgi->handle_changes() }, "handle_changes survives a dying callback" );
     is( \@fired, ['ran'], "and still runs the other callbacks" );
@@ -198,21 +195,20 @@ subtest 'libdir watches still drive autoreload' => sub {
     my $libdir = "$tmp/lib";
     make_path($libdir);
     open( my $fh, '>', "$libdir/Fake.pm" ) or die $!;
-    print $fh "1;\n";
-    close $fh;
+    print {$fh} "1;\n";
+    close($fh) or die "Cannot close: $!";
 
     TPSGI::Startup::watch_for_changes($libdir);
 
     my $restarted = 0;
-    no warnings qw{redefine once};
-    local *TPSGI::signal_restart_parent = sub { $restarted++ };
-    use warnings;
+    my $mock      = Test::MockModule->new('TPSGI');
+    $mock->redefine( signal_restart_parent => sub { $restarted++ } );
 
     open( $fh, '>>', "$libdir/Fake.pm" ) or die $!;
-    print $fh "# poke\n";
-    close $fh;
+    print {$fh} "# poke\n";
+    close($fh) or die "Cannot close: $!";
 
-    local $tpsgi->{autoreload} = 1;
+    $tpsgi->{autoreload} = 1;
     $tpsgi->handle_changes();
     ok( $restarted, "a changed .pm in a libdir signals a restart" );
 
@@ -220,16 +216,17 @@ subtest 'libdir watches still drive autoreload' => sub {
     $restarted = 0;
     my $data = "$tmp/data.pm";
     open( $fh, '>', $data ) or die $!;
-    close $fh;
+    close($fh)              or die "Cannot close: $!";
     $tpsgi->add_watch( $data, sub { } );
     open( $fh, '>>', $data ) or die $!;
-    print $fh "poke\n";
-    close $fh;
+    print {$fh} "poke\n";
+    close($fh) or die "Cannot close: $!";
 
     $tpsgi->handle_changes();
     ok( !$restarted, "but a .pm watched by an app does not" );
 
     TPSGI::Startup::remove_watch($data);
+    $tpsgi->{autoreload} = 0;
 };
 
 done_testing();

+ 66 - 0
weaver.ini

@@ -0,0 +1,66 @@
+[@CorePrep]
+
+[-SingleEncoding]
+
+[Name]
+[Version]
+
+[Region  / prelude]
+
+[Generic / SYNOPSIS]
+[Generic / DESCRIPTION]
+[Generic / OVERVIEW]
+
+[Collect / ATTRIBUTES]
+command = attr
+
+[Collect / METHODS]
+command = method
+
+[Collect / FUNCTIONS]
+command = func
+
+[Leftovers]
+
+[SeeAlso]
+[Bugs]
+
+[Region  / postlude]
+
+; [Authors]
+[GenerateSection / AUTHORS ]
+text = Current Maintainers:
+text =
+text = =over 4
+text =
+text = =item *
+text =
+text = George S. Baugh <george@troglodyne.net>
+text =
+text = =back
+
+[Contributors]
+[GenerateSection / COPYRIGHT AND LICENSE]
+text = Copyright (c) 2026 Troglodyne LLC
+text =
+text =
+text = Permission is hereby granted, free of charge, to any person obtaining a copy
+text = of this software and associated documentation files (the "Software"), to deal
+text = in the Software without restriction, including without limitation the rights
+text = to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+text = copies of the Software, and to permit persons to whom the Software is
+text =furnished to do so, subject to the following conditions:
+
+text = The above copyright notice and this permission notice shall be included in all
+text =copies or substantial portions of the Software.
+
+text = THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+text = IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+text = FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+text = AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+text = LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+text = OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+text = SOFTWARE.
+
+[-Transformer]
+transformer = List

Неке датотеке нису приказане због велике количине промена