lib/App/makefilepl2cpanfile.pm

Index
Structural Coverage (Approximate)

TER1 (Statement): 100.00%
TER2 (Branch): 100.00%
TER3 (LCSAJ): 100.0% (18/18)
Approximate LCSAJ segments: 105

LCSAJ Legend

● Covered — this LCSAJ path was executed during testing.

● Not covered — this LCSAJ path was never executed. These are the paths to focus on.

Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows: 

        start → end → jump

Uncovered paths show [NOT COVERED] in the tooltip.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation 
    1: package App::makefilepl2cpanfile;
    2: 
    3: use strict;
    4: use warnings;
    5: # Nothing is imported: every external function is called by its full name,
    6: # so the only subroutines in this package are its own.  (Importing put
    7: # Load, Dump, home, path, croak, carp and Readonly into the namespace.)
    8: use Carp ();
    9: use Readonly ();
   10: use Path::Tiny ();
   11: use Params::Get ();
   12: use YAML::Tiny ();
   13: use File::HomeDir ();
   14: use Fcntl ();
   15: 
   16: =head1 NAME
   17: 
   18: App::makefilepl2cpanfile - Convert Makefile.PL to a cpanfile automatically
   19: 
   20: =head1 VERSION
   21: 
   22: This document describes App::makefilepl2cpanfile version 0.06.
   23: 
   24: =cut
   25: 
   26: our $VERSION = '0.06';
   27: 
   28: # -----------------------------------------------------------------------
   29: # Constants
   30: # -----------------------------------------------------------------------
   31: 
   32: # Default author/developer tools added to the 'develop' phase when
   33: # with_develop is true and no user config file overrides them.
   34: Readonly::Hash my %DEFAULT_DEVELOP => (
   35: 	'Devel::Cover'        => 0,
   36: 	'Perl::Critic'        => 0,
   37: 	'Test::Pod'           => 0,
   38: 	'Test::Pod::Coverage' => 0,
   39: );
   40: 
   41: # Maps each Makefile.PL simple-dependency key to its cpanfile phase name.
   42: # All of these are treated as 'requires' relationships.
   43: Readonly::Hash my %PHASE_MAP => (
   44: 	BUILD_REQUIRES     => 'build',
   45: 	CONFIGURE_REQUIRES => 'configure',
   46: 	PREREQ_PM          => 'runtime',
   47: 	TEST_REQUIRES      => 'test',
   48: );
   49: 
   50: # Valid cpanfile phase names recognised inside 'prereqs => { ... }' blocks.
   51: Readonly::Hash my %VALID_PHASE => map { $_ => 1 }
   52: 	qw(runtime configure build test develop);
   53: 
   54: # Valid cpanfile relationship keywords inside each phase block.
   55: Readonly::Hash my %VALID_REL => map { $_ => 1 }
   56: 	qw(requires recommends suggests conflicts);
   57: 
   58: # Canonical emit order for non-runtime phases (runtime is special-cased at
   59: # the top level per cpanfile convention).
   60: Readonly::Array my @PHASE_ORDER => qw(configure build test develop);
   61: 
   62: # Within each phase block, emit relationships in this order.
   63: Readonly::Array my @REL_ORDER => qw(requires recommends suggests conflicts);
   64: 
   65: # META spec 1.x top-level keys (e.g. directly under META_MERGE) and the
   66: # phase and relationship each one stands for.
   67: Readonly::Hash my %LEGACY_KEY => (
   68: 	requires           => [ 'runtime',   'requires' ],
   69: 	build_requires     => [ 'build',     'requires' ],
   70: 	configure_requires => [ 'configure', 'requires' ],
   71: 	recommends         => [ 'runtime',   'recommends' ],
   72: 	suggests           => [ 'runtime',   'suggests' ],
   73: 	conflicts          => [ 'runtime',   'conflicts' ],
   74: );
   75: 
   76: # First line of every generated cpanfile.
   77: Readonly::Scalar my $HEADER => '# Generated from Makefile.PL using makefilepl2cpanfile';
   78: 
   79: # A CPAN module name: ASCII only (as PAUSE requires), so look-alike
   80: # characters from other scripts cannot smuggle in a different module.
   81: # Possessive quantifiers: no backtracking on hostile input.
   82: Readonly::Scalar my $MODULE_NAME_RE => qr/
   83: 	\A
   84: 	[A-Za-z_] \w*+    # first part: letter or '_', then word characters
   85: 	(?: :: \w++ )*+    # further parts, each after '::'
   86: 	\z
   87: /xa;
   88: 
   89: # The whole value after '=>': a single- or double-quoted string, or a bare
   90: # token.  The complete token is captured so that it is validated as a
   91: # unit - capturing only a numeric prefix would turn '1e3' into '1'.
   92: Readonly::Scalar my $VALUE_TOKEN_RE => qr/
   93: 	(?:
   94: 		' ([^'\n]*+) '    # $1: single-quoted
   95: 	|  " ([^"\n]*+) "    # $2: double-quoted
   96: 	|  ([^\s,}\#'"]++)    # $3: bare token, up to a separator
   97: 	)
   98: /x;
   99: 
  100: # One dependency entry: a quoted module name (quotes must match), '=>',
  101: # then an optional value token.  Compiled once here: interpolating
  102: # $VALUE_TOKEN_RE inside the per-line loop made Perl re-check the pattern
  103: # on every line.
  104: Readonly::Scalar my $PAIR_RE => qr/
  105: 	(?:
  106: 		' ([^'\n]++) '    # $1: single-quoted name
  107: 	|  " ([^"\n]++) "    # $2: double-quoted name (quotes must match)
  108: 	)
  109: 	\s* => \s*
  110: 	$VALUE_TOKEN_RE?    # $3-$5: the value, if any
  111: /x;
  112: 
  113: # A version number: optional 'v', ASCII digits, '.' and '_', at least one
  114: # digit.  The lookahead finds a digit lazily and the main match is
  115: # possessive, so the check is linear even on long hostile strings.
  116: Readonly::Scalar my $VERSION_RE => qr/
  117: 	\A
  118: 	v?+      # optional leading 'v'
  119: 	(?= [0-9._]*? [0-9] )  # at least one digit (found lazily: linear)
  120: 	[0-9._]++    # nothing but digits, '.' and '_'
  121: 	\z
  122: /x;
  123: 
  124: # A version requirement: a single version (as above), or a CPAN::Meta
  125: # version range - comma-separated versions each with a comparison operator,
  126: # e.g. '>= 1.2, < 2.0'.  Only digits, '.', '_', 'v', the operators, ',' and
  127: # spaces can match, so a requirement can never close the quoted literal it
  128: # is written into.  Every quantifier is possessive: linear on any input.
  129: Readonly::Scalar my $REQUIREMENT_RE => qr/
  130: 	\A
  131: 	(?: (?: >= | <= | == | != | > | < ) \s*+ )?+  # optional operator
  132: 	v?+ (?= [0-9._]*? [0-9] ) [0-9._]++  # a version
  133: 	(?:
  134: 		\s*+ , \s*+
  135: 		(?: >= | <= | == | != | > | < ) \s*+  # further parts need an operator
  136: 		v?+ (?= [0-9._]*? [0-9] ) [0-9._]++
  137: 	)*+
  138: 	\z        # no space before or after the whole value
  139: /x;
  140: 
  141: # Everything on a line up to and including its first '#' that is not
  142: # inside a quoted string.  A quote with no partner is taken as a plain
  143: # character, exactly as a left-to-right scan for quoted strings would.
  144: Readonly::Scalar my $TO_COMMENT_RE => qr/
  145: 	\A
  146: 	(?:
  147: 		[^'"\#]++    # ordinary text
  148: 	|  ' [^']*+ '    # a single-quoted string (may contain '#')
  149: 	|  " [^"]*+ "    # a double-quoted string (may contain '#')
  150: 	|  ['"]      # a quote with no partner: an ordinary character
  151: 	)*+
  152: 	\#      # the first '#' outside quotes
  153: /x;
  154: 
  155: # The four simple keys, for a single pass over the content.
  156: Readonly::Scalar my $SIMPLE_KEY_RE => qr/
  157: 	(?: BUILD_REQUIRES | CONFIGURE_REQUIRES | PREREQ_PM | TEST_REQUIRES )
  158: /x;
  159: 
  160: # Openers of dependency blocks: each captures its key in $1 and ends with
  161: # the '{', whose block _blocks() then takes from the matching-brace table.
  162: Readonly::Scalar my $SIMPLE_OPEN_RE  => qr/ \b ($SIMPLE_KEY_RE) \s*+ => \s*+ \{ /x;
  163: Readonly::Scalar my $PREREQS_OPEN_RE => qr/ \b (prereqs) \s*+ => \s*+ \{ /x;
  164: # A child of a prereqs or phase block: a phase or relationship name.
  165: Readonly::Scalar my $CHILD_OPEN_RE   => qr/ \b (\w++) \s*+ => \s*+ \{ /x;
  166: # The META spec 1.x top-level keys of %LEGACY_KEY, optionally quoted.
  167: Readonly::Scalar my $LEGACY_OPEN_RE  => qr/
  168: 	\b ( requires | build_requires | configure_requires | recommends | suggests | conflicts )
  169: 	['"]? \s*+ => \s*+ \{
  170: /x;
  171: 
  172: # The text of a comment without its outer whitespace: runs of whitespace
  173: # each followed by non-whitespace, taken possessively, so trailing
  174: # whitespace is left out without being rescanned.  (The usual
  175: # s{\s+\z}{} and (.*\S) forms retry from every position inside a long
  176: # whitespace run and are quadratic in its length.)
  177: Readonly::Scalar my $TRIMMED_RE => qr/
  178: 	\s*+        # leading whitespace, skipped
  179: 	( (?: \s*+ \S++ )++ )    # $1: from the first to the last non-space
  180: /x;
  181: 
  182: # The opening of a develop block in an existing cpanfile.
  183: Readonly::Scalar my $DEVELOP_OPEN_RE => qr/
  184: 	on \s+ ["']develop["'] \s* => \s* sub \s* \{
  185: /x;
  186: 
  187: # One entry of a develop block: relationship keyword, quoted module name,
  188: # optional quoted version.  Quotes must match on both.
  189: Readonly::Scalar my $DEVELOP_ENTRY_RE => qr/
  190: 	\b (requires|recommends|suggests|conflicts) \s+  # $1: relationship
  191: 	(?: ' ([^'\n]++) ' | " ([^"\n]++) " )  # $2 or $3: module name
  192: 	(?:
  193: 		\s* , \s*
  194: 		(?: ' ([^'\n]*+) ' | " ([^"\n]*+) " )  # $4 or $5: version
  195: 	)?
  196: /x;
  197: 
  198: # Characters stripped from comments before they are written out: C0/C1
  199: # controls other than TAB (a CR can visually overwrite a line) and the
  200: # Unicode bidirectional controls used by "Trojan Source" (CVE-2021-42574)
  201: # to make text display differently from how it is read.
  202: Readonly::Scalar my $UNSAFE_COMMENT_CHARS_RE =>
  203: 	qr/[\x00-\x08\x0A-\x1F\x7F-\x9F\x{061C}\x{200E}\x{200F}\x{202A}-\x{202E}\x{2066}-\x{2069}]/x;
  204: 
  205: =head1 SYNOPSIS
  206: 
  207: Create or refresh the F<cpanfile> of the project in the current directory:
  208: 
  209: 	use App::makefilepl2cpanfile;
  210: 	use Path::Tiny;
  211: 
  212: 	my $text = App::makefilepl2cpanfile::generate();
  213: 	path('cpanfile')->spew_utf8($text);
  214: 
  215: Keep the hand-written C<develop> section of an existing F<cpanfile>:
  216: 
  217: 	my $old  = path('cpanfile')->slurp_utf8;
  218: 	my $text = App::makefilepl2cpanfile::generate(existing => $old);
  219: 	path('cpanfile')->spew_utf8($text);
  220: 
  221: Make a F<cpanfile> for another project, with no developer tools added.
  222: The result is the same on every computer, which is useful in CI:
  223: 
  224: 	my $text = App::makefilepl2cpanfile::generate({
  225: 		makefile     => '/path/to/other/project/Makefile.PL',
  226: 		with_develop => 0,
  227: 	});
  228: 
  229: List every dependency without making a F<cpanfile>:
  230: 
  231: 	my $deps = App::makefilepl2cpanfile::parse_prereqs(
  232: 		path('Makefile.PL')->slurp_utf8
  233: 	);
  234: 	for my $phase (sort keys %{$deps}) {
  235: 		for my $rel (sort keys %{ $deps->{$phase} }) {
  236: 			for my $module (sort keys %{ $deps->{$phase}{$rel} }) {
  237: 				print "$phase $rel $module\n";
  238: 			}
  239: 		}
  240: 	}
  241: 
  242: Check in a test that the committed F<cpanfile> is up to date:
  243: 
  244: 	use Test::More;
  245: 	is(
  246: 		App::makefilepl2cpanfile::generate(existing => path('cpanfile')->slurp_utf8),
  247: 		path('cpanfile')->slurp_utf8,
  248: 		'cpanfile matches Makefile.PL',
  249: 	);
  250: 
  251: From the command line (see L<makefilepl2cpanfile>):
  252: 
  253: 	makefilepl2cpanfile              # write ./cpanfile
  254: 	makefilepl2cpanfile --dry-run    # print it instead
  255: 	makefilepl2cpanfile --diff       # show what would change
  256: 
  257: =head1 DESCRIPTION
  258: 
  259: A Perl distribution lists the modules it needs in its F<Makefile.PL>.
  260: Many tools (for example C<cpanm --installdeps .> and CI systems) prefer
  261: a F<cpanfile> instead.  This module reads a F<Makefile.PL> and writes the
  262: same list in F<cpanfile> form, so you only keep the list in one place.
  263: 
  264: The F<Makefile.PL> is B<never run>.  It is read as plain text and
  265: searched for the parts that list dependencies.  This makes the tool safe
  266: to use on code you do not trust, but it also means that it cannot see
  267: dependencies that are computed while the program runs (see
  268: L</COMMON PITFALLS>).
  269: 
  270: Reading takes time in proportion to the size of the input, however it is
  271: written, so a hostile F<Makefile.PL> or F<cpanfile> (for example one with
  272: thousands of unclosed braces) cannot make the tool hang.
  273: 
  274: =head2 What it reads
  275: 
  276: =over 4
  277: 
  278: =item * C<PREREQ_PM>, C<BUILD_REQUIRES>, C<TEST_REQUIRES> and
  279: C<CONFIGURE_REQUIRES>.  These become C<requires> lines in the C<runtime>,
  280: C<build>, C<test> and C<configure> phases.
  281: 
  282: =item * C<prereqs =E<gt> { PHASE =E<gt> { RELATIONSHIP =E<gt> { ... } } }>
  283: blocks (the CPAN::Meta::Spec version 2 layout), wherever they appear -
  284: also inside C<META_MERGE>.
  285: 
  286: =item * The older version 1 layout, directly inside C<META_MERGE>:
  287: C<requires>, C<recommends>, C<suggests> and C<conflicts> become lines of
  288: that kind in the C<runtime> phase; C<build_requires> and
  289: C<configure_requires> become C<requires> lines in the C<build> and
  290: C<configure> phases.
  291: 
  292: =item * C<MIN_PERL_VERSION>, which becomes C<requires 'perl', 'VERSION';>.
  293: 
  294: =item * A C<#> comment after an entry.  It is copied to the F<cpanfile>.
  295: 
  296: =back
  297: 
  298: =head2 What it writes
  299: 
  300: 	# Generated from Makefile.PL using makefilepl2cpanfile
  301: 
  302: 	requires 'perl', '5.010';
  303: 
  304: 	requires 'Moo', '2.000';   # object system
  305: 	requires 'Try::Tiny';
  306: 	recommends 'JSON::MaybeXS';
  307: 
  308: 	on 'test' => sub {
  309: 		requires 'Test::More', '0.98';
  310: 	};
  311: 
  312: 	on 'develop' => sub {
  313: 		requires 'Perl::Critic';
  314: 	};
  315: 
  316: Runtime dependencies come first, without an C<on> block.  The other
  317: phases follow in this order: C<configure>, C<build>, C<test>, C<develop>.
  318: Inside each phase, C<requires> lines come first, then C<recommends>, then
  319: C<suggests>, and the modules are in alphabetical order.  The same input
  320: always gives exactly the same output.
  321: 
  322: =head1 CONFIGURATION
  323: 
  324: When C<with_develop> is true (the default), some developer tools are
  325: added to the C<develop> phase.  By default these are L<Devel::Cover>,
  326: L<Perl::Critic>, L<Test::Pod> and L<Test::Pod::Coverage>.
  327: 
  328: To choose your own list, create the file
  329: F<~/.config/makefilepl2cpanfile.yml>:
  330: 
  331: 	develop:
  332: 	  Perl::Critic: 0
  333: 	  Devel::Cover: 0
  334: 	  My::Extra::Tool: '1.00'
  335: 
  336: The number after each name is the minimum version; C<0> means "any
  337: version".  Your list B<replaces> the default list; it is not added to it.
  338: Names that are not valid module names, and versions that are not version
  339: numbers, are ignored with a warning, so a mistake in this file can never
  340: put unexpected code into your F<cpanfile>.
  341: 
  342: =head1 DATA STRUCTURE
  343: 
  344: C<parse_prereqs()> returns a hash reference with three levels:
  345: 
  346: 	{
  347: 		PHASE => {
  348: 			RELATIONSHIP => {
  349: 				'Module::Name' => { version => '1.0', comment => 'why it is needed' },
  350: 			},
  351: 		},
  352: 	}
  353: 
  354: =over 4
  355: 
  356: =item * PHASE is one of C<runtime>, C<configure>, C<build>, C<test> or
  357: C<develop>.
  358: 
  359: =item * RELATIONSHIP is one of C<requires>, C<recommends>, C<suggests> or
  360: C<conflicts>.
  361: 
  362: =item * C<version> is the version requirement exactly as it was written:
  363: a single version (C<'1.60'> stays C<'1.60'>) or a version range such as
  364: C<'E<gt>= 1.2, E<lt> 2.0'>.  It is C<0> when there is no requirement.
  365: 
  366: =item * C<comment> is the text of the C<#> comment after the entry, or
  367: C<undef> when there is none.
  368: 
  369: =back
  370: 
  371: A phase or relationship with no modules is not present at all.
  372: 
  373: =head1 ENCODING
  374: 
  375: =over 4
  376: 
  377: =item * B<The Makefile.PL file> is read as UTF-8.  Comments may contain
  378: any printable Unicode text, including accented letters, emoji and
  379: combining marks; they are copied to the output unchanged.  Control
  380: characters (other than TAB) and Unicode direction-override characters
  381: are removed from comments, so that the generated file cannot be made to
  382: look different from what it really contains.  If the file is not valid UTF-8 you get a
  383: warning and processing continues (see L</generate(%args)>).
  384: 
  385: =item * B<The returned cpanfile text> is a Perl character string.  Write
  386: it with a UTF-8 output layer, for example C<path(...)-E<gt>spew_utf8> or
  387: C<binmode $fh, ':encoding(UTF-8)'>.  Otherwise Perl warns
  388: "Wide character in print" when a comment contains non-ASCII text.
  389: 
  390: =item * B<The existing argument> and B<the content argument of
  391: parse_prereqs()> must be character strings: decode them first (for
  392: example with C<slurp_utf8>).  Raw bytes work for plain ASCII, but a
  393: non-ASCII comment would come back as separate bytes.
  394: 
  395: =item * B<Module names> must be plain ASCII (A-Z, a-z, 0-9, C<_> and
  396: C<::>), as CPAN requires.  A name with any other character is ignored.
  397: This also stops look-alike names, such as C<Test::More> written with a
  398: Cyrillic letter.
  399: 
  400: =item * B<Version numbers> may use only the ASCII digits 0-9, C<.>,
  401: C<_> and a leading C<v>, and must contain at least one digit.  A version
  402: range joins such numbers, each after one of the operators C<E<gt>=>,
  403: C<E<lt>=>, C<==>, C<!=>, C<E<gt>> or C<E<lt>>, with commas.  The whole
  404: value is checked: C<'1.0-TRIAL'> is not shortened to C<'1.0'>.  Anything
  405: else is treated as "no minimum version".
  406: 
  407: =item * B<The YAML configuration file> is read as UTF-8; the same rules
  408: for names and versions apply.
  409: 
  410: =item * B<File names> are passed to the operating system unchanged.
  411: Names with spaces, non-ASCII letters or shell characters such as C<;>
  412: and C<|> are safe: no shell is ever used.
  413: 
  414: =back
  415: 
  416: =head1 METHODS
  417: 
  418: =head2 generate(%args)
  419: 
  420: =head3 PURPOSE
  421: 
  422: Reads a F<Makefile.PL> and returns the text of a matching F<cpanfile>.
  423: The F<Makefile.PL> is read as text and is never run.
  424: 
  425: =head3 ARGUMENTS
  426: 
  427: Give the arguments as a list of name/value pairs, or as one hash
  428: reference.  All of them are optional.
  429: 
  430: =over 4
  431: 
  432: =item * C<content> - the text of a F<Makefile.PL>, for example from
  433: L</read_makefile($path)>.  When it is given it is used as it is, and
  434: C<makefile> is ignored and nothing is read.  Use it to read the file once
  435: and use the same text for more than one purpose.
  436: 
  437: =item * C<makefile> - the path of the F<Makefile.PL> to read.  Default:
  438: C<'Makefile.PL'> in the current directory.  Anything that turns into a
  439: path when used as a string is accepted, such as a L<Path::Tiny> object.
  440: A filehandle or another kind of reference is refused with
  441: C<Cannot read>.
  442: 
  443: =item * C<existing> - the text of your current F<cpanfile>.  Default:
  444: C<''> (none).  Only its C<on 'develop' =E<gt> sub { ... }> section is
  445: used.  Every C<requires>, C<recommends>, C<suggests> and C<conflicts>
  446: line in that section is copied to the new text, so your hand-written developer
  447: dependencies are kept.  Lines that are commented out are not copied.
  448: An entry whose name is not a valid module name is dropped.  An entry
  449: whose version is not a version number or version range is kept without a
  450: version, and you get a warning.
  451: 
  452: =item * C<with_develop> - true or false.  Default: true.  When true, the
  453: developer tools from the configuration file (see L</CONFIGURATION>), or
  454: the default tools, are added to the C<develop> phase as C<requires>.  A
  455: tool that is already in the develop phase, from the F<Makefile.PL> or
  456: from C<existing>, is left exactly as it is.
  457: 
  458: =back
  459: 
  460: =head3 RETURNS
  461: 
  462: A string: the complete F<cpanfile>.  It always starts with the line
  463: C<# Generated from Makefile.PL using makefilepl2cpanfile> and always ends
  464: with exactly one newline.  The layout is described in
  465: L</What it writes>.  A F<Makefile.PL> with no dependencies gives just
  466: the first line.
  467: 
  468: =head3 SIDE EFFECTS
  469: 
  470: =over 4
  471: 
  472: =item * Reads the C<makefile> file.
  473: 
  474: =item * When C<with_develop> is true, reads
  475: F<~/.config/makefilepl2cpanfile.yml> if it exists.
  476: 
  477: =item * Never writes, creates or deletes any file.
  478: 
  479: =item * May print warnings (see MESSAGES below).
  480: 
  481: =item * Does not change the caller's C<$@>, C<$!> or C<$_>.
  482: 
  483: =back
  484: 
  485: =head3 USAGE EXAMPLE
  486: 
  487: 	use App::makefilepl2cpanfile;
  488: 	use Path::Tiny;
  489: 
  490: 	my $cpanfile = path('cpanfile');
  491: 	my $text = App::makefilepl2cpanfile::generate(
  492: 		makefile     => 'Makefile.PL',
  493: 		existing     => $cpanfile->exists ? $cpanfile->slurp_utf8 : '',
  494: 		with_develop => 1,
  495: 	);
  496: 	$cpanfile->spew_utf8($text);
  497: 
  498: =head3 HOW IT WORKS
  499: 
  500: =over 4
  501: 
  502: =item 1. Check that C<makefile> is a readable, regular file.
  503: 
  504: =item 2. Read it as UTF-8.  If that fails because of bad UTF-8, warn and
  505: read the raw bytes instead.  Any other read error is passed on.
  506: 
  507: =item 3. Find C<MIN_PERL_VERSION> and call L</parse_prereqs($content)>.
  508: 
  509: =item 4. Copy the develop entries from C<existing>, without replacing
  510: entries that came from the F<Makefile.PL>.
  511: 
  512: =item 5. If C<with_develop> is true, add each configured tool that is
  513: not already in the develop phase.
  514: 
  515: =item 6. Format and return the text.
  516: 
  517: =back
  518: 
  519: =head3 API SPECIFICATION
  520: 
  521: =head4 Input
  522: 
  523: 	{
  524: 		content => {
  525: 			type     => 'string',
  526: 			optional => 1,
  527: 		},
  528: 		makefile => {
  529: 			type     => 'string',
  530: 			optional => 1,
  531: 			min      => 1,
  532: 			default  => 'Makefile.PL',
  533: 		},
  534: 		existing => {
  535: 			type     => 'string',
  536: 			optional => 1,
  537: 			default  => '',
  538: 		},
  539: 		with_develop => {
  540: 			type     => 'boolean',
  541: 			optional => 1,
  542: 			default  => 1,
  543: 		},
  544: 	}
  545: 
  546: =head4 Output
  547: 
  548: 	{
  549: 		type    => 'string',
  550: 		matches => qr/\A# Generated from Makefile\.PL using makefilepl2cpanfile\n.*(?<!\n)\n\z/s,
  551: 	}
  552: 
  553: =head4 Domains
  554: 
  555: Each argument, split into groups of values that behave the same way.
  556: "Refused" means the call dies with C<Cannot read '...'>.
  557: 
  558: 	makefile
  559: 	  valid:    a readable regular file, given as a relative path, an
  560: 	            absolute path, or an object that stringifies to one
  561: 	            (e.g. Path::Tiny).  Any characters the file system allows,
  562: 	            including spaces, non-ASCII letters and shell characters.
  563: 	  default:  undef or not given -> 'Makefile.PL'
  564: 	  refused:  '' and '0' (unless such a file exists), a missing file,
  565: 	            a directory, a device, a FIFO, a symlink loop, a file
  566: 	            without read permission, any reference (filehandle, glob,
  567: 	            array, hash, code)
  568: 	  limits:   a file name component up to the file system's NAME_MAX
  569: 	            (usually 255 bytes) is accepted; one byte more is refused.
  570: 	            File size: 0 bytes gives just the header line; there is
  571: 	            no upper limit other than memory.
  572: 
  573: 	content
  574: 	  given:    used as the Makefile.PL text; makefile is then ignored
  575: 	            and no file is read (so no "Cannot read" is possible)
  576: 	  default:  undef or not given -> the makefile file is read
  577: 
  578: 	existing
  579: 	  valid:    any string.  Only the first on 'develop' => sub { ... };
  580: 	            block is used; its closing "};" must start a line (after
  581: 	            optional spaces or tabs).  'develop' or "develop".
  582: 	  default:  undef or not given -> ''
  583: 	  ignored:  a string without a develop block, a block that is never
  584: 	            closed, a reference (its "HASH(0x...)" text has no block)
  585: 	  entries:  0 or more; each needs a valid module name; a version, if
  586: 	            given, must be a version or version range (see
  587: 	            parse_prereqs)
  588: 
  589: 	with_develop
  590: 	  true:     any true Perl value, including 'yes' and '0.0'
  591: 	  false:    0, '0', ''
  592: 	  default:  undef or not given -> true
  593: 
  594: 	combinations
  595: 	  - with_develop false does not stop the existing develop block from
  596: 	    being kept; it only stops tools being added.
  597: 	  - An empty Makefile.PL with an existing develop block gives the
  598: 	    header plus that develop block.
  599: 	  - A configuration file with an empty "develop: {}" adds no tools.
  600: 
  601: =head3 MESSAGES
  602: 
  603: Values taken from files or the environment (paths, module names,
  604: versions, parser errors) are shown with control characters and Unicode
  605: direction-override characters replaced by C<\x{..}> escapes, so a
  606: hostile file cannot use a message to send escape sequences to your
  607: terminal.
  608: 
  609: Errors (the call dies):
  610: 
  611: 	Cannot read '$makefile'
  612: 	    The path does not exist, is not a regular file (for example a
  613: 	    directory, a device or a FIFO), cannot be read, or is not a path
  614: 	    at all (for example a filehandle).
  615: 	    What to do: check the path and its permissions.
  616: 
  617: 	Failed to parse $cfg_file: $error
  618: 	    The configuration file exists but contains invalid YAML, cannot be
  619: 	    read, or its location cannot be checked (for example "Permission
  620: 	    denied").  A missing file, or something that is not a regular
  621: 	    file, is simply treated as "no configuration".
  622: 	    What to do: fix the YAML or the permissions, or delete the file.
  623: 
  624: 	(any other error while reading the Makefile.PL)
  625: 	    A real read error, such as a disk failure, is passed on unchanged.
  626: 
  627: Warnings (processing continues):
  628: 
  629: 	Warning: '$makefile' contains invalid UTF-8; reading as raw bytes: $error
  630: 	    The file is not valid UTF-8.  Its raw bytes are used instead.
  631: 	    Note: depending on which optional UTF-8 modules are installed
  632: 	    (Unicode::UTF8, PerlIO::utf8_strict), Path::Tiny may instead
  633: 	    decode the file leniently and print its own warning.  Either way
  634: 	    you get a warning, not an error.
  635: 	    What to do: save the Makefile.PL as UTF-8.
  636: 
  637: 	Ignoring invalid version for '$module' in existing cpanfile: '$version'
  638: 	    A develop entry in the existing cpanfile has a version that is
  639: 	    not a version number.  The entry is kept with no version, so the
  640: 	    bad value cannot change the meaning of the new cpanfile.
  641: 
  642: 	No 'develop' key found in $cfg_file; using defaults
  643: 	    The configuration file has no develop: section.
  644: 	    What to do: add one, or delete the file.
  645: 
  646: 	Skipping invalid module name in $cfg_file: '$module'
  647: 	    A name in the develop: section is not a valid module name.  It is
  648: 	    ignored.
  649: 
  650: 	Skipping invalid version for '$module' in $cfg_file: '$version'
  651: 	    A version in the develop: section is not a version number.  The
  652: 	    module is kept with no minimum version.
  653: 
  654: =cut
  655: 
  656: sub generate {
  657: 	# Accept both flat hash and single-hashref calling styles.
●658 → 681 → 709  658: 	my $args = Params::Get::get_params(undef, \@_);
  659: 
  660: 	# File tests and the reads below (including the config file) change
  661: 	# errno; restore the caller's $! on every exit path.
  662: 	local $! = 0;
  663: 
  664: 	my $existing = $args->{existing} // '';
  665: 	my $with_dev = $args->{with_develop} // 1;
  666: 
  667: 	# Text supplied directly is used as it is; otherwise read the file.
  668: 	my $content = defined $args->{content} ? $args->{content} : read_makefile($args->{makefile});
  669: 	my $min_perl = _parse_min_perl($content);
  670: 	my $deps     = parse_prereqs($content);
  671: 
  672: 	# Merge the develop block from a pre-existing cpanfile so that
  673: 	# hand-curated entries (all relationship types) survive regeneration.
  674: 	#
  675: 	# Two linear steps instead of one /(.*?)^};/ms match: that lazy match
  676: 	# re-scanned to the end of the string from every unclosed opener, which
  677: 	# is quadratic.  Premise: any closing line after a later opener is also
  678: 	# after the first.  Conclusion: only the first opener needs trying.
  679: 	# The closing '};' must start a line, so a '};' inside an inline
  680: 	# comment does not end the block early.
  681: 	if ($existing =~ /$DEVELOP_OPEN_RE/gx) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  682: 		my $open_end = pos $existing;
  683: 		if ($existing =~ /^[ \t]*\};/mgx) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  684: 			my $dev_block = substr $existing, $open_end, $-[0] - $open_end;
  685: 
  686: 			# A commented-out line is not an entry.  '#' cannot occur in a
  687: 			# valid module name or version, so stripping to end of line is safe.
  688: 			$dev_block =~ s/\#[^\n]*+//gx;
  689: 
  690: 			while ($dev_block =~ /$DEVELOP_ENTRY_RE/gx) {
  691: 				# Save immediately: the validation regexes below would reset
  692: 				# the capture variables.
  693: 				my ($rel, $mod, $ver) = ($1, $2 // $3, $4 // $5);
  694: 				next unless $mod =~ $MODULE_NAME_RE;
  695: 				# SECURITY: the version is written back inside a single-quoted
  696: 				# literal; a value such as '\' would escape the closing quote and
  697: 				# turn following entries into executable code.
  698: 				# length(undef) is undef, so one test covers "absent" and "empty":
  699: 				# only a non-empty version can be invalid.
  700: 				if (length($ver // q{}) && !_valid_requirement($ver)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  701: 					Carp::carp "Ignoring invalid version for '$mod' in existing cpanfile: '" . _printable($ver) . q{'};
  702: 					$ver = 0;
  703: 				}
  704: 				$deps->{develop}{$rel}{$mod} //= { version => $ver || 0, comment => undef };
  705: 			}
  706: 		}
  707: 	}
  708: 
●709 → 709 → 724  709: 	if ($with_dev) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  710: 		my $config = _load_develop_config();
  711: 
  712: 		# Premise 1: a listed tool must never be added again or overwritten.
  713: 		# Premise 2: "listed" means present under any relationship.
  714: 		# Conclusion: build that set once, then add every tool outside it.
  715: 		# ($dev is a copy of the reference or a fresh {}, so reading it
  716: 		# cannot autovivify $deps->{develop} or its relationship hashes.)
  717: 		my $dev = $deps->{develop} || {};
  718: 		my %listed = map { $_ => 1 } map { keys %{ $dev->{$_} || {} } } @REL_ORDER;
  719: 		for my $mod (grep { !$listed{$_} } keys %{$config}) {
  720: 			$deps->{develop}{requires}{$mod} = { version => $config->{$mod}, comment => undef };
  721: 		}
  722: 	}
  723: 
  724: 	return _emit($deps, $min_perl);

  Mutants (Total: 2, Killed: 2, Survived: 0)
  725: }
  726: 
  727: =head2 read_makefile($path)
  728: 
  729: =head3 PURPOSE
  730: 
  731: Reads the text of a F<Makefile.PL>, exactly as L</generate(%args)> does
  732: when it is given a C<makefile> argument.  Use it together with the
  733: C<content> argument of C<generate()> when you need the same text for
  734: more than one call, so that the file is read only once.
  735: 
  736: =head3 ARGUMENTS
  737: 
  738: =over 4
  739: 
  740: =item * C<$path> - as the C<makefile> argument of L</generate(%args)>:
  741: optional, default C<'Makefile.PL'>, used as a string.
  742: 
  743: =back
  744: 
  745: =head3 RETURNS
  746: 
  747: The file's text as a character string.  If the file is not valid UTF-8
  748: you get a warning and its raw bytes instead (see L</generate(%args)>).
  749: 
  750: =head3 SIDE EFFECTS
  751: 
  752: Reads the file.  May warn.  Does not change the caller's C<$@>, C<$!>
  753: or C<$_>.
  754: 
  755: =head3 USAGE EXAMPLE
  756: 
  757: 	my $text = App::makefilepl2cpanfile::read_makefile('Makefile.PL');
  758: 	my $deps = App::makefilepl2cpanfile::parse_prereqs($text);
  759: 	my $out  = App::makefilepl2cpanfile::generate(content => $text);
  760: 
  761: =head3 API SPECIFICATION
  762: 
  763: =head4 Input
  764: 
  765: 	{
  766: 		path => {
  767: 			type     => 'string',
  768: 			optional => 1,
  769: 			min      => 1,
  770: 			default  => 'Makefile.PL',
  771: 			position => 0,
  772: 		},
  773: 	}
  774: 
  775: =head4 Output
  776: 
  777: 	{
  778: 		type => 'string',
  779: 	}
  780: 
  781: =head3 MESSAGES
  782: 
  783: The same as the file-reading messages of L</generate(%args)>:
  784: C<Cannot read '$path'> (croak), the invalid-UTF-8 warning, and any
  785: other read error passed on unchanged.
  786: 
  787: =cut
  788: 
  789: sub read_makefile {
  790: 	# Stringify so a filehandle, glob or other reference is judged by the
  791: 	# same "Cannot read" guard as a bad path, rather than being accepted by
  792: 	# -f (which also tests open handles) and then misread as a path.
●793 → 802 → 815  793: 	my $makefile = "@{[ $_[0] // 'Makefile.PL' ]}";
  794: 
  795: 	# File tests and reads change errno; restore the caller's $! and $@.
  796: 	local $! = 0;
  797: 	local $@ = q{};
  798: 
  799: 	Carp::croak "Cannot read '" . _printable($makefile) . q{'} unless -f $makefile && -r _;
  800: 
  801: 	my $content;
  802: 	if (!eval { $content = Path::Tiny::path($makefile)->slurp_utf8; 1 }) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
  803: 		# Only degrade gracefully for encoding errors; re-throw true I/O
  804: 		# failures so callers can distinguish a corrupt file from an
  805: 		# unreadable one.  Path::Tiny reports I/O failures as
  806: 		# Path::Tiny::Error objects, whose text includes the file's path:
  807: 		# matching keywords against that would misread an I/O error in,
  808: 		# say, ~/src/utf8-tools/ as a decoding problem.  So objects are
  809: 		# always rethrown, and only plain decoder messages are matched.
  810: 		die $@ if ref $@ || $@ !~ /decode|ill-formed|utf/ix;  ## no critic (RequireCarping) re-thrown unchanged, as documented; croak would append a location
  811: 		Carp::carp "Warning: '" . _printable($makefile) . "' contains invalid UTF-8; reading as raw bytes: "
  812: 			. _printable($@ =~ s/\n\z//rx);
  813: 		$content = Path::Tiny::path($makefile)->slurp_raw;
  814: 	}
  815: 	return $content;

  Mutants (Total: 2, Killed: 2, Survived: 0)
  816: }
  817: 
  818: =head2 parse_prereqs($content)
  819: 
  820: =head3 PURPOSE
  821: 
  822: Finds every dependency listed in the text of a F<Makefile.PL> and returns
  823: them grouped by phase and relationship.  This is the parser that
  824: L</generate(%args)> uses; call it directly when you want the data rather
  825: than a F<cpanfile>.  The text is never run.
  826: 
  827: =head3 ARGUMENTS
  828: 
  829: =over 4
  830: 
  831: =item * C<$content> - the text of a F<Makefile.PL>, as a character string
  832: (see L</ENCODING>).  C<undef> or a reference is treated as text with no
  833: dependencies.
  834: 
  835: =back
  836: 
  837: The forms that are recognised are listed in L</What it reads>.  These
  838: rules also apply:
  839: 
  840: =over 4
  841: 
  842: =item * Only entries whose name is in quotes and is a valid module name
  843: are used.  Several entries may be on one line; a C<#> comment at the end
  844: of a line belongs to the last entry on that line.
  845: 
  846: =item * Commented-out code is ignored, including a whole dependency list
  847: written on one line after a C<#>.
  848: 
  849: =item * A version must contain at least one digit and use only C<0-9>,
  850: C<.>, C<_> and a leading C<v>; a version range joins such versions, each
  851: after a comparison operator, with commas.  Anything else (for example
  852: C<'.'> or C<$VERSION>) means "no minimum version".
  853: 
  854: =item * When a module appears twice in the same phase and relationship,
  855: the first one wins.  The simple keys are read before C<prereqs> blocks.
  856: 
  857: =item * Relationship hashes inside a C<prereqs> block belong to that
  858: block's phase; only the version 1 keys directly inside C<META_MERGE> are
  859: mapped as described in L</What it reads>.
  860: 
  861: =item * A comment at the end of a line belongs to the last entry on the
  862: line that is actually kept; an entry dropped for an invalid name does not
  863: take the comment with it.
  864: 
  865: =back
  866: 
  867: =head3 RETURNS
  868: 
  869: A hash reference as described in L</DATA STRUCTURE>.  It is empty when
  870: nothing is found.
  871: 
  872: =head3 USAGE EXAMPLE
  873: 
  874: 	use App::makefilepl2cpanfile;
  875: 	use Path::Tiny;
  876: 
  877: 	my $deps = App::makefilepl2cpanfile::parse_prereqs(
  878: 		path('Makefile.PL')->slurp_utf8
  879: 	);
  880: 
  881: 	# Which test modules are needed, and which minimum versions?
  882: 	my $test = $deps->{test}{requires} || {};
  883: 	for my $module (sort keys %{$test}) {
  884: 		printf "%-30s %s\n", $module, $test->{$module}{version} || 'any';
  885: 	}
  886: 
  887: =head3 API SPECIFICATION
  888: 
  889: =head4 Input
  890: 
  891: 	{
  892: 		content => {
  893: 			type     => 'string',
  894: 			optional => 1,
  895: 			position => 0,
  896: 		},
  897: 	}
  898: 
  899: =head4 Output
  900: 
  901: 	{
  902: 		type => 'hashref',
  903: 	}
  904: 
  905: =head4 Domains
  906: 
  907: 	content
  908: 	  valid:    any string (decoded characters; see ENCODING)
  909: 	  empty:    '', undef, any reference, text with no dependency lists
  910: 	            -> {} (no warning)
  911: 
  912: 	module name (the quoted key of an entry)
  913: 	  valid:    ASCII letter or '_' first, then ASCII letters, digits and
  914: 	            '_', in parts joined by '::'.  Shortest: one character
  915: 	            ('A', '_').  No maximum length.
  916: 	  ignored:  '' ; leading digit ('1A') ; '::' at either end ; ':::' ;
  917: 	            '-', space, ';' or the old "'" package separator ;
  918: 	            any non-ASCII character ; a bareword (unquoted) key
  919: 
  920: 	version (the value of an entry, and MIN_PERL_VERSION)
  921: 	  valid:    the whole value is an optional 'v' followed by ASCII
  922: 	            digits, '.' and '_', with at least one digit:
  923: 	            '1', 1.60, 'v1.2.3', '1.23_01', '5.010001'
  924: 	  range:    (entries only, not MIN_PERL_VERSION) such versions, each
  925: 	            after one of >= <= == != > <, joined by commas:
  926: 	            '>= 1.2, < 2.0', '== 1.5', '< 2'.  '>= 0' means "any".
  927: 	  zero:     '0', 0, '0.0', '0.000', 'v0', 'v0.0.0' -> "no minimum"
  928: 	            (nothing is written)
  929: 	  invalid:  -> "no minimum": '.', '_', 'v', '1e3', '1.0-TRIAL',
  930: 	            '1 0', non-ASCII digits, $VERSION, version->parse(...),
  931: 	            spaces around the whole value, and ranges with a missing
  932: 	            comma or operator ('>= 1.2 < 2.0', '1.2, 2.0')
  933: 	  limits:   no maximum length
  934: 
  935: 	phase / relationship (inside prereqs blocks)
  936: 	  valid:    exactly runtime, configure, build, test, develop /
  937: 	            requires, recommends, suggests, conflicts (lower case)
  938: 	  ignored:  anything else, including 'Runtime', 'recommend', 'x_foo'
  939: 
  940: 	comment (text after '#' on an entry's line)
  941: 	  kept:     any printable Unicode: accents, 'ss'-type letters, emoji,
  942: 	            combining marks, right-to-left scripts
  943: 	  removed:  control characters other than TAB (for example CR) and
  944: 	            the bidirectional control characters U+061C, U+200E,
  945: 	            U+200F, U+202A-U+202E, U+2066-U+2069, which could make the
  946: 	            generated file display differently from its real content
  947: 	  empty:    a comment that is empty after this -> undef
  948: 
  949: =head3 MESSAGES
  950: 
  951: None.  Text that is not recognised is ignored without a warning.
  952: 
  953: =cut
  954: 
  955: sub parse_prereqs {
●956 → 976 → 987  956: 	my $content = $_[0];
  957: 
  958: 	# The POD contract is "no errors or warnings - unrecognised content is
  959: 	# silently ignored."  Undef and references are not valid Str inputs; return
  960: 	# {} immediately to avoid "uninitialized value" and "reference used as
  961: 	# string" warnings from the pattern-match operators below.
  962: 	return {} if !defined $content || ref $content;
  963: 
  964: 	my %deps;
  965: 	my $comments = _comment_spans($content);
  966: 
  967: 	# Every block is found through the matching-brace table, so a block may
  968: 	# nest to any depth and each scan below is linear: no pattern has to
  969: 	# match balanced braces, which is what made unclosed openers quadratic.
  970: 	my $pairs = _brace_pairs($content);
  971: 
  972: 	# ---- Simple dependency keys (PREREQ_PM, BUILD_REQUIRES, etc.) ----
  973: 	# These always map to the 'requires' relationship in their phase.  All
  974: 	# four are found in one pass: each key has its own phase, so the order
  975: 	# in which blocks are met cannot change which entry wins.
  976: 	for my $found (@{ _blocks($content, 0, $pairs, $SIMPLE_OPEN_RE) }) {
  977: 		my ($key, $at, undef, $block) = @{$found};
  978: 		next if _in_comment($comments, $at);
  979: 		_extract_pairs($block, \%deps, $PHASE_MAP{$key}, 'requires');
  980: 	}
  981: 
  982: 	# ---- Structured 'prereqs' blocks (CPAN Meta Spec style) ----
  983: 	# These can appear at the top level of WriteMakefile() or nested inside
  984: 	# META_MERGE; both are covered by searching the full content for 'prereqs'.
  985: 	# The [start, end) offset of each block is recorded so that the legacy
  986: 	# scan below can skip relationship blocks nested inside it.
●987 → 988 → 1014  987: 	my @prereqs_spans;
  988: 	for my $prereqs (@{ _blocks($content, 0, $pairs, $PREREQS_OPEN_RE) }) {
  989: 		my (undef, $at, $prereqs_base, $prereqs_block, $end) = @{$prereqs};
  990: 		next if _in_comment($comments, $at);
  991: 		push @prereqs_spans, [ $at, $end ];
  992: 
  993: 		# Each direct child is a phase name mapping to a relationship hash.
  994: 		for my $phase (@{ _blocks($prereqs_block, $prereqs_base, $pairs, $CHILD_OPEN_RE) }) {
  995: 			my ($phase_name, $phase_at, $phase_base, $phase_block) = @{$phase};
  996: 			next unless $VALID_PHASE{$phase_name};
  997: 			next if _in_comment($comments, $phase_at);
  998: 
  999: 			# Each child of the phase block is a relationship name.
 1000: 			for my $relationship (@{ _blocks($phase_block, $phase_base, $pairs, $CHILD_OPEN_RE) }) {
 1001: 				my ($rel, $rel_at, undef, $rel_block) = @{$relationship};
 1002: 				next unless $VALID_REL{$rel};
 1003: 				next if _in_comment($comments, $rel_at);
 1004: 
 1005: 				_extract_pairs($rel_block, \%deps, $phase_name, $rel);
 1006: 			}
 1007: 		}
 1008: 	}
 1009: 
 1010: 	# ---- Legacy top-level keys (META spec 1.x) ----
 1011: 	# e.g. META_MERGE => { recommends => { 'Mod' => 0 } }, mapped through
 1012: 	# %LEGACY_KEY.  Occurrences inside a 'prereqs' block are phase-scoped and
 1013: 	# have already been handled above, so skip them.
●1014 → 1014 → 1025 1014: 	for my $found (@{ _blocks($content, 0, $pairs, $LEGACY_OPEN_RE) }) {
 1015: 		my ($key, $at, undef, $block) = @{$found};
 1016: 		# The spans come from a scan that resumes after each block, so they
 1017: 		# are sorted and do not overlap: the same binary search as for
 1018: 		# comments applies, O(log P) per block instead of a linear scan
 1019: 		# (which made many legacy blocks times many prereqs blocks quadratic).
 1020: 		next if _in_comment(\@prereqs_spans, $at);
 1021: 		next if _in_comment($comments, $at);
 1022: 		_extract_pairs($block, \%deps, @{ $LEGACY_KEY{$key} });
 1023: 	}
 1024: 
 1025: 	return \%deps;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1026: }
 1027: 
 1028: # -----------------------------------------------------------------------
 1029: 
 1030: # _brace_pairs
 1031: #
 1032: # Purpose:  Pair every '{' in the content with its matching '}', in one
 1033: #           left-to-right pass with a stack.
 1034: # Entry:    $_[0] - the content (a defined string).
 1035: # Exit:     Returns a hashref { offset of '{' => offset of its '}' }.  A '{'
 1036: #           that is never closed has no entry; a '}' with no '{' before it
 1037: #           is ignored.
 1038: # Effects:  None.
 1039: #
 1040: # Braces are counted wherever they appear, including inside quoted strings
 1041: # and comments, as the balanced-brace patterns this replaced did.
 1042: sub _brace_pairs {
●1043 → 1045 → 1052 1043: 	my $content = $_[0];
 1044: 	my (%close_of, @open);
 1045: 	while ($content =~ /[{}]/gx) {
 1046: 		if (substr($content, $-[0], 1) eq '{') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1047: 			push @open, $-[0];
 1048: 		} elsif (@open) {
 1049: 			$close_of{ pop @open } = $-[0];
 1050: 		}
 1051: 	}
 1052: 	return \%close_of;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1053: }
 1054: 
 1055: # -----------------------------------------------------------------------
 1056: 
 1057: # _blocks
 1058: #
 1059: # Purpose:  Find each "KEY => {" whose '{' is closed, with the text of its
 1060: #           block.
 1061: # Entry:    $_[0] - text to scan: a substring of the content.
 1062: #           $_[1] - offset of that substring in the content.
 1063: #           $_[2] - _brace_pairs() of the whole content.
 1064: #           $_[3] - opener pattern: captures the key in $1, ends with '{'.
 1065: # Exit:     Returns an arrayref of [ key, offset of the key, offset of the
 1066: #           block's text, the block's text, offset just past its '}' ].
 1067: #           Offsets are in the whole content.
 1068: # Effects:  None.
 1069: #
 1070: # Like a /g match of a balanced-brace pattern, the scan resumes after each
 1071: # block, so a key inside a block that was found is not reported
 1072: # separately.  An unclosed '{' is passed over and the scan continues
 1073: # inside it.
 1074: sub _blocks {
●1075 → 1077 → 1083 1075: 	my ($text, $base, $pairs, $opener_re) = @_;
 1076: 	my @blocks;
 1077: 	while ($text =~ /$opener_re/gx) {
 1078: 		my ($key, $at, $opening) = ($1, $base + $-[0], $base + $+[0] - 1);
 1079: 		my $closing = $pairs->{$opening} // next;
 1080: 		push @blocks, [ $key, $at, $opening + 1, substr($text, $opening + 1 - $base, $closing - $opening - 1), $closing + 1 ];
 1081: 		pos($text) = $closing + 1 - $base;
 1082: 	}
 1083: 	return \@blocks;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1084: }
 1085: 
 1086: # -----------------------------------------------------------------------
 1087: # Private helpers
 1088: # -----------------------------------------------------------------------
 1089: 
 1090: # _extract_pairs
 1091: #
 1092: # Purpose:  Parse a raw block of text (the content between the outermost
 1093: #           braces of a dependency hash) into module/version/comment triples
 1094: #           and store them in the deps structure.  Processes line-by-line
 1095: #           so that trailing inline comments can be captured before the
 1096: #           comment text is discarded.
 1097: # Entry:    $_[0] - raw block text (between the outer braces).
 1098: #           $_[1] - hashref to populate (the top-level %deps).
 1099: #           $_[2] - phase name string (e.g. 'runtime').
 1100: #           $_[3] - relationship string (e.g. 'requires').
 1101: # Exit:     Returns nothing - mutates $_[1] in place.
 1102: # Effects:  Modifies the deps hashref; no I/O.
 1103: #
 1104: # First-occurrence-wins: if the same module appears multiple times (e.g.
 1105: # once in PREREQ_PM and once in a prereqs block), the first parsed entry
 1106: # is kept.
 1107: sub _extract_pairs {
●1108 → 1110 → 1161 1108: 	my ($block, $deps, $phase, $rel) = @_;
 1109: 
 1110: 	for my $line (split /\n/x, $block) {
 1111: 		# Capture any trailing inline comment before stripping it.
 1112: 		# (.*\S) is O(N): greedy .* scans to end, then gives back trailing
 1113: 		# spaces one by one until \S anchors on the last non-space char.
 1114: 		# Avoids the super-linear behaviour of (.+?)\s*$ which re-evaluates
 1115: 		# \s*$ at every expanded position of the lazy quantifier.
 1116: 		my $comment;
 1117: 		# Most lines have no '#': index() is far cheaper than the regexes.
 1118: 		if (index($line, '#') >= 0) {

					

					Mutants (Total: 4, Killed: 1, Survived: 3)
					

 1119: 			# Text after the first '#', then again after removing unsafe
 1120: 			# characters (which can expose new outer whitespace).  Both use
 1121: 			# $TRIMMED_RE, which is linear; see its definition.
 1122: 			my $after = substr $line, index($line, '#') + 1;
 1123: 			($comment) = $after =~ /\A$TRIMMED_RE/x;
 1124: 			if (defined $comment) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1125: 				$comment =~ s/$UNSAFE_COMMENT_CHARS_RE//gx;
 1126: 				($comment) = $comment =~ /\A$TRIMMED_RE/x;
 1127: 			}
 1128: 			$line = substr $line, 0, index($line, '#');
 1129: 		}
 1130: 
 1131: 		# A line may hold several entries ('A' => 0, 'B' => 0); take them all.
 1132: 		my @pairs;
 1133: 		# Opening and closing quotes must match: with ['"]...['"] the key
 1134: 		# "A'B" was read as 'B" and recorded as a different module, B.
 1135: 		while ($line =~ /$PAIR_RE/gx) {
 1136: 			push @pairs, [ $1 // $2, $3 // $4 // $5 ];
 1137: 		}
 1138: 
 1139: 		# Defense-in-depth: [^'"]+ already excludes quote characters, but it
 1140: 		# would accept spaces, ';' and non-ASCII look-alikes.  Only a real
 1141: 		# module name may reach the generated cpanfile.  Invalid names are
 1142: 		# dropped first, so that the line's comment goes to the last entry
 1143: 		# that is actually kept.
 1144: 		@pairs = grep { $_->[0] =~ $MODULE_NAME_RE } @pairs;
 1145: 
 1146: 		for my $i (0 .. $#pairs) {
 1147: 			my ($mod, $ver) = @{ $pairs[$i] };
 1148: 			# Anything that is not a version or version range ('.', '_',
 1149: 			# $VERSION, ...) means "no minimum"; emitting it would produce a
 1150: 			# cpanfile that CPAN::Meta::Requirements rejects.
 1151: 			$ver = 0 unless _valid_requirement($ver);
 1152: 			# First occurrence wins - do not overwrite already-parsed entries.
 1153: 			# A trailing comment belongs to the entry it follows: the last.
 1154: 			$deps->{$phase}{$rel}{$mod} //= {
 1155: 				version => $ver,
 1156: 				comment => $i == $#pairs ? $comment : undef,

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1157: 			};
 1158: 		}
 1159: 	}
 1160: 
 1161: 	return;
 1162: }
 1163: 
 1164: # _parse_min_perl
 1165: #
 1166: # Purpose:  Extract the MIN_PERL_VERSION value from Makefile.PL text.
 1167: # Entry:    $_[0] - raw Makefile.PL content string.
 1168: # Exit:     The version string (e.g. '5.010'), or undef if not declared.
 1169: sub _parse_min_perl {
 1170: 	my $content = $_[0];
 1171: 	return undef if !defined $content || ref $content;	## no critic (ProhibitExplicitReturnUndef)

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1172: 	return undef unless $content =~ /\bMIN_PERL_VERSION\b\s*=>\s*$VALUE_TOKEN_RE/x;	## no critic (ProhibitExplicitReturnUndef)

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1173: 	my $ver = $1 // $2 // $3;
 1174: 	return _valid_version($ver) ? $ver : undef;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1175: }
 1176: 
 1177: # _comment_spans
 1178: #
 1179: # Purpose:  Find every '#' comment in the content, so that a commented-out
 1180: #           one-line dependency hash is not parsed as live.  One linear pass;
 1181: #           the result is queried with _in_comment for each candidate block.
 1182: # Entry:    $_[0] - content string.
 1183: # Exit:     ArrayRef of [start, end) offsets, ascending and non-overlapping,
 1184: #           each running from an unquoted '#' to the end of its line.
 1185: sub _comment_spans {
●1186 → 1189 → 1198 1186: 	my $content = $_[0];
 1187: 	my @spans;
 1188: 	my $offset = 0;
 1189: 	for my $line (split /\n/x, $content, -1) {
 1190: 		# Most lines have no '#' at all; only the rest need the quote-aware
 1191: 		# scan, which finds the first '#' outside quoted strings (so that
 1192: 		# e.g. 'C#' is not mistaken for a comment) without building a copy.
 1193: 		if (index($line, '#') >= 0 && $line =~ $TO_COMMENT_RE) {

  Mutants (Total: 4, Killed: 4, Survived: 0)
 1194: 			push @spans, [ $offset + $+[0] - 1, $offset + length $line ];
 1195: 		}
 1196: 		$offset += length($line) + 1;
 1197: 	}
 1198: 	return \@spans;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1199: }
 1200: 
 1201: # _in_comment
 1202: #
 1203: # Purpose:  Decide whether an offset lies inside one of the comment spans.
 1204: # Entry:    $_[0] - ArrayRef from _comment_spans; $_[1] - offset.
 1205: # Exit:     Boolean.  Binary search, so O(log n) per query.
 1206: sub _in_comment {
●1207 → 1209 → 1216 1207: 	my ($spans, $pos) = @_;
 1208: 	my ($lo, $hi) = (0, $#{$spans});
 1209: 	while ($lo <= $hi) {

  Mutants (Total: 3, Killed: 3, Survived: 0)
 1210: 		my $mid = int(($lo + $hi) / 2);
 1211: 		my ($start, $end) = @{ $spans->[$mid] };
 1212: 		if ($pos < $start) { $hi = $mid - 1 }

  Mutants (Total: 4, Killed: 4, Survived: 0)
 1213: 		elsif ($pos >= $end) { $lo = $mid + 1 }

  Mutants (Total: 3, Killed: 3, Survived: 0)
 1214: 		else { return 1 }

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1215: 	}
 1216: 	return 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1217: }
 1218: 
 1219: # _valid_version
 1220: #
 1221: # Purpose:  Decide whether a string is a plausible version number that is
 1222: #           safe to write inside a single-quoted cpanfile literal.
 1223: # Entry:    $_[0] - candidate version string.
 1224: # Exit:     Boolean: an optional leading 'v' followed only by ASCII digits,
 1225: #           dots and underscores, with at least one digit.
 1226: sub _valid_version {
 1227: 	my $ver = $_[0];
 1228: 	return defined $ver && $ver =~ $VERSION_RE ? 1 : 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1229: }
 1230: 
 1231: # _valid_requirement
 1232: #
 1233: # Purpose:  Decide whether a string is a module version requirement that is
 1234: #           safe to write inside a single-quoted cpanfile literal: a single
 1235: #           version (see _valid_version) or a CPAN::Meta version range.
 1236: # Entry:    $_[0] - candidate string.
 1237: # Exit:     Boolean.
 1238: sub _valid_requirement {
 1239: 	my $req = $_[0];
 1240: 	return defined $req && $req =~ $REQUIREMENT_RE ? 1 : 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1241: }
 1242: 
 1243: # _printable
 1244: #
 1245: # Purpose:  Make text from a file or the environment safe to put in an
 1246: #           error or warning.  SECURITY: such text is printed to the user's
 1247: #           terminal, where escape sequences (e.g. ESC ] 0 ; ... to retitle
 1248: #           the window, or CR and ESC [ 2 K to erase the line and print
 1249: #           something else) could hide or forge messages.
 1250: # Entry:    $_[0] - any value (stringified).
 1251: # Exit:     The string with control characters and bidirectional-override
 1252: #           characters replaced by \x{..} escapes; everything else as is.
 1253: sub _printable {
 1254: 	my $text = "$_[0]";
 1255: 	$text =~ s/($UNSAFE_COMMENT_CHARS_RE)/sprintf '\\x{%X}', ord $1/gex;
 1256: 	return $text;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1257: }
 1258: 
 1259: # _load_develop_config
 1260: #
 1261: # Return the develop-tools hash from the user's YAML config file,
 1262: #   or %DEFAULT_DEVELOP when no config file exists.
 1263: # Entry:    None - reads from the filesystem at a well-known path.
 1264: # Exit:     HashRef { Module::Name => minimum_version_or_0 }.
 1265: # Effects:  Reads from disk. Croaks on YAML parse failure. Carps when the
 1266: #           config file lacks a 'develop' key.
 1267: sub _load_develop_config {
 1268: 	# Path::Tiny and YAML::Tiny use eval internally, which resets $@; keep the
 1269: 	# caller's value intact so an enclosing eval/$@ check is not disturbed.
●1270 → 1284 → 1292 1270: 	local $@ = q{};
 1271: 
 1272: 	# Guard: no usable home directory (containers, chroots, CI).  length()
 1273: 	# of undef is undef, so one test rejects both undef and ''.
 1274: 	my $home = File::HomeDir->my_home;
 1275: 	return {%DEFAULT_DEVELOP} unless length($home // q{});
 1276: 
 1277: 	my $cfg_path = Path::Tiny::path($home)->child('.config', 'makefilepl2cpanfile.yml');
 1278: 	my $cfg_shown = _printable($cfg_path);
 1279: 
 1280: 	# Guard: the path cannot be examined.  A missing file means "use the
 1281: 	# defaults"; any other stat failure (EACCES, ELOOP, stale NFS...) must not
 1282: 	# silently change the output.
 1283: 	my @stat = stat "$cfg_path";
 1284: 	unless (@stat) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1285: 		Carp::croak "Failed to parse $cfg_shown: $!" unless $!{ENOENT} || $!{ENOTDIR};
 1286: 		return {%DEFAULT_DEVELOP};
 1287: 	}
 1288: 
 1289: 	# Guard: not a regular file.  A FIFO would block the read forever and a
 1290: 	# device could stream without end.  The mode bits come from @stat, not
 1291: 	# from Perl's implicit '_' buffer, which another stat could replace.
●1292 → 1299 → 1307 1292: 	return {%DEFAULT_DEVELOP} unless Fcntl::S_ISREG($stat[2]);
 1293: 
 1294: 	# Guard: unreadable or invalid YAML.  YAML::Tiny reports failure by dying
 1295: 	# (current versions) or by returning false with errstr set (older ones);
 1296: 	# both become the single documented message, without YAML::Tiny's own
 1297: 	# location.
 1298: 	my $yaml = eval { YAML::Tiny->read("$cfg_path") };
 1299: 	unless ($yaml) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1300: 		my $err = $@ || YAML::Tiny->errstr() // q{};
 1301: 		$err =~ s/[ ]at[ ]\S++[ ]line[ ]\d++\.?\n?\z//x;
 1302: 		Carp::croak "Failed to parse $cfg_shown: " . _printable($err);
 1303: 	}
 1304: 
 1305: 	# Guard: no develop hash.  Checking the document's type first means a
 1306: 	# document that is not a hash is never dereferenced.
●1307 → 1309 → 1318 1307: 	my $doc     = $yaml->[0];
 1308: 	my $develop = ref $doc eq 'HASH' ? $doc->{develop} : undef;
 1309: 	unless (ref $develop eq 'HASH') {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1310: 		Carp::carp "No 'develop' key found in $cfg_shown; using defaults";
 1311: 		return {%DEFAULT_DEVELOP};
 1312: 	}
 1313: 
 1314: 	# SECURITY: validate every key (module name) and value (version) before
 1315: 	# use.  Keys are arbitrary strings: without this guard a key such as
 1316: 	# "Safe'; system('evil'); requires 'X" would close the quoted literal in
 1317: 	# _fmt_dep and inject code into the generated cpanfile, which cpanm runs.
●1318 → 1319 → 1334 1318: 	my %clean;
 1319: 	for my $mod (keys %{$develop}) {
 1320: 		unless ($mod =~ $MODULE_NAME_RE) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1321: 			Carp::carp "Skipping invalid module name in $cfg_shown: '" . _printable($mod) . q{'};
 1322: 			next;
 1323: 		}
 1324: 		# Premise 1: a null value means "any version", i.e. 0.
 1325: 		# Premise 2: _valid_requirement accepts '0' (it contains a digit).
 1326: 		# Conclusion: '' is the only extra value that needs allowing.
 1327: 		my $v = $develop->{$mod} // 0;
 1328: 		unless ($v eq q{} || _valid_requirement($v)) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1329: 			Carp::carp "Skipping invalid version for '$mod' in $cfg_shown: '" . _printable($v) . q{'};
 1330: 			$v = 0;
 1331: 		}
 1332: 		$clean{$mod} = $v;
 1333: 	}
 1334: 	return \%clean;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1335: }
 1336: 
 1337: # _emit
 1338: #
 1339: # Purpose:  Pure formatter - converts the structured dependency hash and an
 1340: #           optional minimum Perl version into a valid cpanfile string.
 1341: # Entry:    $_[0] - HashRef (see DATA STRUCTURE section in POD)
 1342: #           $_[1] - optional Str minimum Perl version (e.g. '5.010')
 1343: # Exit:     Scalar string; always terminated with exactly one newline.
 1344: #           Never returns undef.
 1345: #
 1346: # Runtime deps are emitted at the top level (no 'on' block) per cpanfile
 1347: # convention. All other phases get 'on phase => sub { ... }' blocks.
 1348: # Within each phase, relationships are emitted in @REL_ORDER order;
 1349: # modules within each relationship are sorted alphabetically.
 1350: # Inline comments are re-emitted after the semicolon on the same line.
 1351: # A version of 0 or '' means "any version" and is omitted.
 1352: sub _emit {
●1353 → 1361 → 1372 1353: 	my ($deps, $min_perl) = @_;
 1354: 
 1355: 	# Build the output as a list of sections joined by blank lines.
 1356: 	my @sections = ($HEADER);
 1357: 	push @sections, "requires 'perl', '$min_perl';" if _has_version($min_perl);
 1358: 
 1359: 	# Runtime is emitted at the top level; every other phase in an 'on'
 1360: 	# block, in @PHASE_ORDER.  Both use the same line builder.
 1361: 	for my $phase ('runtime', @PHASE_ORDER) {
 1362: 		my $indent = $phase eq 'runtime' ? q{} : "\t";
 1363: 		my $body = join q{}, map { _fmt_dep(@{$_}, $indent) } @{ _phase_entries($deps->{$phase}) };
 1364: 		# Premise: an absent phase, or one whose relationships are all
 1365: 		# empty, yields no entries.  Conclusion: it yields no section.
 1366: 		next if $body eq q{};
 1367: 		push @sections, $phase eq 'runtime'
 1368: 			? $body =~ s/\n\z//rx		# the blank-line separator is added by join
 1369: 			: "on '$phase' => sub {\n$body};";
 1370: 	}
 1371: 
 1372: 	return join("\n\n", @sections) . "\n";

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1373: }
 1374: 
 1375: # _phase_entries
 1376: #
 1377: # Purpose:  List one phase's entries in output order: relationships in
 1378: #           @REL_ORDER, modules alphabetically within each.
 1379: # Entry:    $_[0] - the phase's hashref ({ rel => { module => entry } }),
 1380: #           or undef when the phase is absent.
 1381: # Exit:     ArrayRef of [ rel, module, entry ] triples; empty when none.
 1382: sub _phase_entries {
●1383 → 1385 → 1389 1383: 	my $phase = $_[0] || {};
 1384: 	my @entries;
 1385: 	for my $rel (@REL_ORDER) {
 1386: 		my $mods = $phase->{$rel} || {};
 1387: 		push @entries, [ $rel, $_, $mods->{$_} ] for sort keys %{$mods};
 1388: 	}
 1389: 	return \@entries;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1390: }
 1391: 
 1392: # _fmt_dep
 1393: #
 1394: # Purpose:  Format a single dependency line for cpanfile output, including
 1395: #           the optional version constraint and inline comment.
 1396: # Entry:    $_[0] - relationship keyword (e.g. 'requires', 'recommends').
 1397: #           $_[1] - module name string.
 1398: #           $_[2] - entry hashref { version => ..., comment => ... }.
 1399: #           $_[3] - indentation prefix ('' for runtime, "\t" for phase blocks).
 1400: # Exit:     A complete formatted line, including trailing newline.
 1401: sub _fmt_dep {
●1402 → 1411 → 1417 1402: 	my ($rel, $mod, $entry, $indent) = @_;
 1403: 
 1404: 	my $line = "${indent}$rel '$mod'";
 1405: 	$line .= ", '$entry->{version}'" if _has_version($entry->{version});
 1406: 
 1407: 	# Premise 1: every producer of entries stores a comment that is undef
 1408: 	# or non-empty (_extract_pairs turns an empty comment into undef; merged
 1409: 	# and configured entries have none).  Premise 2: _fmt_dep is only called
 1410: 	# by _emit on such entries.  Conclusion: defined() is sufficient.
 1411: 	if (defined $entry->{comment}) {

  Mutants (Total: 1, Killed: 1, Survived: 0)
 1412: 		$line .= ";   # $entry->{comment}\n";
 1413: 	} else {
 1414: 		$line .= ";\n";
 1415: 	}
 1416: 
 1417: 	return $line;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1418: }
 1419: 
 1420: # _has_version
 1421: #
 1422: # Decide whether a version value represents a real minimum version
 1423: #	constraint that should be written into the cpanfile output.
 1424: # Entry:    $_[0] - version value (scalar, possibly undef or numeric '0').
 1425: # Exit:     Boolean: true if the version should be emitted; false if it
 1426: #           means "any version" (undef, empty string, or numeric zero).
 1427: sub _has_version {
 1428: 	my $ver = $_[0];
 1429: 
 1430: 	# Premise 1: every version that reaches here is undef, 0, '' or a string
 1431: 	# accepted by _valid_requirement: a single version (ASCII digits, '.',
 1432: 	# '_', optional 'v') or a range, which always contains an operator.
 1433: 	# Premise 2: a single version is zero exactly when none of its digits is
 1434: 	# 1-9 ('0', '0.000', 'v0.0.0', '0_0'); a range means "any version" only
 1435: 	# when it is '>=' a zero version.
 1436: 	# Conclusion: two tests decide it.
 1437: 	return 0 unless defined $ver;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1438: 	return $ver =~ /\A \s* >= \s* v? [0._]* \s* \z/x ? 0 : 1 if $ver =~ /[<>=!]/x;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1439: 	return $ver =~ /[1-9]/x ? 1 : 0;

  Mutants (Total: 2, Killed: 2, Survived: 0)
 1440: }
 1441: 
 1442: 
 1443: # -----------------------------------------------------------------------
 1444: # Post-release roadmap (from the 0.05 gap analysis)
 1445: # -----------------------------------------------------------------------
 1446: #
 1447: # Features
 1448: # TODO: Write CPAN::Meta optional_features as cpanfile 'feature' blocks,
 1449: #       and carry x_* custom phases through instead of dropping them.
 1450: # TODO: Command line: --diff should exit non-zero when the cpanfile would
 1451: #       change (like 'git diff --exit-code'); add --makefile FILE,
 1452: #       --output FILE, --quiet, and '-' to read Makefile.PL from stdin.
 1453: # TODO: Read other build files: Build.PL (Module::Build requires,
 1454: #       build_requires, test_requires, configure_requires, recommends) and
 1455: #       possibly dist.ini; consider the reverse direction (cpanfile to a
 1456: #       PREREQ_PM snippet).
 1457: # TODO: Keep more of a hand-written cpanfile than its develop block:
 1458: #       feature blocks, extra 'on test' entries, and comments inside the
 1459: #       develop block.
 1460: # TODO: Optional, never default, mode that runs Makefile.PL in an isolated
 1461: #       sandbox to capture dependencies computed by code.
 1462: # TODO: Translatable messages (e.g. Locale::TextDomain); all messages are
 1463: #       English only.
 1464: #
 1465: # Technical debt
 1466: # TODO: Replace the brace matching with PPI: parses Perl without running
 1467: #       it, understands quoting, comments and heredocs (so a brace inside
 1468: #       a string would no longer count), and could flag conditional
 1469: #       dependencies instead of making them unconditional.
 1470: # TODO: Move bin/makefilepl2cpanfile's logic into a module
 1471: #       (e.g. App::makefilepl2cpanfile::CLI->run(\@ARGV) returning an exit
 1472: #       code) for in-process tests, real coverage, and fewer subprocess
 1473: #       tests (slow, and fragile on Windows).
 1474: # TODO: Consolidate the test suite: move duplicated helpers (empty_home,
 1475: #       make_mf, use_home, run_cli) into t/lib, and merge the overlap
 1476: #       between function.t, unit.t and extended_tests.t.
 1477: # TODO: Readonly hashes and arrays (%PHASE_MAP, %VALID_PHASE, %VALID_REL,
 1478: #       %LEGACY_KEY, @REL_ORDER, @PHASE_ORDER, %DEFAULT_DEVELOP) are tied,
 1479: #       adding overhead to every access; use plain lexicals or constant
 1480: #       lists.
 1481: # TODO: In the command-line tool, rename the temporary file directly
 1482: #       instead of Path::Tiny's move (File::Copy::move moves INTO a
 1483: #       directory; only the non-regular-file guard prevents that today),
 1484: #       and close the small race between the symlink check and the write.
 1485: # TODO: Consider a size limit for Makefile.PL and the existing cpanfile, so
 1486: #       a huge hostile file cannot exhaust memory.
 1487: # TODO: CI: Devel::Cover for the command-line tool's subprocesses (via
 1488: #       PERL5OPT).
 1489: 
 1490: 1;
 1491: 
 1492: __END__
 1493: 
 1494: =head1 COMMON PITFALLS
 1495: 
 1496: =over 4
 1497: 
 1498: =item * B<Code in Makefile.PL is not run.>  Dependencies that are built
 1499: by code are not seen, for example C<PREREQ_PM =E<gt> \%deps> or a list
 1500: returned by a function.  Entries inside a condition, such as
 1501: C<$^O eq 'MSWin32' ? ('Win32' =E<gt> 0) : ()>, are seen but become
 1502: unconditional.  Write such dependencies as plain entries, or add them to
 1503: the F<cpanfile> another way.
 1504: 
 1505: =item * B<Only the develop section of an existing cpanfile is kept.>
 1506: Hand edits anywhere else (for example a C<feature> block or an extra
 1507: C<on 'test'> line) are lost when you regenerate.  Put hand-written
 1508: entries in C<on 'develop' =E<gt> sub { ... }>.
 1509: 
 1510: =item * B<Conditions inside the kept develop section are removed.>  An
 1511: C<if (...) { requires 'X' }> inside the develop block is carried over as
 1512: a plain C<requires 'X'>.  Comments in the develop block are not kept.
 1513: 
 1514: =item * B<Which entry wins.>  When the same module is listed twice in the
 1515: same phase and relationship, the first one wins.  The simple keys
 1516: (C<PREREQ_PM> and friends) are read before C<prereqs> blocks, and entries
 1517: from F<Makefile.PL> win over entries in the existing develop section.
 1518: The same module under two different relationships (for example
 1519: C<requires> and C<recommends>) is kept twice.
 1520: 
 1521: =item * B<The configuration file replaces the default tools.>  If you
 1522: list only C<My::Tool>, then C<Perl::Critic> and the others are no longer
 1523: added.  List them too if you want them.
 1524: 
 1525: =item * B<undef means "use the default".>  C<makefile =E<gt> undef> reads
 1526: F<Makefile.PL>; C<existing =E<gt> undef> is the same as C<''>; and
 1527: C<with_develop =E<gt> undef> means B<true>.  Use C<with_develop =E<gt> 0>
 1528: to turn developer tools off.
 1529: 
 1530: =item * B<parse_prereqs(undef) is silent.>  It returns an empty hash
 1531: reference with no warning, so a failed file read can look like "no
 1532: dependencies".  Check that the read worked before you call it.
 1533: 
 1534: =item * B<The output depends on who runs it.>  With C<with_develop> on,
 1535: the tool list comes from the home directory of the current user.  Use
 1536: C<with_develop =E<gt> 0> when every computer must produce the same file.
 1537: 
 1538: =item * B<generate() does not write any file.>  It returns the text.
 1539: Save it yourself (see L</SYNOPSIS>) or use the command-line tool.
 1540: 
 1541: =item * B<Relative paths> in C<makefile> are relative to the current
 1542: working directory, not to your script.
 1543: 
 1544: =item * B<Warnings are not errors.>  Problems such as invalid UTF-8 or a
 1545: bad configuration entry are reported with C<warn> (through L<Carp>) and
 1546: processing continues.  Catch them with C<$SIG{__WARN__}> if you need to
 1547: act on them.
 1548: 
 1549: =back
 1550: 
 1551: =head1 DESIGN NOTES
 1552: 
 1553: Some checks are made once, where data enters, and relied on afterwards.
 1554: Each rule below is proved by F<t/logic.t>.
 1555: 
 1556: =over 4
 1557: 
 1558: =item * B<Versions.>  Every version is checked when it is read (from the
 1559: F<Makefile.PL>, the existing F<cpanfile> or the configuration file) and
 1560: replaced by C<0> if it is not a version number or version range.  A
 1561: version number is zero exactly when none of its digits is 1 to 9, and a
 1562: range means "any version" only when it is C<E<gt>=> a zero version.  So,
 1563: when the output is written, those two tests decide whether to print a
 1564: requirement.
 1565: 
 1566: =item * B<Comments.>  An empty comment is stored as "no comment" when it
 1567: is read, and entries from other sources have no comment.  So, when the
 1568: output is written, a comment that exists is never empty and can be
 1569: printed without further checks.
 1570: 
 1571: =item * B<Developer tools.>  A tool must not be added if the develop
 1572: phase already lists it under any relationship.  So the set of listed
 1573: modules is built once, and every configured tool outside that set is
 1574: added.
 1575: 
 1576: =item * B<Speed.>  Parsing takes time proportional to the size of the
 1577: F<Makefile.PL>, however its blocks are arranged: every position test
 1578: (is this block inside a comment, or inside a C<prereqs> block?) is a
 1579: binary search over sorted, non-overlapping ranges.  Lines without a
 1580: C<#> skip the comment checks, the four simple keys are found in one
 1581: pass, and the patterns used on every line are compiled once.
 1582: 
 1583: =item * B<Order of checks.>  Each function stops at the first check that
 1584: fails: an unreadable F<Makefile.PL> is refused before anything is read,
 1585: and the configuration file is only parsed once it is known to exist and
 1586: to be a regular file.
 1587: 
 1588: =back
 1589: 
 1590: =head1 LIMITATIONS
 1591: 
 1592: =over 4
 1593: 
 1594: =item * The F<Makefile.PL> is read with patterns, not run, so dependencies
 1595: that are computed by code cannot be found (see L</COMMON PITFALLS>).
 1596: 
 1597: =item * Braces are matched without regard to quotes or comments, so an
 1598: unmatched C<{> or C<}> inside a string or a C<#> comment within a
 1599: dependency list can hide some or all of that list's entries.  Dependency
 1600: lists may otherwise nest to any depth.
 1601: 
 1602: =item * Only one C<on 'develop'> section of an existing F<cpanfile> is
 1603: used: the first one.
 1604: 
 1605: =back
 1606: 
 1607: =head1 SEE ALSO
 1608: 
 1609: =over 4
 1610: 
 1611: =item * L<makefilepl2cpanfile> - the command-line tool
 1612: 
 1613: =item * L<Module::CPANfile>, L<cpanfile> - the F<cpanfile> format
 1614: 
 1615: =item * L<CPAN::Meta::Spec> - the meaning of phases and relationships
 1616: 
 1617: =item * L<ExtUtils::MakeMaker> - the F<Makefile.PL> format
 1618: 
 1619: =item * L<Test Dashboard|https://nigelhorne.github.io/App-makefilepl2cpanfile/coverage/>
 1620: 
 1621: =back
 1622: 
 1623: =head1 SUPPORT
 1624: 
 1625: This module is provided as-is without any warranty.
 1626: 
 1627: Please report bugs and feature requests at
 1628: L<https://github.com/nigelhorne/App-makefilepl2cpanfile/issues>.
 1629: 
 1630: =head1 AUTHOR
 1631: 
 1632: Nigel Horne E<lt>njh@nigelhorne.comE<gt>
 1633: 
 1634: =encoding utf-8
 1635: 
 1636: =head1 FORMAL SPECIFICATION
 1637: 
 1638: The specifications below use Z notation.  They describe what each
 1639: function computes; the English sections above are the normative
 1640: description for everyday use.
 1641: 
 1642: =head2 Basic types and helpers
 1643: 
 1644: 	[CHAR, PATH]
 1645: 	Str       == seq CHAR
 1646: 	ModName   == { s : Str | s matches [A-Za-z_][A-Za-z0-9_]*(::[A-Za-z0-9_]+)* }
 1647: 	VersionStr == { s : Str | s matches v?[0-9._]+ ∧ (∃ c ∈ ran s • c ∈ '0'..'9') }
 1648: 	Op        ::= >= | <= | == | != | > | <
 1649: 	Requirement == VersionStr ∪ { ⁀/ ⟨ o₁ ⁀ v₁, ", " ⁀ o₂ ⁀ v₂, … ⟩ | oᵢ ∈ Op, vᵢ ∈ VersionStr }
 1650: 	Phase     ::= runtime | configure | build | test | develop
 1651: 	Rel       ::= requires | recommends | suggests | conflicts
 1652: 	Entry     == [ version : Requirement ∪ {0}; comment : Str ∪ {⊥} ]
 1653: 	LEGACY    == { requires ↦ (runtime, requires), build_requires ↦ (build, requires),
 1654: 	               configure_requires ↦ (configure, requires), recommends ↦ (runtime, recommends),
 1655: 	               suggests ↦ (runtime, suggests), conflicts ↦ (runtime, conflicts) }
 1656: 	DepMap    == Phase ⇸ (Rel ⇸ (ModName ⇸ Entry))
 1657: 
 1658: 	-- Left-biased merge: entries already present win.
 1659: 	_⊕ₗ_ : DepMap × DepMap -> DepMap
 1660: 	a ⊕ₗ b == a ∪ { p ↦ (r ↦ (m ↦ e)) ∈ b | m ∉ dom(a(p)(r)) }
 1661: 
 1662: 	-- Environment read by generate (it is never modified).
 1663: 	Env ≙ [ fs : PATH ⇸ seq BYTE; home : PATH ∪ {⊥} ]
 1664: 	cfg(E) == E.home ⁀ "/.config/makefilepl2cpanfile.yml"
 1665: 
 1666: =head2 parse_prereqs
 1667: 
 1668: 	parse_prereqs : (Str ∪ {⊥}) -> DepMap
 1669: 
 1670: 	parse_prereqs(s) ==
 1671: 	  if s = ⊥ ∨ is_ref(s) then ∅
 1672: 	  else simple(s') ⊕ₗ structured(s') ⊕ₗ legacy(s')
 1673: 	  where s' == s with every '#' comment removed
 1674: 
 1675: 	simple(s)     == ⋃ { {PHASE_MAP(k) ↦ {requires ↦ pairs(b)}}
 1676: 	                     | k ∈ {PREREQ_PM, BUILD_REQUIRES, TEST_REQUIRES, CONFIGURE_REQUIRES},
 1677: 	                       b ∈ blocks(k, s) }
 1678: 	structured(s) == ⋃ { {p ↦ {r ↦ pairs(b)}}
 1679: 	                     | P ∈ blocks(prereqs, s), (p ↦ (r ↦ b)) ∈ P, p ∈ Phase, r ∈ Rel }
 1680: 	legacy(s)     == ⋃ { {first(LEGACY(k)) ↦ {second(LEGACY(k)) ↦ pairs(b)}}
 1681: 	                     | k ∈ dom LEGACY, b ∈ blocks(k, s),
 1682: 	                       ¬ (∃ P ∈ blocks(prereqs, s) • b ⊆ P) }
 1683: 	pairs(b)      == { m ↦ ⟨ if v ∈ Requirement then v else 0, comment(m, b) ⟩
 1684: 	                     | ('m' => v) ∈ b, m ∈ ModName }
 1685: 	-- comment(m, b): the line's comment if m is the last valid entry on it
 1686: 
 1687: 	post  ∀ p ↦ R ∈ result • R ≠ ∅ ∧ (∀ r ↦ M ∈ R • M ≠ ∅)
 1688: 	      ∧ no I/O ∧ no warnings
 1689: 
 1690: =head2 generate
 1691: 
 1692: 	Args ≙ [ content : Str ∪ {⊥}; makefile : Str; existing : Str; with_develop : 𝔹 ]
 1693: 
 1694: 	generate : Args × Env ⇸ Str
 1695: 
 1696: 	pre   (a.content ≠ ⊥ ∨ string(a.makefile) ∈ dom E.fs ∧ regular(a.makefile) ∧ readable(a.makefile))
 1697: 	      ∧ (a.with_develop ⇒ cfg(E) ∉ dom E.fs ∨ ¬ regular(cfg(E)) ∨ yaml_ok(cfg(E)))
 1698: 
 1699: 	generate(a, E) ==
 1700: 	  let content == if a.content ≠ ⊥ then a.content else decode_utf8_or_raw(E.fs(a.makefile))
 1701: 	      deps    == parse_prereqs(content)
 1702: 	      kept    == { r ↦ { m ↦ ⟨ if v ∈ Requirement then v else 0, ⊥ ⟩ }
 1703: 	                   | (r m v) ∈ develop_entries(a.existing) \ comments, m ∈ ModName }
 1704: 	      dev     == deps ⊕ₗ {develop ↦ kept}
 1705: 	      listed  == ⋃ { dom(dev(develop)(r)) | r ∈ Rel }
 1706: 	      tools   == if E.home = ⊥ ∨ E.home = "" ∨ ¬ regular(cfg(E)) then DEFAULT_DEVELOP
 1707: 	                 else valid_entries(yaml(cfg(E)).develop)
 1708: 	      final   == if a.with_develop
 1709: 	                 then dev ⊕ₗ {develop ↦ {requires ↦ { m ↦ ⟨v, ⊥⟩ | (m ↦ v) ∈ tools, m ∉ listed }}}
 1710: 	                 else dev
 1711: 	  in  emit(final, min_perl(content))
 1712: 
 1713: 	post  result ∈ Str
 1714: 	      ∧ prefix(result, HEADER ⁀ "\n") ∧ last(result) = '\n' ∧ ¬ suffix(result, "\n\n")
 1715: 	      ∧ E′ = E                           -- nothing is written
 1716: 	      ∧ $@′ = $@ ∧ $!′ = $! ∧ $_′ = $_
 1717: 	      -- every value from a file or the environment in a message is
 1718: 	      -- printable(v): control and bidi characters as \x{..}
 1719: 
 1720: 	-- Failure cases (the function dies):
 1721: 	a.content = ⊥ ∧ (¬ regular(a.makefile) ∨ ¬ readable(a.makefile))  ⇒  croak("Cannot read '" ⁀ a.makefile ⁀ "'")
 1722: 	a.with_develop ∧ regular(cfg(E)) ∧ ¬ yaml_ok(cfg(E))  ⇒  croak("Failed to parse " ⁀ cfg(E) ⁀ ": " ⁀ err)
 1723: 	a.with_develop ∧ stat(cfg(E)) fails with errno ∉ {ENOENT, ENOTDIR}  ⇒  croak("Failed to parse " ⁀ cfg(E) ⁀ ": " ⁀ errno)
 1724: 
 1725: =head1 STATE DIAGRAM
 1726: 
 1727: The module keeps no state between calls: every call starts at START and
 1728: ends at RETURN or at an error.  The diagram shows the states that one
 1729: call to C<generate()> passes through.  C<parse_prereqs()> is the single
 1730: step PARSE.
 1731: 
 1732: 	+-------+
 1733: 	| START |  generate(%args) is called
 1734: 	+-------+
 1735: 	    |
 1736: 	    | makefile is a readable regular file?
 1737: 	    |---- no ------------------------------------> [DIE] croak "Cannot read '...'"
 1738: 	    | yes
 1739: 	    v
 1740: 	+------------+  read as UTF-8
 1741: 	| READ_UTF8  |---- decode error --> +-----------+  carp "invalid UTF-8"
 1742: 	+------------+                      | READ_RAW  |  (read the raw bytes)
 1743: 	    |     \                         +-----------+
 1744: 	    |      \                             |---- raw read fails --> [DIE] error passed on
 1745: 	    |       \---- other I/O error --------------------------> [DIE] error passed on
 1746: 	    | ok                                 |
 1747: 	    v                                    |
 1748: 	+------------+ <-------------------------+
 1749: 	|   PARSE    |  parse_prereqs(content); find MIN_PERL_VERSION
 1750: 	+------------+  (pure: no I/O, no warnings)
 1751: 	    |
 1752: 	    | existing has an on 'develop' section?
 1753: 	    |---- no ----------------------------+
 1754: 	    | yes                                |
 1755: 	    v                                    |
 1756: 	+------------+  copy entries; drop       |
 1757: 	|   MERGE    |  bad names; carp and      |
 1758: 	+------------+  drop bad versions        |
 1759: 	    |                                    |
 1760: 	    +<-----------------------------------+
 1761: 	    |
 1762: 	    | with_develop true?
 1763: 	    |---- no ----------------------------------------------+
 1764: 	    | yes                                                  |
 1765: 	    v                                                      |
 1766: 	+------------+  no home dir, or config path missing        |
 1767: 	| CONFIG     |  or not a regular file -------> DEFAULTS    |
 1768: 	+------------+                                   |         |
 1769: 	    | config is a regular file                   |         |
 1770: 	    |---- stat/read/YAML error --> [DIE] croak "Failed to parse ..."
 1771: 	    v                                            |         |
 1772: 	+------------+  no develop: key --> carp --> DEFAULTS      |
 1773: 	| VALIDATE   |  bad name    --> carp, skip entry           |
 1774: 	+------------+  bad version --> carp, version 0            |
 1775: 	    |                                            |         |
 1776: 	    v                                            v         |
 1777: 	+------------+ <---------------------------------+         |
 1778: 	|   INJECT   |  add tools not already in develop           |
 1779: 	+------------+                                             |
 1780: 	    |                                                      |
 1781: 	    v                                                      |
 1782: 	+------------+ <-------------------------------------------+
 1783: 	|    EMIT    |  format the text (sorted, fixed order)
 1784: 	+------------+
 1785: 	    |
 1786: 	    v
 1787: 	+--------+
 1788: 	| RETURN |  the cpanfile text; no file written;
 1789: 	+--------+  caller's $@, $! and $_ unchanged
 1790: 
 1791: With the C<content> argument, START goes straight to PARSE: nothing is
 1792: read, so neither C<Cannot read> nor the READ states can occur.
 1793: 
 1794: The command-line tool wraps this machine:
 1795: 
 1796: 	+-----------+  conflicting --with-develop/--no-develop --> [EXIT 255]
 1797: 	| OPTIONS   |  --help --> print usage --> [EXIT 0]
 1798: 	+-----------+
 1799: 	    |
 1800: 	    v
 1801: 	+-----------+  cpanfile is a symlink, or exists but is not a
 1802: 	| GUARD     |  regular file --> [DIE] "Refusing to use 'cpanfile': ..."
 1803: 	+-----------+  (nothing is read or written)
 1804: 	    |
 1805: 	    v
 1806: 	+-----------+  read existing cpanfile (if any) and, with read_makefile(),
 1807: 	| READ      |  Makefile.PL - once; READ_UTF8/READ_RAW/DIE as above
 1808: 	+-----------+
 1809: 	    |
 1810: 	    v
 1811: 	generate(content => ...) from PARSE to RETURN, as above
 1812: 	    |
 1813: 	    v
 1814: 	+-----------+  --check: parse the same text; missing modules --> warn,
 1815: 	| CHECK     |  exit status will be 1 (the output below still happens)
 1816: 	+-----------+
 1817: 	    |---- --diff    --> print a diff, write nothing --> [EXIT 0 or 1]
 1818: 	    |---- --dry-run --> print the text, write nothing --> [EXIT 0 or 1]
 1819: 	    v
 1820: 	+-----------+  GUARD again, then write a temporary file and rename it
 1821: 	| WRITE     |  over cpanfile; any failure --> [DIE], old cpanfile kept,
 1822: 	+-----------+  no temporary file left
 1823: 	    |
 1824: 	    v
 1825: 	[EXIT 0 or 1]  "cpanfile written successfully."
 1826: 
 1827: =head1 LICENSE AND COPYRIGHT
 1828: 
 1829: Copyright 2025-2026 Nigel Horne.
 1830: 
 1831: Usage is subject to the GPL2 licence terms.
 1832: If you use it,
 1833: please let me know.
 1834: 
 1835: =cut
 1836: