PPR-0.001010/000755 000765 000024 00000000000 14700726025 012773 5ustar00damianstaff000000 000000 PPR-0.001010/demo/000755 000765 000024 00000000000 14700726025 013717 5ustar00damianstaff000000 000000 PPR-0.001010/bin/000755 000765 000024 00000000000 14700726025 013543 5ustar00damianstaff000000 000000 PPR-0.001010/Changes000644 000765 000024 00000023005 14700726016 014266 0ustar00damianstaff000000 000000 Revision history for PPR 0.000001 Wed May 27 15:12:24 2015 * Initial release. 0.000003 Tue Jun 20 06:05:22 2017 * No changes logged 0.000005 Tue Jun 20 19:27:37 2017 * Added missing PPR::X module (Thanks MST) 0.000006 Thu Jun 22 21:04:14 2017 * Fixed documentation bug with slurp (pre-)example. (Thanks, Randal!) * Optimized matching of builtins slightly * Added $PPR::ERROR variable to assist error reporting on failure to match (Many thanks, MST!) 0.000007 Fri Jun 23 06:45:49 2017 * Improved $PPR::ERROR API by adding origin location and diagnostics 0.000008 Sun Jun 25 15:24:13 2017 * Unknotted POD nits. * Small optimizations to keyword and identifier recognition. * Fixed handling of multiline quotelikes that span heredoc contents. (Thanks Lukas) * SIGNIFICANT CHANGE: The $PPR::GRAMMAR variable now has to be interpolated at the start of any regex using it. * Fixed handling of layered heredocs (at the cost of having to install $PPR::GRAMMAR at the start of each grammar). (Thanks Lukas) * Fixed diamond operator parsing. (Thanks Lukas) 0.000009 Thu Jun 29 08:17:24 2017 * SIGNIFICANT REVERSION: The $PPR::GRAMMAR variable no longer has to be interpolated at the start of any regex using it. Indeed, that placement is not recommended due to its effects on the numbering of positional captures within the main regex. * Fixed test files to allow testing under 5.10+, rather than 5.14+ 0.000010 Fri Jul 14 07:36:47 2017 * Added yada-yada (...) statement (Thanks, MST!) 0.000011 Fri Aug 11 17:52:14 2017 * Further optimized parsing of heredocs * Eliminated even more repetition backtracking (bringing the grammar ever closer to DFA-osity) * Micro-optimization: Reordered PerlOWS and PerlNWS components to reflect that \n whitespace is more common that # comments or __END__ blocks * Made formats and heredocs play nice together by adding a potential heredoc skip at the end of the first line of a format. (Sincere thanks to Merijn) * Made interpolating quotelikes work (more) correctly. 0.000012 Mon Aug 21 20:40:08 2017 * Handled /.../n flag (thanks, David) * Handled leading BOM correctly (thanks, David) * Handled ${!}-style punctuation variables (thanks, David) * "fline" is not a word (thanks, Hugo ;-) * Added (?&PerlEndOfLine) (Thanks, Yves) * Handled s/.../.../e behaviour better. Still not perfect, but perfection may not be possible using regexes. (Thanks, Aaron!) * Neutralized bizarre undefined warnings under earlier Perl versions. 0.000013 Mon Aug 21 20:54:42 2017 * Removed spurious Regexp::Debugger dependency (Thanks Slaven!) 0.000014 Thu Sep 28 21:43:51 2017 * Added BAIL_OUTs to test suite to accelerate and clarify testing under Perl 5.20 * Added missing optional whitespace to DESTROY and AUTOLOAD declarations (thanks, Hauke D) 0.000015 Wed Dec 6 08:18:09 2017 * Fixed disapproval.t test (Thanks, Martin!) * Fixed handling of ->$*, ->@*, and ->%* (Thanks, Curtis!) 0.000016 Mon Jun 4 13:58:06 2018 * Uninlined optimizations in PPR::X to make redeclaration of subrules easier and more reliable. (Thanks, Matt!) * Added (?&PerlReturnExpression) to distinguish in-term usages from statement-level usages requiring (?&PerlReturnStatement) 0.000017 Tue Jun 19 07:57:57 2018 * Added PPR::decomment() (mostly as an example of technique) * Updated for loop parsing to support explicitly aliased iterator variables (including arrays and hashes) * Added (?&PerlTermPostfixDereference) to simplify PPR::X overloading of terms * Added Perl 5.28 ":attributes(before) ($ignature)" syntax for subroutines (thanks, Matt) 0.000018 Mon Jun 25 09:59:36 2018 * Fixed _uniq() (thanks Adriano!) 0.000019 Tue Jun 26 19:33:17 2018 * Fixed parsing of multiple POD sections (thanks Adriano!) 0.000020 Tue Jun 26 19:54:42 2018 * Oops, fixed decomment() too. * Updates PPR::X appropriately as well. 0.000021 Wed Jun 27 06:33:51 2018 * Removed spurious Regexp::Debugger dependency (thanks, Adriano) * Fixed edge case on POD/whitespace parsing (thanks, Adriano) 0.000022 Fri Oct 5 07:10:33 2018 * Optimized calls to (?&PerlStatementSequence) and (?&PerlPodSequence) (thanks, Adriano) * Optimized several tests to remove unnecessary (?&PerlOWS) calls (thanks, Adriano) 0.000023 Fri Feb 15 09:20:25 2019 * Fixed (?&PerlScalarExpression) 0.000024 Tue Dec 10 05:20:23 2019 * Relaxed parsing of __DATA__ and __END__ in line with actual Perl parser * Numerous doc bugs fixed (thanks F.Li!) 0.000025 Wed Apr 22 22:19:14 2020 * Added full code block parsing of (?{...}) and (??{...}) within regexes * Fixed an obscure problem when heredocs are greater than 32766 characters (thanks Albert!) 0.000026 Fri Apr 24 04:39:59 2020 * Improved detection of trailing unbalanced curlies in decomment() (thanks Albert) * Added (?&PerlEntireDocument) rule * BACKWARDS INCOMPATIBLE CHANGE: PPR::decomment() now retains all newlines from any comments, POD, etc. that it removes. This does not change the meaning or behaviour of the decommented source code in any way, but ensures that consistent line numbers are preserved through the operation. (thanks Albert) 0.000027 Thu Jun 25 07:12:58 2020 * Tweaked handling of unary prefix operators to correctly identify '++' and '--' as atomic lexemes * Added correct parsing of lexical subroutines 0.000028 Sun Jun 28 02:58:01 2020 * Corrected edge-case behaviour in parsing __END__ and __DATA__ by adding the (?&PerlOWSOrEND) rule (many thanks, Branislav!) * Corrected edge-case behaviour in parsing of s/.../.../e constructs 0.001000 Wed Aug 3 00:33:24 2022 * Improved parsing of modern subroutine signatures (Thanks, Juerd!) * Now supports all the new syntactic features added in Perls v5.28 to v5.36 including: - try/catch/finally - the isa operator - named regex assertions - missing lower bounds on regex counted repetitions - "spacey" curlies in regexes - 0o7777 octal constants - Unicode paired delimiters on quotelikes * Improved parsing of s/.../{...}e code blocks (Thanks, Zaki!) * Fixed several edge cases of postfix dereferencing (Thanks, Zaki!) * The perlop manpage states: "Interpolation in patterns has several quirks: $|, $(, and $) are not interpolated..." PPR now enforces that. (Thanks, Zaki!) * Also fixed NON-interpolation of variables inside qq'...', qr'...', etc. (Thanks, Zaki!) * NOTE: BACKWARDS INCOMPATIBLE CHANGE... Solving some of the above issues required deep changes to the mechanism of term-matching within the regex...to better reflect actual term precedence within Perl. This means that the subrules (?&PerlTerm), (?&PerlScalarAccess) and (?&PerlArrayAccess) now match differently. Specifically, (?&PerlTerm) now matches chains of trailing -> dereferences and/or -> sub/method calls, while (?&PerlScalarAccess) and (?&PerlArrayAccess) no longer do so. If you were previously using these last two subrules for stand-along matching you will need to be more specific: # Old behaviour of... # Now requires... / (?&PerlScalarAccess) /x / (?&PerlScalarAccess) (?&PerlTermPostfixDerefence) /x / (?&PerlArrayAccess) /x / (?&PerlArrayAccess) (?&PerlTermPostfixDerefence) /x 0.001001 Wed Aug 3 01:52:51 2022 * Added try/catch/finally/defer to the list of keywords that are never treated as barewords * Corrected parsing of try/catch syntax (the catch block is not optional!) * Updated workarounds for parsing code that uses Try::Tiny and TryCatch in line with the above changes 0.001002 Wed Aug 3 02:04:01 2022 * Rereleasing with ::X and ::Debug variations properly updated 0.001003 Mon Aug 8 04:27:57 2022 * Improved accuracy of variable-post-dereference detection specifically: (?&PerlScalarAccessNoSpace) and (?&PerlArrayAccessNoSpace) within interpolating quotelikes (Thanks, Zaki!) 0.001004 Mon Aug 8 23:24:09 2022 * Fixed edge case of 'state' variable declarations (Thanks, Zaki!) 0.001005 Tue Sep 6 22:54:34 2022 * Fixed erroneous non-interpolation of q'...' (Thanks, Zaki!) 0.001006 Thu Sep 8 03:50:55 2022 * Worked around bugs in regex engine that made it impossible to interpolate PPR grammars into other regexes in some cases. Note that such interpolations still don't work under Perl 5.18 to 5.28, as the bug was only fixed in 5.30. (Thanks, Zaki!) 0.001007 Fri Mar 3 09:44:34 2023 * Improved error handling via PPR::ERROR mechanism (Thanks, Yves!) 0.001008 Tue Apr 11 15:49:58 2023 * Added support for Perl 5.38 features: classes, methods, fields, optimistic regex evals, //= and ||= in signatures 0.001009 Wed Jun 26 14:33:28 2024 * Added explicit -- and extensible -- rule for (?&PerlComment) * Some minor doc fixes 0.001010 Mon Oct 7 20:38:22 2024 * Clarified licensing of the module: "same terms as Perl itself". (Thanks Gregor) PPR-0.001010/MANIFEST000644 000765 000024 00000003442 14700726025 014127 0ustar00damianstaff000000 000000 Changes lib/PPR.pm lib/PPR/X.pm Makefile.PL MANIFEST README t/00.load.t t/blocks.t t/control.t t/document_self.t t/format.t t/heredoc.t t/misc.t t/pod.t t/quotelike_misc.t t/regex_self.t t/selfgol.t t/statement_include.t t/statement_variable.t t/token_quote.t t/token_quote_double.t t/token_quote_single.t t/token_quotelike_words.t t/token_word.t t/vars.t bin/gen_blocks.pl bin/gen_builtin_expr.pl bin/gen_nullary_builtin_expr.pl bin/gen_statements.pl t/disapproval.t t/erudil.t t/eyedrops.t t/unpunctuated.t t/PPR_X.t t/for_ref_iterator.t t/keywords.t t/ppi_lexer.t t/ppi_node.t t/ppi_statement.t t/ppi_statement_compound.t t/ppi_statement_include.t t/ppi_statement_package.t t/ppi_statement_sub.t t/ppi_statement_variable.t t/ppi_token_dashedword.t t/ppi_token_magic.t t/ppi_token_operator.t t/ppi_token_prototype.t t/ppi_token_quote_double.t t/ppi_token_quote_interpolate.t t/ppi_token_quote_single.t t/ppi_token_word.t demo/count_statements.pl demo/strip_code.pl demo/strip_comments.pl demo/strip_comments_v5.14.pl demo/validator.pl t/PPR_ERROR.t t/heredoc_and_quotelike.t t/heredoc_null_then_shift.t t/heredoc_same_terminator.t t/PPR_GRAMMAR_placement.t t/yadayadayada.t t/heredoc_and_format.t t/merijn_is_evil.t t/quotelike_s_e.t t/subdecl.t t/postfix_deref.t t/decomment.t t/misc_docs.t t/perl_pod.t t/decomment_heredoc_large.t t/heredoc_large.t t/PPR_ERROR_trailing.t t/sub_END.t t/perl_v5.28.t t/perl_v5.30.t t/perl_v5.32.t t/perl_v5.34.t t/perl_v5.36.t t/quotelike_noninerpolating.t t/regex_interpolation.t t/substitution_ge.t t/trycatch.t t/trytiny.t t/postfix_deref_qq.t t/scalar_attributes.t t/qr_combine.t t/PPR_ERROR_multiple.t t/perl_v5.38.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) PPR-0.001010/t/000755 000765 000024 00000000000 14700726025 013236 5ustar00damianstaff000000 000000 PPR-0.001010/README000644 000765 000024 00000000757 14700726016 013664 0ustar00damianstaff000000 000000 PPR version 0.001010 This module defines a single regex that will match syntactically valid Perl documents, or valid components (such as statements, expressions, blocks, strings, etc.) INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install DEPENDENCIES None. COPYRIGHT AND LICENCE Copyright (C) 2015, Damian Conway This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. PPR-0.001010/META.yml000644 000765 000024 00000001070 14700726025 014242 0ustar00damianstaff000000 000000 --- abstract: 'Pattern-based Perl Recognizer' author: - 'Damian Conway ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PPR no_index: directory: - t - inc requires: Test::More: '0' perl: '5.010' version: '0.001010' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PPR-0.001010/lib/000755 000765 000024 00000000000 14700726025 013541 5ustar00damianstaff000000 000000 PPR-0.001010/Makefile.PL000644 000765 000024 00000001013 14700725162 014741 0ustar00damianstaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'PPR', AUTHOR => 'Damian Conway ', VERSION_FROM => 'lib/PPR.pm', ABSTRACT_FROM => 'lib/PPR.pm', PL_FILES => {}, LICENSE => 'perl', MIN_PERL_VERSION => 5.010, PREREQ_PM => { 'Test::More' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'PPR-*' }, ); PPR-0.001010/META.json000644 000765 000024 00000001674 14700726025 014424 0ustar00damianstaff000000 000000 { "abstract" : "Pattern-based Perl Recognizer", "author" : [ "Damian Conway " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PPR", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Test::More" : "0", "perl" : "5.010" } } }, "release_status" : "stable", "version" : "0.001010", "x_serialization_backend" : "JSON::PP version 4.16" } PPR-0.001010/lib/PPR/000755 000765 000024 00000000000 14700726025 014202 5ustar00damianstaff000000 000000 PPR-0.001010/lib/PPR.pm000644 000765 000024 00000514434 14700726016 014553 0ustar00damianstaff000000 000000 package PPR; use 5.010; use if $] < 5.018004, re => 'eval'; BEGIN { if ($] >= 5.020 && $] <= 5.021) { say {STDERR} <<" END_WARNING" Warning: This program is running under Perl $^V and uses the PPR module. Due to an unresolved issue with compilation of large regexes in this version of Perl, your code is likely to compile extremely slowly (i.e. it may take more than a minute). PPR is being loaded at ${\join ' line ', (caller(2))[1,2]}. END_WARNING } } use warnings; our $VERSION = '0.001010'; use utf8; use List::Util qw; # Class for $PPR::ERROR objects... { package PPR::ERROR; use overload q{""} => 'source', q{0+} => 'line', fallback => 1; sub new { my ($class, %obj) = @_; return bless \%obj, $class; } sub prefix { return shift->{prefix} } sub source { return shift->{source} } sub line { my $self = shift; my $offset = $self->{line} // shift // 1; return $offset + $self->{prefix} =~ tr/\n//; } sub origin { my $self = shift; my $line = shift // 0; my $file = shift // ""; return bless { %{$self}, line => $line, file => $file }, ref($self); } sub diagnostic { my $self = shift; my $line = defined $self->{line} ? $self->{line} + $self->{prefix} =~ tr/\n// : 0; my $file = $self->{file} // q{}; return q{} if eval "no strict;\n" . "#line $line $file\n" . "sub{ $self->{source} }"; my $diagnostic = $@; $diagnostic =~ s{ \s*+ \bat \s++ \( eval \s++ \d++ \) \s++ line \s++ 0, | \s*+ \( eval \s++ \d++ \) | \s++ \Z | \s++ \bExecution \s++ of \s++ .*? \s++ aborted \s++ due \s++ to \s++ compilation \s++ errors\. }{}gx; return $diagnostic; } } # Define the grammar... our $GRAMMAR = qr{ (?(DEFINE) (? \A (?&PerlDocument) (?: \Z | (?(?{ !defined $PPR::ERROR }) (?>(?&PerlOWSOrEND)) (?{pos()}) ([^\n]++) (?{ $PPR::ERROR = PPR::ERROR->new(source => "$^N", prefix => substr($_, 0, $^R) ) }) (?!) ) ) ) # End of rule (?) (? \x{FEFF}?+ # Optional BOM marker (?&PerlStatementSequence) (?&PerlOWSOrEND) ) # End of rule (?) (? (?>(?&PerlPodSequence)) (?: (?&PerlStatement) (?&PerlPodSequence) )*+ ) # End of rule (?) (? (?> (?>(?&PerlPodSequence)) (?: (?>(?&PerlLabel)) (?&PerlOWSOrEND) )?+ (?>(?&PerlPodSequence)) (?> (?&PerlKeyword) | # Inlined (?&PerlSubroutineDeclaration) (?> (?: (?> my | our | state ) \b (?>(?&PerlOWS)) )?+ sub \b (?>(?&PerlOWS)) (?>(?&PerlOldQualifiedIdentifier)) (?&PerlOWS) | AUTOLOAD (?&PerlOWS) | DESTROY (?&PerlOWS) ) (?: # Perl pre 5.028 (?: (?> (?&PerlSignature) # Parameter list | \( [^)]*+ \) # Prototype ( ) (?&PerlOWS) )?+ (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ | # Perl post 5.028 (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list ) (?> ; | (?&PerlBlock) ) # End of inlining | # Inlined (?&PerlMethodDeclaration) method \b (?>(?&PerlOWS)) (?>(?&PerlQualifiedIdentifier)) (?&PerlOWS) (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list (?> ; | (?&PerlBlock) ) # End of inlining | # Inlined (?&PerlUseStatement) (?: use | no ) (?>(?&PerlNWS)) (?> (?&PerlVersionNumber) | (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) (?! (?>(?&PerlOWS)) (?> (?&PerlInfixBinaryOperator) | (?&PerlComma) | \? ) ) )?+ (?: (?>(?&PerlNWS)) (?&PerlPodSequence) )?+ (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ ) (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) # End of inlining | # Inlined (?&PerlPackageDeclaration) package (?>(?&PerlNWS)) (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?&PerlBlock) | (?= \} | \z )) # End of inlining | # Inlined (?&PerlClassDeclaration) class (?>(?&PerlNWS)) (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) | (?>(?&PerlOWS)) : (?>(?&PerlOWS)) isa (?= \( ) (?&PPR_quotelike_body) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?&PerlBlock) | (?= \} | \z )) # End of inlining | # Inlined (?&PerlFieldDeclaration) field \b (?: (?>(?&PerlOWS)) \$ (?>(?&PerlOWS)) (?&PerlIdentifier) (?: (?>(?&PerlOWS)) : (?>(?&PerlOWS)) param (?: (?= \( ) (?&PPR_quotelike_body) # ) )?+ )?+ | (?>(?&PerlOWS)) [\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) ) (?: (?>(?&PerlOWS)) (?: //= | \|\|= | = ) (?>(?&PerlOWS)) (?&PerlConditionalExpression) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) # End of inlining | (?&PerlControlBlock) | (?&PerlFormat) | (?>(?&PerlExpression)) (?>(?&PerlOWS)) (?&PerlStatementModifier)?+ (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) | (?&PerlBlock) | ; ) | # A yada-yada... \.\.\. (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) | # Just a label... (?>(?&PerlLabel)) (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) | # Just an empty statement... (?>(?&PerlOWS)) ; | # An error (report it, if it's the first)... (?(?{ !defined $PPR::ERROR }) (?> (?&PerlOWS) ) (?! (?: \} | \z ) ) (?{ pos() }) ( (?&PerlExpression) (?&PerlOWS) [^\n]++ | [^;\}]++ ) (?{ $PPR::ERROR //= PPR::ERROR->new(source => $^N, prefix => substr($_, 0, $^R) ) }) (?!) ) ) ) # End of rule (?) (? (?> (?: (?> my | our | state ) \b (?>(?&PerlOWS)) )?+ sub \b (?>(?&PerlOWS)) (?>(?&PerlOldQualifiedIdentifier)) (?&PerlOWS) | AUTOLOAD (?&PerlOWS) | DESTROY (?&PerlOWS) ) (?: # Perl pre 5.028 (?: (?> (?&PerlSignature) # Parameter list | \( [^)]*+ \) # Prototype ( ) (?&PerlOWS) )?+ (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ | # Perl post 5.028 (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list ) (?> ; | (?&PerlBlock) ) ) # End of rule (?) (? method \b (?>(?&PerlOWS)) (?>(?&PerlQualifiedIdentifier)) (?&PerlOWS) (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list (?> ; | (?&PerlBlock) ) ) # End of rule (?) (? \( (?>(?&PerlOWS)) (?&PerlParameterDeclaration)*+ \) ) # End of rule (?) (? (?: \$ (?>(?&PerlOWS)) (?: (?: = | //= | \|\|= ) (?>(?&PerlOWS)) (?&PerlConditionalExpression)?+ (?>(?&PerlOWS)) )?+ | (?&PerlVariableScalar) (?>(?&PerlOWS)) (?: (?: = | //= | \|\|= ) (?>(?&PerlOWS)) (?&PerlConditionalExpression) (?>(?&PerlOWS)) )?+ | (?&PerlVariableArray) (?>(?&PerlOWS)) | (?&PerlVariableHash) (?>(?&PerlOWS)) ) (?: , (?>(?&PerlOWS)) | (?= \) ) ) # ( ) # End of rule (?) (? (?: use | no ) (?>(?&PerlNWS)) (?> (?&PerlVersionNumber) | (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) (?! (?>(?&PerlOWS)) (?> (?&PerlInfixBinaryOperator) | (?&PerlComma) | \? ) ) )?+ (?: (?>(?&PerlNWS)) (?&PerlPodSequence) )?+ (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ ) (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) ) # End of rule (?) (? return \b (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ ) # End of rule (?) (? return \b (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) ) # End of rule (?) (? package (?>(?&PerlNWS)) (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?&PerlBlock) | (?= \} | \z )) ) # End of rule (?) (? class (?>(?&PerlNWS)) (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) | (?>(?&PerlOWS)) : (?>(?&PerlOWS)) isa (?= \( ) (?&PPR_quotelike_body) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?&PerlBlock) | (?= \} | \z )) ) # End of rule (?) (? (?>(?&PerlLowPrecedenceNotExpression)) (?: (?>(?&PerlOWS)) (?>(?&PerlLowPrecedenceInfixOperator)) (?>(?&PerlOWS)) (?&PerlLowPrecedenceNotExpression) )*+ ) # End of rule (?) (? (?: not \b (?&PerlOWS) )*+ (?&PerlCommaList) ) # End of rule (?) (? (?>(?&PerlAssignment)) (?>(?&PerlOWS)) (?: (?: (?>(?&PerlComma)) (?&PerlOWS) )++ (?>(?&PerlAssignment)) (?>(?&PerlOWS)) )*+ (?: (?>(?&PerlComma)) (?&PerlOWSOrEND) )*+ ) # End of rule (?) (? (?>(?&PerlConditionalExpression)) (?: (?>(?&PerlOWS)) (?>(?&PerlAssignmentOperator)) (?>(?&PerlOWS)) (?&PerlConditionalExpression) )*+ ) # End of rule (?) (? (? (?>(?&PerlBinaryExpression)) (?: (?>(?&PerlOWS)) \? (?>(?&PerlOWS)) (?>(?&PerlAssignment)) (?>(?&PerlOWS)) : (?>(?&PerlOWS)) (?&PerlConditionalExpression) )?+ ) # End of rule (?) ) # End of rule (?) (? (?>(?&PerlPrefixPostfixTerm)) (?: (?>(?&PerlOWS)) (?>(?&PerlInfixBinaryOperator)) (?>(?&PerlOWS)) (?&PerlPrefixPostfixTerm) )*+ ) # End of rule (?) (? (?: (?>(?&PerlPrefixUnaryOperator)) (?&PerlOWS) )*+ (?>(?&PerlTerm)) (?: (?>(?&PerlOWS)) (?&PerlPostfixUnaryOperator) )?+ ) # End of rule (?) (? (?> \\?+ [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) | \( (?>(?&PerlOWS)) (?> \\?+ [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) | undef ) (?>(?&PerlOWS)) (?: (?>(?&PerlComma)) (?>(?&PerlOWS)) (?> \\?+ [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) | undef ) (?>(?&PerlOWS)) )*+ (?: (?>(?&PerlComma)) (?&PerlOWS) )?+ \) ) ) # End of rule (?) (? (?> # Inlined (?&PerlReturnExpression) return \b (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ # End of inlining # The remaining alternatives can all take postfix dereferencers... | (?: (?= \$ ) (?&PerlScalarAccess) | (?= \@ ) (?&PerlArrayAccess) | (?= % ) (?&PerlHashAccess) | (?&PerlAnonymousSubroutine) | (?&PerlAnonymousMethod) | (?>(?&PerlNullaryBuiltinFunction)) (?! (?>(?&PerlOWS)) \( ) | # Inlined (?&PerlDoBlock) | (?&PerlEvalBlock) (?> do | eval ) (?>(?&PerlOWS)) (?&PerlBlock) # End of inlining | (?&PerlCall) | # Inlined (?&PerlVariableDeclaration) (?> my | our | state ) \b (?>(?&PerlOWS)) (?: (?&PerlQualifiedIdentifier) (?&PerlOWS) )?+ (?>(?&PerlLvalue)) (?>(?&PerlOWSOrEND)) (?&PerlAttributes)?+ # End of inlining | (?&PerlTypeglob) | (?>(?&PerlParenthesesList)) # Can optionally do a [...] lookup straight after the parens, # followed by any number of other look-ups (?: (?>(?&PerlOWS)) (?&PerlArrayIndexer) (?: (?>(?&PerlOWS)) (?> (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )*+ )?+ | (?&PerlAnonymousArray) | (?&PerlAnonymousHash) | (?&PerlDiamondOperator) | (?&PerlContextualMatch) | (?&PerlQuotelikeS) | (?&PerlQuotelikeTR) | (?&PerlQuotelikeQX) | (?&PerlLiteral) ) (?: (?&PerlTermPostfixDereference) )?+ ) ) # End of rule (?) (? # Must have at least one arrowed dereference... (?: (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) (?> # A series of simple brackets can omit interstitial arrows... (?> (?&PerlParenthesesList) | (?&PerlArrayIndexer) | (?&PerlHashIndexer) ) (?: (?>(?&PerlOWS)) (?> (?&PerlParenthesesList) | (?&PerlArrayIndexer) | (?&PerlHashIndexer) ) )*+ | # A method call... (?> (?&PerlQualifiedIdentifier) | (?! \$\#\* ) (?&PerlVariableScalar) ) (?: (?>(?&PerlOWS)) (?&PerlParenthesesList) )?+ | # An array or hash slice or k/v slice # (provided it's not subsequently dereferenced) [\@%] (?> (?>(?&PerlArrayIndexer)) | (?>(?&PerlHashIndexer)) ) (?! (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) [\@%]?+ [\[\{] ) | # An array max-index lookup... \$\#\* | # A scalar-, glob-, or subroutine dereference... [\$*&] \* | # An array dereference (provided it's not subsequently dereferenced)... \@\* (?! (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) [\[\@] ) | # A hash dereference (provided it's not subsequently dereferenced)... \%\* (?! (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) [\{%] ) | # A glob lookup... \* (?&PerlHashIndexer) ) )++ ) # End of rule (?) (? (?> # Conditionals... (?> if | unless ) \b (?>(?&PerlOWS)) (?>(?&PerlParenthesesList)) (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) (?>(?&PerlPodSequence)) elsif \b (?>(?&PerlOWS)) (?>(?&PerlParenthesesList)) (?>(?&PerlOWS)) (?&PerlBlock) )*+ (?: (?>(?&PerlOWS)) (?>(?&PerlPodSequence)) else \b (?>(?&PerlOWS)) (?&PerlBlock) )?+ | # Loops... (?> for(?:each)?+ \b (?>(?&PerlOWS)) (?: (?> # Explicitly aliased iterator variable... (?> \\ (?>(?&PerlOWS)) (?> my | our | state ) | (?> my | our | state ) (?>(?&PerlOWS)) \\ ) (?>(?&PerlOWS)) (?> (?&PerlVariableScalar) | (?&PerlVariableArray) | (?&PerlVariableHash) ) | # List of scalar iterator variables... my (?>(?&PerlOWS)) \( (?>(?&PerlOWS)) (?>(?&PerlVariableScalar)) (?>(?&PerlOWS)) (?: , (?>(?&PerlOWS)) (?>(?&PerlVariableScalar)) (?>(?&PerlOWS)) )*+ (?: , (?>(?&PerlOWS)) )?+ \) | # Implicitly aliased iterator variable... (?> (?: my | our | state ) (?>(?&PerlOWS)) )?+ (?&PerlVariableScalar) )?+ (?>(?&PerlOWS)) (?> (?&PerlParenthesesList) | (?&PerlQuotelikeQW) ) | (?&PPR_three_part_list) ) | (?> while | until) \b (?>(?&PerlOWS)) (?&PerlParenthesesList) ) (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) continue (?>(?&PerlOWS)) (?&PerlBlock) )?+ | # Phasers... (?> BEGIN | END | CHECK | INIT | UNITCHECK | ADJUST ) \b (?>(?&PerlOWS)) (?&PerlBlock) | # Try/catch/finallys... (?>(?&PerlTryCatchFinallyBlock)) | # Defers... defer (?>(?&PerlOWS)) (?&PerlBlock) | # Switches... (?> given | when ) \b (?>(?&PerlOWS)) (?>(?&PerlParenthesesList)) (?>(?&PerlOWS)) (?&PerlBlock) | default (?>(?&PerlOWS)) (?&PerlBlock) ) ) # End of rule (?) (? format (?: (?>(?&PerlNWS)) (?&PerlQualifiedIdentifier) )?+ (?>(?&PerlOWS)) = [^\n]*+ (?&PPR_newline_and_heredoc) (?: (?! \. \n ) [^\n\$\@]*+ (?: (?> (?= \$ (?! \s ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \s ) ) (?&PerlArrayAccessNoSpace) ) [^\n\$\@]*+ )*+ (?&PPR_newline_and_heredoc) )*+ \. (?&PerlEndOfLine) ) # End of rule (?) (? (?> if | for(?:each)?+ | while | unless | until | when ) \b (?>(?&PerlOWS)) (?&PerlExpression) ) # End of rule (?) (? \{ (?>(?&PerlStatementSequence)) \} ) # End of rule (?) (? (?> [&] (?>(?&PerlOWS)) (?> (?&PerlBlock) | (?&PerlVariableScalar) | (?&PerlQualifiedIdentifier) ) (?>(?&PerlOWS)) (?: \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \) )?+ | - (?>(?&PPR_filetest_name)) (?>(?&PerlOWS)) (?&PerlPrefixPostfixTerm)?+ | (?>(?&PerlBuiltinFunction)) (?>(?&PerlOWS)) (?> \( (?>(?&PerlOWS)) (?> (?= (?>(?&PPR_non_reserved_identifier)) (?>(?&PerlOWS)) (?! \( | (?&PerlComma) ) ) (?&PerlCall) | (?>(?&PerlBlock)) (?>(?&PerlOWS)) (?&PerlExpression)?+ | (?>(?&PPR_indirect_obj)) (?>(?&PerlNWS)) (?&PerlExpression) | (?&PerlExpression)?+ ) (?>(?&PerlOWS)) \) | (?> (?= (?>(?&PPR_non_reserved_identifier)) (?>(?&PerlOWS)) (?! \( | (?&PerlComma) ) ) (?&PerlCall) | (?>(?&PerlBlock)) (?>(?&PerlOWS)) (?&PerlCommaList)?+ | (?>(?&PPR_indirect_obj)) (?>(?&PerlNWS)) (?&PerlCommaList) | (?&PerlCommaList)?+ ) ) | (?>(?&PPR_non_reserved_identifier)) (?>(?&PerlOWS)) (?> \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \) | (?> (?= (?>(?&PPR_non_reserved_identifier)) (?>(?&PerlOWS)) (?! \( | (?&PerlComma) ) ) (?&PerlCall) | (?>(?&PerlBlock)) (?>(?&PerlOWS)) (?&PerlCommaList)?+ | (?>(?&PPR_indirect_obj)) (?&PerlNWS) (?&PerlCommaList) | (?&PerlCommaList)?+ ) ) ) ) # End of rule (?) (? (?> my | our | state ) \b (?>(?&PerlOWS)) (?: (?&PerlQualifiedIdentifier) (?&PerlOWS) )?+ (?>(?&PerlLvalue)) (?>(?&PerlOWS)) (?&PerlAttributes)?+ ) # End of rule (?) (? field \b (?>(?&PerlOWS)) [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) (?: (?>(?&PerlOWS)) : (?>(?&PerlOWS)) param (?: (?= \( ) (?&PPR_quotelike_body) # ) )?+ )?+ (?: (?>(?&PerlOWS)) (?: //= | \|\|= | = ) (?>(?&PerlOWS)) (?&PerlConditionalExpression) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) ) # End of rule (?) (? do (?>(?&PerlOWS)) (?&PerlBlock) ) # End of rule (?) (? eval (?>(?&PerlOWS)) (?&PerlBlock) ) # End of rule (?) (? try \b (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?>(?&PerlOWS)) catch \b (?>(?&PerlOWS)) \( (?>(?&PerlVariableScalar)) \) (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) finally \b (?>(?&PerlOWS)) (?>(?&PerlBlock)) )?+ ) # End of rule (?) (? : (?>(?&PerlOWS)) (?>(?&PerlIdentifier)) (?: (?= \( ) (?&PPR_quotelike_body) )?+ (?: (?> (?>(?&PerlOWS)) : (?&PerlOWS) | (?&PerlNWS) ) (?>(?&PerlIdentifier)) (?: (?= \( ) (?&PPR_quotelike_body) )?+ )*+ ) # End of rule (?) (? (?> (?&PerlParenthesesList) | (?&PerlCommaList) ) ) # End of rule (?) (? \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \) ) # End of rule (?) (? \[ (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \] ) # End of rule (?) (? \{ (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \} ) # End of rule (?) (? \[ (?>(?&PerlOWS)) (?>(?&PerlExpression)) (?>(?&PerlOWS)) \] ) # End of rule (?) (? \{ (?>(?&PerlOWS)) (?: -?+ (?&PerlIdentifier) | (?&PerlExpression) ) # (Note: MUST allow backtracking here) (?>(?&PerlOWS)) \} ) # End of rule (?) (? <<>> # Perl 5.22 "double diamond" | < (?! < ) (?>(?&PPR_balanced_angles)) > (?= (?>(?&PerlOWSOrEND)) (?> \z | [,;\}\])?] | => | : (?! :) # ( | (?&PerlInfixBinaryOperator) | (?&PerlLowPrecedenceInfixOperator) | (?= \w) (?> for(?:each)?+ | while | if | unless | until | when ) ) ) ) # End of rule (?) (? (?> , | => ) ) # End of rule (?) (? (?> \+\+ | -- | [!\\+~] | - (?! (?&PPR_filetest_name) \b ) ) ) # End of rule (?) (? (?> \+\+ | -- ) ) # End of rule (?) (? (?> [=!][~=] | cmp | <= >?+ | >= | [lg][te] | eq | ne | [+] (?! [+=] ) | - (?! [-=] ) | [.]{2,3}+ | [.%x] (?! [=] ) | [&|^][.] (?! [=] ) | [<>*&|/]{1,2}+ (?! [=] ) | \^ (?! [=] ) | ~~ | isa ) ) # End of rule (?) (? (?: [<>*&|/]{2} | [-+.*/%x] | [&|^][.]?+ )?+ = (?! > ) ) # End of rule (?) (? (?> or | and | xor ) ) # End of rule (?) (? sub \b (?>(?&PerlOWS)) (?: # Perl pre 5.028 (?: (?> (?&PerlSignature) # Parameter list | \( [^)]*+ \) # Prototype ( ) (?&PerlOWS) )?+ (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ | # Perl post 5.028 (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list ) (?&PerlBlock) ) # End of rule (?) (? method \b (?>(?&PerlOWS)) (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list (?&PerlBlock) ) # End of rule (?) (? (?= [\$\@%] ) (?> (?&PerlScalarAccess) | (?&PerlHashAccess) | (?&PerlArrayAccess) ) (?> (?&PerlTermPostfixDereference) )?+ ) # End of rule (?) (? \* (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | (?&PerlVariableScalar) | [][!"#\$%&'()*+,./:;<=>?\@\^`|~-] | (?&PerlBlock) ) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ # Note: subsequent arrowed postdereferences that would follow here # are handled at the level ) # End of rule (?) (? (?>(?&PerlVariableArray)) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ # Note: subsequent arrowed postdereferences that would follow here # are handled at the level ) # End of rule (?) (? (?>(?&PerlVariableArrayNoSpace)) # Optional arrowless access(es) to begin (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )*+ # Then any number of optional arrowed accesses # (this is an inlined subset of (?&PerlTermPostfixDereference))... (?: -> (?> # A series of simple brackets can omit interstitial arrows... (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )++ | # An array or hash slice... \@ (?> (?>(?&PerlArrayIndexer)) | (?>(?&PerlHashIndexer)) ) ) )*+ # Followed by at most one of these terminal arrowed dereferences... (?: -> (?> # An array or scalar deref... [\@\$] \* | # An array count deref... \$ \# \* ) )?+ ) # End of rule (?) (? (?>(?&PerlVariableArray)) (?: (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) ) )*+ ) # End of rule (?) (? (?>(?&PerlVariableHash)) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ ) # End of rule (?) (? (?>(?&PerlVariableScalar)) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ # Note: subsequent arrowed postdereferences that would follow here # are handled at the level ) # End of rule (?) (? (?>(?&PerlVariableScalarNoSpace)) # Optional arrowless access(es) to begin... (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )*+ # Then any nuber of arrowed accesses # (this is an inlined subset of (?&PerlTermPostfixDereference))... (?: -> (?> # A series of simple brackets can omit interstitial arrows... (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )++ | # An array or hash slice... \@ (?> (?>(?&PerlArrayIndexer)) | (?>(?&PerlHashIndexer)) ) ) )*+ # Followed by at most one of these terminal arrowed dereferences... (?: -> (?> # An array or scalar deref... [\@\$] \* | # An array count deref... \$ \# \* ) )?+ ) # End of rule (?) (? (?>(?&PerlVariableScalarNoSpace)) # Optional arrowless access(es) (but parens can't be first)... (?: (?! \( ) (?: (?> (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ ) # End of rule (?) (? \$\$ (?! [\$\{\w] ) | (?: \$ (?: [#] (?= (?> [\$^\w\{:+] | - (?! > ) ) ) )?+ (?&PerlOWS) )++ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | \{ [!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] \} | \{ \w++ \} | (?&PerlBlock) ) | \$\# ) # End of rule (?) (? \$\$ (?! [\$\{\w] ) | (?: \$ (?: [#] (?= (?> [\$^\w\{:+] | - (?! > ) ) ) )?+ )++ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | \{ \w++ \} | (?&PerlBlock) ) | \$\# ) # End of rule (?) (? \@ (?>(?&PerlOWS)) (?: \$ (?&PerlOWS) )*+ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | (?&PerlBlock) ) ) # End of rule (?) (? \@ (?: \$ )*+ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | (?&PerlBlock) ) ) # End of rule (?) (? % (?>(?&PerlOWS)) (?: \$ (?&PerlOWS) )*+ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock)?+ | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | (?&PerlBlock) ) ) # End of rule (?) (? (?! (?> [msy] | q[wrxq]?+ | tr ) \b ) (?>(?&PerlIdentifier)) : (?! : ) ) # End of rule (?) (? (?> (?&PerlString) | (?&PerlQuotelikeQR) | (?&PerlQuotelikeQW) | (?&PerlNumber) | (?&PerlBareword) ) ) # End of rule (?) (? (?> # Inlined (?&PerlQuotelikeQ) ' [^'\\]*+ (?: \\. [^'\\]*+ )*+ ' | q \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_quotelike_body) # End of inlining | # Inlined (?&PerlQuotelikeQQ) " [^"\\]*+ (?: \\. [^"\\]*+ )*+ " | qq \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_quotelike_body_always_interpolated) # End of inlining | (?&PerlHeredoc) | (?&PerlVString) ) ) # End of rule (?) (? (?> (?&PerlString) | (?&PerlQuotelikeQR) | (?&PerlQuotelikeQW) | (?&PerlQuotelikeQX) | (?&PerlContextualMatch) | (?&PerlQuotelikeS) | (?&PerlQuotelikeTR) ) ) # End of rule (?) (? # Match the introducer... << (?<_heredoc_indented> [~]?+ ) # Match the terminator specification... (?> \\?+ (?<_heredoc_terminator> (?&PerlIdentifier) ) | (?>(?&PerlOWS)) (?> " (?<_heredoc_terminator> [^"\\]*+ (?: \\. [^"\\]*+ )*+ ) " #" | (? ' ) (?<_heredoc_terminator> [^'\\]*+ (?: \\. [^'\\]*+ )*+ ) ' #' | ` (?<_heredoc_terminator> [^`\\]*+ (?: \\. [^`\\]*+ )*+ ) ` #` ) | (?<_heredoc_terminator> ) ) # Do we need to reset the heredoc cache??? (?{ if ( ($PPR::_heredoc_origin // q{}) ne $_ ) { %PPR::_heredoc_skip = (); %PPR::_heredoc_parsed_to = (); $PPR::_heredoc_origin = $_; } }) # Do we need to cache content lookahead for this heredoc??? (?(?{ my $need_to_lookahead = !$PPR::_heredoc_parsed_to{+pos()}; $PPR::_heredoc_parsed_to{+pos()} = 1; $need_to_lookahead; }) # Lookahead to detect and remember trailing contents of heredoc (?= [^\n]*+ \n # Go to the end of the current line (?{ +pos() }) # Remember the start of the contents (??{ $PPR::_heredoc_skip{+pos()} // q{} }) # Skip earlier heredoc contents (?> # The heredoc contents consist of... (?: (?! (?(?{ $+{_heredoc_indented} }) \h*+ ) # An indent (if it was a <<~) \g{_heredoc_terminator} # The terminator (?: \n | \z ) # At an end-of-line ) (?() [^\n]*+ \n | [^\n\$\@]*+ (?: (?> (?{ local $PPR::_heredoc_EOL_start = $^R }) (?= \$ ) (?&PerlScalarAccess) (?{ $PPR::_heredoc_EOL_start }) | (?{ local $PPR::_heredoc_EOL_start = $^R }) (?= \@ ) (?&PerlArrayAccess) (?{ $PPR::_heredoc_EOL_start }) ) [^\n\$\@]*+ )*+ \n (??{ $PPR::_heredoc_skip{+pos()} // q{} }) ) )*+ (?(?{ $+{_heredoc_indented} }) \h*+ ) # An indent (if it was a <<~) \g{_heredoc_terminator} # The specified terminator (?: \n | \z ) # Followed by EOL ) # Then memoize the skip for when it's subsequently needed by PerlOWS or PerlNWS... (?{ # Split .{N} repetition into multiple repetitions to avoid the 32766 limit... $PPR::_heredoc_skip{$^R} = '(?s:' . ( '.{32766}' x int((pos() - $^R) / 32766) ) . '.{' . (pos() - $^R) % 32766 . '})'; }) ) ) ) # End of rule (?) (? (?> ' [^'\\]*+ (?: \\. [^'\\]*+ )*+ ' | \b q \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_quotelike_body) ) ) # End of rule (?) (? (?> " [^"\\]*+ (?: \\. [^"\\]*+ )*+ " | \b qq \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_quotelike_body_always_interpolated) ) ) # End of rule (?) (? (?> qw \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_quotelike_body) ) ) # End of rule (?) (? (?> ` [^`]*+ (?: \\. [^`]*+ )*+ ` | qx (?> (?= (?>(?&PerlOWS)) ' ) (?&PPR_quotelike_body) | \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_quotelike_body_interpolated) ) ) ) # End of rule (?) (? (? s \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?> # Hashed syntax... (?= [#] ) (?>(?&PPR_regex_body_interpolated_unclosed)) (?&PPR_quotelike_s_e_check) (?>(?&PPR_quotelike_body_interpolated)) | # Bracketed syntax... (?= (?>(?&PerlOWS)) (?: [\[(<\{] # ) | (\X) (??{ exists $PPR::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) ) ) (?>(?&PPR_regex_body_interpolated)) (?>(?&PerlOWS)) (?&PPR_quotelike_s_e_check) (?>(?&PPR_quotelike_body_interpolated)) | # Single-quoted syntax... (?= (?>(?&PerlOWS)) ' ) (?>(?&PPR_regex_body_unclosed)) (?&PPR_quotelike_s_e_check) (?>(?&PPR_quotelike_body_interpolated)) | # Delimited syntax... (?>(?&PPR_regex_body_interpolated_unclosed)) (?&PPR_quotelike_s_e_check) (?>(?&PPR_quotelike_body_interpolated)) ) [msixpodualgcern]*+ ) # End of rule (?) ) # End of rule (?) (? (? (?> tr | y ) \b (?! (?>(?&PerlOWS)) => ) (?> # Hashed syntax... (?= [#] ) (?>(?&PPR_quotelike_body_interpolated_unclosed)) (?&PPR_quotelike_body_interpolated) | # Bracketed syntax... (?= (?>(?&PerlOWS)) (?: [\[(<\{\«] # )] | (\X) (??{ exists $PPR::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) ) ) (?>(?&PPR_quotelike_body_interpolated)) (?>(?&PerlOWS)) (?&PPR_quotelike_body_interpolated) | # Delimited syntax... (?>(?&PPR_quotelike_body_interpolated_unclosed)) (?&PPR_quotelike_body_interpolated) ) [cdsr]*+ ) # End of rule (?) ) # End of rule (?) (? (? (? (? (?> \/\/ | (?> m (?= [#] ) | m \b (?! (?>(?&PerlOWS)) => ) | (?= \/ [^/] ) ) (?&PPR_regex_body_interpolated) ) [msixpodualgcn]*+ ) # End of rule (?) ) # End of rule (?) (?= (?>(?&PerlOWS)) (?> \z | [,;\}\])?] | => | : (?! :) | (?&PerlInfixBinaryOperator) | (?&PerlLowPrecedenceInfixOperator) | (?= \w) (?> for(?:each)?+ | while | if | unless | until | when ) ) ) ) # End of rule (?) ) # End of rule (?) (? qr \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?>(?&PPR_regex_body_interpolated)) [msixpodualn]*+ ) # End of rule (?) (? (?> (?&PerlMatch) | (?&PerlQuotelikeQR) ) ) # End of rule (?) (? (?> (?&PerlContextualMatch) | (?&PerlQuotelikeQR) ) ) # End of rule (?) (? # Optimized to match any Perl builtin name, without backtracking... (?=[^\W\d]) # Skip if possible (?> s(?>e(?>t(?>(?>(?>(?>hos|ne)t|gr)en|s(?>erven|ockop))t|p(?>r(?>iority|otoent)|went|grp))|m(?>ctl|get|op)|ek(?>dir)?|lect|nd)|y(?>s(?>write|call|open|read|seek|tem)|mlink)|h(?>m(?>write|read|ctl|get)|utdown|ift)|o(?>cket(?>pair)?|rt)|p(?>li(?>ce|t)|rintf)|(?>cala|ubst)r|t(?>at|udy)|leep|rand|qrt|ay|in) | g(?>et(?>p(?>r(?>oto(?>byn(?>umber|ame)|ent)|iority)|w(?>ent|nam|uid)|eername|grp|pid)|s(?>erv(?>by(?>name|port)|ent)|ock(?>name|opt))|host(?>by(?>addr|name)|ent)|net(?>by(?>addr|name)|ent)|gr(?>ent|gid|nam)|login|c)|mtime|lob|oto|rep) | r(?>e(?>ad(?>lin[ek]|pipe|dir)?|(?>quir|vers|nam)e|winddir|turn|set|cv|do|f)|index|mdir|and) | c(?>h(?>o(?>m?p|wn)|r(?>oot)?|dir|mod)|o(?>n(?>tinue|nect)|s)|lose(?>dir)?|aller|rypt) | e(?>nd(?>(?>hos|ne)t|p(?>roto|w)|serv|gr)ent|x(?>i(?>sts|t)|ec|p)|ach|val(?>bytes)?+|of) | l(?>o(?>c(?>al(?>time)?|k)|g)|i(?>sten|nk)|(?>sta|as)t|c(?>first)?|ength) | u(?>n(?>(?>lin|pac)k|shift|def|tie)|c(?>first)?|mask|time) | p(?>r(?>ototype|intf?)|ack(?>age)?|o[ps]|ipe|ush) | d(?>bm(?>close|open)|e(?>fined|lete)|ump|ie|o) | f(?>or(?>m(?>line|at)|k)|ileno|cntl|c|lock) | t(?>i(?>mes?|ed?)|ell(?>dir)?|runcate) | w(?>a(?>it(?>pid)?|ntarray|rn)|rite) | m(?>sg(?>ctl|get|rcv|snd)|kdir|ap) | b(?>in(?>mode|d)|less|reak) | i(?>n(?>dex|t)|mport|octl) | a(?>ccept|larm|tan2|bs) | o(?>pen(?>dir)?|ct|rd) | v(?>alues|ec) | k(?>eys|ill) | quotemeta | join | next | hex | _ ) \b ) # End of rule (?) (? # Optimized to match any Perl builtin name, without backtracking... (?= [^\W\d] ) # Skip if possible (?> get(?:(?:(?:hos|ne)t|serv|gr)ent|p(?:(?:roto|w)ent|pid)|login) | end(?:(?:hos|ne)t|p(?:roto|w)|serv|gr)ent | wa(?:ntarray|it) | times? | fork | _ ) \b ) # End of rule (?) (? (?> (?&PerlVString) | (?>(?&PPR_digit_seq)) (?: \. (?&PPR_digit_seq)?+ )*+ ) ) # End of rule (?) (? v (?>(?&PPR_digit_seq)) (?: \. (?&PPR_digit_seq) )*+ ) # End of rule (?) (? [+-]?+ (?> 0 (?> x (?&PPR_x_digit_seq) | b (?&PPR_b_digit_seq) | o? (?&PPR_o_digit_seq) ) | (?> (?>(?&PPR_digit_seq)) (?: \. (?&PPR_digit_seq)?+ )?+ | \. (?&PPR_digit_seq) ) (?: [eE] [+-]?+ (?&PPR_digit_seq) )?+ ) ) # End of rule (?) (? (?> (?> :: | ' ) \w++ | [^\W\d]\w*+ ) (?: (?> :: | ' ) \w++ )*+ ) # End of rule (?) (? (?> :: \w++ | [^\W\d]\w*+ ) (?: (?> :: | ' ) \w++ )*+ ) # End of rule (?) (? [^\W\d]\w*+ ) # End of rule (?) (? (?! (?> (?= \w ) (?> for(?:each)?+ | while | if | unless | until | use | no | given | when | sub | return | my | our | state | try | catch | finally | defer ) | (?&PPR_named_op) | __ (?> END | DATA ) __ \b ) \b (?! (?>(?&PerlOWS)) => ) ) (?! (?> q[qwrx]?+ | [mys] | tr ) \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) ) (?: :: )?+ [^\W\d]\w*+ (?: (?: :: | ' ) [^\W\d]\w*+ )*+ (?: :: )?+ (?! \( ) # ) | :: (?! \w | \{ ) ) # End of rule (?) (? (?!) # None, by default, but can be overridden in a composing regex ) # End of rule (?) (? (?>(?&PerlOWS)) (?: (?>(?&PerlPod)) (?&PerlOWS) )*+ ) # End of rule (?) (? ^ = [^\W\d]\w*+ # A line starting with = .*? # Up to the first... (?> ^ = cut \b [^\n]*+ $ # ...line starting with =cut | # or \z # ...EOF ) ) # End of rule (?) ##### Whitespace matching (part of API) ################################# (? (?: \h++ | (?&PPR_newline_and_heredoc) | # Inlined (?&PerlComment) [#] [^\n]*+ # End of inlining | __ (?> END | DATA ) __ \b .*+ \z )*+ ) # End of rule (?) (? (?: \h++ | (?&PPR_newline_and_heredoc) | # Inlined (?&PerlComment) [#] [^\n]*+ # End of inlining )*+ ) # End of rule (?) (? (?: \h++ | (?&PPR_newline_and_heredoc) | # Inlined (?&PerlComment) [#] [^\n]*+ # End of inlining )++ ) # End of rule (?) (? [#] [^\n]*+ ) # End of rule (?) (? \n ) # End of rule (?) ###### Internal components (not part of API) ########################## (? (?> cmp | [lg][te] | eq | ne | and | or | xor ) ) # End of rule (?) (? (?! (?> for(?:each)?+ | while | if | unless | until | given | when | default | sub | format | use | no | my | our | state | try | catch | finally | defer | (?&PPR_named_op) | [msy] | q[wrxq]?+ | tr | __ (?> END | DATA ) __ ) \b ) (?>(?&PerlQualifiedIdentifier)) (?! :: ) ) # End of rule (?) (? \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?? ; (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?? ; (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?? \) ) # End of rule (?) (? (?&PerlBareword) | (?>(?&PerlVariableScalar)) (?! (?>(?&PerlOWS)) (?> [<\[\{] | -> ) ) ) # End of rule (?) (? (?>(?&PPR_quotelike_body_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? [^)(\\\n]*+ (?: (?> \\. | \( (?>(?&PPR_balanced_parens)) \) | (?&PPR_newline_and_heredoc) ) [^)(\\\n]*+ )*+ ) # End of rule (?) (? [^\}\{\\\n]*+ (?: (?> \\. | \{ (?>(?&PPR_balanced_curlies)) \} | (?&PPR_newline_and_heredoc) ) [^\}\{\\\n]*+ )*+ ) # End of rule (?) (? [^][\\\n]*+ (?: (?> \\. | \[ (?&PPR_balanced_squares) \] | (?&PPR_newline_and_heredoc) ) [^][\\\n]*+ )*+ ) # End of rule (?) (? [^><\\\n]*+ (?: (?> \\. | < (?>(?&PPR_balanced_angles)) > | (?&PPR_newline_and_heredoc) ) [^><\\\n]*+ )*+ ) # End of rule (?) (? (??{$PPR::_qld_not_special}) (?: (?> \\. | (??{$PPR::_qld_open}) (?>(?&PPR_balanced_unicode_delims)) (??{$PPR::_qld_close}) | (?&PPR_newline_and_heredoc) ) (??{$PPR::_qld_not_special}) )*+ ) # End of rule (?) (? (?> [#] [^#\\\n]*+ (?: (?: \\. | (?&PPR_newline_and_heredoc) ) [^#\\\n]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_balanced_curlies)) (?= \} ) | \[ (?>(?&PPR_balanced_squares)) (?= \] ) | \( (?> \?{1,2}+ (?= \{ ) (?>(?&PerlBlock)) | (?! \?{1,2}+ \{ ) (?>(?&PPR_balanced_parens)) ) (?= \) ) | < (?>(?&PPR_balanced_angles)) (?= > ) | (\X) (??{ exists $PPR::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::_qld_open = $^N; local $PPR::_qld_close = $PPR::_QLD_CLOSE_FOR{$PPR::_qld_open}; local $PPR::_qld_not_special = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n]*+"; local $PPR::_qld_not_special_or_sigil = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::_qld_not_special_in_regex_var = "[^$PPR::_qld_open$PPR::_qld_close\\s(|)]"; }) (?>(?&PPR_balanced_unicode_delims_regex_interpolated)) (?= (??{$PPR::_qld_close}) ) | \\ [^\\\n]*+ ( (?&PPR_newline_and_heredoc) [^\\\n]*+ )*+ (?= \\ ) | / [^\\/\n]*+ (?: (?: \\. | (?&PPR_newline_and_heredoc) ) [^\\/\n]*+ )*+ (?= / ) | (? \S ) (?: \\. | (?&PPR_newline_and_heredoc) | (?! \g{PPR_qldel} ) . )*+ (?= \g{PPR_qldel} ) ) ) ) # End of rule (?) (? (?> [#] [^#\\\n]*+ (?: (?: \\. | (?&PPR_newline_and_heredoc) ) [^#\\\n]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_balanced_curlies)) (?= \} ) | \[ (?>(?&PPR_balanced_squares)) (?= \] ) | \( (?>(?&PPR_balanced_parens)) (?= \) ) | < (?>(?&PPR_balanced_angles)) (?= > ) | (\X) (??{ exists $PPR::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::_qld_open = $^N; local $PPR::_qld_close = $PPR::_QLD_CLOSE_FOR{$PPR::_qld_open}; local $PPR::_qld_not_special = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n]*+"; local $PPR::_qld_not_special_or_sigil = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::_qld_not_special_in_regex_var = "[^$PPR::_qld_open$PPR::_qld_close\\s(|)]"; }) (?>(?&PPR_balanced_unicode_delims)) (?= (??{$PPR::_qld_close}) ) | \\ [^\\\n]*+ ( (?&PPR_newline_and_heredoc) [^\\\n]*+ )*+ (?= \\ ) | / [^\\/\n]*+ (?: (?: \\. | (?&PPR_newline_and_heredoc) ) [^\\/\n]*+ )*+ (?= / ) | (? \S ) (?: \\. | (?&PPR_newline_and_heredoc) | (?! \g{PPR_qldel} ) . )*+ (?= \g{PPR_qldel} ) ) ) ) # End of rule (?) (? (?>(?&PPR_quotelike_body_always_interpolated_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? (?>(?&PPR_quotelike_body_interpolated_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? (?>(?&PPR_regex_body_interpolated_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? [^)(\\\n\$\@]*+ (?: (?> \\. | \( (?>(?&PPR_balanced_parens_regex_interpolated)) \) | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s(|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s(|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^)(\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^\}\{\\\n\$\@]*+ (?: (?> \\. | \{ (?>(?&PPR_balanced_curlies_regex_interpolated)) \} | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\}(|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\}(|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\}\{\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^][\\\n\$\@]*+ (?: (?> \\. | \[ (?>(?&PPR_balanced_squares_regex_interpolated)) \] | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\](|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\](|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^][\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^><\\\n\$\@]*+ (?: (?> \\. | < (?>(?&PPR_balanced_angles_regex_interpolated)) > | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s>(|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s>(|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^><\\\n\$\@]*+ )*+ ) # End of rule (?) (? (??{$PPR::_qld_not_special_or_sigil}) (?: (?> \\. | (??{ $PPR::_qld_open }) (?>(?&PPR_balanced_unicode_delims_regex_interpolated)) (??{ $PPR::_qld_close }) | (?&PPR_newline_and_heredoc) | (?= \$ (??{ $PPR::_qld_not_special_in_regex_var }) ) (?&PerlScalarAccessNoSpace) | (?= \$ (??{ $PPR::_qld_not_special_in_regex_var }) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) (??{$PPR::_qld_not_special_or_sigil}) )*+ ) # End of rule (?) (? [^)(\\\n\$\@]*+ (?: (?> \\. | \( (?>(?&PPR_balanced_parens_interpolated)) \) | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^)(\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^\}\{\\\n\$\@]*+ (?: (?> \\. | \{ (?>(?&PPR_balanced_curlies_interpolated)) \} | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\}] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\}] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\}\{\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^][\\\n\$\@]*+ (?: (?> \\. | \[ (?>(?&PPR_balanced_squares_interpolated)) \] | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\]] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\]] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^][\\\n\$\@]*+ )*+ ) # End of rule (?) (? (??{$PPR::_qld_not_special_or_sigil}) (?: (?> \\. | (??{$PPR::_qld_open}) (?>(?&PPR_balanced_unicode_delims_interpolated)) (??{$PPR::_qld_close}) | (?&PPR_newline_and_heredoc) | (?= \$ (?! \s | (??{$PPR::_qld_close}) ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \s | (??{$PPR::_qld_close}) ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) (??{$PPR::_qld_not_special_or_sigil}) )*+ ) # End of rule (?) (? [^><\\\n\$\@]*+ (?: (?> \\. | < (?>(?&PPR_balanced_angles_interpolated)) > | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s>] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s>] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^><\\\n\$\@]*+ )*+ ) # End of rule (?) (? # Start by working out where it actually ends (ignoring interpolations)... (?= (?> [#] [^#\\\n\$\@]*+ (?: (?> \\. | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s#|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s#|()] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^#\\\n\$\@]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_balanced_curlies_regex_interpolated)) (?= \} ) | \[ (?>(?&PPR_balanced_squares_regex_interpolated)) (?= \] ) | \( (?>(?&PPR_balanced_parens_regex_interpolated)) (?= \) ) | < (?>(?&PPR_balanced_angles_regex_interpolated)) (?= > ) | (\X) (??{ exists $PPR::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::_qld_open = $^N; local $PPR::_qld_close = $PPR::_QLD_CLOSE_FOR{$PPR::_qld_open}; local $PPR::_qld_not_special = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n]*+"; local $PPR::_qld_not_special_or_sigil = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::_qld_not_special_in_regex_var = "[^$PPR::_qld_open$PPR::_qld_close\\s(|)]"; }) (?>(?&PPR_balanced_unicode_delims_regex_interpolated)) (?= (??{$PPR::_qld_close}) ) | ' [^'\n]*+ (?: (?> (?&PPR_newline_and_heredoc)) [^'\n]*+ )*+ (?= ' ) | \\ [^\\\n\$\@]*+ (?: (?> (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\\|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\\|()] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\\n\$\@]*+ )*+ (?= \\ ) | / [^\\/\n\$\@]*+ (?: (?> \\. | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s/|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s/|()] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\/\n\$\@]*+ )*+ (?= / ) | - (?: \\. | (?&PPR_newline_and_heredoc) | (?: (?= \$ (?! [\s|()-] ) ) (?&PerlScalarAccessNoSpaceNoArrow) | (?= \@ (?! [\s|()-] ) ) (?&PerlArrayAccessNoSpaceNoArrow) | [^-] ) )*+ (?= - ) | (? \S ) (?: \\. | (?&PPR_newline_and_heredoc) | (?! \g{PPR_qldel} ) (?: (?= \$ (?! \g{PPR_qldel} | [\s|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \g{PPR_qldel} | [\s|()] ) ) (?&PerlArrayAccessNoSpace) | . ) )*+ (?= \g{PPR_qldel} ) ) ) ) (?&PPR_regex_body_unclosed) ) # End of rule (?) (? # Start by working out where it actually ends (ignoring interpolations)... (?= (?> [#] [^#\\\n\$\@]*+ (?: (?> \\. | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s#] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s#] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^#\\\n\$\@]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_balanced_curlies_interpolated)) (?= \} ) | \[ (?>(?&PPR_balanced_squares_interpolated)) (?= \] ) | \( (?>(?&PPR_balanced_parens_interpolated)) (?= \) ) | < (?>(?&PPR_balanced_angles_interpolated)) (?= > ) | (\X) (??{ exists $PPR::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::_qld_open = $^N; local $PPR::_qld_close = $PPR::_QLD_CLOSE_FOR{$PPR::_qld_open}; local $PPR::_qld_not_special = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n]*+"; local $PPR::_qld_not_special_or_sigil = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::_qld_not_special_in_regex_var = "[^$PPR::_qld_open$PPR::_qld_close\\s(|)]"; }) (?>(?&PPR_balanced_unicode_delims_interpolated)) (?= (??{$PPR::_qld_close}) ) | \\ [^\\\n\$\@]*+ (?: (?> (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\\] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\\] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\\n\$\@]*+ )*+ (?= \\ ) | / [^\\/\n\$\@]*+ (?: (?> \\. | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s/] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s/] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\/\n\$\@]*+ )*+ (?= / ) | - (?: \\. | (?&PPR_newline_and_heredoc) | (?: (?= \$ (?! [\s-] ) ) (?&PerlScalarAccessNoSpaceNoArrow) | (?= \@ (?! [\s-] ) ) (?&PerlArrayAccessNoSpaceNoArrow) | [^-] ) )*+ (?= - ) | (? \S ) (?: \\. | (?&PPR_newline_and_heredoc) | (?! \g{PPR_qldel} ) (?: (?= \$ (?! \g{PPR_qldel} | \s ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \g{PPR_qldel} | \s ) ) (?&PerlArrayAccessNoSpace) | . ) )*+ (?= \g{PPR_qldel} ) ) ) ) (?&PPR_quotelike_body_unclosed) ) # End of rule (?) (? # Start by working out where it actually ends (ignoring interpolations)... (?= (?> [#] [^#\\\n\$\@]*+ (?: (?> \\. | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s#] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s#] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^#\\\n\$\@]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_balanced_curlies_interpolated)) (?= \} ) | \[ (?>(?&PPR_balanced_squares_interpolated)) (?= \] ) | \( (?>(?&PPR_balanced_parens_interpolated)) (?= \) ) | < (?>(?&PPR_balanced_angles_interpolated)) (?= > ) | (\X) (??{ exists $PPR::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::_qld_open = $^N; local $PPR::_qld_close = $PPR::_QLD_CLOSE_FOR{$PPR::_qld_open}; local $PPR::_qld_not_special = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n]*+"; local $PPR::_qld_not_special_or_sigil = "[^$PPR::_qld_open$PPR::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::_qld_not_special_in_regex_var = "[^$PPR::_qld_open$PPR::_qld_close\\s(|)]"; }) (?>(?&PPR_balanced_unicode_delims_interpolated)) (?= (??{$PPR::_qld_close}) ) | ' [^'\n]*+ (?: (?> (?&PPR_newline_and_heredoc)) [^'\n]*+ )*+ (?= ' ) | \\ [^\\\n\$\@]*+ (?: (?> (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s\\] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\\] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\\n\$\@]*+ )*+ (?= \\ ) | / [^\\/\n\$\@]*+ (?: (?> \\. | (?&PPR_newline_and_heredoc) | (?= \$ (?! [\s/] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s/] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\/\n\$\@]*+ )*+ (?= / ) | - (?: \\. | (?&PPR_newline_and_heredoc) | (?: (?= \$ (?! [\s-] ) ) (?&PerlScalarAccessNoSpaceNoArrow) | (?= \@ (?! [\s-] ) ) (?&PerlArrayAccessNoSpaceNoArrow) | [^-] ) )*+ (?= - ) | (? \S ) (?: \\. | (?&PPR_newline_and_heredoc) | (?! \g{PPR_qldel} ) (?: (?= \$ (?! \g{PPR_qldel} | \s ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \g{PPR_qldel} | \s ) ) (?&PerlArrayAccessNoSpace) | . ) )*+ (?= \g{PPR_qldel} ) ) ) ) (?&PPR_quotelike_body_unclosed) ) # End of rule (?) (? (??{ local $PPR::_quotelike_s_end = -1; '' }) (?: (?= (?&PPR_quotelike_body_interpolated) (??{ $PPR::_quotelike_s_end = +pos(); '' }) [msixpodualgcrn]*+ e [msixpodualgcern]*+ ) (?= \S # Skip the left delimiter (?(?{ $PPR::_quotelike_s_end >= 0 }) (?> (??{ +pos() && +pos() < $PPR::_quotelike_s_end ? '' : '(?!)' }) (?> (?&PerlExpression) | \\?+ . ) )*+ ) ) )?+ ) # End of rule (?) (? (??{ local $PPR::_quotelike_s_end = -1; '' }) (?: (?= (?&PPR_quotelike_body) (??{ $PPR::_quotelike_s_end = +pos(); '' }) [msixpodualgcrn]*+ e [msixpodualgcern]*+ ) (?= \S # Skip the left delimiter (?(?{ $PPR::_quotelike_s_end >= 0 }) (?> (??{ +pos() && +pos() < $PPR::_quotelike_s_end ? '' : '(?!)' }) (?> (?&PerlExpression) | \\?+ . ) )*+ ) ) )?+ ) # End of rule (?) (? [ABCMORSTWXbcdefgkloprstuwxz] ) (? \d++ (?: _?+ \d++ )*+ ) (? [\da-fA-F]++ (?: _?+ [\da-fA-F]++ )*+ ) (? [0-7]++ (?: _?+ [0-7]++ )*+ ) (? [0-1]++ (?: _?+ [0-1]++ )*+ ) (? \n (??{ ($PPR::_heredoc_origin // q{}) eq ($_//q{}) ? ($PPR::_heredoc_skip{+pos()} // q{}) : q{} }) ) # End of rule (?) ) # END OF GRAMMAR }xms; BEGIN { %PPR::_QLD_CLOSE_FOR = ( # "\x{0028}" => "\x{0029}", # LEFT/RIGHT PARENTHESIS # "\x{003C}" => "\x{003E}", # LESS-THAN/GREATER-THAN SIGN # "\x{005B}" => "\x{005D}", # LEFT/RIGHT SQUARE BRACKET # "\x{007B}" => "\x{007D}", # LEFT/RIGHT CURLY BRACKET "\x{00AB}" => "\x{00BB}", # LEFT/RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK "\x{00BB}" => "\x{00AB}", # RIGHT/LEFT-POINTING DOUBLE ANGLE QUOTATION MARK "\x{0706}" => "\x{0707}", # SYRIAC COLON SKEWED LEFT/RIGHT "\x{0F3A}" => "\x{0F3B}", # TIBETAN MARK GUG RTAGS GYON, TIBETAN MARK GUG RTAGS GYAS "\x{0F3C}" => "\x{0F3D}", # TIBETAN MARK ANG KHANG GYON, TIBETAN MARK ANG KHANG GYAS "\x{169B}" => "\x{169C}", # OGHAM FEATHER MARK, OGHAM REVERSED FEATHER MARK "\x{2018}" => "\x{2019}", # LEFT/RIGHT SINGLE QUOTATION MARK "\x{2019}" => "\x{2018}", # RIGHT/LEFT SINGLE QUOTATION MARK "\x{201C}" => "\x{201D}", # LEFT/RIGHT DOUBLE QUOTATION MARK "\x{201D}" => "\x{201C}", # RIGHT/LEFT DOUBLE QUOTATION MARK "\x{2035}" => "\x{2032}", # REVERSED PRIME, PRIME "\x{2036}" => "\x{2033}", # REVERSED DOUBLE PRIME, DOUBLE PRIME "\x{2037}" => "\x{2034}", # REVERSED TRIPLE PRIME, TRIPLE PRIME "\x{2039}" => "\x{203A}", # SINGLE LEFT/RIGHT-POINTING ANGLE QUOTATION MARK "\x{203A}" => "\x{2039}", # SINGLE RIGHT/LEFT-POINTING ANGLE QUOTATION MARK "\x{2045}" => "\x{2046}", # LEFT/RIGHT SQUARE BRACKET WITH QUILL "\x{204D}" => "\x{204C}", # BLACK RIGHT/LEFTWARDS BULLET "\x{207D}" => "\x{207E}", # SUPERSCRIPT LEFT/RIGHT PARENTHESIS "\x{208D}" => "\x{208E}", # SUBSCRIPT LEFT/RIGHT PARENTHESIS "\x{2192}" => "\x{2190}", # RIGHT/LEFTWARDS ARROW "\x{219B}" => "\x{219A}", # RIGHT/LEFTWARDS ARROW WITH STROKE "\x{219D}" => "\x{219C}", # RIGHT/LEFTWARDS WAVE ARROW "\x{21A0}" => "\x{219E}", # RIGHT/LEFTWARDS TWO HEADED ARROW "\x{21A3}" => "\x{21A2}", # RIGHT/LEFTWARDS ARROW WITH TAIL "\x{21A6}" => "\x{21A4}", # RIGHT/LEFTWARDS ARROW FROM BAR "\x{21AA}" => "\x{21A9}", # RIGHT/LEFTWARDS ARROW WITH HOOK "\x{21AC}" => "\x{21AB}", # RIGHT/LEFTWARDS ARROW WITH LOOP "\x{21B1}" => "\x{21B0}", # UPWARDS ARROW WITH TIP RIGHT/LEFTWARDS "\x{21B3}" => "\x{21B2}", # DOWNWARDS ARROW WITH TIP RIGHT/LEFTWARDS "\x{21C0}" => "\x{21BC}", # RIGHT/LEFTWARDS HARPOON WITH BARB UPWARDS "\x{21C1}" => "\x{21BD}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWNWARDS "\x{21C9}" => "\x{21C7}", # RIGHT/LEFTWARDS PAIRED ARROWS "\x{21CF}" => "\x{21CD}", # RIGHT/LEFTWARDS DOUBLE ARROW WITH STROKE "\x{21D2}" => "\x{21D0}", # RIGHT/LEFTWARDS DOUBLE ARROW "\x{21DB}" => "\x{21DA}", # RIGHT/LEFTWARDS TRIPLE ARROW "\x{21DD}" => "\x{21DC}", # RIGHT/LEFTWARDS SQUIGGLE ARROW "\x{21E2}" => "\x{21E0}", # RIGHT/LEFTWARDS DASHED ARROW "\x{21E5}" => "\x{21E4}", # RIGHT/LEFTWARDS ARROW TO BAR "\x{21E8}" => "\x{21E6}", # RIGHT/LEFTWARDS WHITE ARROW "\x{21F4}" => "\x{2B30}", # RIGHT/LEFT ARROW WITH SMALL CIRCLE "\x{21F6}" => "\x{2B31}", # THREE RIGHT/LEFTWARDS ARROWS "\x{21F8}" => "\x{21F7}", # RIGHT/LEFTWARDS ARROW WITH VERTICAL STROKE "\x{21FB}" => "\x{21FA}", # RIGHT/LEFTWARDS ARROW WITH DOUBLE VERTICAL STROKE "\x{21FE}" => "\x{21FD}", # RIGHT/LEFTWARDS OPEN-HEADED ARROW "\x{2208}" => "\x{220B}", # ELEMENT OF, CONTAINS AS MEMBER "\x{2209}" => "\x{220C}", # NOT AN ELEMENT OF, DOES NOT CONTAIN AS MEMBER "\x{220A}" => "\x{220D}", # SMALL ELEMENT OF, SMALL CONTAINS AS MEMBER "\x{2264}" => "\x{2265}", # LESS-THAN/GREATER-THAN OR EQUAL TO "\x{2266}" => "\x{2267}", # LESS-THAN/GREATER-THAN OVER EQUAL TO "\x{2268}" => "\x{2269}", # LESS-THAN/GREATER-THAN BUT NOT EQUAL TO "\x{226A}" => "\x{226B}", # MUCH LESS-THAN/GREATER-THAN "\x{226E}" => "\x{226F}", # NOT LESS-THAN/GREATER-THAN "\x{2270}" => "\x{2271}", # NEITHER LESS-THAN/GREATER-THAN NOR EQUAL TO "\x{2272}" => "\x{2273}", # LESS-THAN/GREATER-THAN OR EQUIVALENT TO "\x{2274}" => "\x{2275}", # NEITHER LESS-THAN/GREATER-THAN NOR EQUIVALENT TO "\x{227A}" => "\x{227B}", # PRECEDES/SUCCEEDS "\x{227C}" => "\x{227D}", # PRECEDES/SUCCEEDS OR EQUAL TO "\x{227E}" => "\x{227F}", # PRECEDES/SUCCEEDS OR EQUIVALENT TO "\x{2280}" => "\x{2281}", # DOES NOT PRECEDE/SUCCEED "\x{2282}" => "\x{2283}", # SUBSET/SUPERSET OF "\x{2284}" => "\x{2285}", # NOT A SUBSET/SUPERSET OF "\x{2286}" => "\x{2287}", # SUBSET/SUPERSET OF OR EQUAL TO "\x{2288}" => "\x{2289}", # NEITHER A SUBSET/SUPERSET OF NOR EQUAL TO "\x{228A}" => "\x{228B}", # SUBSET/SUPERSET OF WITH NOT EQUAL TO "\x{22A3}" => "\x{22A2}", # LEFT/RIGHT TACK "\x{22A6}" => "\x{2ADE}", # ASSERTION, SHORT LEFT TACK "\x{22A8}" => "\x{2AE4}", # TRUE, VERTICAL BAR DOUBLE LEFT TURNSTILE "\x{22A9}" => "\x{2AE3}", # FORCES, DOUBLE VERTICAL BAR LEFT TURNSTILE "\x{22B0}" => "\x{22B1}", # PRECEDES/SUCCEEDS UNDER RELATION "\x{22D0}" => "\x{22D1}", # DOUBLE SUBSET/SUPERSET "\x{22D6}" => "\x{22D7}", # LESS-THAN/GREATER-THAN WITH DOT "\x{22D8}" => "\x{22D9}", # VERY MUCH LESS-THAN/GREATER-THAN "\x{22DC}" => "\x{22DD}", # EQUAL TO OR LESS-THAN/GREATER-THAN "\x{22DE}" => "\x{22DF}", # EQUAL TO OR PRECEDES/SUCCEEDS "\x{22E0}" => "\x{22E1}", # DOES NOT PRECEDE/SUCCEED OR EQUAL "\x{22E6}" => "\x{22E7}", # LESS-THAN/GREATER-THAN BUT NOT EQUIVALENT TO "\x{22E8}" => "\x{22E9}", # PRECEDES/SUCCEEDS BUT NOT EQUIVALENT TO "\x{22F2}" => "\x{22FA}", # ELEMENT OF/CONTAINS WITH LONG HORIZONTAL STROKE "\x{22F3}" => "\x{22FB}", # ELEMENT OF/CONTAINS WITH VERTICAL BAR AT END OF HORIZONTAL STROKE "\x{22F4}" => "\x{22FC}", # SMALL ELEMENT OF/CONTAINS WITH VERTICAL BAR AT END OF HORIZONTAL STROKE "\x{22F6}" => "\x{22FD}", # ELEMENT OF/CONTAINS WITH OVERBAR "\x{22F7}" => "\x{22FE}", # SMALL ELEMENT OF/CONTAINS WITH OVERBAR "\x{2308}" => "\x{2309}", # LEFT/RIGHT CEILING "\x{230A}" => "\x{230B}", # LEFT/RIGHT FLOOR "\x{2326}" => "\x{232B}", # ERASE TO THE RIGHT/LEFT "\x{2329}" => "\x{232A}", # LEFT/RIGHT-POINTING ANGLE BRACKET "\x{2348}" => "\x{2347}", # APL FUNCTIONAL SYMBOL QUAD RIGHT/LEFTWARDS ARROW "\x{23E9}" => "\x{23EA}", # BLACK RIGHT/LEFT-POINTING DOUBLE TRIANGLE "\x{23ED}" => "\x{23EE}", # BLACK RIGHT/LEFT-POINTING DOUBLE TRIANGLE WITH VERTICAL BAR "\x{261B}" => "\x{261A}", # BLACK RIGHT/LEFT POINTING INDEX "\x{261E}" => "\x{261C}", # WHITE RIGHT/LEFT POINTING INDEX "\x{269E}" => "\x{269F}", # THREE LINES CONVERGING RIGHT/LEFT "\x{2768}" => "\x{2769}", # MEDIUM LEFT/RIGHT PARENTHESIS ORNAMENT "\x{276A}" => "\x{276B}", # MEDIUM FLATTENED LEFT/RIGHT PARENTHESIS ORNAMENT "\x{276C}" => "\x{276D}", # MEDIUM LEFT/RIGHT-POINTING ANGLE BRACKET ORNAMENT "\x{276E}" => "\x{276F}", # HEAVY LEFT/RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT "\x{2770}" => "\x{2771}", # HEAVY LEFT/RIGHT-POINTING ANGLE BRACKET ORNAMENT "\x{2772}" => "\x{2773}", # LIGHT LEFT/RIGHT TORTOISE SHELL BRACKET ORNAMENT "\x{2774}" => "\x{2775}", # MEDIUM LEFT/RIGHT CURLY BRACKET ORNAMENT "\x{27C3}" => "\x{27C4}", # OPEN SUBSET/SUPERSET "\x{27C5}" => "\x{27C6}", # LEFT/RIGHT S-SHAPED BAG DELIMITER "\x{27C8}" => "\x{27C9}", # REVERSE SOLIDUS PRECEDING SUBSET, SUPERSET PRECEDING SOLIDUS "\x{27DE}" => "\x{27DD}", # LONG LEFT/RIGHT TACK "\x{27E6}" => "\x{27E7}", # MATHEMATICAL LEFT/RIGHT WHITE SQUARE BRACKET "\x{27E8}" => "\x{27E9}", # MATHEMATICAL LEFT/RIGHT ANGLE BRACKET "\x{27EA}" => "\x{27EB}", # MATHEMATICAL LEFT/RIGHT DOUBLE ANGLE BRACKET "\x{27EC}" => "\x{27ED}", # MATHEMATICAL LEFT/RIGHT WHITE TORTOISE SHELL BRACKET "\x{27EE}" => "\x{27EF}", # MATHEMATICAL LEFT/RIGHT FLATTENED PARENTHESIS "\x{27F4}" => "\x{2B32}", # RIGHT/LEFT ARROW WITH CIRCLED PLUS "\x{27F6}" => "\x{27F5}", # LONG RIGHT/LEFTWARDS ARROW "\x{27F9}" => "\x{27F8}", # LONG RIGHT/LEFTWARDS DOUBLE ARROW "\x{27FC}" => "\x{27FB}", # LONG RIGHT/LEFTWARDS ARROW FROM BAR "\x{27FE}" => "\x{27FD}", # LONG RIGHT/LEFTWARDS DOUBLE ARROW FROM BAR "\x{27FF}" => "\x{2B33}", # LONG RIGHT/LEFTWARDS SQUIGGLE ARROW "\x{2900}" => "\x{2B34}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH VERTICAL STROKE "\x{2901}" => "\x{2B35}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH DOUBLE VERTICAL STROKE "\x{2903}" => "\x{2902}", # RIGHT/LEFTWARDS DOUBLE ARROW WITH VERTICAL STROKE "\x{2905}" => "\x{2B36}", # RIGHT/LEFTWARDS TWO-HEADED ARROW FROM BAR "\x{2907}" => "\x{2906}", # RIGHT/LEFTWARDS DOUBLE ARROW FROM BAR "\x{290D}" => "\x{290C}", # RIGHT/LEFTWARDS DOUBLE DASH ARROW "\x{290F}" => "\x{290E}", # RIGHT/LEFTWARDS TRIPLE DASH ARROW "\x{2910}" => "\x{2B37}", # RIGHT/LEFTWARDS TWO-HEADED TRIPLE DASH ARROW "\x{2911}" => "\x{2B38}", # RIGHT/LEFTWARDS ARROW WITH DOTTED STEM "\x{2914}" => "\x{2B39}", # RIGHT/LEFTWARDS ARROW WITH TAIL WITH VERTICAL STROKE "\x{2915}" => "\x{2B3A}", # RIGHT/LEFTWARDS ARROW WITH TAIL WITH DOUBLE VERTICAL STROKE "\x{2916}" => "\x{2B3B}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TAIL "\x{2917}" => "\x{2B3C}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TAIL WITH VERTICAL STROKE "\x{2918}" => "\x{2B3D}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TAIL WITH DOUBLE VERTICAL STROKE "\x{291A}" => "\x{2919}", # RIGHT/LEFTWARDS ARROW-TAIL "\x{291C}" => "\x{291B}", # RIGHT/LEFTWARDS DOUBLE ARROW-TAIL "\x{291E}" => "\x{291D}", # RIGHT/LEFTWARDS ARROW TO BLACK DIAMOND "\x{2920}" => "\x{291F}", # RIGHT/LEFTWARDS ARROW FROM BAR TO BLACK DIAMOND "\x{2933}" => "\x{2B3F}", # WAVE ARROW POINTING DIRECTLY RIGHT/LEFT "\x{2937}" => "\x{2936}", # ARROW POINTING DOWNWARDS THEN CURVING RIGHT/LEFTWARDS "\x{2945}" => "\x{2946}", # RIGHT/LEFTWARDS ARROW WITH PLUS BELOW "\x{2947}" => "\x{2B3E}", # RIGHT/LEFTWARDS ARROW THROUGH X "\x{2953}" => "\x{2952}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP TO BAR "\x{2957}" => "\x{2956}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWN TO BAR "\x{295B}" => "\x{295A}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP FROM BAR "\x{295F}" => "\x{295E}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWN FROM BAR "\x{2964}" => "\x{2962}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP ABOVE RIGHT/LEFTWARDS HARPOON WITH BARB DOWN "\x{296C}" => "\x{296A}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP ABOVE LONG DASH "\x{296D}" => "\x{296B}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWN BELOW LONG DASH "\x{2971}" => "\x{2B40}", # EQUALS SIGN ABOVE RIGHT/LEFTWARDS ARROW "\x{2972}" => "\x{2B41}", # TILDE OPERATOR ABOVE RIGHTWARDS ARROW, REVERSE TILDE OPERATOR ABOVE LEFTWARDS ARROW "\x{2974}" => "\x{2B4B}", # RIGHTWARDS ARROW ABOVE TILDE OPERATOR, LEFTWARDS ARROW ABOVE REVERSE TILDE OPERATOR "\x{2975}" => "\x{2B42}", # RIGHTWARDS ARROW ABOVE ALMOST EQUAL TO, LEFTWARDS ARROW ABOVE REVERSE ALMOST EQUAL TO "\x{2979}" => "\x{297B}", # SUBSET/SUPERSET ABOVE RIGHT/LEFTWARDS ARROW "\x{2983}" => "\x{2984}", # LEFT/RIGHT WHITE CURLY BRACKET "\x{2985}" => "\x{2986}", # LEFT/RIGHT WHITE PARENTHESIS "\x{2987}" => "\x{2988}", # Z NOTATION LEFT/RIGHT IMAGE BRACKET "\x{2989}" => "\x{298A}", # Z NOTATION LEFT/RIGHT BINDING BRACKET "\x{298B}" => "\x{298C}", # LEFT/RIGHT SQUARE BRACKET WITH UNDERBAR "\x{298D}" => "\x{2990}", # LEFT/RIGHT SQUARE BRACKET WITH TICK IN TOP CORNER "\x{298F}" => "\x{298E}", # LEFT/RIGHT SQUARE BRACKET WITH TICK IN BOTTOM CORNER "\x{2991}" => "\x{2992}", # LEFT/RIGHT ANGLE BRACKET WITH DOT "\x{2993}" => "\x{2994}", # LEFT/RIGHT ARC LESS-THAN/GREATER-THAN BRACKET "\x{2995}" => "\x{2996}", # DOUBLE LEFT/RIGHT ARC GREATER-THAN/LESS-THAN BRACKET "\x{2997}" => "\x{2998}", # LEFT/RIGHT BLACK TORTOISE SHELL BRACKET "\x{29A8}" => "\x{29A9}", # MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING UP AND RIGHT/LEFT "\x{29AA}" => "\x{29AB}", # MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING DOWN AND RIGHT/LEFT "\x{29B3}" => "\x{29B4}", # EMPTY SET WITH RIGHT/LEFT ARROW ABOVE "\x{29C0}" => "\x{29C1}", # CIRCLED LESS-THAN/GREATER-THAN "\x{29D8}" => "\x{29D9}", # LEFT/RIGHT WIGGLY FENCE "\x{29DA}" => "\x{29DB}", # LEFT/RIGHT DOUBLE WIGGLY FENCE "\x{29FC}" => "\x{29FD}", # LEFT/RIGHT-POINTING CURVED ANGLE BRACKET "\x{2A79}" => "\x{2A7A}", # LESS-THAN/GREATER-THAN WITH CIRCLE INSIDE "\x{2A7B}" => "\x{2A7C}", # LESS-THAN/GREATER-THAN WITH QUESTION MARK ABOVE "\x{2A7D}" => "\x{2A7E}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO "\x{2A7F}" => "\x{2A80}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO WITH DOT INSIDE "\x{2A81}" => "\x{2A82}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO WITH DOT ABOVE "\x{2A83}" => "\x{2A84}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO WITH DOT ABOVE RIGHT/LEFT "\x{2A85}" => "\x{2A86}", # LESS-THAN/GREATER-THAN OR APPROXIMATE "\x{2A87}" => "\x{2A88}", # LESS-THAN/GREATER-THAN AND SINGLE-LINE NOT EQUAL TO "\x{2A89}" => "\x{2A8A}", # LESS-THAN/GREATER-THAN AND NOT APPROXIMATE "\x{2A8D}" => "\x{2A8E}", # LESS-THAN/GREATER-THAN ABOVE SIMILAR OR EQUAL "\x{2A95}" => "\x{2A96}", # SLANTED EQUAL TO OR LESS-THAN/GREATER-THAN "\x{2A97}" => "\x{2A98}", # SLANTED EQUAL TO OR LESS-THAN/GREATER-THAN WITH DOT INSIDE "\x{2A99}" => "\x{2A9A}", # DOUBLE-LINE EQUAL TO OR LESS-THAN/GREATER-THAN "\x{2A9B}" => "\x{2A9C}", # DOUBLE-LINE SLANTED EQUAL TO OR LESS-THAN/ GREATER-THAN "\x{2A9D}" => "\x{2A9E}", # SIMILAR OR LESS-THAN/GREATER-THAN "\x{2A9F}" => "\x{2AA0}", # SIMILAR ABOVE LESS-THAN/GREATER-THAN ABOVE EQUALS SIGN "\x{2AA1}" => "\x{2AA2}", # DOUBLE NESTED LESS-THAN/GREATER-THAN "\x{2AA6}" => "\x{2AA7}", # LESS-THAN/GREATER-THAN CLOSED BY CURVE "\x{2AA8}" => "\x{2AA9}", # LESS-THAN/GREATER-THAN CLOSED BY CURVE ABOVE SLANTED EQUAL "\x{2AAA}" => "\x{2AAB}", # SMALLER THAN/LARGER THAN "\x{2AAC}" => "\x{2AAD}", # SMALLER THAN/LARGER THAN OR EQUAL TO "\x{2AAF}" => "\x{2AB0}", # PRECEDES/SUCCEEDS ABOVE SINGLE-LINE EQUALS SIGN "\x{2AB1}" => "\x{2AB2}", # PRECEDES/SUCCEEDS ABOVE SINGLE-LINE NOT EQUAL TO "\x{2AB3}" => "\x{2AB4}", # PRECEDES/SUCCEEDS ABOVE EQUALS SIGN "\x{2AB5}" => "\x{2AB6}", # PRECEDES/SUCCEEDS ABOVE NOT EQUAL TO "\x{2AB7}" => "\x{2AB8}", # PRECEDES/SUCCEEDS ABOVE ALMOST EQUAL TO "\x{2AB9}" => "\x{2ABA}", # PRECEDES/SUCCEEDS ABOVE NOT ALMOST EQUAL TO "\x{2ABB}" => "\x{2ABC}", # DOUBLE PRECEDES/SUCCEEDS "\x{2ABD}" => "\x{2ABE}", # SUBSET/SUPERSET WITH DOT "\x{2ABF}" => "\x{2AC0}", # SUBSET/SUPERSET WITH PLUS SIGN BELOW "\x{2AC1}" => "\x{2AC2}", # SUBSET/SUPERSET WITH MULTIPLICATION SIGN BELOW "\x{2AC3}" => "\x{2AC4}", # SUBSET/SUPERSET OF OR EQUAL TO WITH DOT ABOVE "\x{2AC5}" => "\x{2AC6}", # SUBSET/SUPERSET OF ABOVE EQUALS SIGN "\x{2AC7}" => "\x{2AC8}", # SUBSET/SUPERSET OF ABOVE TILDE OPERATOR "\x{2AC9}" => "\x{2ACA}", # SUBSET/SUPERSET OF ABOVE ALMOST EQUAL TO "\x{2ACB}" => "\x{2ACC}", # SUBSET/SUPERSET OF ABOVE NOT EQUAL TO "\x{2ACF}" => "\x{2AD0}", # CLOSED SUBSET/SUPERSET "\x{2AD1}" => "\x{2AD2}", # CLOSED SUBSET/SUPERSET OR EQUAL TO "\x{2AD5}" => "\x{2AD6}", # SUBSET/SUPERSET ABOVE SUBSET/SUPERSET "\x{2AE5}" => "\x{22AB}", # DOUBLE VERTICAL BAR DOUBLE LEFT/RIGHT TURNSTILE "\x{2AF7}" => "\x{2AF8}", # TRIPLE NESTED LESS-THAN/GREATER-THAN "\x{2AF9}" => "\x{2AFA}", # DOUBLE-LINE SLANTED LESS-THAN/GREATER-THAN OR EQUAL TO "\x{2B46}" => "\x{2B45}", # RIGHT/LEFTWARDS QUADRUPLE ARROW "\x{2B47}" => "\x{2B49}", # REVERSE TILDE OPERATOR ABOVE RIGHTWARDS ARROW, TILDE OPERATOR ABOVE LEFTWARDS ARROW "\x{2B48}" => "\x{2B4A}", # RIGHTWARDS ARROW ABOVE REVERSE ALMOST EQUAL TO, LEFTWARDS ARROW ABOVE ALMOST EQUAL TO "\x{2B4C}" => "\x{2973}", # RIGHTWARDS ARROW ABOVE REVERSE TILDE OPERATOR, LEFTWARDS ARROW ABOVE TILDE OPERATOR "\x{2B62}" => "\x{2B60}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW "\x{2B6C}" => "\x{2B6A}", # RIGHT/LEFTWARDS TRIANGLE-HEADED DASHED ARROW "\x{2B72}" => "\x{2B70}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW TO BAR "\x{2B7C}" => "\x{2B7A}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH DOUBLE VERTICAL STROKE "\x{2B86}" => "\x{2B84}", # RIGHT/LEFTWARDS TRIANGLE-HEADED PAIRED ARROWS "\x{2B8A}" => "\x{2B88}", # RIGHT/LEFTWARDS BLACK CIRCLED WHITE ARROW "\x{2B95}" => "\x{2B05}", # RIGHT/LEFTWARDS BLACK ARROW "\x{2B9A}" => "\x{2B98}", # THREE-D TOP-LIGHTED RIGHT/LEFTWARDS EQUILATERAL ARROWHEAD "\x{2B9E}" => "\x{2B9C}", # BLACK RIGHT/LEFTWARDS EQUILATERAL ARROWHEAD "\x{2BA1}" => "\x{2BA0}", # DOWNWARDS TRIANGLE-HEADED ARROW WITH LONG TIP RIGHT/LEFTWARDS "\x{2BA3}" => "\x{2BA2}", # UPWARDS TRIANGLE-HEADED ARROW WITH LONG TIP RIGHT/LEFTWARDS "\x{2BA9}" => "\x{2BA8}", # BLACK CURVED DOWNWARDS AND RIGHT/LEFTWARDS ARROW "\x{2BAB}" => "\x{2BAA}", # BLACK CURVED UPWARDS AND RIGHT/LEFTWARDS ARROW "\x{2BB1}" => "\x{2BB0}", # RIBBON ARROW DOWN RIGHT/LEFT "\x{2BB3}" => "\x{2BB2}", # RIBBON ARROW UP RIGHT/LEFT "\x{2BEE}" => "\x{2BEC}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS "\x{2E02}" => "\x{2E03}", # LEFT/RIGHT SUBSTITUTION BRACKET "\x{2E03}" => "\x{2E02}", # RIGHT/LEFT SUBSTITUTION BRACKET "\x{2E04}" => "\x{2E05}", # LEFT/RIGHT DOTTED SUBSTITUTION BRACKET "\x{2E05}" => "\x{2E04}", # RIGHT/LEFT DOTTED SUBSTITUTION BRACKET "\x{2E09}" => "\x{2E0A}", # LEFT/RIGHT TRANSPOSITION BRACKET "\x{2E0A}" => "\x{2E09}", # RIGHT/LEFT TRANSPOSITION BRACKET "\x{2E0C}" => "\x{2E0D}", # LEFT/RIGHT RAISED OMISSION BRACKET "\x{2E0D}" => "\x{2E0C}", # RIGHT/LEFT RAISED OMISSION BRACKET "\x{2E11}" => "\x{2E10}", # REVERSED FORKED PARAGRAPHOS, FORKED PARAGRAPHOS "\x{2E1C}" => "\x{2E1D}", # LEFT/RIGHT LOW PARAPHRASE BRACKET "\x{2E1D}" => "\x{2E1C}", # RIGHT/LEFT LOW PARAPHRASE BRACKET "\x{2E20}" => "\x{2E21}", # LEFT/RIGHT VERTICAL BAR WITH QUILL "\x{2E21}" => "\x{2E20}", # RIGHT/LEFT VERTICAL BAR WITH QUILL "\x{2E22}" => "\x{2E23}", # TOP LEFT/RIGHT HALF BRACKET "\x{2E24}" => "\x{2E25}", # BOTTOM LEFT/RIGHT HALF BRACKET "\x{2E26}" => "\x{2E27}", # LEFT/RIGHT SIDEWAYS U BRACKET "\x{2E28}" => "\x{2E29}", # LEFT/RIGHT DOUBLE PARENTHESIS "\x{2E36}" => "\x{2E37}", # DAGGER WITH LEFT/RIGHT GUARD "\x{2E42}" => "\x{201E}", # DOUBLE LOW-REVERSED-9 QUOTATION MARK, DOUBLE LOW-9 QUOTATION MARK "\x{2E55}" => "\x{2E56}", # LEFT/RIGHT SQUARE BRACKET WITH STROKE "\x{2E57}" => "\x{2E58}", # LEFT/RIGHT SQUARE BRACKET WITH DOUBLE STROKE "\x{2E59}" => "\x{2E5A}", # TOP HALF LEFT/RIGHT PARENTHESIS "\x{2E5B}" => "\x{2E5C}", # BOTTOM HALF LEFT/RIGHT PARENTHESIS "\x{3008}" => "\x{3009}", # LEFT/RIGHT ANGLE BRACKET "\x{300A}" => "\x{300B}", # LEFT/RIGHT DOUBLE ANGLE BRACKET "\x{300C}" => "\x{300D}", # LEFT/RIGHT CORNER BRACKET "\x{300E}" => "\x{300F}", # LEFT/RIGHT WHITE CORNER BRACKET "\x{3010}" => "\x{3011}", # LEFT/RIGHT BLACK LENTICULAR BRACKET "\x{3014}" => "\x{3015}", # LEFT/RIGHT TORTOISE SHELL BRACKET "\x{3016}" => "\x{3017}", # LEFT/RIGHT WHITE LENTICULAR BRACKET "\x{3018}" => "\x{3019}", # LEFT/RIGHT WHITE TORTOISE SHELL BRACKET "\x{301A}" => "\x{301B}", # LEFT/RIGHT WHITE SQUARE BRACKET "\x{301D}" => "\x{301E}", # REVERSED DOUBLE PRIME QUOTATION MARK, DOUBLE PRIME QUOTATION MARK "\x{A9C1}" => "\x{A9C2}", # JAVANESE LEFT/RIGHT RERENGGAN "\x{FD3E}" => "\x{FD3F}", # ORNATE LEFT/RIGHT PARENTHESIS "\x{FE59}" => "\x{FE5A}", # SMALL LEFT/RIGHT PARENTHESIS "\x{FE5B}" => "\x{FE5C}", # SMALL LEFT/RIGHT CURLY BRACKET "\x{FE5D}" => "\x{FE5E}", # SMALL LEFT/RIGHT TORTOISE SHELL BRACKET "\x{FE64}" => "\x{FE65}", # SMALL LESS-THAN/GREATER-THAN SIGN "\x{FF08}" => "\x{FF09}", # FULLWIDTH LEFT/RIGHT PARENTHESIS "\x{FF1C}" => "\x{FF1E}", # FULLWIDTH LESS-THAN/GREATER-THAN SIGN "\x{FF3B}" => "\x{FF3D}", # FULLWIDTH LEFT/RIGHT SQUARE BRACKET "\x{FF5B}" => "\x{FF5D}", # FULLWIDTH LEFT/RIGHT CURLY BRACKET "\x{FF5F}" => "\x{FF60}", # FULLWIDTH LEFT/RIGHT WHITE PARENTHESIS "\x{FF62}" => "\x{FF63}", # HALFWIDTH LEFT/RIGHT CORNER BRACKET "\x{FFEB}" => "\x{FFE9}", # HALFWIDTH RIGHT/LEFTWARDS ARROW "\x{1D103}" => "\x{1D102}", # MUSICAL SYMBOL REVERSE FINAL BARLINE, MUSICAL SYMBOL FINAL BARLINE "\x{1D106}" => "\x{1D107}", # MUSICAL SYMBOL LEFT/RIGHT REPEAT SIGN "\x{1F449}" => "\x{1F448}", # WHITE RIGHT/LEFT POINTING BACKHAND INDEX "\x{1F508}" => "\x{1F568}", # SPEAKER, RIGHT SPEAKER "\x{1F509}" => "\x{1F569}", # SPEAKER WITH ONE SOUND WAVE, RIGHT SPEAKER WITH ONE SOUND WAVE "\x{1F50A}" => "\x{1F56A}", # SPEAKER WITH THREE SOUND WAVES, RIGHT SPEAKER WITH THREE SOUND WAVES "\x{1F57B}" => "\x{1F57D}", # LEFT/RIGHT HAND TELEPHONE RECEIVER "\x{1F599}" => "\x{1F598}", # SIDEWAYS WHITE RIGHT/LEFT POINTING INDEX "\x{1F59B}" => "\x{1F59A}", # SIDEWAYS BLACK RIGHT/LEFT POINTING INDEX "\x{1F59D}" => "\x{1F59C}", # BLACK RIGHT/LEFT POINTING BACKHAND INDEX "\x{1F5E6}" => "\x{1F5E7}", # THREE RAYS LEFT/RIGHT "\x{1F802}" => "\x{1F800}", # RIGHT/LEFTWARDS ARROW WITH SMALL TRIANGLE ARROWHEAD "\x{1F806}" => "\x{1F804}", # RIGHT/LEFTWARDS ARROW WITH MEDIUM TRIANGLE ARROWHEAD "\x{1F80A}" => "\x{1F808}", # RIGHT/LEFTWARDS ARROW WITH LARGE TRIANGLE ARROWHEAD "\x{1F812}" => "\x{1F810}", # RIGHT/LEFTWARDS ARROW WITH SMALL EQUILATERAL ARROWHEAD "\x{1F816}" => "\x{1F814}", # RIGHT/LEFTWARDS ARROW WITH EQUILATERAL ARROWHEAD "\x{1F81A}" => "\x{1F818}", # HEAVY RIGHT/LEFTWARDS ARROW WITH EQUILATERAL ARROWHEAD "\x{1F81E}" => "\x{1F81C}", # HEAVY RIGHT/LEFTWARDS ARROW WITH LARGE EQUILATERAL ARROWHEAD "\x{1F822}" => "\x{1F820}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH NARROW SHAFT "\x{1F826}" => "\x{1F824}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH MEDIUM SHAFT "\x{1F82A}" => "\x{1F828}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH BOLD SHAFT "\x{1F82E}" => "\x{1F82C}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH HEAVY SHAFT "\x{1F832}" => "\x{1F830}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH VERY HEAVY SHAFT "\x{1F836}" => "\x{1F834}", # RIGHT/LEFTWARDS FINGER-POST ARROW "\x{1F83A}" => "\x{1F838}", # RIGHT/LEFTWARDS SQUARED ARROW "\x{1F83E}" => "\x{1F83C}", # RIGHT/LEFTWARDS COMPRESSED ARROW "\x{1F842}" => "\x{1F840}", # RIGHT/LEFTWARDS HEAVY COMPRESSED ARROW "\x{1F846}" => "\x{1F844}", # RIGHT/LEFTWARDS HEAVY ARROW "\x{1F852}" => "\x{1F850}", # RIGHT/LEFTWARDS SANS-SERIF ARROW "\x{1F862}" => "\x{1F860}", # WIDE-HEADED RIGHT/LEFTWARDS LIGHT BARB ARROW "\x{1F86A}" => "\x{1F868}", # WIDE-HEADED RIGHT/LEFTWARDS BARB ARROW "\x{1F872}" => "\x{1F870}", # WIDE-HEADED RIGHT/LEFTWARDS MEDIUM BARB ARROW "\x{1F87A}" => "\x{1F878}", # WIDE-HEADED RIGHT/LEFTWARDS HEAVY BARB ARROW "\x{1F882}" => "\x{1F880}", # WIDE-HEADED RIGHT/LEFTWARDS VERY HEAVY BARB ARROW "\x{1F892}" => "\x{1F890}", # RIGHT/LEFTWARDS TRIANGLE ARROWHEAD "\x{1F896}" => "\x{1F894}", # RIGHT/LEFTWARDS WHITE ARROW WITHIN TRIANGLE ARROWHEAD "\x{1F89A}" => "\x{1F898}", # RIGHT/LEFTWARDS ARROW WITH NOTCHED TAIL "\x{1F8A1}" => "\x{1F8A0}", # RIGHTWARDS BOTTOM SHADED WHITE ARROW, LEFTWARDS BOTTOM-SHADED WHITE ARROW "\x{1F8A3}" => "\x{1F8A2}", # RIGHT/LEFTWARDS TOP SHADED WHITE ARROW "\x{1F8A5}" => "\x{1F8A6}", # RIGHT/LEFTWARDS RIGHT-SHADED WHITE ARROW "\x{1F8A7}" => "\x{1F8A4}", # RIGHT/LEFTWARDS LEFT-SHADED WHITE ARROW "\x{1F8A9}" => "\x{1F8A8}", # RIGHT/LEFTWARDS BACK-TILTED SHADOWED WHITE ARROW "\x{1F8AB}" => "\x{1F8AA}", # RIGHT/LEFTWARDS FRONT-TILTED SHADOWED WHITE ARROW ); } sub decomment { if ($] >= 5.014 && $] < 5.016) { _croak( "PPR::decomment() does not work under Perl 5.14" )} my ($str) = @_; local %PPR::comment_len; # Locate comments... $str =~ m{ (?&PerlEntireDocument) (?(DEFINE) (? ( (? (?: \h++ | (?&PPR_newline_and_heredoc) | (?&decomment) | __ (?> END | DATA ) __ \b .*+ \z )*+ ) # End of rule (? (?: \h++ | (?&PPR_newline_and_heredoc) | (?&decomment) | __ (?> END | DATA ) __ \b .*+ \z )++ ) # End of rule (? ( ^ = [^\W\d]\w*+ .*? (?> ^ = cut \b [^\n]*+ $ | \z ) ) (?{ my $len = length($^N); my $pos = pos() - $len; $PPR::comment_len{$pos} = $len; }) ) # End of rule $PPR::GRAMMAR ) }xms or return; # Delete the comments found... for my $from_pos (_uniq(sort { $b <=> $a } keys %PPR::comment_len)) { substr($str, $from_pos, $PPR::comment_len{$from_pos}) =~ s/.+//g; } return $str; } sub _uniq { my %seen; return grep {!$seen{$_}++} @_; } sub _croak { require Carp; Carp::croak(@_); } sub _report { state $CONTEXT_WIDTH = 20; state $BUFFER = q{ } x $CONTEXT_WIDTH; state $depth = 0; my ($msg, $increment) = @_; $depth++ if $increment; my $at = pos(); my $str = $BUFFER . $_ . $BUFFER; my $pre = substr($str, $at, $CONTEXT_WIDTH); my $post = substr($str, $at+$CONTEXT_WIDTH, $CONTEXT_WIDTH); tr/\n/ / for $pre, $post; no warnings 'utf8'; warn sprintf("%05d ⎜%*s⎜%-*s⎜ %s%s\n", $at, $CONTEXT_WIDTH, $pre, $CONTEXT_WIDTH, $post, q{ } x $depth, $msg); $depth-- if !$increment; } 1; # Magic true value required at end of module __END__ =head1 NAME PPR - Pattern-based Perl Recognizer =head1 VERSION This document describes PPR version 0.001010 =head1 SYNOPSIS use PPR; # Define a regex that will match an entire Perl document... my $perl_document = qr{ # What to match # Install the (?&PerlDocument) rule (?&PerlEntireDocument) $PPR::GRAMMAR }x; # Define a regex that will match a single Perl block... my $perl_block = qr{ # What to match... # Install the (?&PerlBlock) rule... (?&PerlBlock) $PPR::GRAMMAR }x; # Define a regex that will match a simple Perl extension... my $perl_coroutine = qr{ # What to match... coro (?&PerlOWS) (? (?&PerlQualifiedIdentifier) ) (?&PerlOWS) (? (?&PerlBlock) ) # Install the necessary subrules... $PPR::GRAMMAR }x; # Define a regex that will match an integrated Perl extension... my $perl_with_classes = qr{ # What to match... \A (?&PerlOWS) # Optional whitespace (including comments) (?&PerlDocument) # A full Perl document (?&PerlOWS) # More optional whitespace \Z # Add a 'class' keyword into the syntax that PPR understands... (?(DEFINE) (? class (?&PerlOWS) (?&PerlQualifiedIdentifier) (?&PerlOWS) (?: is (?&PerlNWS) (?&PerlIdentifier) (?&PerlOWS) )*+ (?&PerlBlock) ) (? \( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) ) # Install the necessary standard subrules... $PPR::GRAMMAR }x; =head1 DESCRIPTION The PPR module provides a single regular expression that defines a set of independent subpatterns suitable for matching entire Perl documents, as well as a wide range of individual syntactic components of Perl (i.e. statements, expressions, control blocks, variables, etc.) The regex does not "parse" Perl (that is, it does not build a syntax tree, like the PPI module does). Instead it simply "recognizes" standard Perl constructs, or new syntaxes composed from Perl constructs. Its features and capabilities therefore complement those of the PPI module, rather than replacing them. See L<"Comparison with PPI">. =head1 INTERFACE =head2 Importing and using the Perl grammar regex The PPR module exports no subroutines or variables, and provides no methods. Instead, it defines a single package variable, C<$PPR::GRAMMAR>, which can be interpolated into regexes to add rules that permit Perl constructs to be parsed: $source_code =~ m{ (?&PerlEntireDocument) $PPR::GRAMMAR }x; Note that all the examples shown so far have interpolated this "grammar variable" at the end of the regular expression. This placement is desirable, but not necessary. Both of the following work identically: $source_code =~ m{ (?&PerlEntireDocument) $PPR::GRAMMAR }x; $source_code =~ m{ $PPR::GRAMMAR (?&PerlEntireDocument) }x; However, if the grammar is to be L, then the extensions must be specified B> the base grammar (i.e. before the interpolation of C<$PPR::GRAMMAR>). Placing the grammar variable at the end of a regex ensures that will be the case, and has the added advantage of "front-loading" the regex with the most important information: what is actually going to be matched. Note too that, because the PPR grammar internally uses capture groups, placing C<$PPR::GRAMMAR> anywhere other than the very end of your regex may change the numbering of any explicit capture groups in your regex. For complete safety, regexes that use the PPR grammar should probably use named captures, instead of numbered captures. =head2 Error reporting Regex-based parsing is all-or-nothing: either your regex matches (and returns any captures you requested), or it fails to match (and returns nothing). This can make it difficult to detect I a PPR-based match failed; to work out what the "bad source code" was that prevented your regex from matching. So the module provides a special variable that attempts to detect the source code that prevented any call to the C<(?&PerlStatement)> subpattern from matching. That variable is: C<$PPR::ERROR> C<$PPR::ERROR> is only set if it is undefined at the point where an error is detected, and will only be set to the first such error that is encountered during parsing. Note that errors are only detected when matching context-sensitive components (for example in the middle of a C<(?&PerlStatement), as part of a C<(?&PerlContextualRegex)>, or at the end of a C<(?&PerlEntireDocument>)>. Errors, especially errors at the end of otherwise valid code, will often not be detected in context-free components (for example, at the end of a C<(?&PerlStatementSequence), as part of a C<(?&PerlRegex)>, or at the end of a C<(?&PerlDocument>)>. A common mistake in this area is to attempt to match an entire Perl document using: m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }x instead of: m{ (?&PerlEntireDocument) $PPR::GRAMMAR }x Only the second approach will be able to successfully detect an unclosed curly bracket at the end of the document. =head3 C interface If it is set, C<$PPR::ERROR> will contain an object of type PPR::ERROR, with the following methods: =over =item C<< $PPR::ERROR->origin($line, $file) >> Returns a clone of the PPR::ERROR object that now believes that the source code parsing failure it is reporting occurred in a code fragment starting at the specified line and file. If the second argument is omitted, the file name is not reported in any diagnostic. =item C<< $PPR::ERROR->source() >> Returns a string containing the specific source code that could not be parsed as a Perl statement. =item C<< $PPR::ERROR->prefix() >> Returns a string containing all the source code preceding the code that could not be parsed. That is: the valid code that is the preceding context of the unparsable code. =item C<< $PPR::ERROR->line( $opt_offset ) >> Returns an integer which is the line number at which the unparsable code was encountered. If the optional "offset" argument is provided, it will be added to the line number returned. Note that the offset is ignored if the PPR::ERROR object originates from a prior call to C<< $PPR::ERROR->origin >> (because in that case you will have already specified the correct offset). =item C<< $PPR::ERROR->diagnostic() >> Returns a string containing the diagnostic that would be returned by C if the source code were compiled. B> The diagnostic is obtained by partially eval'ing the source code. This means that run-time code will not be executed, but C and C blocks will run. Do B> call this method if the source code that created this error might also have non-trivial compile-time side-effects. =back A typical use might therefore be: # Make sure it's undefined, and will only be locally modified... local $PPR::ERROR; # Process the matched block... if ($source_code =~ m{ (? (?&PerlBlock) ) $PPR::GRAMMAR }x) { process( $+{Block} ); } # Or report the offending code that stopped it being a valid block... else { die "Invalid Perl block: " . $PPR::ERROR->source . "\n", $PPR::ERROR->origin($linenum, $filename)->diagnostic . "\n"; } =head2 Decommenting code with C The module provides (but does not export) a C subroutine that can remove any comments and/or POD from source code. It takes a single argument: a string containing the course code. It returns a single value: a string containing the decommented source code. For example: $decommented_code = PPR::decomment( $commented_code ); The subroutine will fail if the argument wasn't valid Perl code, in which case it returns C and sets C<$PPR::ERROR> to indicate where the invalid source code was encountered. Note that, due to separate bugs in the regex engine in Perl 5.14 and 5.20, the C subroutine is not available when running under these releases. =head2 Examples I In each of the following examples, the subroutine C is used to acquire the source code from a file whose name is passed as its argument. The C subroutine is just: sub slurp { local (*ARGV, $/); @ARGV = shift; readline; } or, for the less twisty-minded: sub slurp { my ($filename) = @_; open my $filehandle, '<', $filename or die $!; local $/; return readline($filehandle); } =head3 Validating source code # "Valid" if source code matches a Perl document under the Perl grammar printf( "$filename %s a valid Perl file\n", slurp($filename) =~ m{ (?&PerlEntireDocument) $PPR::GRAMMAR }x ? "is" : "is not" ); =head3 Counting statements printf( # Output "$filename contains %d statements\n", # a report of scalar # the count of grep {defined} # defined matches slurp($filename) # from the source code, =~ m{ \G (?&PerlOWS) # skipping whitespace ((?&PerlStatement)) # and keeping statements, $PPR::GRAMMAR # using the Perl grammar }gcx; # incrementally ); =head3 Stripping comments and POD from source code my $source = slurp($filename); # Get the source $source =~ s{ (?&PerlNWS) $PPR::GRAMMAR }{ }gx; # Compact whitespace print $source; # Print the result =head3 Stripping comments and POD from source code (in Perl v5.14 or later) # Print the source code, having compacted whitespace... print slurp($filename) =~ s{ (?&PerlNWS) $PPR::GRAMMAR }{ }gxr; =head3 Stripping everything C comments and POD from source code say # Output grep {defined} # defined matches slurp($filename) # from the source code, =~ m{ \G ((?&PerlOWS)) # keeping whitespace, (?&PerlStatement)? # skipping statements, $PPR::GRAMMAR # using the Perl grammar }gcx; # incrementally =head2 Available rules Interpolating C<$PPR::GRAMMAR> in a regex makes all of the following rules available within that regex. Note that other rules not listed here may also be added, but these are all considered strictly internal to the PPR module and are not guaranteed to continue to exist in future releases. All such "internal-use-only" rules have names that start with C... =head3 C<< (?&PerlDocument) >> Matches a valid Perl document, including leading or trailing whitespace, comments, and any final C<__DATA__> or C<__END__> section. This rule is context-free, so it can be embedded in a larger regex. For example, to match an embedded chunk of Perl code, delimited by C<<<< <<< >>>>...C<<<< >>> >>>>: $src = m{ <<< (?&PerlDocument) >>> $PPR::GRAMMAR }x; =head3 C<< (?&PerlEntireDocument) >> Matches an entire valid Perl document, including leading or trailing whitespace, comments, and any final C<__DATA__> or C<__END__> section. This rule is I context-free. It has an internal C<\A> at the beginning and C<\Z> at the end, so a regex containing C<(?&PerlEntireDocument)> will only match if: =over =item (a) the C<(?&PerlEntireDocument)> is the sole top-level element of the regex (or, at least the sole element of a single top-level C<|>-branch of the regex), =item B> =item (b) the entire string being matched contains only a single valid Perl document. =back In general, if you want to check that a string consists entirely of a single valid sequence of Perl code, use: $str =~ m{ (?&PerlEntireDocument) $PPR::GRAMMAR } If you want to check that a string I at least one valid sequence of Perl code at some point, possibly embedded in other text, use: $str =~ m{ (?&PerlDocument) $PPR::GRAMMAR } =head3 C<< (?&PerlStatementSequence) >> Matches zero-or-more valid Perl statements, separated by optional POD sequences. =head3 C<< (?&PerlStatement) >> Matches a single valid Perl statement, including: control structures; C, C, C, C, C, C, or C blocks; variable declarations, C statements, etc. =head3 C<< (?&PerlExpression) >> Matches a single valid Perl expression involving operators of any precedence, but not any kind of block (i.e. not control structures, C blocks, etc.) nor any trailing statement modifier (e.g. not a postfix C, C, or C). =head3 C<< (?&PerlLowPrecedenceNotExpression) >> Matches an expression at the precedence of the C operator. That is, a single valid Perl expression that involves operators above the precedence of C. =head3 C<< (?&PerlAssignment) >> Matches an assignment expression. That is, a single valid Perl expression involving operators above the precedence of comma (C<,> or C<< => >>). =head3 C<< (?&PerlConditionalExpression) >> or C<< (?&PerlScalarExpression) >> Matches a conditional expression that uses the C...C<:> ternary operator. That is, a single valid Perl expression involving operators above the precedence of assignment. The alterative name comes from the fact that anything matching this rule is what most people think of as a single element of a comma-separated list. =head3 C<< (?&PerlBinaryExpression) >> Matches an expression that uses any high-precedence binary operators. That is, a single valid Perl expression involving operators above the precedence of the ternary operator. =head3 C<< (?&PerlPrefixPostfixTerm) >> Matches a term with optional prefix and/or postfix unary operators and/or a trailing sequence of C<< -> >> dereferences. That is, a single valid Perl expression involving operators above the precedence of exponentiation (C<**>). =head3 C<< (?&PerlTerm) >> Matches a simple high-precedence term within a Perl expression. That is: a subroutine or builtin function call; a variable declaration; a variable or typeglob lookup; an anonymous array, hash, or subroutine constructor; a quotelike or numeric literal; a regex match; a substitution; a transliteration; a C or C block; or any other expression in surrounding parentheses. =head3 C<< (?&PerlTermPostfixDereference) >> Matches a sequence of array- or hash-lookup brackets, or subroutine call parentheses, or a postfix dereferencer (e.g. C<< ->$* >>), with explicit or implicit intervening C<< -> >>, such as might appear after a term. =head3 C<< (?&PerlLvalue) >> Matches any variable or parenthesized list of variables that could be assigned to. =head3 C<< (?&PerlPackageDeclaration) >> Matches the declaration of any package (with or without a defining block). =head3 C<< (?&PerlSubroutineDeclaration) >> Matches the declaration of any named subroutine (with or without a defining block). =head3 C<< (?&PerlUseStatement) >> Matches a C<< use ...; >> or C<< use ; >> statement. =head3 C<< (?&PerlReturnStatement) >> Matches a C<< return ; >> or C<< return; >> statement. =head3 C<< (?&PerlReturnExpression) >> Matches a C<< return >> as an expression without trailing end-of-statement markers. =head3 C<< (?&PerlControlBlock) >> Matches an C, C, C, C, C, or C statement, including its block. =head3 C<< (?&PerlDoBlock) >> Matches a C-block expression. =head3 C<< (?&PerlEvalBlock) >> Matches a C-block expression. =head3 C<< (?&PerlTryCatchFinallyBlock) >> Matches an C block, followed by an option C block, followed by an optional C block, using the built-in syntax introduced in Perl v5.34 and v5.36. Note that if your code uses one of the many CPAN modules (such as C or C) that provided try/catch behaviours prior to Perl v5.34, then you will most likely need to override this subrule to match the alternate C/C syntax provided by your preferred module. For example, if your code uses the C module, you would need to alter the PPR parser by explicitly redefining the subrule for C blocks, with something like: my $MATCH_A_PERL_DOCUMENT = qr{ \A (?&PerlEntireDocument) \Z (?(DEFINE) # Redefine this subrule to match TryCatch syntax... (? try (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) catch (?>(?&PerlOWS)) (?: \( (?>(?&PPR_balanced_parens)) \) (?>(?&PerlOWS)) )?+ (?>(?&PerlBlock)) )*+ ) ) $PPR::GRAMMAR }xms; Note that the popular C module actually implements C/C as a normally parsed Perl subroutine call expression, rather than a statement. This means that the unmodified PPR grammar can successfully parse all the module's constructs. However, the unmodified PPR grammar may misclassify some C usages as being built-in Perl v5.36 C blocks followed by an unrelated call to the C subroutine, rather than identifying the C and C as a single expression containing two subroutine calls. If that difference in interpretation matters to you, you can deactivate the built-in Perl v5.36 C/C syntax entirely, like so: my $MATCH_A_PERL_DOCUMENT = qr{ \A (?&PerlEntireDocument) \Z (?(DEFINE) # Turn off built-in try/catch syntax... (? (?!) ) # Decanonize 'try' and 'catch' as reserved words ineligible for sub names... (? (?! (?> for(?:each)?+ | while | if | unless | until | given | when | default | sub | format | use | no | my | our | state | defer | finally # Note: Removed 'try' and 'catch' which appear here in the original subrule | (?&PPR_X_named_op) | [msy] | q[wrxq]?+ | tr | __ (?> END | DATA ) __ ) \b ) (?>(?&PerlQualifiedIdentifier)) (?! :: ) ) ) $PPR::GRAMMAR }xms; For more details and options for modifying PPR grammars in this way, see also the documentation of the C module. =head3 C<< (?&PerlStatementModifier) >> Matches an C, C, C, C, C, or C modifier that could appear after a statement. Only matches the modifier, not the preceding statement. =head3 C<< (?&PerlFormat) >> Matches a C declaration, including its terminating "dot". =head3 C<< (?&PerlBlock) >> Matches a C<{>...C<}>-delimited block containing zero-or-more statements. =head3 C<< (?&PerlCall) >> Matches a call to a subroutine or built-in function. Accepts all valid call syntaxes, either via a literal names or a reference, with or without a leading C<&>, with or without arguments, with or without parentheses on any argument list. =head3 C<< (?&PerlAttributes) >> Matches a list of colon-preceded attributes, such as might be specified on the declaration of a subroutine or a variable. =head3 C<< (?&PerlCommaList) >> Matches a list of zero-or-more comma-separated subexpressions. That is, a single valid Perl expression that involves operators above the precedence of C. =head3 C<< (?&PerlParenthesesList) >> Matches a list of zero-or-more comma-separated subexpressions inside a set of parentheses. =head3 C<< (?&PerlList) >> Matches either a parenthesized or unparenthesized list of comma-separated subexpressions. That is, matches anything that either of the two preceding rules would match. =head3 C<< (?&PerlAnonymousArray) >> Matches an anonymous array constructor. That is: a list of zero-or-more subexpressions inside square brackets. =head3 C<< (?&PerlAnonymousHash) >> Matches an anonymous hash constructor. That is: a list of zero-or-more subexpressions inside curly brackets. =head3 C<< (?&PerlArrayIndexer) >> Matches a valid indexer that could be applied to look up elements of a array. That is: a list of or one-or-more subexpressions inside square brackets. =head3 C<< (?&PerlHashIndexer) >> Matches a valid indexer that could be applied to look up entries of a hash. That is: a list of or one-or-more subexpressions inside curly brackets, or a simple bareword indentifier inside curley brackets. =head3 C<< (?&PerlDiamondOperator) >> Matches anything in angle brackets. That is: any "diamond" readline (e.g. C<< <$filehandle> >> or file-grep operation (e.g. C<< <*.pl> >>). =head3 C<< (?&PerlComma) >> Matches a short (C<,>) or long (C<< => >>) comma. =head3 C<< (?&PerlPrefixUnaryOperator) >> Matches any high-precedence prefix unary operator. =head3 C<< (?&PerlPostfixUnaryOperator) >> Matches any high-precedence postfix unary operator. =head3 C<< (?&PerlInfixBinaryOperator) >> Matches any infix binary operator whose precedence is between C<..> and C<**>. =head3 C<< (?&PerlAssignmentOperator) >> Matches any assignment operator, including all IC<=> variants. =head3 C<< (?&PerlLowPrecedenceInfixOperator) >> Matches C, , or C. =head3 C<< (?&PerlAnonymousSubroutine) >> Matches an anonymous subroutine. =head3 C<< (?&PerlVariable) >> Matches any type of access on any scalar, array, or hash variable. =head3 C<< (?&PerlVariableScalar) >> Matches any scalar variable, including fully qualified package variables, punctuation variables, scalar dereferences, and the C<$#array> syntax. =head3 C<< (?&PerlVariableArray) >> Matches any array variable, including fully qualified package variables, punctuation variables, and array dereferences. =head3 C<< (?&PerlVariableHash) >> Matches any hash variable, including fully qualified package variables, punctuation variables, and hash dereferences. =head3 C<< (?&PerlTypeglob) >> Matches a typeglob. =head3 C<< (?&PerlScalarAccess) >> Matches any kind of variable access beginning with a C<$>, including fully qualified package variables, punctuation variables, scalar dereferences, the C<$#array> syntax, and single-value array or hash look-ups. =head3 C<< (?&PerlScalarAccessNoSpace) >> Matches any kind of variable access beginning with a C<$>, including fully qualified package variables, punctuation variables, scalar dereferences, the C<$#array> syntax, and single-value array or hash look-ups. But does not allow spaces between the components of the variable access (i.e. imposes the same constraint as within an interpolating quotelike). =head3 C<< (?&PerlScalarAccessNoSpaceNoArrow) >> Matches any kind of variable access beginning with a C<$>, including fully qualified package variables, punctuation variables, scalar dereferences, the C<$#array> syntax, and single-value array or hash look-ups. But does not allow spaces or arrows between the components of the variable access (i.e. imposes the same constraint as within a C<< <...> >>-delimited interpolating quotelike). =head3 C<< (?&PerlArrayAccess) >> Matches any kind of variable access beginning with a C<@>, including arrays, array dereferences, and list slices of arrays or hashes. =head3 C<< (?&PerlArrayAccessNoSpace) >> Matches any kind of variable access beginning with a C<@>, including arrays, array dereferences, and list slices of arrays or hashes. But does not allow spaces between the components of the variable access (i.e. imposes the same constraint as within an interpolating quotelike). =head3 C<< (?&PerlArrayAccessNoSpaceNoArrow) >> Matches any kind of variable access beginning with a C<@>, including arrays, array dereferences, and list slices of arrays or hashes. But does not allow spaces or arrows between the components of the variable access (i.e. imposes the same constraint as within a C<< <...> >>-delimited interpolating quotelike). =head3 C<< (?&PerlHashAccess) >> Matches any kind of variable access beginning with a C<%>, including hashes, hash dereferences, and kv-slices of hashes or arrays. =head3 C<< (?&PerlLabel) >> Matches a colon-terminated label. =head3 C<< (?&PerlLiteral) >> Matches a literal value. That is: a number, a C or C quotelike, a string, or a bareword. =head3 C<< (?&PerlString) >> Matches a string literal. That is: a single- or double-quoted string, a C or C string, a heredoc, or a version string. =head3 C<< (?&PerlQuotelike) >> Matches any form of quotelike operator. That is: a single- or double-quoted string, a C or C string, a heredoc, a version string, a C, a C, a C, a C or C regex, a substitution, or a transliteration. =head3 C<< (?&PerlHeredoc) >> Matches a heredoc specifier. That is: just the initial C<< < >> component, I the actual contents of the heredoc on the subsequent lines. This rule only matches a heredoc specifier if that specifier is correctly followed on the next line by any heredoc contents and then the correct terminator. However, if the heredoc specifier I correctly matched, subsequent calls to either of the whitespace-matching rules (C<(?&PerlOWS)> or C<(?&PerlNWS)>) will also consume the trailing heredoc contents and the terminator. So, for example, to correctly match a heredoc plus its contents you could use something like: m/ (?&PerlHeredoc) (?&PerlOWS) $PPR::GRAMMAR /x or, if there may be trailing items on the same line as the heredoc specifier: m/ (?&PerlHeredoc) (? [^\n]* ) (?&PerlOWS) $PPR::GRAMMAR /x Note that the saeme limitations apply to other constructs that match heredocs, such a C<< (?&PerlQuotelike) >> or C<< (?&PerlString) >>. =head3 C<< (?&PerlQuotelikeQ) >> Matches a single-quoted string, either a C<'...'> or a C (with any valid delimiters). =head3 C<< (?&PerlQuotelikeQQ) >> Matches a double-quoted string, either a C<"..."> or a C (with any valid delimiters). =head3 C<< (?&PerlQuotelikeQW) >> Matches a "quotewords" list. That is a C (with any valid delimiters). =head3 C<< (?&PerlQuotelikeQX) >> Matches a C system call, either a C<`...`> or a C (with any valid delimiters) =head3 C<< (?&PerlQuotelikeS) >> or C<< (?&PerlSubstitution) >> Matches a substitution operation. That is: C (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlQuotelikeTR) >> or C<< (?&PerlTransliteration) >> Matches a transliteration operation. That is: C or C (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlContextualQuotelikeM) >> or C<< (?&PerContextuallMatch) >> Matches a regex-match operation in any context where it would be allowed in valid Perl. That is: C or C (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlQuotelikeM) >> or C<< (?&PerlMatch) >> Matches a regex-match operation. That is: C or C (with any valid delimiters and any valid trailing modifiers) in any context (i.e. even in places where it would not normally be allowed within a valid piece of Perl code). =head3 C<< (?&PerlQuotelikeQR) >> Matches a C regex constructor (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlContextualRegex) >> Matches a C regex constructor or a C or C regex-match operation (with any valid delimiters and any valid trailing modifiers) anywhere where either would be allowed in valid Perl. In other words: anything capable of matching within valid Perl code. =head3 C<< (?&PerlRegex) >> Matches a C regex constructor or a C or C regex-match operation in any context (i.e. even in places where it would not normally be allowed within a valid piece of Perl code). In other words: anything capable of matching. =head3 C<< (?&PerlBuiltinFunction) >> Matches the I of any builtin function. To match an actual call to a built-in function, use: m/ (?= (?&PerlBuiltinFunction) ) (?&PerlCall) /x =head3 C<< (?&PerlNullaryBuiltinFunction) >> Matches the name of any builtin function that never takes arguments. To match an actual call to a built-in function that never takes arguments, use: m/ (?= (?&PerlNullaryBuiltinFunction) ) (?&PerlCall) /x =head3 C<< (?&PerlVersionNumber) >> Matches any number or version-string that can be used as a version number within a C, C, or C statement. =head3 C<< (?&PerlVString) >> Matches a version-string (a.k.a v-string). =head3 C<< (?&PerlNumber) >> Matches a valid number, including binary, octal, decimal and hexadecimal integers, and floating-point numbers with or without an exponent. =head3 C<< (?&PerlIdentifier) >> Matches a simple, unqualified identifier. =head3 C<< (?&PerlQualifiedIdentifier) >> Matches a qualified or unqualified identifier, which may use either C<::> or C<'> as internal separators, but only C<::> as initial or terminal separators. =head3 C<< (?&PerlOldQualifiedIdentifier) >> Matches a qualified or unqualified identifier, which may use either C<::> or C<'> as both internal and external separators. =head3 C<< (?&PerlBareword) >> Matches a valid bareword. Note that this is not the same as an simple identifier, nor the same as a qualified identifier. =head3 C<< (?&PerlPod) >> Matches a single POD section containing any contiguous set of POD directives, up to the first C<=cut> or end-of-file. =head3 C<< (?&PerlPodSequence) >> Matches any sequence of POD sections, separated and /or surrounded by optional whitespace. =head3 C<< (?&PerlNWS) >> Match one-or-more characters of necessary whitespace, including spaces, tabs, newlines, comments, and POD. =head3 C<< (?&PerlOWS) >> Match zero-or-more characters of optional whitespace, including spaces, tabs, newlines, comments, and POD. =head3 C<< (?&PerlOWSOrEND) >> Match zero-or-more characters of optional whitespace, including spaces, tabs, newlines, comments, POD, and any trailing C<__END__> or C<__DATA__> section. =head3 C<< (?&PerlEndOfLine) >> Matches a single newline (C<\n>) character. This is provided mainly to allow newlines to be "hooked" by redefining C<< (?) >> (for example, to count lines during a parse). =head3 C<< (?&PerlKeyword) >> Match a pluggable keyword. Note that there are no pluggable keywords in the default PPR regex; they must be added by the end-user. See the following section for details. =head2 Extending the Perl syntax with keywords In Perl 5.12 and later, it's possible to add new types of statements to the language using a mechanism called "pluggable keywords". This mechanism (best accessed via CPAN modules such as C or C) acts like a limited macro facility. It detects when a statement begins with a particular, pre-specified keyword, passes the trailing text to an associated keyword handler, and replaces the trailing source code with whatever the keyword handler produces. For example, the L module uses this mechanism to add keywords such as C, C, and C to Perl 5, providing a declarative OO syntax. And the L module uses pluggable keywords to add a C statement that simplifies returning an ad hoc object from a subroutine. Unfortunately, because such modules effectively extend the standard Perl syntax, by default PPR has no way of successfully parsing them. However, when setting up a regex using C<$PPR::GRAMMAR> it is possible to extend that grammar to deal with new keywords...by defining a rule named C<< (?...) >>. This rule is always tested as the first option within the standard C<(?&PerlStatement)> rule, so any syntax declared within effectively becomes a new kind of statement. Note that each alternative within the rule must begin with a valid "keyword" (that is: a simple identifier of some kind). For example, to support the three keywords from L: $Dios::GRAMMAR = qr{ # Add a keyword rule to support Dios... (?(DEFINE) (? class (?&PerlOWS) (?&PerlQualifiedIdentifier) (?&PerlOWS) (?: is (?&PerlNWS) (?&PerlIdentifier) (?&PerlOWS) )*+ (?&PerlBlock) | method (?&PerlOWS) (?&PerlIdentifier) (?&PerlOWS) (?: (?&kw_balanced_parens) (?&PerlOWS) )?+ (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?&PerlBlock) | has (?&PerlOWS) (?: (?&PerlQualifiedIdentifier) (?&PerlOWS) )?+ [\@\$%][.!]?(?&PerlIdentifier) (?&PerlOWS) (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?: (?: // )?+ = (?&PerlOWS) (?&PerlExpression) (?&PerlOWS) )?+ (?> ; | (?= \} ) | \z ) ) (? \( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) ) # Add all the standard PPR rules... $PPR::GRAMMAR }x; # Then parse with it... $source_code =~ m{ \A (?&PerlDocument) \Z $Dios::GRAMMAR }x; Or, to support the C statement from C: my $ORK_GRAMMAR = qr{ # Add a keyword rule to support Object::Result... (?(DEFINE) (? result (?&PerlOWS) \{ (?&PerlOWS) (?: (?> (?&PerlIdentifier) | < [[:upper:]]++ > ) (?&PerlOWS) (?&PerlParenthesesList)?+ (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) )*+ \} ) ) # Add all the standard PPR rules... $PPR::GRAMMAR }x; # Then parse with it... $source_code =~ m{ \A (?&PerlDocument) \Z $ORK_GRAMMAR }x; Note that, although pluggable keywords are only available from Perl 5.12 onwards, PPR will still accept C<(&?PerlKeyword)> extensions under Perl 5.10. =head2 Extending the Perl syntax in other ways Other modules (such as C and C) make it possible to extend Perl syntax in even more flexible ways. The L<< PPR::X >> module provides support for syntactic extensions more general than pluggable keywords. =begin PPR::X PPR::X allows I of its public rules to be redefined in a particular regex. For example, to create a regex that matches standard Perl syntax, but which allows the keyword C as a synonym for C: my $FUN_GRAMMAR = qr{ # Extend the subroutine-matching rules... (?(DEFINE) (? # Try the standard syntax... (?&PerlStdStatement) | # Try the new syntax... fun (?&PerlOWS) (?&PerlOldQualifiedIdentifier) (?&PerlOWS) (?: \( [^)]*+ \) )?+ (?&PerlOWS) (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?> ; | (?&PerlBlock) ) ) (? # Try the standard syntax (?&PerlStdAnonymousSubroutine) | # Try the new syntax fun (?&PerlOWS) (?: \( [^)]*+ \) )?+ (?&PerlOWS) (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?> ; | (?&PerlBlock) ) ) ) $PPR::X::GRAMMAR }x; Note first that any redefinitions of the various rules have to be specified before the interpolation of the standard rules (so that the new rules take syntactic precedence over the originals). The structure of each redefinition is essentially identical. First try the original rule, which is still accessible as C<(?&PerlStd...)> (instead of C<(?&Perl...)>). Otherwise, try the new alternative, which may be constructed out of other rules. original rule. There is no absolute requirement to try the original rule as part of the new rule, but if you don't then you are I the rule, rather than extending it. For example, to replace the low-precedence boolean operators (C, C, C, and C) with their Latin equivalents: my $GRAMMATICA = qr{ # Verbum sapienti satis est... (?(DEFINE) # Iunctiones... (? atque | vel | aut ) # Contradicetur... (? (?: non (?&PerlOWS) )*+ (?&PerlCommaList) ) ) $PPR::X::GRAMMAR }x; Or to maintain a line count within the parse: my $COUNTED_GRAMMAR = qr{ (?(DEFINE) (? # Try the standard syntax (?&PerlStdEndOfLine) # Then count the line (must localize, to handle backtracking)... (?{ local $linenum = $linenum + 1; }) ) ) $PPR::X::GRAMMAR }x; =end PPR::X =head2 Comparison with PPI The PPI and PPR modules can both identify valid Perl code, but they do so in very different ways, and are optimal for different purposes. PPI scans an entire Perl document and builds a hierarchical representation of the various components. It is therefore suitable for recognition, validation, partial extraction, and in-place transformation of Perl code. PPR matches only as much of a Perl document as specified by the regex you create, and does not build any hierarchical representation of the various components it matches. It is therefore suitable for recognition and validation of Perl code. However, unless great care is taken, PPR is not as reliable as PPI for extractions or transformations of components smaller than a single statement. On the other hand, PPI always has to parse its entire input, and build a complete non-trivial nested data structure for it, before it can be used to recognize or validate any component. So it is almost always significantly slower and more complicated than PPR for those kinds of tasks. For example, to determine whether an input string begins with a valid Perl block, PPI requires something like: if (my $document = PPI::Document->new(\$input_string) ) { my $block = $document->schild(0)->schild(0); if ($block->isa('PPI::Structure::Block')) { $block->remove; process_block($block); process_extra($document); } } whereas PPR needs just: if ($input_string =~ m{ \A (?&PerlOWS) ((?&PerlBlock)) (.*) }xs) { process_block($1); process_extra($2); } Moreover, the PPR version will be at least twice as fast at recognizing that leading block (and usually four to seven times faster)...mainly because it doesn't have to parse the trailing code at all, nor build any representation of its hierarchical structure. As a simple rule of thumb, when you only need to quickly detect, identify, or confirm valid Perl (or just a single valid Perl component), use PPR. When you need to examine, traverse, or manipulate the internal structure or component relationships within an entire Perl document, use PPI. =head1 DIAGNOSTICS =over =item C Due to an unsolved issue with that particular release of Perl, the single regex in the PPR module takes a ridiculously long time to compile under Perl 5.20 (i.e. minutes, not milliseconds). The code will work correctly when it eventually does compile, but the start-up delay is so extreme that the module issues this warning, to reassure users the something is actually happening, and explain why it's happening so slowly. The only remedy at present is to use an older or newer version of Perl. For all the gory details, see: L L =item C<< PPR::decomment() does not work under Perl 5.14 >> There is a separate bug in the Perl 5.14 regex engine that prevents the C subroutine from correctly detecting the location of comments. The subroutine throws an exception if you attempt to call it when running under Perl 5.14 specifically. =back The module has no other diagnostics, apart from those Perl provides for all regular expressions. The commonest error is to forget to add C<$PPR::GRAMMAR> to a regex, in which case you will get a standard Perl error message such as: Reference to nonexistent named group in regex; marked by <-- HERE in m/ (?&PerlDocument <-- HERE ) / at example.pl line 42. Adding C<$PPR::GRAMMAR> at the end of the regex solves the problem. =head1 CONFIGURATION AND ENVIRONMENT PPR requires no configuration files or environment variables. =head1 DEPENDENCIES Requires Perl 5.10 or later. =head1 INCOMPATIBILITIES None reported. =head1 LIMITATIONS This module works under all versions of Perl from 5.10 onwards. However, the lastest release of Perl 5.20 seems to have significant difficulties compiling large regular expressions, and typically requires over a minute to build any regex that incorporates the C<$PPR::GRAMMAR> rule definitions. The problem does not occur in Perl 5.10 to 5.18, nor in Perl 5.22 or later, though the parser is still measurably slower in all Perl versions greater than 5.20 (presumably because I regexes are measurably slower in more modern versions of Perl; such is the price of full re-entrancy and safe lexical scoping). The C subroutine trips a separate regex engine bug in Perl 5.14 only and will not run under that version. There was a lingering bug in regex re-interpolation between Perl 5.18 and 5.28, which means that interpolating a PPR grammar (or any other precompiled regex that uses the C<(??{...})> construct) into another regex sometimes does not work. In these cases, the spurious error message generated is usually: S>. This problem is unlikely ever to be resolved, as those versions of Perl are no longer being maintained. The only known workaround is to upgrade to Perl 5.30 or later. There are also constructs in Perl 5 which cannot be parsed without actually executing some code...which the regex does not attempt to do, for obvious reasons. =head1 BUGS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Damian Conway C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2017, Damian Conway C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. PPR-0.001010/lib/PPR/X.pm000644 000765 000024 00000504603 14700726003 014753 0ustar00damianstaff000000 000000 package PPR::X; use 5.010; use if $] < 5.018004, re => 'eval'; BEGIN { if ($] >= 5.020 && $] <= 5.021) { say {STDERR} <<" END_WARNING" Warning: This program is running under Perl $^V and uses the PPR::X module. Due to an unresolved issue with compilation of large regexes in this version of Perl, your code is likely to compile extremely slowly (i.e. it may take more than a minute). PPR::X is being loaded at ${\join ' line ', (caller(2))[1,2]}. END_WARNING } } use warnings; our $VERSION = '0.001009'; use utf8; use List::Util qw; # Class for $PPR::X::ERROR objects... { package PPR::X::ERROR; use overload q{""} => 'source', q{0+} => 'line', fallback => 1; sub new { my ($class, %obj) = @_; return bless \%obj, $class; } sub prefix { return shift->{prefix} } sub source { return shift->{source} } sub line { my $self = shift; my $offset = $self->{line} // shift // 1; return $offset + $self->{prefix} =~ tr/\n//; } sub origin { my $self = shift; my $line = shift // 0; my $file = shift // ""; return bless { %{$self}, line => $line, file => $file }, ref($self); } sub diagnostic { my $self = shift; my $line = defined $self->{line} ? $self->{line} + $self->{prefix} =~ tr/\n// : 0; my $file = $self->{file} // q{}; return q{} if eval "no strict;\n" . "#line $line $file\n" . "sub{ $self->{source} }"; my $diagnostic = $@; $diagnostic =~ s{ \s*+ \bat \s++ \( eval \s++ \d++ \) \s++ line \s++ 0, | \s*+ \( eval \s++ \d++ \) | \s++ \Z | \s++ \bExecution \s++ of \s++ .*? \s++ aborted \s++ due \s++ to \s++ compilation \s++ errors\. }{}gx; return $diagnostic; } } # Define the grammar... our $GRAMMAR = qr{ (?(DEFINE) (? (? \A (?&PerlDocument) (?: \Z | (?(?{ !defined $PPR::X::ERROR }) (?>(?&PerlOWSOrEND)) (?{pos()}) ([^\n]++) (?{ $PPR::X::ERROR = PPR::X::ERROR->new(source => "$^N", prefix => substr($_, 0, $^R) ) }) (?!) ) ) )) # End of rule (? (? \x{FEFF}?+ # Optional BOM marker (?&PerlStatementSequence) (?&PerlOWSOrEND) )) # End of rule (? (? (?>(?&PerlPodSequence)) (?: (?&PerlStatement) (?&PerlPodSequence) )*+ )) # End of rule (? (? (?> (?>(?&PerlPodSequence)) (?: (?>(?&PerlLabel)) (?&PerlOWSOrEND) )?+ (?>(?&PerlPodSequence)) (?> (?&PerlKeyword) | (?&PerlSubroutineDeclaration) | (?&PerlMethodDeclaration) | (?&PerlUseStatement) | (?&PerlPackageDeclaration) | (?&PerlClassDeclaration) | (?&PerlFieldDeclaration) | (?&PerlControlBlock) | (?&PerlFormat) | (?>(?&PerlExpression)) (?>(?&PerlOWS)) (?&PerlStatementModifier)?+ (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) | (?&PerlBlock) | ; ) | # A yada-yada... \.\.\. (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) | # Just a label... (?>(?&PerlLabel)) (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) | # Just an empty statement... (?>(?&PerlOWS)) ; | # An error (report it, if it's the first)... (?(?{ !defined $PPR::X::ERROR }) (?> (?&PerlOWS) ) (?! (?: \} | \z ) ) (?{ pos() }) ( (?&PerlExpression) (?&PerlOWS) [^\n]++ | [^;\}]++ ) (?{ $PPR::X::ERROR //= PPR::X::ERROR->new(source => $^N, prefix => substr($_, 0, $^R) ) }) (?!) ) ) )) # End of rule (? (? (?> (?: (?> my | our | state ) \b (?>(?&PerlOWS)) )?+ sub \b (?>(?&PerlOWS)) (?>(?&PerlOldQualifiedIdentifier)) (?&PerlOWS) | AUTOLOAD (?&PerlOWS) | DESTROY (?&PerlOWS) ) (?: # Perl pre 5.028 (?: (?> (?&PerlSignature) # Parameter list | \( [^)]*+ \) # Prototype ( ) (?&PerlOWS) )?+ (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ | # Perl post 5.028 (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list ) (?> ; | (?&PerlBlock) ) )) # End of rule (? (? method \b (?>(?&PerlOWS)) (?>(?&PerlQualifiedIdentifier)) (?&PerlOWS) (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list (?> ; | (?&PerlBlock) ) )) # End of rule (? (? \( (?>(?&PerlOWS)) (?&PerlParameterDeclaration)*+ \) )) # End of rule (? (? (?: \$ (?>(?&PerlOWS)) (?: (?: = | //= | \|\|= ) (?>(?&PerlOWS)) (?&PerlConditionalExpression)?+ (?>(?&PerlOWS)) )?+ | (?&PerlVariableScalar) (?>(?&PerlOWS)) (?: (?: = | //= | \|\|= ) (?>(?&PerlOWS)) (?&PerlConditionalExpression) (?>(?&PerlOWS)) )?+ | (?&PerlVariableArray) (?>(?&PerlOWS)) | (?&PerlVariableHash) (?>(?&PerlOWS)) ) (?: , (?>(?&PerlOWS)) | (?= \) ) ) # ( )) # End of rule (? (? (?: use | no ) (?>(?&PerlNWS)) (?> (?&PerlVersionNumber) | (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) (?! (?>(?&PerlOWS)) (?> (?&PerlInfixBinaryOperator) | (?&PerlComma) | \? ) ) )?+ (?: (?>(?&PerlNWS)) (?&PerlPodSequence) )?+ (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ ) (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) )) # End of rule (? (? return \b (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ )) # End of rule (? (? return \b (?: (?>(?&PerlOWS)) (?&PerlExpression) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) )) # End of rule (? (? package (?>(?&PerlNWS)) (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?&PerlBlock) | (?= \} | \z )) )) # End of rule (? (? class (?>(?&PerlNWS)) (?>(?&PerlQualifiedIdentifier)) (?: (?>(?&PerlNWS)) (?&PerlVersionNumber) | (?>(?&PerlOWS)) : (?>(?&PerlOWS)) isa (?= \( ) (?&PPR_X_quotelike_body) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?&PerlBlock) | (?= \} | \z )) )) # End of rule (? (? (?>(?&PerlLowPrecedenceNotExpression)) (?: (?>(?&PerlOWS)) (?>(?&PerlLowPrecedenceInfixOperator)) (?>(?&PerlOWS)) (?&PerlLowPrecedenceNotExpression) )*+ )) # End of rule (? (? (?: not \b (?&PerlOWS) )*+ (?&PerlCommaList) )) # End of rule (? (? (?>(?&PerlAssignment)) (?>(?&PerlOWS)) (?: (?: (?>(?&PerlComma)) (?&PerlOWS) )++ (?>(?&PerlAssignment)) (?>(?&PerlOWS)) )*+ (?: (?>(?&PerlComma)) (?&PerlOWSOrEND) )*+ )) # End of rule (? (? (?>(?&PerlConditionalExpression)) (?: (?>(?&PerlOWS)) (?>(?&PerlAssignmentOperator)) (?>(?&PerlOWS)) (?&PerlConditionalExpression) )*+ )) # End of rule (? (? (? (? (?>(?&PerlBinaryExpression)) (?: (?>(?&PerlOWS)) \? (?>(?&PerlOWS)) (?>(?&PerlAssignment)) (?>(?&PerlOWS)) : (?>(?&PerlOWS)) (?&PerlConditionalExpression) )?+ )) # End of rule )) # End of rule (? (? (?>(?&PerlPrefixPostfixTerm)) (?: (?>(?&PerlOWS)) (?>(?&PerlInfixBinaryOperator)) (?>(?&PerlOWS)) (?&PerlPrefixPostfixTerm) )*+ )) # End of rule (? (? (?: (?>(?&PerlPrefixUnaryOperator)) (?&PerlOWS) )*+ (?>(?&PerlTerm)) (?: (?>(?&PerlOWS)) (?&PerlPostfixUnaryOperator) )?+ )) # End of rule (? (? (?> \\?+ [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) | \( (?>(?&PerlOWS)) (?> \\?+ [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) | undef ) (?>(?&PerlOWS)) (?: (?>(?&PerlComma)) (?>(?&PerlOWS)) (?> \\?+ [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) | undef ) (?>(?&PerlOWS)) )*+ (?: (?>(?&PerlComma)) (?&PerlOWS) )?+ \) ) )) # End of rule (? (? (?> (?&PerlReturnExpression) # The remaining alternatives can all take postfix dereferencers... | (?: (?= \$ ) (?&PerlScalarAccess) | (?= \@ ) (?&PerlArrayAccess) | (?= % ) (?&PerlHashAccess) | (?&PerlAnonymousSubroutine) | (?&PerlAnonymousMethod) | (?>(?&PerlNullaryBuiltinFunction)) (?! (?>(?&PerlOWS)) \( ) | (?&PerlDoBlock) | (?&PerlEvalBlock) | (?&PerlCall) | (?&PerlVariableDeclaration) | (?&PerlTypeglob) | (?>(?&PerlParenthesesList)) # Can optionally do a [...] lookup straight after the parens, # followed by any number of other look-ups (?: (?>(?&PerlOWS)) (?&PerlArrayIndexer) (?: (?>(?&PerlOWS)) (?> (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )*+ )?+ | (?&PerlAnonymousArray) | (?&PerlAnonymousHash) | (?&PerlDiamondOperator) | (?&PerlContextualMatch) | (?&PerlQuotelikeS) | (?&PerlQuotelikeTR) | (?&PerlQuotelikeQX) | (?&PerlLiteral) ) (?: (?&PerlTermPostfixDereference) )?+ ) )) # End of rule (? (? # Must have at least one arrowed dereference... (?: (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) (?> # A series of simple brackets can omit interstitial arrows... (?> (?&PerlParenthesesList) | (?&PerlArrayIndexer) | (?&PerlHashIndexer) ) (?: (?>(?&PerlOWS)) (?> (?&PerlParenthesesList) | (?&PerlArrayIndexer) | (?&PerlHashIndexer) ) )*+ | # A method call... (?> (?&PerlQualifiedIdentifier) | (?! \$\#\* ) (?&PerlVariableScalar) ) (?: (?>(?&PerlOWS)) (?&PerlParenthesesList) )?+ | # An array or hash slice or k/v slice # (provided it's not subsequently dereferenced) [\@%] (?> (?>(?&PerlArrayIndexer)) | (?>(?&PerlHashIndexer)) ) (?! (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) [\@%]?+ [\[\{] ) | # An array max-index lookup... \$\#\* | # A scalar-, glob-, or subroutine dereference... [\$*&] \* | # An array dereference (provided it's not subsequently dereferenced)... \@\* (?! (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) [\[\@] ) | # A hash dereference (provided it's not subsequently dereferenced)... \%\* (?! (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) [\{%] ) | # A glob lookup... \* (?&PerlHashIndexer) ) )++ )) # End of rule (? (? (?> # Conditionals... (?> if | unless ) \b (?>(?&PerlOWS)) (?>(?&PerlParenthesesList)) (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) (?>(?&PerlPodSequence)) elsif \b (?>(?&PerlOWS)) (?>(?&PerlParenthesesList)) (?>(?&PerlOWS)) (?&PerlBlock) )*+ (?: (?>(?&PerlOWS)) (?>(?&PerlPodSequence)) else \b (?>(?&PerlOWS)) (?&PerlBlock) )?+ | # Loops... (?> for(?:each)?+ \b (?>(?&PerlOWS)) (?: (?> # Explicitly aliased iterator variable... (?> \\ (?>(?&PerlOWS)) (?> my | our | state ) | (?> my | our | state ) (?>(?&PerlOWS)) \\ ) (?>(?&PerlOWS)) (?> (?&PerlVariableScalar) | (?&PerlVariableArray) | (?&PerlVariableHash) ) | # List of scalar iterator variables... my (?>(?&PerlOWS)) \( (?>(?&PerlOWS)) (?>(?&PerlVariableScalar)) (?>(?&PerlOWS)) (?: , (?>(?&PerlOWS)) (?>(?&PerlVariableScalar)) (?>(?&PerlOWS)) )*+ (?: , (?>(?&PerlOWS)) )?+ \) | # Implicitly aliased iterator variable... (?> (?: my | our | state ) (?>(?&PerlOWS)) )?+ (?&PerlVariableScalar) )?+ (?>(?&PerlOWS)) (?> (?&PerlParenthesesList) | (?&PerlQuotelikeQW) ) | (?&PPR_X_three_part_list) ) | (?> while | until) \b (?>(?&PerlOWS)) (?&PerlParenthesesList) ) (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) continue (?>(?&PerlOWS)) (?&PerlBlock) )?+ | # Phasers... (?> BEGIN | END | CHECK | INIT | UNITCHECK | ADJUST ) \b (?>(?&PerlOWS)) (?&PerlBlock) | # Try/catch/finallys... (?>(?&PerlTryCatchFinallyBlock)) | # Defers... defer (?>(?&PerlOWS)) (?&PerlBlock) | # Switches... (?> given | when ) \b (?>(?&PerlOWS)) (?>(?&PerlParenthesesList)) (?>(?&PerlOWS)) (?&PerlBlock) | default (?>(?&PerlOWS)) (?&PerlBlock) ) )) # End of rule (? (? format (?: (?>(?&PerlNWS)) (?&PerlQualifiedIdentifier) )?+ (?>(?&PerlOWS)) = [^\n]*+ (?&PPR_X_newline_and_heredoc) (?: (?! \. \n ) [^\n\$\@]*+ (?: (?> (?= \$ (?! \s ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \s ) ) (?&PerlArrayAccessNoSpace) ) [^\n\$\@]*+ )*+ (?&PPR_X_newline_and_heredoc) )*+ \. (?&PerlEndOfLine) )) # End of rule (? (? (?> if | for(?:each)?+ | while | unless | until | when ) \b (?>(?&PerlOWS)) (?&PerlExpression) )) # End of rule (? (? \{ (?>(?&PerlStatementSequence)) \} )) # End of rule (? (? (?> [&] (?>(?&PerlOWS)) (?> (?&PerlBlock) | (?&PerlVariableScalar) | (?&PerlQualifiedIdentifier) ) (?>(?&PerlOWS)) (?: \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \) )?+ | - (?>(?&PPR_X_filetest_name)) (?>(?&PerlOWS)) (?&PerlPrefixPostfixTerm)?+ | (?>(?&PerlBuiltinFunction)) (?>(?&PerlOWS)) (?> \( (?>(?&PerlOWS)) (?> (?= (?>(?&PPR_X_non_reserved_identifier)) (?>(?&PerlOWS)) (?! \( | (?&PerlComma) ) ) (?&PerlCall) | (?>(?&PerlBlock)) (?>(?&PerlOWS)) (?&PerlExpression)?+ | (?>(?&PPR_X_indirect_obj)) (?>(?&PerlNWS)) (?&PerlExpression) | (?&PerlExpression)?+ ) (?>(?&PerlOWS)) \) | (?> (?= (?>(?&PPR_X_non_reserved_identifier)) (?>(?&PerlOWS)) (?! \( | (?&PerlComma) ) ) (?&PerlCall) | (?>(?&PerlBlock)) (?>(?&PerlOWS)) (?&PerlCommaList)?+ | (?>(?&PPR_X_indirect_obj)) (?>(?&PerlNWS)) (?&PerlCommaList) | (?&PerlCommaList)?+ ) ) | (?>(?&PPR_X_non_reserved_identifier)) (?>(?&PerlOWS)) (?> \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \) | (?> (?= (?>(?&PPR_X_non_reserved_identifier)) (?>(?&PerlOWS)) (?! \( | (?&PerlComma) ) ) (?&PerlCall) | (?>(?&PerlBlock)) (?>(?&PerlOWS)) (?&PerlCommaList)?+ | (?>(?&PPR_X_indirect_obj)) (?&PerlNWS) (?&PerlCommaList) | (?&PerlCommaList)?+ ) ) ) )) # End of rule (? (? (?> my | our | state ) \b (?>(?&PerlOWS)) (?: (?&PerlQualifiedIdentifier) (?&PerlOWS) )?+ (?>(?&PerlLvalue)) (?>(?&PerlOWS)) (?&PerlAttributes)?+ )) # End of rule (? (? field \b (?>(?&PerlOWS)) [\$\@%] (?>(?&PerlOWS)) (?&PerlIdentifier) (?: (?>(?&PerlOWS)) : (?>(?&PerlOWS)) param (?: (?= \( ) (?&PPR_X_quotelike_body) # ) )?+ )?+ (?: (?>(?&PerlOWS)) (?: //= | \|\|= | = ) (?>(?&PerlOWS)) (?&PerlConditionalExpression) )?+ (?>(?&PerlOWSOrEND)) (?> ; | (?= \} | \z )) )) # End of rule (? (? do (?>(?&PerlOWS)) (?&PerlBlock) )) # End of rule (? (? eval (?>(?&PerlOWS)) (?&PerlBlock) )) # End of rule (? (? try \b (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?>(?&PerlOWS)) catch \b (?>(?&PerlOWS)) \( (?>(?&PerlVariableScalar)) \) (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) finally \b (?>(?&PerlOWS)) (?>(?&PerlBlock)) )?+ )) # End of rule (? (? : (?>(?&PerlOWS)) (?>(?&PerlIdentifier)) (?: (?= \( ) (?&PPR_X_quotelike_body) )?+ (?: (?> (?>(?&PerlOWS)) : (?&PerlOWS) | (?&PerlNWS) ) (?>(?&PerlIdentifier)) (?: (?= \( ) (?&PPR_X_quotelike_body) )?+ )*+ )) # End of rule (? (? (?> (?&PerlParenthesesList) | (?&PerlCommaList) ) )) # End of rule (? (? \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \) )) # End of rule (? (? \[ (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \] )) # End of rule (? (? \{ (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?+ \} )) # End of rule (? (? \[ (?>(?&PerlOWS)) (?>(?&PerlExpression)) (?>(?&PerlOWS)) \] )) # End of rule (? (? \{ (?>(?&PerlOWS)) (?: -?+ (?&PerlIdentifier) | (?&PerlExpression) ) # (Note: MUST allow backtracking here) (?>(?&PerlOWS)) \} )) # End of rule (? (? <<>> # Perl 5.22 "double diamond" | < (?! < ) (?>(?&PPR_X_balanced_angles)) > (?= (?>(?&PerlOWSOrEND)) (?> \z | [,;\}\])?] | => | : (?! :) # ( | (?&PerlInfixBinaryOperator) | (?&PerlLowPrecedenceInfixOperator) | (?= \w) (?> for(?:each)?+ | while | if | unless | until | when ) ) ) )) # End of rule (? (? (?> , | => ) )) # End of rule (? (? (?> \+\+ | -- | [!\\+~] | - (?! (?&PPR_X_filetest_name) \b ) ) )) # End of rule (? (? (?> \+\+ | -- ) )) # End of rule (? (? (?> [=!][~=] | cmp | <= >?+ | >= | [lg][te] | eq | ne | [+] (?! [+=] ) | - (?! [-=] ) | [.]{2,3}+ | [.%x] (?! [=] ) | [&|^][.] (?! [=] ) | [<>*&|/]{1,2}+ (?! [=] ) | \^ (?! [=] ) | ~~ | isa ) )) # End of rule (? (? (?: [<>*&|/]{2} | [-+.*/%x] | [&|^][.]?+ )?+ = (?! > ) )) # End of rule (? (? (?> or | and | xor ) )) # End of rule (? (? sub \b (?>(?&PerlOWS)) (?: # Perl pre 5.028 (?: (?> (?&PerlSignature) # Parameter list | \( [^)]*+ \) # Prototype ( ) (?&PerlOWS) )?+ (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ | # Perl post 5.028 (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list ) (?&PerlBlock) )) # End of rule (? (? method \b (?>(?&PerlOWS)) (?: (?>(?&PerlAttributes)) (?&PerlOWS) )?+ (?: (?>(?&PerlSignature)) (?&PerlOWS) )?+ # Parameter list (?&PerlBlock) )) # End of rule (? (? (?= [\$\@%] ) (?> (?&PerlScalarAccess) | (?&PerlHashAccess) | (?&PerlArrayAccess) ) (?> (?&PerlTermPostfixDereference) )?+ )) # End of rule (? (? \* (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | (?&PerlVariableScalar) | [][!"#\$%&'()*+,./:;<=>?\@\^`|~-] | (?&PerlBlock) ) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ # Note: subsequent arrowed postdereferences that would follow here # are handled at the level )) # End of rule (? (? (?>(?&PerlVariableArray)) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ # Note: subsequent arrowed postdereferences that would follow here # are handled at the level )) # End of rule (? (? (?>(?&PerlVariableArrayNoSpace)) # Optional arrowless access(es) to begin (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )*+ # Then any number of optional arrowed accesses # (this is an inlined subset of (?&PerlTermPostfixDereference))... (?: -> (?> # A series of simple brackets can omit interstitial arrows... (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )++ | # An array or hash slice... \@ (?> (?>(?&PerlArrayIndexer)) | (?>(?&PerlHashIndexer)) ) ) )*+ # Followed by at most one of these terminal arrowed dereferences... (?: -> (?> # An array or scalar deref... [\@\$] \* | # An array count deref... \$ \# \* ) )?+ )) # End of rule (? (? (?>(?&PerlVariableArray)) (?: (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) ) )*+ )) # End of rule (? (? (?>(?&PerlVariableHash)) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ )) # End of rule (? (? (?>(?&PerlVariableScalar)) # Optional arrowless access(es) to begin (but can't start with a parens)... (?: (?! (?>(?&PerlOWS)) \( ) (?: (?>(?&PerlOWS)) (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ # Note: subsequent arrowed postdereferences that would follow here # are handled at the level )) # End of rule (? (? (?>(?&PerlVariableScalarNoSpace)) # Optional arrowless access(es) to begin... (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )*+ # Then any nuber of arrowed accesses # (this is an inlined subset of (?&PerlTermPostfixDereference))... (?: -> (?> # A series of simple brackets can omit interstitial arrows... (?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )++ | # An array or hash slice... \@ (?> (?>(?&PerlArrayIndexer)) | (?>(?&PerlHashIndexer)) ) ) )*+ # Followed by at most one of these terminal arrowed dereferences... (?: -> (?> # An array or scalar deref... [\@\$] \* | # An array count deref... \$ \# \* ) )?+ )) # End of rule (? (? (?>(?&PerlVariableScalarNoSpace)) # Optional arrowless access(es) (but parens can't be first)... (?: (?! \( ) (?: (?> (?&PerlArrayIndexer) | (?&PerlHashIndexer) | (?&PerlParenthesesList) ) )++ )?+ )) # End of rule (? (? \$\$ (?! [\$\{\w] ) | (?: \$ (?: [#] (?= (?> [\$^\w\{:+] | - (?! > ) ) ) )?+ (?&PerlOWS) )++ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | \{ [!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] \} | \{ \w++ \} | (?&PerlBlock) ) | \$\# )) # End of rule (? (? \$\$ (?! [\$\{\w] ) | (?: \$ (?: [#] (?= (?> [\$^\w\{:+] | - (?! > ) ) ) )?+ )++ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | \{ \w++ \} | (?&PerlBlock) ) | \$\# )) # End of rule (? (? \@ (?>(?&PerlOWS)) (?: \$ (?&PerlOWS) )*+ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | (?&PerlBlock) ) )) # End of rule (? (? \@ (?: \$ )*+ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock) | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | (?&PerlBlock) ) )) # End of rule (? (? % (?>(?&PerlOWS)) (?: \$ (?&PerlOWS) )*+ (?> \d++ | \^ [][A-Z^_?\\] | \{ \^ [A-Z_] \w*+ \} | (?>(?&PerlOldQualifiedIdentifier)) (?: :: )?+ | :: (?&PerlBlock)?+ | [][!"#\$%&'()*+,.\\/:;<=>?\@\^`|~-] | (?&PerlBlock) ) )) # End of rule (? (? (?! (?> [msy] | q[wrxq]?+ | tr ) \b ) (?>(?&PerlIdentifier)) : (?! : ) )) # End of rule (? (? (?> (?&PerlString) | (?&PerlQuotelikeQR) | (?&PerlQuotelikeQW) | (?&PerlNumber) | (?&PerlBareword) ) )) # End of rule (? (? (?> (?&PerlQuotelikeQ) | (?&PerlQuotelikeQQ) | (?&PerlHeredoc) | (?&PerlVString) ) )) # End of rule (? (? (?> (?&PerlString) | (?&PerlQuotelikeQR) | (?&PerlQuotelikeQW) | (?&PerlQuotelikeQX) | (?&PerlContextualMatch) | (?&PerlQuotelikeS) | (?&PerlQuotelikeTR) ) )) # End of rule (? (? # Match the introducer... << (?<_heredoc_indented> [~]?+ ) # Match the terminator specification... (?> \\?+ (?<_heredoc_terminator> (?&PerlIdentifier) ) | (?>(?&PerlOWS)) (?> " (?<_heredoc_terminator> [^"\\]*+ (?: \\. [^"\\]*+ )*+ ) " #" | (? ' ) (?<_heredoc_terminator> [^'\\]*+ (?: \\. [^'\\]*+ )*+ ) ' #' | ` (?<_heredoc_terminator> [^`\\]*+ (?: \\. [^`\\]*+ )*+ ) ` #` ) | (?<_heredoc_terminator> ) ) # Do we need to reset the heredoc cache??? (?{ if ( ($PPR::X::_heredoc_origin // q{}) ne $_ ) { %PPR::X::_heredoc_skip = (); %PPR::X::_heredoc_parsed_to = (); $PPR::X::_heredoc_origin = $_; } }) # Do we need to cache content lookahead for this heredoc??? (?(?{ my $need_to_lookahead = !$PPR::X::_heredoc_parsed_to{+pos()}; $PPR::X::_heredoc_parsed_to{+pos()} = 1; $need_to_lookahead; }) # Lookahead to detect and remember trailing contents of heredoc (?= [^\n]*+ \n # Go to the end of the current line (?{ +pos() }) # Remember the start of the contents (??{ $PPR::X::_heredoc_skip{+pos()} // q{} }) # Skip earlier heredoc contents (?> # The heredoc contents consist of... (?: (?! (?(?{ $+{_heredoc_indented} }) \h*+ ) # An indent (if it was a <<~) \g{_heredoc_terminator} # The terminator (?: \n | \z ) # At an end-of-line ) (?() [^\n]*+ \n | [^\n\$\@]*+ (?: (?> (?{ local $PPR::X::_heredoc_EOL_start = $^R }) (?= \$ ) (?&PerlScalarAccess) (?{ $PPR::X::_heredoc_EOL_start }) | (?{ local $PPR::X::_heredoc_EOL_start = $^R }) (?= \@ ) (?&PerlArrayAccess) (?{ $PPR::X::_heredoc_EOL_start }) ) [^\n\$\@]*+ )*+ \n (??{ $PPR::X::_heredoc_skip{+pos()} // q{} }) ) )*+ (?(?{ $+{_heredoc_indented} }) \h*+ ) # An indent (if it was a <<~) \g{_heredoc_terminator} # The specified terminator (?: \n | \z ) # Followed by EOL ) # Then memoize the skip for when it's subsequently needed by PerlOWS or PerlNWS... (?{ # Split .{N} repetition into multiple repetitions to avoid the 32766 limit... $PPR::X::_heredoc_skip{$^R} = '(?s:' . ( '.{32766}' x int((pos() - $^R) / 32766) ) . '.{' . (pos() - $^R) % 32766 . '})'; }) ) ) )) # End of rule (? (? (?> ' [^'\\]*+ (?: \\. [^'\\]*+ )*+ ' | \b q \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_X_quotelike_body) ) )) # End of rule (? (? (?> " [^"\\]*+ (?: \\. [^"\\]*+ )*+ " | \b qq \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_X_quotelike_body_always_interpolated) ) )) # End of rule (? (? (?> qw \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_X_quotelike_body) ) )) # End of rule (? (? (?> ` [^`]*+ (?: \\. [^`]*+ )*+ ` | qx (?> (?= (?>(?&PerlOWS)) ' ) (?&PPR_X_quotelike_body) | \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?&PPR_X_quotelike_body_interpolated) ) ) )) # End of rule (? (? (? (? s \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?> # Hashed syntax... (?= [#] ) (?>(?&PPR_X_regex_body_interpolated_unclosed)) (?&PPR_X_quotelike_s_e_check) (?>(?&PPR_X_quotelike_body_interpolated)) | # Bracketed syntax... (?= (?>(?&PerlOWS)) (?: [\[(<\{] # ) | (\X) (??{ exists $PPR::X::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) ) ) (?>(?&PPR_X_regex_body_interpolated)) (?>(?&PerlOWS)) (?&PPR_X_quotelike_s_e_check) (?>(?&PPR_X_quotelike_body_interpolated)) | # Single-quoted syntax... (?= (?>(?&PerlOWS)) ' ) (?>(?&PPR_X_regex_body_unclosed)) (?&PPR_X_quotelike_s_e_check) (?>(?&PPR_X_quotelike_body_interpolated)) | # Delimited syntax... (?>(?&PPR_X_regex_body_interpolated_unclosed)) (?&PPR_X_quotelike_s_e_check) (?>(?&PPR_X_quotelike_body_interpolated)) ) [msixpodualgcern]*+ )) # End of rule )) # End of rule (? (? (? (? (?> tr | y ) \b (?! (?>(?&PerlOWS)) => ) (?> # Hashed syntax... (?= [#] ) (?>(?&PPR_X_quotelike_body_interpolated_unclosed)) (?&PPR_X_quotelike_body_interpolated) | # Bracketed syntax... (?= (?>(?&PerlOWS)) (?: [\[(<\{\«] # )] | (\X) (??{ exists $PPR::X::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) ) ) (?>(?&PPR_X_quotelike_body_interpolated)) (?>(?&PerlOWS)) (?&PPR_X_quotelike_body_interpolated) | # Delimited syntax... (?>(?&PPR_X_quotelike_body_interpolated_unclosed)) (?&PPR_X_quotelike_body_interpolated) ) [cdsr]*+ )) # End of rule )) # End of rule (? (? (? (? (? (? (?> \/\/ | (?> m (?= [#] ) | m \b (?! (?>(?&PerlOWS)) => ) | (?= \/ [^/] ) ) (?&PPR_X_regex_body_interpolated) ) [msixpodualgcn]*+ ) # End of rule (?) ) # End of rule (?) (?= (?>(?&PerlOWS)) (?> \z | [,;\}\])?] | => | : (?! :) | (?&PerlInfixBinaryOperator) | (?&PerlLowPrecedenceInfixOperator) | (?= \w) (?> for(?:each)?+ | while | if | unless | until | when ) ) ) )) # End of rule )) # End of rule (? (? qr \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) (?>(?&PPR_X_regex_body_interpolated)) [msixpodualn]*+ )) # End of rule (? (? (?> (?&PerlMatch) | (?&PerlQuotelikeQR) ) )) # End of rule (? (? (?> (?&PerlContextualMatch) | (?&PerlQuotelikeQR) ) )) # End of rule (? (? # Optimized to match any Perl builtin name, without backtracking... (?=[^\W\d]) # Skip if possible (?> s(?>e(?>t(?>(?>(?>(?>hos|ne)t|gr)en|s(?>erven|ockop))t|p(?>r(?>iority|otoent)|went|grp))|m(?>ctl|get|op)|ek(?>dir)?|lect|nd)|y(?>s(?>write|call|open|read|seek|tem)|mlink)|h(?>m(?>write|read|ctl|get)|utdown|ift)|o(?>cket(?>pair)?|rt)|p(?>li(?>ce|t)|rintf)|(?>cala|ubst)r|t(?>at|udy)|leep|rand|qrt|ay|in) | g(?>et(?>p(?>r(?>oto(?>byn(?>umber|ame)|ent)|iority)|w(?>ent|nam|uid)|eername|grp|pid)|s(?>erv(?>by(?>name|port)|ent)|ock(?>name|opt))|host(?>by(?>addr|name)|ent)|net(?>by(?>addr|name)|ent)|gr(?>ent|gid|nam)|login|c)|mtime|lob|oto|rep) | r(?>e(?>ad(?>lin[ek]|pipe|dir)?|(?>quir|vers|nam)e|winddir|turn|set|cv|do|f)|index|mdir|and) | c(?>h(?>o(?>m?p|wn)|r(?>oot)?|dir|mod)|o(?>n(?>tinue|nect)|s)|lose(?>dir)?|aller|rypt) | e(?>nd(?>(?>hos|ne)t|p(?>roto|w)|serv|gr)ent|x(?>i(?>sts|t)|ec|p)|ach|val(?>bytes)?+|of) | l(?>o(?>c(?>al(?>time)?|k)|g)|i(?>sten|nk)|(?>sta|as)t|c(?>first)?|ength) | u(?>n(?>(?>lin|pac)k|shift|def|tie)|c(?>first)?|mask|time) | p(?>r(?>ototype|intf?)|ack(?>age)?|o[ps]|ipe|ush) | d(?>bm(?>close|open)|e(?>fined|lete)|ump|ie|o) | f(?>or(?>m(?>line|at)|k)|ileno|cntl|c|lock) | t(?>i(?>mes?|ed?)|ell(?>dir)?|runcate) | w(?>a(?>it(?>pid)?|ntarray|rn)|rite) | m(?>sg(?>ctl|get|rcv|snd)|kdir|ap) | b(?>in(?>mode|d)|less|reak) | i(?>n(?>dex|t)|mport|octl) | a(?>ccept|larm|tan2|bs) | o(?>pen(?>dir)?|ct|rd) | v(?>alues|ec) | k(?>eys|ill) | quotemeta | join | next | hex | _ ) \b )) # End of rule (? (? # Optimized to match any Perl builtin name, without backtracking... (?= [^\W\d] ) # Skip if possible (?> get(?:(?:(?:hos|ne)t|serv|gr)ent|p(?:(?:roto|w)ent|pid)|login) | end(?:(?:hos|ne)t|p(?:roto|w)|serv|gr)ent | wa(?:ntarray|it) | times? | fork | _ ) \b )) # End of rule (? (? (?> (?&PerlVString) | (?>(?&PPR_X_digit_seq)) (?: \. (?&PPR_X_digit_seq)?+ )*+ ) )) # End of rule (? (? v (?>(?&PPR_X_digit_seq)) (?: \. (?&PPR_X_digit_seq) )*+ )) # End of rule (? (? [+-]?+ (?> 0 (?> x (?&PPR_X_x_digit_seq) | b (?&PPR_X_b_digit_seq) | o? (?&PPR_X_o_digit_seq) ) | (?> (?>(?&PPR_X_digit_seq)) (?: \. (?&PPR_X_digit_seq)?+ )?+ | \. (?&PPR_X_digit_seq) ) (?: [eE] [+-]?+ (?&PPR_X_digit_seq) )?+ ) )) # End of rule (? (? (?> (?> :: | ' ) \w++ | [^\W\d]\w*+ ) (?: (?> :: | ' ) \w++ )*+ )) # End of rule (? (? (?> :: \w++ | [^\W\d]\w*+ ) (?: (?> :: | ' ) \w++ )*+ )) # End of rule (? (? [^\W\d]\w*+ )) # End of rule (? (? (?! (?> (?= \w ) (?> for(?:each)?+ | while | if | unless | until | use | no | given | when | sub | return | my | our | state | try | catch | finally | defer ) | (?&PPR_X_named_op) | __ (?> END | DATA ) __ \b ) \b (?! (?>(?&PerlOWS)) => ) ) (?! (?> q[qwrx]?+ | [mys] | tr ) \b (?> (?= [#] ) | (?! (?>(?&PerlOWS)) => ) ) ) (?: :: )?+ [^\W\d]\w*+ (?: (?: :: | ' ) [^\W\d]\w*+ )*+ (?: :: )?+ (?! \( ) # ) | :: (?! \w | \{ ) )) # End of rule (? (? (?!) # None, by default, but can be overridden in a composing regex )) # End of rule (? (? (?>(?&PerlOWS)) (?: (?>(?&PerlPod)) (?&PerlOWS) )*+ )) # End of rule (? (? ^ = [^\W\d]\w*+ # A line starting with = .*? # Up to the first... (?> ^ = cut \b [^\n]*+ $ # ...line starting with =cut | # or \z # ...EOF ) )) # End of rule ##### Whitespace matching (part of API) ################################# (? (? (?: \h++ | (?&PPR_X_newline_and_heredoc) | (?&PerlComment) | __ (?> END | DATA ) __ \b .*+ \z )*+ )) # End of rule (? (? (?: \h++ | (?&PPR_X_newline_and_heredoc) | (?&PerlComment) )*+ )) # End of rule (? (? (?: \h++ | (?&PPR_X_newline_and_heredoc) | (?&PerlComment) )++ )) # End of rule (? (? [#] [^\n]*+ )) # End of rule (? (? \n )) # End of rule ###### Internal components (not part of API) ########################## (? (?> cmp | [lg][te] | eq | ne | and | or | xor ) ) # End of rule (?) (? (?! (?> for(?:each)?+ | while | if | unless | until | given | when | default | sub | format | use | no | my | our | state | try | catch | finally | defer | (?&PPR_X_named_op) | [msy] | q[wrxq]?+ | tr | __ (?> END | DATA ) __ ) \b ) (?>(?&PerlQualifiedIdentifier)) (?! :: ) ) # End of rule (?) (? \( (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?? ; (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?? ; (?>(?&PerlOWS)) (?: (?>(?&PerlExpression)) (?&PerlOWS) )?? \) ) # End of rule (?) (? (?&PerlBareword) | (?>(?&PerlVariableScalar)) (?! (?>(?&PerlOWS)) (?> [<\[\{] | -> ) ) ) # End of rule (?) (? (?>(?&PPR_X_quotelike_body_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? [^)(\\\n]*+ (?: (?> \\. | \( (?>(?&PPR_X_balanced_parens)) \) | (?&PPR_X_newline_and_heredoc) ) [^)(\\\n]*+ )*+ ) # End of rule (?) (? [^\}\{\\\n]*+ (?: (?> \\. | \{ (?>(?&PPR_X_balanced_curlies)) \} | (?&PPR_X_newline_and_heredoc) ) [^\}\{\\\n]*+ )*+ ) # End of rule (?) (? [^][\\\n]*+ (?: (?> \\. | \[ (?&PPR_X_balanced_squares) \] | (?&PPR_X_newline_and_heredoc) ) [^][\\\n]*+ )*+ ) # End of rule (?) (? [^><\\\n]*+ (?: (?> \\. | < (?>(?&PPR_X_balanced_angles)) > | (?&PPR_X_newline_and_heredoc) ) [^><\\\n]*+ )*+ ) # End of rule (?) (? (??{$PPR::X::_qld_not_special}) (?: (?> \\. | (??{$PPR::X::_qld_open}) (?>(?&PPR_X_balanced_unicode_delims)) (??{$PPR::X::_qld_close}) | (?&PPR_X_newline_and_heredoc) ) (??{$PPR::X::_qld_not_special}) )*+ ) # End of rule (?) (? (?> [#] [^#\\\n]*+ (?: (?: \\. | (?&PPR_X_newline_and_heredoc) ) [^#\\\n]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_X_balanced_curlies)) (?= \} ) | \[ (?>(?&PPR_X_balanced_squares)) (?= \] ) | \( (?> \?{1,2}+ (?= \{ ) (?>(?&PerlBlock)) | (?! \?{1,2}+ \{ ) (?>(?&PPR_X_balanced_parens)) ) (?= \) ) | < (?>(?&PPR_X_balanced_angles)) (?= > ) | (\X) (??{ exists $PPR::X::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::X::_qld_open = $^N; local $PPR::X::_qld_close = $PPR::X::_QLD_CLOSE_FOR{$PPR::X::_qld_open}; local $PPR::X::_qld_not_special = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n]*+"; local $PPR::X::_qld_not_special_or_sigil = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::X::_qld_not_special_in_regex_var = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\s(|)]"; }) (?>(?&PPR_X_balanced_unicode_delims_regex_interpolated)) (?= (??{$PPR::X::_qld_close}) ) | \\ [^\\\n]*+ ( (?&PPR_X_newline_and_heredoc) [^\\\n]*+ )*+ (?= \\ ) | / [^\\/\n]*+ (?: (?: \\. | (?&PPR_X_newline_and_heredoc) ) [^\\/\n]*+ )*+ (?= / ) | (? \S ) (?: \\. | (?&PPR_X_newline_and_heredoc) | (?! \g{PPR_X_qldel} ) . )*+ (?= \g{PPR_X_qldel} ) ) ) ) # End of rule (?) (? (?> [#] [^#\\\n]*+ (?: (?: \\. | (?&PPR_X_newline_and_heredoc) ) [^#\\\n]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_X_balanced_curlies)) (?= \} ) | \[ (?>(?&PPR_X_balanced_squares)) (?= \] ) | \( (?>(?&PPR_X_balanced_parens)) (?= \) ) | < (?>(?&PPR_X_balanced_angles)) (?= > ) | (\X) (??{ exists $PPR::X::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::X::_qld_open = $^N; local $PPR::X::_qld_close = $PPR::X::_QLD_CLOSE_FOR{$PPR::X::_qld_open}; local $PPR::X::_qld_not_special = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n]*+"; local $PPR::X::_qld_not_special_or_sigil = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::X::_qld_not_special_in_regex_var = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\s(|)]"; }) (?>(?&PPR_X_balanced_unicode_delims)) (?= (??{$PPR::X::_qld_close}) ) | \\ [^\\\n]*+ ( (?&PPR_X_newline_and_heredoc) [^\\\n]*+ )*+ (?= \\ ) | / [^\\/\n]*+ (?: (?: \\. | (?&PPR_X_newline_and_heredoc) ) [^\\/\n]*+ )*+ (?= / ) | (? \S ) (?: \\. | (?&PPR_X_newline_and_heredoc) | (?! \g{PPR_X_qldel} ) . )*+ (?= \g{PPR_X_qldel} ) ) ) ) # End of rule (?) (? (?>(?&PPR_X_quotelike_body_always_interpolated_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? (?>(?&PPR_X_quotelike_body_interpolated_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? (?>(?&PPR_X_regex_body_interpolated_unclosed)) \S # (Note: Don't have to test that this matches; the preceding subrule already did that) ) # End of rule (?) (? [^)(\\\n\$\@]*+ (?: (?> \\. | \( (?>(?&PPR_X_balanced_parens_regex_interpolated)) \) | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s(|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s(|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^)(\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^\}\{\\\n\$\@]*+ (?: (?> \\. | \{ (?>(?&PPR_X_balanced_curlies_regex_interpolated)) \} | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\}(|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\}(|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\}\{\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^][\\\n\$\@]*+ (?: (?> \\. | \[ (?>(?&PPR_X_balanced_squares_regex_interpolated)) \] | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\](|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\](|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^][\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^><\\\n\$\@]*+ (?: (?> \\. | < (?>(?&PPR_X_balanced_angles_regex_interpolated)) > | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s>(|)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s>(|)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^><\\\n\$\@]*+ )*+ ) # End of rule (?) (? (??{$PPR::X::_qld_not_special_or_sigil}) (?: (?> \\. | (??{ $PPR::X::_qld_open }) (?>(?&PPR_X_balanced_unicode_delims_regex_interpolated)) (??{ $PPR::X::_qld_close }) | (?&PPR_X_newline_and_heredoc) | (?= \$ (??{ $PPR::X::_qld_not_special_in_regex_var }) ) (?&PerlScalarAccessNoSpace) | (?= \$ (??{ $PPR::X::_qld_not_special_in_regex_var }) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) (??{$PPR::X::_qld_not_special_or_sigil}) )*+ ) # End of rule (?) (? [^)(\\\n\$\@]*+ (?: (?> \\. | \( (?>(?&PPR_X_balanced_parens_interpolated)) \) | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\)] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\)] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^)(\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^\}\{\\\n\$\@]*+ (?: (?> \\. | \{ (?>(?&PPR_X_balanced_curlies_interpolated)) \} | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\}] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\}] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\}\{\\\n\$\@]*+ )*+ ) # End of rule (?) (? [^][\\\n\$\@]*+ (?: (?> \\. | \[ (?>(?&PPR_X_balanced_squares_interpolated)) \] | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\]] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\]] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^][\\\n\$\@]*+ )*+ ) # End of rule (?) (? (??{$PPR::X::_qld_not_special_or_sigil}) (?: (?> \\. | (??{$PPR::X::_qld_open}) (?>(?&PPR_X_balanced_unicode_delims_interpolated)) (??{$PPR::X::_qld_close}) | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! \s | (??{$PPR::X::_qld_close}) ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \s | (??{$PPR::X::_qld_close}) ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) (??{$PPR::X::_qld_not_special_or_sigil}) )*+ ) # End of rule (?) (? [^><\\\n\$\@]*+ (?: (?> \\. | < (?>(?&PPR_X_balanced_angles_interpolated)) > | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s>] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s>] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^><\\\n\$\@]*+ )*+ ) # End of rule (?) (? # Start by working out where it actually ends (ignoring interpolations)... (?= (?> [#] [^#\\\n\$\@]*+ (?: (?> \\. | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s#|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s#|()] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^#\\\n\$\@]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_X_balanced_curlies_regex_interpolated)) (?= \} ) | \[ (?>(?&PPR_X_balanced_squares_regex_interpolated)) (?= \] ) | \( (?>(?&PPR_X_balanced_parens_regex_interpolated)) (?= \) ) | < (?>(?&PPR_X_balanced_angles_regex_interpolated)) (?= > ) | (\X) (??{ exists $PPR::X::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::X::_qld_open = $^N; local $PPR::X::_qld_close = $PPR::X::_QLD_CLOSE_FOR{$PPR::X::_qld_open}; local $PPR::X::_qld_not_special = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n]*+"; local $PPR::X::_qld_not_special_or_sigil = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::X::_qld_not_special_in_regex_var = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\s(|)]"; }) (?>(?&PPR_X_balanced_unicode_delims_regex_interpolated)) (?= (??{$PPR::X::_qld_close}) ) | ' [^'\n]*+ (?: (?> (?&PPR_X_newline_and_heredoc)) [^'\n]*+ )*+ (?= ' ) | \\ [^\\\n\$\@]*+ (?: (?> (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\\|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\\|()] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\\n\$\@]*+ )*+ (?= \\ ) | / [^\\/\n\$\@]*+ (?: (?> \\. | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s/|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s/|()] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\/\n\$\@]*+ )*+ (?= / ) | - (?: \\. | (?&PPR_X_newline_and_heredoc) | (?: (?= \$ (?! [\s|()-] ) ) (?&PerlScalarAccessNoSpaceNoArrow) | (?= \@ (?! [\s|()-] ) ) (?&PerlArrayAccessNoSpaceNoArrow) | [^-] ) )*+ (?= - ) | (? \S ) (?: \\. | (?&PPR_X_newline_and_heredoc) | (?! \g{PPR_X_qldel} ) (?: (?= \$ (?! \g{PPR_X_qldel} | [\s|()] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \g{PPR_X_qldel} | [\s|()] ) ) (?&PerlArrayAccessNoSpace) | . ) )*+ (?= \g{PPR_X_qldel} ) ) ) ) (?&PPR_X_regex_body_unclosed) ) # End of rule (?) (? # Start by working out where it actually ends (ignoring interpolations)... (?= (?> [#] [^#\\\n\$\@]*+ (?: (?> \\. | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s#] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s#] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^#\\\n\$\@]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_X_balanced_curlies_interpolated)) (?= \} ) | \[ (?>(?&PPR_X_balanced_squares_interpolated)) (?= \] ) | \( (?>(?&PPR_X_balanced_parens_interpolated)) (?= \) ) | < (?>(?&PPR_X_balanced_angles_interpolated)) (?= > ) | (\X) (??{ exists $PPR::X::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::X::_qld_open = $^N; local $PPR::X::_qld_close = $PPR::X::_QLD_CLOSE_FOR{$PPR::X::_qld_open}; local $PPR::X::_qld_not_special = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n]*+"; local $PPR::X::_qld_not_special_or_sigil = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::X::_qld_not_special_in_regex_var = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\s(|)]"; }) (?>(?&PPR_X_balanced_unicode_delims_interpolated)) (?= (??{$PPR::X::_qld_close}) ) | \\ [^\\\n\$\@]*+ (?: (?> (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\\] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\\] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\\n\$\@]*+ )*+ (?= \\ ) | / [^\\/\n\$\@]*+ (?: (?> \\. | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s/] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s/] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\/\n\$\@]*+ )*+ (?= / ) | - (?: \\. | (?&PPR_X_newline_and_heredoc) | (?: (?= \$ (?! [\s-] ) ) (?&PerlScalarAccessNoSpaceNoArrow) | (?= \@ (?! [\s-] ) ) (?&PerlArrayAccessNoSpaceNoArrow) | [^-] ) )*+ (?= - ) | (? \S ) (?: \\. | (?&PPR_X_newline_and_heredoc) | (?! \g{PPR_X_qldel} ) (?: (?= \$ (?! \g{PPR_X_qldel} | \s ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \g{PPR_X_qldel} | \s ) ) (?&PerlArrayAccessNoSpace) | . ) )*+ (?= \g{PPR_X_qldel} ) ) ) ) (?&PPR_X_quotelike_body_unclosed) ) # End of rule (?) (? # Start by working out where it actually ends (ignoring interpolations)... (?= (?> [#] [^#\\\n\$\@]*+ (?: (?> \\. | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s#] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s#] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^#\\\n\$\@]*+ )*+ (?= [#] ) | (?>(?&PerlOWS)) (?> \{ (?>(?&PPR_X_balanced_curlies_interpolated)) (?= \} ) | \[ (?>(?&PPR_X_balanced_squares_interpolated)) (?= \] ) | \( (?>(?&PPR_X_balanced_parens_interpolated)) (?= \) ) | < (?>(?&PPR_X_balanced_angles_interpolated)) (?= > ) | (\X) (??{ exists $PPR::X::_QLD_CLOSE_FOR{$^N} ? '' : '(?!)' }) (?{ local $PPR::X::_qld_open = $^N; local $PPR::X::_qld_close = $PPR::X::_QLD_CLOSE_FOR{$PPR::X::_qld_open}; local $PPR::X::_qld_not_special = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n]*+"; local $PPR::X::_qld_not_special_or_sigil = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\\\\\n\\\$\\\@]*+"; local $PPR::X::_qld_not_special_in_regex_var = "[^$PPR::X::_qld_open$PPR::X::_qld_close\\s(|)]"; }) (?>(?&PPR_X_balanced_unicode_delims_interpolated)) (?= (??{$PPR::X::_qld_close}) ) | ' [^'\n]*+ (?: (?> (?&PPR_X_newline_and_heredoc)) [^'\n]*+ )*+ (?= ' ) | \\ [^\\\n\$\@]*+ (?: (?> (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s\\] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s\\] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\\n\$\@]*+ )*+ (?= \\ ) | / [^\\/\n\$\@]*+ (?: (?> \\. | (?&PPR_X_newline_and_heredoc) | (?= \$ (?! [\s/] ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! [\s/] ) ) (?&PerlArrayAccessNoSpace) | [\$\@] ) [^\\/\n\$\@]*+ )*+ (?= / ) | - (?: \\. | (?&PPR_X_newline_and_heredoc) | (?: (?= \$ (?! [\s-] ) ) (?&PerlScalarAccessNoSpaceNoArrow) | (?= \@ (?! [\s-] ) ) (?&PerlArrayAccessNoSpaceNoArrow) | [^-] ) )*+ (?= - ) | (? \S ) (?: \\. | (?&PPR_X_newline_and_heredoc) | (?! \g{PPR_X_qldel} ) (?: (?= \$ (?! \g{PPR_X_qldel} | \s ) ) (?&PerlScalarAccessNoSpace) | (?= \@ (?! \g{PPR_X_qldel} | \s ) ) (?&PerlArrayAccessNoSpace) | . ) )*+ (?= \g{PPR_X_qldel} ) ) ) ) (?&PPR_X_quotelike_body_unclosed) ) # End of rule (?) (? (??{ local $PPR::X::_quotelike_s_end = -1; '' }) (?: (?= (?&PPR_X_quotelike_body_interpolated) (??{ $PPR::X::_quotelike_s_end = +pos(); '' }) [msixpodualgcrn]*+ e [msixpodualgcern]*+ ) (?= \S # Skip the left delimiter (?(?{ $PPR::X::_quotelike_s_end >= 0 }) (?> (??{ +pos() && +pos() < $PPR::X::_quotelike_s_end ? '' : '(?!)' }) (?> (?&PerlExpression) | \\?+ . ) )*+ ) ) )?+ ) # End of rule (?) (? (??{ local $PPR::X::_quotelike_s_end = -1; '' }) (?: (?= (?&PPR_X_quotelike_body) (??{ $PPR::X::_quotelike_s_end = +pos(); '' }) [msixpodualgcrn]*+ e [msixpodualgcern]*+ ) (?= \S # Skip the left delimiter (?(?{ $PPR::X::_quotelike_s_end >= 0 }) (?> (??{ +pos() && +pos() < $PPR::X::_quotelike_s_end ? '' : '(?!)' }) (?> (?&PerlExpression) | \\?+ . ) )*+ ) ) )?+ ) # End of rule (?) (? [ABCMORSTWXbcdefgkloprstuwxz] ) (? \d++ (?: _?+ \d++ )*+ ) (? [\da-fA-F]++ (?: _?+ [\da-fA-F]++ )*+ ) (? [0-7]++ (?: _?+ [0-7]++ )*+ ) (? [0-1]++ (?: _?+ [0-1]++ )*+ ) (? \n (??{ ($PPR::X::_heredoc_origin // q{}) eq ($_//q{}) ? ($PPR::X::_heredoc_skip{+pos()} // q{}) : q{} }) ) # End of rule (?) ) # END OF GRAMMAR }xms; BEGIN { %PPR::X::_QLD_CLOSE_FOR = ( # "\x{0028}" => "\x{0029}", # LEFT/RIGHT PARENTHESIS # "\x{003C}" => "\x{003E}", # LESS-THAN/GREATER-THAN SIGN # "\x{005B}" => "\x{005D}", # LEFT/RIGHT SQUARE BRACKET # "\x{007B}" => "\x{007D}", # LEFT/RIGHT CURLY BRACKET "\x{00AB}" => "\x{00BB}", # LEFT/RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK "\x{00BB}" => "\x{00AB}", # RIGHT/LEFT-POINTING DOUBLE ANGLE QUOTATION MARK "\x{0706}" => "\x{0707}", # SYRIAC COLON SKEWED LEFT/RIGHT "\x{0F3A}" => "\x{0F3B}", # TIBETAN MARK GUG RTAGS GYON, TIBETAN MARK GUG RTAGS GYAS "\x{0F3C}" => "\x{0F3D}", # TIBETAN MARK ANG KHANG GYON, TIBETAN MARK ANG KHANG GYAS "\x{169B}" => "\x{169C}", # OGHAM FEATHER MARK, OGHAM REVERSED FEATHER MARK "\x{2018}" => "\x{2019}", # LEFT/RIGHT SINGLE QUOTATION MARK "\x{2019}" => "\x{2018}", # RIGHT/LEFT SINGLE QUOTATION MARK "\x{201C}" => "\x{201D}", # LEFT/RIGHT DOUBLE QUOTATION MARK "\x{201D}" => "\x{201C}", # RIGHT/LEFT DOUBLE QUOTATION MARK "\x{2035}" => "\x{2032}", # REVERSED PRIME, PRIME "\x{2036}" => "\x{2033}", # REVERSED DOUBLE PRIME, DOUBLE PRIME "\x{2037}" => "\x{2034}", # REVERSED TRIPLE PRIME, TRIPLE PRIME "\x{2039}" => "\x{203A}", # SINGLE LEFT/RIGHT-POINTING ANGLE QUOTATION MARK "\x{203A}" => "\x{2039}", # SINGLE RIGHT/LEFT-POINTING ANGLE QUOTATION MARK "\x{2045}" => "\x{2046}", # LEFT/RIGHT SQUARE BRACKET WITH QUILL "\x{204D}" => "\x{204C}", # BLACK RIGHT/LEFTWARDS BULLET "\x{207D}" => "\x{207E}", # SUPERSCRIPT LEFT/RIGHT PARENTHESIS "\x{208D}" => "\x{208E}", # SUBSCRIPT LEFT/RIGHT PARENTHESIS "\x{2192}" => "\x{2190}", # RIGHT/LEFTWARDS ARROW "\x{219B}" => "\x{219A}", # RIGHT/LEFTWARDS ARROW WITH STROKE "\x{219D}" => "\x{219C}", # RIGHT/LEFTWARDS WAVE ARROW "\x{21A0}" => "\x{219E}", # RIGHT/LEFTWARDS TWO HEADED ARROW "\x{21A3}" => "\x{21A2}", # RIGHT/LEFTWARDS ARROW WITH TAIL "\x{21A6}" => "\x{21A4}", # RIGHT/LEFTWARDS ARROW FROM BAR "\x{21AA}" => "\x{21A9}", # RIGHT/LEFTWARDS ARROW WITH HOOK "\x{21AC}" => "\x{21AB}", # RIGHT/LEFTWARDS ARROW WITH LOOP "\x{21B1}" => "\x{21B0}", # UPWARDS ARROW WITH TIP RIGHT/LEFTWARDS "\x{21B3}" => "\x{21B2}", # DOWNWARDS ARROW WITH TIP RIGHT/LEFTWARDS "\x{21C0}" => "\x{21BC}", # RIGHT/LEFTWARDS HARPOON WITH BARB UPWARDS "\x{21C1}" => "\x{21BD}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWNWARDS "\x{21C9}" => "\x{21C7}", # RIGHT/LEFTWARDS PAIRED ARROWS "\x{21CF}" => "\x{21CD}", # RIGHT/LEFTWARDS DOUBLE ARROW WITH STROKE "\x{21D2}" => "\x{21D0}", # RIGHT/LEFTWARDS DOUBLE ARROW "\x{21DB}" => "\x{21DA}", # RIGHT/LEFTWARDS TRIPLE ARROW "\x{21DD}" => "\x{21DC}", # RIGHT/LEFTWARDS SQUIGGLE ARROW "\x{21E2}" => "\x{21E0}", # RIGHT/LEFTWARDS DASHED ARROW "\x{21E5}" => "\x{21E4}", # RIGHT/LEFTWARDS ARROW TO BAR "\x{21E8}" => "\x{21E6}", # RIGHT/LEFTWARDS WHITE ARROW "\x{21F4}" => "\x{2B30}", # RIGHT/LEFT ARROW WITH SMALL CIRCLE "\x{21F6}" => "\x{2B31}", # THREE RIGHT/LEFTWARDS ARROWS "\x{21F8}" => "\x{21F7}", # RIGHT/LEFTWARDS ARROW WITH VERTICAL STROKE "\x{21FB}" => "\x{21FA}", # RIGHT/LEFTWARDS ARROW WITH DOUBLE VERTICAL STROKE "\x{21FE}" => "\x{21FD}", # RIGHT/LEFTWARDS OPEN-HEADED ARROW "\x{2208}" => "\x{220B}", # ELEMENT OF, CONTAINS AS MEMBER "\x{2209}" => "\x{220C}", # NOT AN ELEMENT OF, DOES NOT CONTAIN AS MEMBER "\x{220A}" => "\x{220D}", # SMALL ELEMENT OF, SMALL CONTAINS AS MEMBER "\x{2264}" => "\x{2265}", # LESS-THAN/GREATER-THAN OR EQUAL TO "\x{2266}" => "\x{2267}", # LESS-THAN/GREATER-THAN OVER EQUAL TO "\x{2268}" => "\x{2269}", # LESS-THAN/GREATER-THAN BUT NOT EQUAL TO "\x{226A}" => "\x{226B}", # MUCH LESS-THAN/GREATER-THAN "\x{226E}" => "\x{226F}", # NOT LESS-THAN/GREATER-THAN "\x{2270}" => "\x{2271}", # NEITHER LESS-THAN/GREATER-THAN NOR EQUAL TO "\x{2272}" => "\x{2273}", # LESS-THAN/GREATER-THAN OR EQUIVALENT TO "\x{2274}" => "\x{2275}", # NEITHER LESS-THAN/GREATER-THAN NOR EQUIVALENT TO "\x{227A}" => "\x{227B}", # PRECEDES/SUCCEEDS "\x{227C}" => "\x{227D}", # PRECEDES/SUCCEEDS OR EQUAL TO "\x{227E}" => "\x{227F}", # PRECEDES/SUCCEEDS OR EQUIVALENT TO "\x{2280}" => "\x{2281}", # DOES NOT PRECEDE/SUCCEED "\x{2282}" => "\x{2283}", # SUBSET/SUPERSET OF "\x{2284}" => "\x{2285}", # NOT A SUBSET/SUPERSET OF "\x{2286}" => "\x{2287}", # SUBSET/SUPERSET OF OR EQUAL TO "\x{2288}" => "\x{2289}", # NEITHER A SUBSET/SUPERSET OF NOR EQUAL TO "\x{228A}" => "\x{228B}", # SUBSET/SUPERSET OF WITH NOT EQUAL TO "\x{22A3}" => "\x{22A2}", # LEFT/RIGHT TACK "\x{22A6}" => "\x{2ADE}", # ASSERTION, SHORT LEFT TACK "\x{22A8}" => "\x{2AE4}", # TRUE, VERTICAL BAR DOUBLE LEFT TURNSTILE "\x{22A9}" => "\x{2AE3}", # FORCES, DOUBLE VERTICAL BAR LEFT TURNSTILE "\x{22B0}" => "\x{22B1}", # PRECEDES/SUCCEEDS UNDER RELATION "\x{22D0}" => "\x{22D1}", # DOUBLE SUBSET/SUPERSET "\x{22D6}" => "\x{22D7}", # LESS-THAN/GREATER-THAN WITH DOT "\x{22D8}" => "\x{22D9}", # VERY MUCH LESS-THAN/GREATER-THAN "\x{22DC}" => "\x{22DD}", # EQUAL TO OR LESS-THAN/GREATER-THAN "\x{22DE}" => "\x{22DF}", # EQUAL TO OR PRECEDES/SUCCEEDS "\x{22E0}" => "\x{22E1}", # DOES NOT PRECEDE/SUCCEED OR EQUAL "\x{22E6}" => "\x{22E7}", # LESS-THAN/GREATER-THAN BUT NOT EQUIVALENT TO "\x{22E8}" => "\x{22E9}", # PRECEDES/SUCCEEDS BUT NOT EQUIVALENT TO "\x{22F2}" => "\x{22FA}", # ELEMENT OF/CONTAINS WITH LONG HORIZONTAL STROKE "\x{22F3}" => "\x{22FB}", # ELEMENT OF/CONTAINS WITH VERTICAL BAR AT END OF HORIZONTAL STROKE "\x{22F4}" => "\x{22FC}", # SMALL ELEMENT OF/CONTAINS WITH VERTICAL BAR AT END OF HORIZONTAL STROKE "\x{22F6}" => "\x{22FD}", # ELEMENT OF/CONTAINS WITH OVERBAR "\x{22F7}" => "\x{22FE}", # SMALL ELEMENT OF/CONTAINS WITH OVERBAR "\x{2308}" => "\x{2309}", # LEFT/RIGHT CEILING "\x{230A}" => "\x{230B}", # LEFT/RIGHT FLOOR "\x{2326}" => "\x{232B}", # ERASE TO THE RIGHT/LEFT "\x{2329}" => "\x{232A}", # LEFT/RIGHT-POINTING ANGLE BRACKET "\x{2348}" => "\x{2347}", # APL FUNCTIONAL SYMBOL QUAD RIGHT/LEFTWARDS ARROW "\x{23E9}" => "\x{23EA}", # BLACK RIGHT/LEFT-POINTING DOUBLE TRIANGLE "\x{23ED}" => "\x{23EE}", # BLACK RIGHT/LEFT-POINTING DOUBLE TRIANGLE WITH VERTICAL BAR "\x{261B}" => "\x{261A}", # BLACK RIGHT/LEFT POINTING INDEX "\x{261E}" => "\x{261C}", # WHITE RIGHT/LEFT POINTING INDEX "\x{269E}" => "\x{269F}", # THREE LINES CONVERGING RIGHT/LEFT "\x{2768}" => "\x{2769}", # MEDIUM LEFT/RIGHT PARENTHESIS ORNAMENT "\x{276A}" => "\x{276B}", # MEDIUM FLATTENED LEFT/RIGHT PARENTHESIS ORNAMENT "\x{276C}" => "\x{276D}", # MEDIUM LEFT/RIGHT-POINTING ANGLE BRACKET ORNAMENT "\x{276E}" => "\x{276F}", # HEAVY LEFT/RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT "\x{2770}" => "\x{2771}", # HEAVY LEFT/RIGHT-POINTING ANGLE BRACKET ORNAMENT "\x{2772}" => "\x{2773}", # LIGHT LEFT/RIGHT TORTOISE SHELL BRACKET ORNAMENT "\x{2774}" => "\x{2775}", # MEDIUM LEFT/RIGHT CURLY BRACKET ORNAMENT "\x{27C3}" => "\x{27C4}", # OPEN SUBSET/SUPERSET "\x{27C5}" => "\x{27C6}", # LEFT/RIGHT S-SHAPED BAG DELIMITER "\x{27C8}" => "\x{27C9}", # REVERSE SOLIDUS PRECEDING SUBSET, SUPERSET PRECEDING SOLIDUS "\x{27DE}" => "\x{27DD}", # LONG LEFT/RIGHT TACK "\x{27E6}" => "\x{27E7}", # MATHEMATICAL LEFT/RIGHT WHITE SQUARE BRACKET "\x{27E8}" => "\x{27E9}", # MATHEMATICAL LEFT/RIGHT ANGLE BRACKET "\x{27EA}" => "\x{27EB}", # MATHEMATICAL LEFT/RIGHT DOUBLE ANGLE BRACKET "\x{27EC}" => "\x{27ED}", # MATHEMATICAL LEFT/RIGHT WHITE TORTOISE SHELL BRACKET "\x{27EE}" => "\x{27EF}", # MATHEMATICAL LEFT/RIGHT FLATTENED PARENTHESIS "\x{27F4}" => "\x{2B32}", # RIGHT/LEFT ARROW WITH CIRCLED PLUS "\x{27F6}" => "\x{27F5}", # LONG RIGHT/LEFTWARDS ARROW "\x{27F9}" => "\x{27F8}", # LONG RIGHT/LEFTWARDS DOUBLE ARROW "\x{27FC}" => "\x{27FB}", # LONG RIGHT/LEFTWARDS ARROW FROM BAR "\x{27FE}" => "\x{27FD}", # LONG RIGHT/LEFTWARDS DOUBLE ARROW FROM BAR "\x{27FF}" => "\x{2B33}", # LONG RIGHT/LEFTWARDS SQUIGGLE ARROW "\x{2900}" => "\x{2B34}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH VERTICAL STROKE "\x{2901}" => "\x{2B35}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH DOUBLE VERTICAL STROKE "\x{2903}" => "\x{2902}", # RIGHT/LEFTWARDS DOUBLE ARROW WITH VERTICAL STROKE "\x{2905}" => "\x{2B36}", # RIGHT/LEFTWARDS TWO-HEADED ARROW FROM BAR "\x{2907}" => "\x{2906}", # RIGHT/LEFTWARDS DOUBLE ARROW FROM BAR "\x{290D}" => "\x{290C}", # RIGHT/LEFTWARDS DOUBLE DASH ARROW "\x{290F}" => "\x{290E}", # RIGHT/LEFTWARDS TRIPLE DASH ARROW "\x{2910}" => "\x{2B37}", # RIGHT/LEFTWARDS TWO-HEADED TRIPLE DASH ARROW "\x{2911}" => "\x{2B38}", # RIGHT/LEFTWARDS ARROW WITH DOTTED STEM "\x{2914}" => "\x{2B39}", # RIGHT/LEFTWARDS ARROW WITH TAIL WITH VERTICAL STROKE "\x{2915}" => "\x{2B3A}", # RIGHT/LEFTWARDS ARROW WITH TAIL WITH DOUBLE VERTICAL STROKE "\x{2916}" => "\x{2B3B}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TAIL "\x{2917}" => "\x{2B3C}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TAIL WITH VERTICAL STROKE "\x{2918}" => "\x{2B3D}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TAIL WITH DOUBLE VERTICAL STROKE "\x{291A}" => "\x{2919}", # RIGHT/LEFTWARDS ARROW-TAIL "\x{291C}" => "\x{291B}", # RIGHT/LEFTWARDS DOUBLE ARROW-TAIL "\x{291E}" => "\x{291D}", # RIGHT/LEFTWARDS ARROW TO BLACK DIAMOND "\x{2920}" => "\x{291F}", # RIGHT/LEFTWARDS ARROW FROM BAR TO BLACK DIAMOND "\x{2933}" => "\x{2B3F}", # WAVE ARROW POINTING DIRECTLY RIGHT/LEFT "\x{2937}" => "\x{2936}", # ARROW POINTING DOWNWARDS THEN CURVING RIGHT/LEFTWARDS "\x{2945}" => "\x{2946}", # RIGHT/LEFTWARDS ARROW WITH PLUS BELOW "\x{2947}" => "\x{2B3E}", # RIGHT/LEFTWARDS ARROW THROUGH X "\x{2953}" => "\x{2952}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP TO BAR "\x{2957}" => "\x{2956}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWN TO BAR "\x{295B}" => "\x{295A}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP FROM BAR "\x{295F}" => "\x{295E}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWN FROM BAR "\x{2964}" => "\x{2962}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP ABOVE RIGHT/LEFTWARDS HARPOON WITH BARB DOWN "\x{296C}" => "\x{296A}", # RIGHT/LEFTWARDS HARPOON WITH BARB UP ABOVE LONG DASH "\x{296D}" => "\x{296B}", # RIGHT/LEFTWARDS HARPOON WITH BARB DOWN BELOW LONG DASH "\x{2971}" => "\x{2B40}", # EQUALS SIGN ABOVE RIGHT/LEFTWARDS ARROW "\x{2972}" => "\x{2B41}", # TILDE OPERATOR ABOVE RIGHTWARDS ARROW, REVERSE TILDE OPERATOR ABOVE LEFTWARDS ARROW "\x{2974}" => "\x{2B4B}", # RIGHTWARDS ARROW ABOVE TILDE OPERATOR, LEFTWARDS ARROW ABOVE REVERSE TILDE OPERATOR "\x{2975}" => "\x{2B42}", # RIGHTWARDS ARROW ABOVE ALMOST EQUAL TO, LEFTWARDS ARROW ABOVE REVERSE ALMOST EQUAL TO "\x{2979}" => "\x{297B}", # SUBSET/SUPERSET ABOVE RIGHT/LEFTWARDS ARROW "\x{2983}" => "\x{2984}", # LEFT/RIGHT WHITE CURLY BRACKET "\x{2985}" => "\x{2986}", # LEFT/RIGHT WHITE PARENTHESIS "\x{2987}" => "\x{2988}", # Z NOTATION LEFT/RIGHT IMAGE BRACKET "\x{2989}" => "\x{298A}", # Z NOTATION LEFT/RIGHT BINDING BRACKET "\x{298B}" => "\x{298C}", # LEFT/RIGHT SQUARE BRACKET WITH UNDERBAR "\x{298D}" => "\x{2990}", # LEFT/RIGHT SQUARE BRACKET WITH TICK IN TOP CORNER "\x{298F}" => "\x{298E}", # LEFT/RIGHT SQUARE BRACKET WITH TICK IN BOTTOM CORNER "\x{2991}" => "\x{2992}", # LEFT/RIGHT ANGLE BRACKET WITH DOT "\x{2993}" => "\x{2994}", # LEFT/RIGHT ARC LESS-THAN/GREATER-THAN BRACKET "\x{2995}" => "\x{2996}", # DOUBLE LEFT/RIGHT ARC GREATER-THAN/LESS-THAN BRACKET "\x{2997}" => "\x{2998}", # LEFT/RIGHT BLACK TORTOISE SHELL BRACKET "\x{29A8}" => "\x{29A9}", # MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING UP AND RIGHT/LEFT "\x{29AA}" => "\x{29AB}", # MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING DOWN AND RIGHT/LEFT "\x{29B3}" => "\x{29B4}", # EMPTY SET WITH RIGHT/LEFT ARROW ABOVE "\x{29C0}" => "\x{29C1}", # CIRCLED LESS-THAN/GREATER-THAN "\x{29D8}" => "\x{29D9}", # LEFT/RIGHT WIGGLY FENCE "\x{29DA}" => "\x{29DB}", # LEFT/RIGHT DOUBLE WIGGLY FENCE "\x{29FC}" => "\x{29FD}", # LEFT/RIGHT-POINTING CURVED ANGLE BRACKET "\x{2A79}" => "\x{2A7A}", # LESS-THAN/GREATER-THAN WITH CIRCLE INSIDE "\x{2A7B}" => "\x{2A7C}", # LESS-THAN/GREATER-THAN WITH QUESTION MARK ABOVE "\x{2A7D}" => "\x{2A7E}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO "\x{2A7F}" => "\x{2A80}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO WITH DOT INSIDE "\x{2A81}" => "\x{2A82}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO WITH DOT ABOVE "\x{2A83}" => "\x{2A84}", # LESS-THAN/GREATER-THAN OR SLANTED EQUAL TO WITH DOT ABOVE RIGHT/LEFT "\x{2A85}" => "\x{2A86}", # LESS-THAN/GREATER-THAN OR APPR::XOXIMATE "\x{2A87}" => "\x{2A88}", # LESS-THAN/GREATER-THAN AND SINGLE-LINE NOT EQUAL TO "\x{2A89}" => "\x{2A8A}", # LESS-THAN/GREATER-THAN AND NOT APPR::XOXIMATE "\x{2A8D}" => "\x{2A8E}", # LESS-THAN/GREATER-THAN ABOVE SIMILAR OR EQUAL "\x{2A95}" => "\x{2A96}", # SLANTED EQUAL TO OR LESS-THAN/GREATER-THAN "\x{2A97}" => "\x{2A98}", # SLANTED EQUAL TO OR LESS-THAN/GREATER-THAN WITH DOT INSIDE "\x{2A99}" => "\x{2A9A}", # DOUBLE-LINE EQUAL TO OR LESS-THAN/GREATER-THAN "\x{2A9B}" => "\x{2A9C}", # DOUBLE-LINE SLANTED EQUAL TO OR LESS-THAN/ GREATER-THAN "\x{2A9D}" => "\x{2A9E}", # SIMILAR OR LESS-THAN/GREATER-THAN "\x{2A9F}" => "\x{2AA0}", # SIMILAR ABOVE LESS-THAN/GREATER-THAN ABOVE EQUALS SIGN "\x{2AA1}" => "\x{2AA2}", # DOUBLE NESTED LESS-THAN/GREATER-THAN "\x{2AA6}" => "\x{2AA7}", # LESS-THAN/GREATER-THAN CLOSED BY CURVE "\x{2AA8}" => "\x{2AA9}", # LESS-THAN/GREATER-THAN CLOSED BY CURVE ABOVE SLANTED EQUAL "\x{2AAA}" => "\x{2AAB}", # SMALLER THAN/LARGER THAN "\x{2AAC}" => "\x{2AAD}", # SMALLER THAN/LARGER THAN OR EQUAL TO "\x{2AAF}" => "\x{2AB0}", # PRECEDES/SUCCEEDS ABOVE SINGLE-LINE EQUALS SIGN "\x{2AB1}" => "\x{2AB2}", # PRECEDES/SUCCEEDS ABOVE SINGLE-LINE NOT EQUAL TO "\x{2AB3}" => "\x{2AB4}", # PRECEDES/SUCCEEDS ABOVE EQUALS SIGN "\x{2AB5}" => "\x{2AB6}", # PRECEDES/SUCCEEDS ABOVE NOT EQUAL TO "\x{2AB7}" => "\x{2AB8}", # PRECEDES/SUCCEEDS ABOVE ALMOST EQUAL TO "\x{2AB9}" => "\x{2ABA}", # PRECEDES/SUCCEEDS ABOVE NOT ALMOST EQUAL TO "\x{2ABB}" => "\x{2ABC}", # DOUBLE PRECEDES/SUCCEEDS "\x{2ABD}" => "\x{2ABE}", # SUBSET/SUPERSET WITH DOT "\x{2ABF}" => "\x{2AC0}", # SUBSET/SUPERSET WITH PLUS SIGN BELOW "\x{2AC1}" => "\x{2AC2}", # SUBSET/SUPERSET WITH MULTIPLICATION SIGN BELOW "\x{2AC3}" => "\x{2AC4}", # SUBSET/SUPERSET OF OR EQUAL TO WITH DOT ABOVE "\x{2AC5}" => "\x{2AC6}", # SUBSET/SUPERSET OF ABOVE EQUALS SIGN "\x{2AC7}" => "\x{2AC8}", # SUBSET/SUPERSET OF ABOVE TILDE OPERATOR "\x{2AC9}" => "\x{2ACA}", # SUBSET/SUPERSET OF ABOVE ALMOST EQUAL TO "\x{2ACB}" => "\x{2ACC}", # SUBSET/SUPERSET OF ABOVE NOT EQUAL TO "\x{2ACF}" => "\x{2AD0}", # CLOSED SUBSET/SUPERSET "\x{2AD1}" => "\x{2AD2}", # CLOSED SUBSET/SUPERSET OR EQUAL TO "\x{2AD5}" => "\x{2AD6}", # SUBSET/SUPERSET ABOVE SUBSET/SUPERSET "\x{2AE5}" => "\x{22AB}", # DOUBLE VERTICAL BAR DOUBLE LEFT/RIGHT TURNSTILE "\x{2AF7}" => "\x{2AF8}", # TRIPLE NESTED LESS-THAN/GREATER-THAN "\x{2AF9}" => "\x{2AFA}", # DOUBLE-LINE SLANTED LESS-THAN/GREATER-THAN OR EQUAL TO "\x{2B46}" => "\x{2B45}", # RIGHT/LEFTWARDS QUADRUPLE ARROW "\x{2B47}" => "\x{2B49}", # REVERSE TILDE OPERATOR ABOVE RIGHTWARDS ARROW, TILDE OPERATOR ABOVE LEFTWARDS ARROW "\x{2B48}" => "\x{2B4A}", # RIGHTWARDS ARROW ABOVE REVERSE ALMOST EQUAL TO, LEFTWARDS ARROW ABOVE ALMOST EQUAL TO "\x{2B4C}" => "\x{2973}", # RIGHTWARDS ARROW ABOVE REVERSE TILDE OPERATOR, LEFTWARDS ARROW ABOVE TILDE OPERATOR "\x{2B62}" => "\x{2B60}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW "\x{2B6C}" => "\x{2B6A}", # RIGHT/LEFTWARDS TRIANGLE-HEADED DASHED ARROW "\x{2B72}" => "\x{2B70}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW TO BAR "\x{2B7C}" => "\x{2B7A}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH DOUBLE VERTICAL STROKE "\x{2B86}" => "\x{2B84}", # RIGHT/LEFTWARDS TRIANGLE-HEADED PAIRED ARROWS "\x{2B8A}" => "\x{2B88}", # RIGHT/LEFTWARDS BLACK CIRCLED WHITE ARROW "\x{2B95}" => "\x{2B05}", # RIGHT/LEFTWARDS BLACK ARROW "\x{2B9A}" => "\x{2B98}", # THREE-D TOP-LIGHTED RIGHT/LEFTWARDS EQUILATERAL ARROWHEAD "\x{2B9E}" => "\x{2B9C}", # BLACK RIGHT/LEFTWARDS EQUILATERAL ARROWHEAD "\x{2BA1}" => "\x{2BA0}", # DOWNWARDS TRIANGLE-HEADED ARROW WITH LONG TIP RIGHT/LEFTWARDS "\x{2BA3}" => "\x{2BA2}", # UPWARDS TRIANGLE-HEADED ARROW WITH LONG TIP RIGHT/LEFTWARDS "\x{2BA9}" => "\x{2BA8}", # BLACK CURVED DOWNWARDS AND RIGHT/LEFTWARDS ARROW "\x{2BAB}" => "\x{2BAA}", # BLACK CURVED UPWARDS AND RIGHT/LEFTWARDS ARROW "\x{2BB1}" => "\x{2BB0}", # RIBBON ARROW DOWN RIGHT/LEFT "\x{2BB3}" => "\x{2BB2}", # RIBBON ARROW UP RIGHT/LEFT "\x{2BEE}" => "\x{2BEC}", # RIGHT/LEFTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS "\x{2E02}" => "\x{2E03}", # LEFT/RIGHT SUBSTITUTION BRACKET "\x{2E03}" => "\x{2E02}", # RIGHT/LEFT SUBSTITUTION BRACKET "\x{2E04}" => "\x{2E05}", # LEFT/RIGHT DOTTED SUBSTITUTION BRACKET "\x{2E05}" => "\x{2E04}", # RIGHT/LEFT DOTTED SUBSTITUTION BRACKET "\x{2E09}" => "\x{2E0A}", # LEFT/RIGHT TRANSPOSITION BRACKET "\x{2E0A}" => "\x{2E09}", # RIGHT/LEFT TRANSPOSITION BRACKET "\x{2E0C}" => "\x{2E0D}", # LEFT/RIGHT RAISED OMISSION BRACKET "\x{2E0D}" => "\x{2E0C}", # RIGHT/LEFT RAISED OMISSION BRACKET "\x{2E11}" => "\x{2E10}", # REVERSED FORKED PARAGRAPHOS, FORKED PARAGRAPHOS "\x{2E1C}" => "\x{2E1D}", # LEFT/RIGHT LOW PARAPHRASE BRACKET "\x{2E1D}" => "\x{2E1C}", # RIGHT/LEFT LOW PARAPHRASE BRACKET "\x{2E20}" => "\x{2E21}", # LEFT/RIGHT VERTICAL BAR WITH QUILL "\x{2E21}" => "\x{2E20}", # RIGHT/LEFT VERTICAL BAR WITH QUILL "\x{2E22}" => "\x{2E23}", # TOP LEFT/RIGHT HALF BRACKET "\x{2E24}" => "\x{2E25}", # BOTTOM LEFT/RIGHT HALF BRACKET "\x{2E26}" => "\x{2E27}", # LEFT/RIGHT SIDEWAYS U BRACKET "\x{2E28}" => "\x{2E29}", # LEFT/RIGHT DOUBLE PARENTHESIS "\x{2E36}" => "\x{2E37}", # DAGGER WITH LEFT/RIGHT GUARD "\x{2E42}" => "\x{201E}", # DOUBLE LOW-REVERSED-9 QUOTATION MARK, DOUBLE LOW-9 QUOTATION MARK "\x{2E55}" => "\x{2E56}", # LEFT/RIGHT SQUARE BRACKET WITH STROKE "\x{2E57}" => "\x{2E58}", # LEFT/RIGHT SQUARE BRACKET WITH DOUBLE STROKE "\x{2E59}" => "\x{2E5A}", # TOP HALF LEFT/RIGHT PARENTHESIS "\x{2E5B}" => "\x{2E5C}", # BOTTOM HALF LEFT/RIGHT PARENTHESIS "\x{3008}" => "\x{3009}", # LEFT/RIGHT ANGLE BRACKET "\x{300A}" => "\x{300B}", # LEFT/RIGHT DOUBLE ANGLE BRACKET "\x{300C}" => "\x{300D}", # LEFT/RIGHT CORNER BRACKET "\x{300E}" => "\x{300F}", # LEFT/RIGHT WHITE CORNER BRACKET "\x{3010}" => "\x{3011}", # LEFT/RIGHT BLACK LENTICULAR BRACKET "\x{3014}" => "\x{3015}", # LEFT/RIGHT TORTOISE SHELL BRACKET "\x{3016}" => "\x{3017}", # LEFT/RIGHT WHITE LENTICULAR BRACKET "\x{3018}" => "\x{3019}", # LEFT/RIGHT WHITE TORTOISE SHELL BRACKET "\x{301A}" => "\x{301B}", # LEFT/RIGHT WHITE SQUARE BRACKET "\x{301D}" => "\x{301E}", # REVERSED DOUBLE PRIME QUOTATION MARK, DOUBLE PRIME QUOTATION MARK "\x{A9C1}" => "\x{A9C2}", # JAVANESE LEFT/RIGHT RERENGGAN "\x{FD3E}" => "\x{FD3F}", # ORNATE LEFT/RIGHT PARENTHESIS "\x{FE59}" => "\x{FE5A}", # SMALL LEFT/RIGHT PARENTHESIS "\x{FE5B}" => "\x{FE5C}", # SMALL LEFT/RIGHT CURLY BRACKET "\x{FE5D}" => "\x{FE5E}", # SMALL LEFT/RIGHT TORTOISE SHELL BRACKET "\x{FE64}" => "\x{FE65}", # SMALL LESS-THAN/GREATER-THAN SIGN "\x{FF08}" => "\x{FF09}", # FULLWIDTH LEFT/RIGHT PARENTHESIS "\x{FF1C}" => "\x{FF1E}", # FULLWIDTH LESS-THAN/GREATER-THAN SIGN "\x{FF3B}" => "\x{FF3D}", # FULLWIDTH LEFT/RIGHT SQUARE BRACKET "\x{FF5B}" => "\x{FF5D}", # FULLWIDTH LEFT/RIGHT CURLY BRACKET "\x{FF5F}" => "\x{FF60}", # FULLWIDTH LEFT/RIGHT WHITE PARENTHESIS "\x{FF62}" => "\x{FF63}", # HALFWIDTH LEFT/RIGHT CORNER BRACKET "\x{FFEB}" => "\x{FFE9}", # HALFWIDTH RIGHT/LEFTWARDS ARROW "\x{1D103}" => "\x{1D102}", # MUSICAL SYMBOL REVERSE FINAL BARLINE, MUSICAL SYMBOL FINAL BARLINE "\x{1D106}" => "\x{1D107}", # MUSICAL SYMBOL LEFT/RIGHT REPEAT SIGN "\x{1F449}" => "\x{1F448}", # WHITE RIGHT/LEFT POINTING BACKHAND INDEX "\x{1F508}" => "\x{1F568}", # SPEAKER, RIGHT SPEAKER "\x{1F509}" => "\x{1F569}", # SPEAKER WITH ONE SOUND WAVE, RIGHT SPEAKER WITH ONE SOUND WAVE "\x{1F50A}" => "\x{1F56A}", # SPEAKER WITH THREE SOUND WAVES, RIGHT SPEAKER WITH THREE SOUND WAVES "\x{1F57B}" => "\x{1F57D}", # LEFT/RIGHT HAND TELEPHONE RECEIVER "\x{1F599}" => "\x{1F598}", # SIDEWAYS WHITE RIGHT/LEFT POINTING INDEX "\x{1F59B}" => "\x{1F59A}", # SIDEWAYS BLACK RIGHT/LEFT POINTING INDEX "\x{1F59D}" => "\x{1F59C}", # BLACK RIGHT/LEFT POINTING BACKHAND INDEX "\x{1F5E6}" => "\x{1F5E7}", # THREE RAYS LEFT/RIGHT "\x{1F802}" => "\x{1F800}", # RIGHT/LEFTWARDS ARROW WITH SMALL TRIANGLE ARROWHEAD "\x{1F806}" => "\x{1F804}", # RIGHT/LEFTWARDS ARROW WITH MEDIUM TRIANGLE ARROWHEAD "\x{1F80A}" => "\x{1F808}", # RIGHT/LEFTWARDS ARROW WITH LARGE TRIANGLE ARROWHEAD "\x{1F812}" => "\x{1F810}", # RIGHT/LEFTWARDS ARROW WITH SMALL EQUILATERAL ARROWHEAD "\x{1F816}" => "\x{1F814}", # RIGHT/LEFTWARDS ARROW WITH EQUILATERAL ARROWHEAD "\x{1F81A}" => "\x{1F818}", # HEAVY RIGHT/LEFTWARDS ARROW WITH EQUILATERAL ARROWHEAD "\x{1F81E}" => "\x{1F81C}", # HEAVY RIGHT/LEFTWARDS ARROW WITH LARGE EQUILATERAL ARROWHEAD "\x{1F822}" => "\x{1F820}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH NARROW SHAFT "\x{1F826}" => "\x{1F824}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH MEDIUM SHAFT "\x{1F82A}" => "\x{1F828}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH BOLD SHAFT "\x{1F82E}" => "\x{1F82C}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH HEAVY SHAFT "\x{1F832}" => "\x{1F830}", # RIGHT/LEFTWARDS TRIANGLE-HEADED ARROW WITH VERY HEAVY SHAFT "\x{1F836}" => "\x{1F834}", # RIGHT/LEFTWARDS FINGER-POST ARROW "\x{1F83A}" => "\x{1F838}", # RIGHT/LEFTWARDS SQUARED ARROW "\x{1F83E}" => "\x{1F83C}", # RIGHT/LEFTWARDS COMPRESSED ARROW "\x{1F842}" => "\x{1F840}", # RIGHT/LEFTWARDS HEAVY COMPRESSED ARROW "\x{1F846}" => "\x{1F844}", # RIGHT/LEFTWARDS HEAVY ARROW "\x{1F852}" => "\x{1F850}", # RIGHT/LEFTWARDS SANS-SERIF ARROW "\x{1F862}" => "\x{1F860}", # WIDE-HEADED RIGHT/LEFTWARDS LIGHT BARB ARROW "\x{1F86A}" => "\x{1F868}", # WIDE-HEADED RIGHT/LEFTWARDS BARB ARROW "\x{1F872}" => "\x{1F870}", # WIDE-HEADED RIGHT/LEFTWARDS MEDIUM BARB ARROW "\x{1F87A}" => "\x{1F878}", # WIDE-HEADED RIGHT/LEFTWARDS HEAVY BARB ARROW "\x{1F882}" => "\x{1F880}", # WIDE-HEADED RIGHT/LEFTWARDS VERY HEAVY BARB ARROW "\x{1F892}" => "\x{1F890}", # RIGHT/LEFTWARDS TRIANGLE ARROWHEAD "\x{1F896}" => "\x{1F894}", # RIGHT/LEFTWARDS WHITE ARROW WITHIN TRIANGLE ARROWHEAD "\x{1F89A}" => "\x{1F898}", # RIGHT/LEFTWARDS ARROW WITH NOTCHED TAIL "\x{1F8A1}" => "\x{1F8A0}", # RIGHTWARDS BOTTOM SHADED WHITE ARROW, LEFTWARDS BOTTOM-SHADED WHITE ARROW "\x{1F8A3}" => "\x{1F8A2}", # RIGHT/LEFTWARDS TOP SHADED WHITE ARROW "\x{1F8A5}" => "\x{1F8A6}", # RIGHT/LEFTWARDS RIGHT-SHADED WHITE ARROW "\x{1F8A7}" => "\x{1F8A4}", # RIGHT/LEFTWARDS LEFT-SHADED WHITE ARROW "\x{1F8A9}" => "\x{1F8A8}", # RIGHT/LEFTWARDS BACK-TILTED SHADOWED WHITE ARROW "\x{1F8AB}" => "\x{1F8AA}", # RIGHT/LEFTWARDS FRONT-TILTED SHADOWED WHITE ARROW ); } sub decomment { if ($] >= 5.014 && $] < 5.016) { _croak( "PPR::X::decomment() does not work under Perl 5.14" )} my ($str) = @_; local %PPR::X::comment_len; # Locate comments... $str =~ m{ (?&PerlEntireDocument) (?(DEFINE) (? ( (? (?: \h++ | (?&PPR_X_newline_and_heredoc) | (?&decomment) | __ (?> END | DATA ) __ \b .*+ \z )*+ ) # End of rule (? (?: \h++ | (?&PPR_X_newline_and_heredoc) | (?&decomment) | __ (?> END | DATA ) __ \b .*+ \z )++ ) # End of rule (? ( ^ = [^\W\d]\w*+ .*? (?> ^ = cut \b [^\n]*+ $ | \z ) ) (?{ my $len = length($^N); my $pos = pos() - $len; $PPR::X::comment_len{$pos} = $len; }) ) # End of rule $PPR::X::GRAMMAR ) }xms or return; # Delete the comments found... for my $from_pos (_uniq(sort { $b <=> $a } keys %PPR::X::comment_len)) { substr($str, $from_pos, $PPR::X::comment_len{$from_pos}) =~ s/.+//g; } return $str; } sub _uniq { my %seen; return grep {!$seen{$_}++} @_; } sub _croak { require Carp; Carp::croak(@_); } sub _report { state $CONTEXT_WIDTH = 20; state $BUFFER = q{ } x $CONTEXT_WIDTH; state $depth = 0; my ($msg, $increment) = @_; $depth++ if $increment; my $at = pos(); my $str = $BUFFER . $_ . $BUFFER; my $pre = substr($str, $at, $CONTEXT_WIDTH); my $post = substr($str, $at+$CONTEXT_WIDTH, $CONTEXT_WIDTH); tr/\n/ / for $pre, $post; no warnings 'utf8'; warn sprintf("%05d ⎜%*s⎜%-*s⎜ %s%s\n", $at, $CONTEXT_WIDTH, $pre, $CONTEXT_WIDTH, $post, q{ } x $depth, $msg); $depth-- if !$increment; } 1; # Magic true value required at end of module __END__ =head1 NAME PPR::X - Pattern-based Perl Recognizer =head1 VERSION This document describes PPR::X version 0.001009 =head1 SYNOPSIS use PPR::X; # Define a regex that will match an entire Perl document... my $perl_document = qr{ # What to match # Install the (?&PerlDocument) rule (?&PerlEntireDocument) $PPR::X::GRAMMAR }x; # Define a regex that will match a single Perl block... my $perl_block = qr{ # What to match... # Install the (?&PerlBlock) rule... (?&PerlBlock) $PPR::X::GRAMMAR }x; # Define a regex that will match a simple Perl extension... my $perl_coroutine = qr{ # What to match... coro (?&PerlOWS) (? (?&PerlQualifiedIdentifier) ) (?&PerlOWS) (? (?&PerlBlock) ) # Install the necessary subrules... $PPR::X::GRAMMAR }x; # Define a regex that will match an integrated Perl extension... my $perl_with_classes = qr{ # What to match... \A (?&PerlOWS) # Optional whitespace (including comments) (?&PerlDocument) # A full Perl document (?&PerlOWS) # More optional whitespace \Z # Add a 'class' keyword into the syntax that PPR::X understands... (?(DEFINE) (? class (?&PerlOWS) (?&PerlQualifiedIdentifier) (?&PerlOWS) (?: is (?&PerlNWS) (?&PerlIdentifier) (?&PerlOWS) )*+ (?&PerlBlock) ) (? \( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) ) # Install the necessary standard subrules... $PPR::X::GRAMMAR }x; =head1 DESCRIPTION The PPR::X module provides a single regular expression that defines a set of independent subpatterns suitable for matching entire Perl documents, as well as a wide range of individual syntactic components of Perl (i.e. statements, expressions, control blocks, variables, etc.) The regex does not "parse" Perl (that is, it does not build a syntax tree, like the PPI module does). Instead it simply "recognizes" standard Perl constructs, or new syntaxes composed from Perl constructs. Its features and capabilities therefore complement those of the PPI module, rather than replacing them. See L<"Comparison with PPI">. =head1 INTERFACE =head2 Importing and using the Perl grammar regex The PPR::X module exports no subroutines or variables, and provides no methods. Instead, it defines a single package variable, C<$PPR::X::GRAMMAR>, which can be interpolated into regexes to add rules that permit Perl constructs to be parsed: $source_code =~ m{ (?&PerlEntireDocument) $PPR::X::GRAMMAR }x; Note that all the examples shown so far have interpolated this "grammar variable" at the end of the regular expression. This placement is desirable, but not necessary. Both of the following work identically: $source_code =~ m{ (?&PerlEntireDocument) $PPR::X::GRAMMAR }x; $source_code =~ m{ $PPR::X::GRAMMAR (?&PerlEntireDocument) }x; However, if the grammar is to be L, then the extensions must be specified B> the base grammar (i.e. before the interpolation of C<$PPR::X::GRAMMAR>). Placing the grammar variable at the end of a regex ensures that will be the case, and has the added advantage of "front-loading" the regex with the most important information: what is actually going to be matched. Note too that, because the PPR::X grammar internally uses capture groups, placing C<$PPR::X::GRAMMAR> anywhere other than the very end of your regex may change the numbering of any explicit capture groups in your regex. For complete safety, regexes that use the PPR::X grammar should probably use named captures, instead of numbered captures. =head2 Error reporting Regex-based parsing is all-or-nothing: either your regex matches (and returns any captures you requested), or it fails to match (and returns nothing). This can make it difficult to detect I a PPR::X-based match failed; to work out what the "bad source code" was that prevented your regex from matching. So the module provides a special variable that attempts to detect the source code that prevented any call to the C<(?&PerlStatement)> subpattern from matching. That variable is: C<$PPR::X::ERROR> C<$PPR::X::ERROR> is only set if it is undefined at the point where an error is detected, and will only be set to the first such error that is encountered during parsing. Note that errors are only detected when matching context-sensitive components (for example in the middle of a C<(?&PerlStatement), as part of a C<(?&PerlContextualRegex)>, or at the end of a C<(?&PerlEntireDocument>)>. Errors, especially errors at the end of otherwise valid code, will often not be detected in context-free components (for example, at the end of a C<(?&PerlStatementSequence), as part of a C<(?&PerlRegex)>, or at the end of a C<(?&PerlDocument>)>. A common mistake in this area is to attempt to match an entire Perl document using: m{ \A (?&PerlDocument) \Z $PPR::X::GRAMMAR }x instead of: m{ (?&PerlEntireDocument) $PPR::X::GRAMMAR }x Only the second approach will be able to successfully detect an unclosed curly bracket at the end of the document. =head3 C interface If it is set, C<$PPR::X::ERROR> will contain an object of type PPR::X::ERROR, with the following methods: =over =item C<< $PPR::X::ERROR->origin($line, $file) >> Returns a clone of the PPR::X::ERROR object that now believes that the source code parsing failure it is reporting occurred in a code fragment starting at the specified line and file. If the second argument is omitted, the file name is not reported in any diagnostic. =item C<< $PPR::X::ERROR->source() >> Returns a string containing the specific source code that could not be parsed as a Perl statement. =item C<< $PPR::X::ERROR->prefix() >> Returns a string containing all the source code preceding the code that could not be parsed. That is: the valid code that is the preceding context of the unparsable code. =item C<< $PPR::X::ERROR->line( $opt_offset ) >> Returns an integer which is the line number at which the unparsable code was encountered. If the optional "offset" argument is provided, it will be added to the line number returned. Note that the offset is ignored if the PPR::X::ERROR object originates from a prior call to C<< $PPR::X::ERROR->origin >> (because in that case you will have already specified the correct offset). =item C<< $PPR::X::ERROR->diagnostic() >> Returns a string containing the diagnostic that would be returned by C if the source code were compiled. B> The diagnostic is obtained by partially eval'ing the source code. This means that run-time code will not be executed, but C and C blocks will run. Do B> call this method if the source code that created this error might also have non-trivial compile-time side-effects. =back A typical use might therefore be: # Make sure it's undefined, and will only be locally modified... local $PPR::X::ERROR; # Process the matched block... if ($source_code =~ m{ (? (?&PerlBlock) ) $PPR::X::GRAMMAR }x) { process( $+{Block} ); } # Or report the offending code that stopped it being a valid block... else { die "Invalid Perl block: " . $PPR::X::ERROR->source . "\n", $PPR::X::ERROR->origin($linenum, $filename)->diagnostic . "\n"; } =head2 Decommenting code with C The module provides (but does not export) a C subroutine that can remove any comments and/or POD from source code. It takes a single argument: a string containing the course code. It returns a single value: a string containing the decommented source code. For example: $decommented_code = PPR::X::decomment( $commented_code ); The subroutine will fail if the argument wasn't valid Perl code, in which case it returns C and sets C<$PPR::X::ERROR> to indicate where the invalid source code was encountered. Note that, due to separate bugs in the regex engine in Perl 5.14 and 5.20, the C subroutine is not available when running under these releases. =head2 Examples I In each of the following examples, the subroutine C is used to acquire the source code from a file whose name is passed as its argument. The C subroutine is just: sub slurp { local (*ARGV, $/); @ARGV = shift; readline; } or, for the less twisty-minded: sub slurp { my ($filename) = @_; open my $filehandle, '<', $filename or die $!; local $/; return readline($filehandle); } =head3 Validating source code # "Valid" if source code matches a Perl document under the Perl grammar printf( "$filename %s a valid Perl file\n", slurp($filename) =~ m{ (?&PerlEntireDocument) $PPR::X::GRAMMAR }x ? "is" : "is not" ); =head3 Counting statements printf( # Output "$filename contains %d statements\n", # a report of scalar # the count of grep {defined} # defined matches slurp($filename) # from the source code, =~ m{ \G (?&PerlOWS) # skipping whitespace ((?&PerlStatement)) # and keeping statements, $PPR::X::GRAMMAR # using the Perl grammar }gcx; # incrementally ); =head3 Stripping comments and POD from source code my $source = slurp($filename); # Get the source $source =~ s{ (?&PerlNWS) $PPR::X::GRAMMAR }{ }gx; # Compact whitespace print $source; # Print the result =head3 Stripping comments and POD from source code (in Perl v5.14 or later) # Print the source code, having compacted whitespace... print slurp($filename) =~ s{ (?&PerlNWS) $PPR::X::GRAMMAR }{ }gxr; =head3 Stripping everything C comments and POD from source code say # Output grep {defined} # defined matches slurp($filename) # from the source code, =~ m{ \G ((?&PerlOWS)) # keeping whitespace, (?&PerlStatement)? # skipping statements, $PPR::X::GRAMMAR # using the Perl grammar }gcx; # incrementally =head2 Available rules Interpolating C<$PPR::X::GRAMMAR> in a regex makes all of the following rules available within that regex. Note that other rules not listed here may also be added, but these are all considered strictly internal to the PPR::X module and are not guaranteed to continue to exist in future releases. All such "internal-use-only" rules have names that start with C... =head3 C<< (?&PerlDocument) >> Matches a valid Perl document, including leading or trailing whitespace, comments, and any final C<__DATA__> or C<__END__> section. This rule is context-free, so it can be embedded in a larger regex. For example, to match an embedded chunk of Perl code, delimited by C<<<< <<< >>>>...C<<<< >>> >>>>: $src = m{ <<< (?&PerlDocument) >>> $PPR::X::GRAMMAR }x; =head3 C<< (?&PerlEntireDocument) >> Matches an entire valid Perl document, including leading or trailing whitespace, comments, and any final C<__DATA__> or C<__END__> section. This rule is I context-free. It has an internal C<\A> at the beginning and C<\Z> at the end, so a regex containing C<(?&PerlEntireDocument)> will only match if: =over =item (a) the C<(?&PerlEntireDocument)> is the sole top-level element of the regex (or, at least the sole element of a single top-level C<|>-branch of the regex), =item B> =item (b) the entire string being matched contains only a single valid Perl document. =back In general, if you want to check that a string consists entirely of a single valid sequence of Perl code, use: $str =~ m{ (?&PerlEntireDocument) $PPR::X::GRAMMAR } If you want to check that a string I at least one valid sequence of Perl code at some point, possibly embedded in other text, use: $str =~ m{ (?&PerlDocument) $PPR::X::GRAMMAR } =head3 C<< (?&PerlStatementSequence) >> Matches zero-or-more valid Perl statements, separated by optional POD sequences. =head3 C<< (?&PerlStatement) >> Matches a single valid Perl statement, including: control structures; C, C, C, C, C, C, or C blocks; variable declarations, C statements, etc. =head3 C<< (?&PerlExpression) >> Matches a single valid Perl expression involving operators of any precedence, but not any kind of block (i.e. not control structures, C blocks, etc.) nor any trailing statement modifier (e.g. not a postfix C, C, or C). =head3 C<< (?&PerlLowPrecedenceNotExpression) >> Matches an expression at the precedence of the C operator. That is, a single valid Perl expression that involves operators above the precedence of C. =head3 C<< (?&PerlAssignment) >> Matches an assignment expression. That is, a single valid Perl expression involving operators above the precedence of comma (C<,> or C<< => >>). =head3 C<< (?&PerlConditionalExpression) >> or C<< (?&PerlScalarExpression) >> Matches a conditional expression that uses the C...C<:> ternary operator. That is, a single valid Perl expression involving operators above the precedence of assignment. The alterative name comes from the fact that anything matching this rule is what most people think of as a single element of a comma-separated list. =head3 C<< (?&PerlBinaryExpression) >> Matches an expression that uses any high-precedence binary operators. That is, a single valid Perl expression involving operators above the precedence of the ternary operator. =head3 C<< (?&PerlPrefixPostfixTerm) >> Matches a term with optional prefix and/or postfix unary operators and/or a trailing sequence of C<< -> >> dereferences. That is, a single valid Perl expression involving operators above the precedence of exponentiation (C<**>). =head3 C<< (?&PerlTerm) >> Matches a simple high-precedence term within a Perl expression. That is: a subroutine or builtin function call; a variable declaration; a variable or typeglob lookup; an anonymous array, hash, or subroutine constructor; a quotelike or numeric literal; a regex match; a substitution; a transliteration; a C or C block; or any other expression in surrounding parentheses. =head3 C<< (?&PerlTermPostfixDereference) >> Matches a sequence of array- or hash-lookup brackets, or subroutine call parentheses, or a postfix dereferencer (e.g. C<< ->$* >>), with explicit or implicit intervening C<< -> >>, such as might appear after a term. =head3 C<< (?&PerlLvalue) >> Matches any variable or parenthesized list of variables that could be assigned to. =head3 C<< (?&PerlPackageDeclaration) >> Matches the declaration of any package (with or without a defining block). =head3 C<< (?&PerlSubroutineDeclaration) >> Matches the declaration of any named subroutine (with or without a defining block). =head3 C<< (?&PerlUseStatement) >> Matches a C<< use ...; >> or C<< use ; >> statement. =head3 C<< (?&PerlReturnStatement) >> Matches a C<< return ; >> or C<< return; >> statement. =head3 C<< (?&PerlReturnExpression) >> Matches a C<< return >> as an expression without trailing end-of-statement markers. =head3 C<< (?&PerlControlBlock) >> Matches an C, C, C, C, C, or C statement, including its block. =head3 C<< (?&PerlDoBlock) >> Matches a C-block expression. =head3 C<< (?&PerlEvalBlock) >> Matches a C-block expression. =head3 C<< (?&PerlTryCatchFinallyBlock) >> Matches an C block, followed by an option C block, followed by an optional C block, using the built-in syntax introduced in Perl v5.34 and v5.36. Note that if your code uses one of the many CPAN modules (such as C or C) that provided try/catch behaviours prior to Perl v5.34, then you will most likely need to override this subrule to match the alternate C/C syntax provided by your preferred module. For example, if your code uses the C module, you would need to alter the PPR::X parser by explicitly redefining the subrule for C blocks, with something like: my $MATCH_A_PERL_DOCUMENT = qr{ \A (?&PerlEntireDocument) \Z (?(DEFINE) # Redefine this subrule to match TryCatch syntax... (? try (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) catch (?>(?&PerlOWS)) (?: \( (?>(?&PPR_X_balanced_parens)) \) (?>(?&PerlOWS)) )?+ (?>(?&PerlBlock)) )*+ ) ) $PPR::X::GRAMMAR }xms; Note that the popular C module actually implements C/C as a normally parsed Perl subroutine call expression, rather than a statement. This means that the unmodified PPR::X grammar can successfully parse all the module's constructs. However, the unmodified PPR::X grammar may misclassify some C usages as being built-in Perl v5.36 C blocks followed by an unrelated call to the C subroutine, rather than identifying the C and C as a single expression containing two subroutine calls. If that difference in interpretation matters to you, you can deactivate the built-in Perl v5.36 C/C syntax entirely, like so: my $MATCH_A_PERL_DOCUMENT = qr{ \A (?&PerlEntireDocument) \Z (?(DEFINE) # Turn off built-in try/catch syntax... (? (?!) ) # Decanonize 'try' and 'catch' as reserved words ineligible for sub names... (? (?! (?> for(?:each)?+ | while | if | unless | until | given | when | default | sub | format | use | no | my | our | state | defer | finally # Note: Removed 'try' and 'catch' which appear here in the original subrule | (?&PPR_X_X_named_op) | [msy] | q[wrxq]?+ | tr | __ (?> END | DATA ) __ ) \b ) (?>(?&PerlQualifiedIdentifier)) (?! :: ) ) ) $PPR::X::GRAMMAR }xms; For more details and options for modifying PPR::X grammars in this way, see also the documentation of the C module. =head3 C<< (?&PerlStatementModifier) >> Matches an C, C, C, C, C, or C modifier that could appear after a statement. Only matches the modifier, not the preceding statement. =head3 C<< (?&PerlFormat) >> Matches a C declaration, including its terminating "dot". =head3 C<< (?&PerlBlock) >> Matches a C<{>...C<}>-delimited block containing zero-or-more statements. =head3 C<< (?&PerlCall) >> Matches a call to a subroutine or built-in function. Accepts all valid call syntaxes, either via a literal names or a reference, with or without a leading C<&>, with or without arguments, with or without parentheses on any argument list. =head3 C<< (?&PerlAttributes) >> Matches a list of colon-preceded attributes, such as might be specified on the declaration of a subroutine or a variable. =head3 C<< (?&PerlCommaList) >> Matches a list of zero-or-more comma-separated subexpressions. That is, a single valid Perl expression that involves operators above the precedence of C. =head3 C<< (?&PerlParenthesesList) >> Matches a list of zero-or-more comma-separated subexpressions inside a set of parentheses. =head3 C<< (?&PerlList) >> Matches either a parenthesized or unparenthesized list of comma-separated subexpressions. That is, matches anything that either of the two preceding rules would match. =head3 C<< (?&PerlAnonymousArray) >> Matches an anonymous array constructor. That is: a list of zero-or-more subexpressions inside square brackets. =head3 C<< (?&PerlAnonymousHash) >> Matches an anonymous hash constructor. That is: a list of zero-or-more subexpressions inside curly brackets. =head3 C<< (?&PerlArrayIndexer) >> Matches a valid indexer that could be applied to look up elements of a array. That is: a list of or one-or-more subexpressions inside square brackets. =head3 C<< (?&PerlHashIndexer) >> Matches a valid indexer that could be applied to look up entries of a hash. That is: a list of or one-or-more subexpressions inside curly brackets, or a simple bareword indentifier inside curley brackets. =head3 C<< (?&PerlDiamondOperator) >> Matches anything in angle brackets. That is: any "diamond" readline (e.g. C<< <$filehandle> >> or file-grep operation (e.g. C<< <*.pl> >>). =head3 C<< (?&PerlComma) >> Matches a short (C<,>) or long (C<< => >>) comma. =head3 C<< (?&PerlPrefixUnaryOperator) >> Matches any high-precedence prefix unary operator. =head3 C<< (?&PerlPostfixUnaryOperator) >> Matches any high-precedence postfix unary operator. =head3 C<< (?&PerlInfixBinaryOperator) >> Matches any infix binary operator whose precedence is between C<..> and C<**>. =head3 C<< (?&PerlAssignmentOperator) >> Matches any assignment operator, including all IC<=> variants. =head3 C<< (?&PerlLowPrecedenceInfixOperator) >> Matches C, , or C. =head3 C<< (?&PerlAnonymousSubroutine) >> Matches an anonymous subroutine. =head3 C<< (?&PerlVariable) >> Matches any type of access on any scalar, array, or hash variable. =head3 C<< (?&PerlVariableScalar) >> Matches any scalar variable, including fully qualified package variables, punctuation variables, scalar dereferences, and the C<$#array> syntax. =head3 C<< (?&PerlVariableArray) >> Matches any array variable, including fully qualified package variables, punctuation variables, and array dereferences. =head3 C<< (?&PerlVariableHash) >> Matches any hash variable, including fully qualified package variables, punctuation variables, and hash dereferences. =head3 C<< (?&PerlTypeglob) >> Matches a typeglob. =head3 C<< (?&PerlScalarAccess) >> Matches any kind of variable access beginning with a C<$>, including fully qualified package variables, punctuation variables, scalar dereferences, the C<$#array> syntax, and single-value array or hash look-ups. =head3 C<< (?&PerlScalarAccessNoSpace) >> Matches any kind of variable access beginning with a C<$>, including fully qualified package variables, punctuation variables, scalar dereferences, the C<$#array> syntax, and single-value array or hash look-ups. But does not allow spaces between the components of the variable access (i.e. imposes the same constraint as within an interpolating quotelike). =head3 C<< (?&PerlScalarAccessNoSpaceNoArrow) >> Matches any kind of variable access beginning with a C<$>, including fully qualified package variables, punctuation variables, scalar dereferences, the C<$#array> syntax, and single-value array or hash look-ups. But does not allow spaces or arrows between the components of the variable access (i.e. imposes the same constraint as within a C<< <...> >>-delimited interpolating quotelike). =head3 C<< (?&PerlArrayAccess) >> Matches any kind of variable access beginning with a C<@>, including arrays, array dereferences, and list slices of arrays or hashes. =head3 C<< (?&PerlArrayAccessNoSpace) >> Matches any kind of variable access beginning with a C<@>, including arrays, array dereferences, and list slices of arrays or hashes. But does not allow spaces between the components of the variable access (i.e. imposes the same constraint as within an interpolating quotelike). =head3 C<< (?&PerlArrayAccessNoSpaceNoArrow) >> Matches any kind of variable access beginning with a C<@>, including arrays, array dereferences, and list slices of arrays or hashes. But does not allow spaces or arrows between the components of the variable access (i.e. imposes the same constraint as within a C<< <...> >>-delimited interpolating quotelike). =head3 C<< (?&PerlHashAccess) >> Matches any kind of variable access beginning with a C<%>, including hashes, hash dereferences, and kv-slices of hashes or arrays. =head3 C<< (?&PerlLabel) >> Matches a colon-terminated label. =head3 C<< (?&PerlLiteral) >> Matches a literal value. That is: a number, a C or C quotelike, a string, or a bareword. =head3 C<< (?&PerlString) >> Matches a string literal. That is: a single- or double-quoted string, a C or C string, a heredoc, or a version string. =head3 C<< (?&PerlQuotelike) >> Matches any form of quotelike operator. That is: a single- or double-quoted string, a C or C string, a heredoc, a version string, a C, a C, a C, a C or C regex, a substitution, or a transliteration. =head3 C<< (?&PerlHeredoc) >> Matches a heredoc specifier. That is: just the initial C<< < >> component, I the actual contents of the heredoc on the subsequent lines. This rule only matches a heredoc specifier if that specifier is correctly followed on the next line by any heredoc contents and then the correct terminator. However, if the heredoc specifier I correctly matched, subsequent calls to either of the whitespace-matching rules (C<(?&PerlOWS)> or C<(?&PerlNWS)>) will also consume the trailing heredoc contents and the terminator. So, for example, to correctly match a heredoc plus its contents you could use something like: m/ (?&PerlHeredoc) (?&PerlOWS) $PPR::X::GRAMMAR /x or, if there may be trailing items on the same line as the heredoc specifier: m/ (?&PerlHeredoc) (? [^\n]* ) (?&PerlOWS) $PPR::X::GRAMMAR /x Note that the saeme limitations apply to other constructs that match heredocs, such a C<< (?&PerlQuotelike) >> or C<< (?&PerlString) >>. =head3 C<< (?&PerlQuotelikeQ) >> Matches a single-quoted string, either a C<'...'> or a C (with any valid delimiters). =head3 C<< (?&PerlQuotelikeQQ) >> Matches a double-quoted string, either a C<"..."> or a C (with any valid delimiters). =head3 C<< (?&PerlQuotelikeQW) >> Matches a "quotewords" list. That is a C (with any valid delimiters). =head3 C<< (?&PerlQuotelikeQX) >> Matches a C system call, either a C<`...`> or a C (with any valid delimiters) =head3 C<< (?&PerlQuotelikeS) >> or C<< (?&PerlSubstitution) >> Matches a substitution operation. That is: C (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlQuotelikeTR) >> or C<< (?&PerlTransliteration) >> Matches a transliteration operation. That is: C or C (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlContextualQuotelikeM) >> or C<< (?&PerContextuallMatch) >> Matches a regex-match operation in any context where it would be allowed in valid Perl. That is: C or C (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlQuotelikeM) >> or C<< (?&PerlMatch) >> Matches a regex-match operation. That is: C or C (with any valid delimiters and any valid trailing modifiers) in any context (i.e. even in places where it would not normally be allowed within a valid piece of Perl code). =head3 C<< (?&PerlQuotelikeQR) >> Matches a C regex constructor (with any valid delimiters and any valid trailing modifiers). =head3 C<< (?&PerlContextualRegex) >> Matches a C regex constructor or a C or C regex-match operation (with any valid delimiters and any valid trailing modifiers) anywhere where either would be allowed in valid Perl. In other words: anything capable of matching within valid Perl code. =head3 C<< (?&PerlRegex) >> Matches a C regex constructor or a C or C regex-match operation in any context (i.e. even in places where it would not normally be allowed within a valid piece of Perl code). In other words: anything capable of matching. =head3 C<< (?&PerlBuiltinFunction) >> Matches the I of any builtin function. To match an actual call to a built-in function, use: m/ (?= (?&PerlBuiltinFunction) ) (?&PerlCall) /x =head3 C<< (?&PerlNullaryBuiltinFunction) >> Matches the name of any builtin function that never takes arguments. To match an actual call to a built-in function that never takes arguments, use: m/ (?= (?&PerlNullaryBuiltinFunction) ) (?&PerlCall) /x =head3 C<< (?&PerlVersionNumber) >> Matches any number or version-string that can be used as a version number within a C, C, or C statement. =head3 C<< (?&PerlVString) >> Matches a version-string (a.k.a v-string). =head3 C<< (?&PerlNumber) >> Matches a valid number, including binary, octal, decimal and hexadecimal integers, and floating-point numbers with or without an exponent. =head3 C<< (?&PerlIdentifier) >> Matches a simple, unqualified identifier. =head3 C<< (?&PerlQualifiedIdentifier) >> Matches a qualified or unqualified identifier, which may use either C<::> or C<'> as internal separators, but only C<::> as initial or terminal separators. =head3 C<< (?&PerlOldQualifiedIdentifier) >> Matches a qualified or unqualified identifier, which may use either C<::> or C<'> as both internal and external separators. =head3 C<< (?&PerlBareword) >> Matches a valid bareword. Note that this is not the same as an simple identifier, nor the same as a qualified identifier. =head3 C<< (?&PerlPod) >> Matches a single POD section containing any contiguous set of POD directives, up to the first C<=cut> or end-of-file. =head3 C<< (?&PerlPodSequence) >> Matches any sequence of POD sections, separated and /or surrounded by optional whitespace. =head3 C<< (?&PerlNWS) >> Match one-or-more characters of necessary whitespace, including spaces, tabs, newlines, comments, and POD. =head3 C<< (?&PerlOWS) >> Match zero-or-more characters of optional whitespace, including spaces, tabs, newlines, comments, and POD. =head3 C<< (?&PerlOWSOrEND) >> Match zero-or-more characters of optional whitespace, including spaces, tabs, newlines, comments, POD, and any trailing C<__END__> or C<__DATA__> section. =head3 C<< (?&PerlEndOfLine) >> Matches a single newline (C<\n>) character. This is provided mainly to allow newlines to be "hooked" by redefining C<< (?) >> (for example, to count lines during a parse). =head3 C<< (?&PerlKeyword) >> Match a pluggable keyword. Note that there are no pluggable keywords in the default PPR::X regex; they must be added by the end-user. See the following section for details. =head2 Extending the Perl syntax with keywords In Perl 5.12 and later, it's possible to add new types of statements to the language using a mechanism called "pluggable keywords". This mechanism (best accessed via CPAN modules such as C or C) acts like a limited macro facility. It detects when a statement begins with a particular, pre-specified keyword, passes the trailing text to an associated keyword handler, and replaces the trailing source code with whatever the keyword handler produces. For example, the L module uses this mechanism to add keywords such as C, C, and C to Perl 5, providing a declarative OO syntax. And the L module uses pluggable keywords to add a C statement that simplifies returning an ad hoc object from a subroutine. Unfortunately, because such modules effectively extend the standard Perl syntax, by default PPR::X has no way of successfully parsing them. However, when setting up a regex using C<$PPR::X::GRAMMAR> it is possible to extend that grammar to deal with new keywords...by defining a rule named C<< (?...) >>. This rule is always tested as the first option within the standard C<(?&PerlStatement)> rule, so any syntax declared within effectively becomes a new kind of statement. Note that each alternative within the rule must begin with a valid "keyword" (that is: a simple identifier of some kind). For example, to support the three keywords from L: $Dios::GRAMMAR = qr{ # Add a keyword rule to support Dios... (?(DEFINE) (? class (?&PerlOWS) (?&PerlQualifiedIdentifier) (?&PerlOWS) (?: is (?&PerlNWS) (?&PerlIdentifier) (?&PerlOWS) )*+ (?&PerlBlock) | method (?&PerlOWS) (?&PerlIdentifier) (?&PerlOWS) (?: (?&kw_balanced_parens) (?&PerlOWS) )?+ (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?&PerlBlock) | has (?&PerlOWS) (?: (?&PerlQualifiedIdentifier) (?&PerlOWS) )?+ [\@\$%][.!]?(?&PerlIdentifier) (?&PerlOWS) (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?: (?: // )?+ = (?&PerlOWS) (?&PerlExpression) (?&PerlOWS) )?+ (?> ; | (?= \} ) | \z ) ) (? \( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) ) # Add all the standard PPR::X rules... $PPR::X::GRAMMAR }x; # Then parse with it... $source_code =~ m{ \A (?&PerlDocument) \Z $Dios::GRAMMAR }x; Or, to support the C statement from C: my $ORK_GRAMMAR = qr{ # Add a keyword rule to support Object::Result... (?(DEFINE) (? result (?&PerlOWS) \{ (?&PerlOWS) (?: (?> (?&PerlIdentifier) | < [[:upper:]]++ > ) (?&PerlOWS) (?&PerlParenthesesList)?+ (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) )*+ \} ) ) # Add all the standard PPR::X rules... $PPR::X::GRAMMAR }x; # Then parse with it... $source_code =~ m{ \A (?&PerlDocument) \Z $ORK_GRAMMAR }x; Note that, although pluggable keywords are only available from Perl 5.12 onwards, PPR::X will still accept C<(&?PerlKeyword)> extensions under Perl 5.10. =head2 Extending the Perl syntax in other ways Other modules (such as C and C) make it possible to extend Perl syntax in even more flexible ways. The L<< PPR::X >> module provides support for syntactic extensions more general than pluggable keywords. PPR::X allows I of its public rules to be redefined in a particular regex. For example, to create a regex that matches standard Perl syntax, but which allows the keyword C as a synonym for C: my $FUN_GRAMMAR = qr{ # Extend the subroutine-matching rules... (?(DEFINE) (? # Try the standard syntax... (?&PerlStdStatement) | # Try the new syntax... fun (?&PerlOWS) (?&PerlOldQualifiedIdentifier) (?&PerlOWS) (?: \( [^)]*+ \) )?+ (?&PerlOWS) (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?> ; | (?&PerlBlock) ) ) (? # Try the standard syntax (?&PerlStdAnonymousSubroutine) | # Try the new syntax fun (?&PerlOWS) (?: \( [^)]*+ \) )?+ (?&PerlOWS) (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?> ; | (?&PerlBlock) ) ) ) $PPR::X::GRAMMAR }x; Note first that any redefinitions of the various rules have to be specified before the interpolation of the standard rules (so that the new rules take syntactic precedence over the originals). The structure of each redefinition is essentially identical. First try the original rule, which is still accessible as C<(?&PerlStd...)> (instead of C<(?&Perl...)>). Otherwise, try the new alternative, which may be constructed out of other rules. original rule. There is no absolute requirement to try the original rule as part of the new rule, but if you don't then you are I the rule, rather than extending it. For example, to replace the low-precedence boolean operators (C, C, C, and C) with their Latin equivalents: my $GRAMMATICA = qr{ # Verbum sapienti satis est... (?(DEFINE) # Iunctiones... (? atque | vel | aut ) # Contradicetur... (? (?: non (?&PerlOWS) )*+ (?&PerlCommaList) ) ) $PPR::X::GRAMMAR }x; Or to maintain a line count within the parse: my $COUNTED_GRAMMAR = qr{ (?(DEFINE) (? # Try the standard syntax (?&PerlStdEndOfLine) # Then count the line (must localize, to handle backtracking)... (?{ local $linenum = $linenum + 1; }) ) ) $PPR::X::GRAMMAR }x; =head2 Comparison with PPI The PPI and PPR::X modules can both identify valid Perl code, but they do so in very different ways, and are optimal for different purposes. PPI scans an entire Perl document and builds a hierarchical representation of the various components. It is therefore suitable for recognition, validation, partial extraction, and in-place transformation of Perl code. PPR::X matches only as much of a Perl document as specified by the regex you create, and does not build any hierarchical representation of the various components it matches. It is therefore suitable for recognition and validation of Perl code. However, unless great care is taken, PPR::X is not as reliable as PPI for extractions or transformations of components smaller than a single statement. On the other hand, PPI always has to parse its entire input, and build a complete non-trivial nested data structure for it, before it can be used to recognize or validate any component. So it is almost always significantly slower and more complicated than PPR::X for those kinds of tasks. For example, to determine whether an input string begins with a valid Perl block, PPI requires something like: if (my $document = PPI::Document->new(\$input_string) ) { my $block = $document->schild(0)->schild(0); if ($block->isa('PPI::Structure::Block')) { $block->remove; process_block($block); process_extra($document); } } whereas PPR::X needs just: if ($input_string =~ m{ \A (?&PerlOWS) ((?&PerlBlock)) (.*) }xs) { process_block($1); process_extra($2); } Moreover, the PPR::X version will be at least twice as fast at recognizing that leading block (and usually four to seven times faster)...mainly because it doesn't have to parse the trailing code at all, nor build any representation of its hierarchical structure. As a simple rule of thumb, when you only need to quickly detect, identify, or confirm valid Perl (or just a single valid Perl component), use PPR::X. When you need to examine, traverse, or manipulate the internal structure or component relationships within an entire Perl document, use PPI. =head1 DIAGNOSTICS =over =item C Due to an unsolved issue with that particular release of Perl, the single regex in the PPR::X module takes a ridiculously long time to compile under Perl 5.20 (i.e. minutes, not milliseconds). The code will work correctly when it eventually does compile, but the start-up delay is so extreme that the module issues this warning, to reassure users the something is actually happening, and explain why it's happening so slowly. The only remedy at present is to use an older or newer version of Perl. For all the gory details, see: L L =item C<< PPR::X::decomment() does not work under Perl 5.14 >> There is a separate bug in the Perl 5.14 regex engine that prevents the C subroutine from correctly detecting the location of comments. The subroutine throws an exception if you attempt to call it when running under Perl 5.14 specifically. =back The module has no other diagnostics, apart from those Perl provides for all regular expressions. The commonest error is to forget to add C<$PPR::X::GRAMMAR> to a regex, in which case you will get a standard Perl error message such as: Reference to nonexistent named group in regex; marked by <-- HERE in m/ (?&PerlDocument <-- HERE ) / at example.pl line 42. Adding C<$PPR::X::GRAMMAR> at the end of the regex solves the problem. =head1 CONFIGURATION AND ENVIRONMENT PPR::X requires no configuration files or environment variables. =head1 DEPENDENCIES Requires Perl 5.10 or later. =head1 INCOMPATIBILITIES None reported. =head1 LIMITATIONS This module works under all versions of Perl from 5.10 onwards. However, the lastest release of Perl 5.20 seems to have significant difficulties compiling large regular expressions, and typically requires over a minute to build any regex that incorporates the C<$PPR::X::GRAMMAR> rule definitions. The problem does not occur in Perl 5.10 to 5.18, nor in Perl 5.22 or later, though the parser is still measurably slower in all Perl versions greater than 5.20 (presumably because I regexes are measurably slower in more modern versions of Perl; such is the price of full re-entrancy and safe lexical scoping). The C subroutine trips a separate regex engine bug in Perl 5.14 only and will not run under that version. There was a lingering bug in regex re-interpolation between Perl 5.18 and 5.28, which means that interpolating a PPR::X grammar (or any other precompiled regex that uses the C<(??{...})> construct) into another regex sometimes does not work. In these cases, the spurious error message generated is usually: S>. This problem is unlikely ever to be resolved, as those versions of Perl are no longer being maintained. The only known workaround is to upgrade to Perl 5.30 or later. There are also constructs in Perl 5 which cannot be parsed without actually executing some code...which the regex does not attempt to do, for obvious reasons. =head1 BUGS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Damian Conway C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2017, Damian Conway C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. PPR-0.001010/t/subdecl.t000644 000765 000024 00000001573 14413652343 015054 0ustar00damianstaff000000 000000 use warnings; use strict; use B::Deparse; use Test::More; use PPR; plan tests => 9; my $subdecl = qr{ ^ (?&PerlSubroutineDeclaration) $ $PPR::GRAMMAR }x; # Perl 5.38 addition... ok 'sub or_equals ($x ||= 0 ) {...}' =~ $subdecl, 'or_equals'; ok 'sub doh_equals ($x //= 0 ) {...}' =~ $subdecl, 'doh_equals'; # 'sub' keyword is optional for these... ok 'AUTOLOAD {}' =~ $subdecl, 'AUTOLOAD'; ok 'DESTROY {}' =~ $subdecl, 'DESTROY'; ok '&DESTROY();' !~ $subdecl, '&DESTROY();'; ok 'DESTROY();' =~ $subdecl, 'DESTROY();'; # Prototypes may come before or after signature, depending on the Perl version... ok 'sub protofirst :prototype($$@) ($x, $y, @z) {...}' =~ $subdecl, 'protofirst'; ok 'sub protolast ($x, $y, @z) :prototype($$@) {...}' =~ $subdecl, 'protolast'; # Unnamed subs can have signatures too... ok 'sub unnamed ($, $y) {...}' =~ $subdecl, 'unnamed'; done_testing(); PPR-0.001010/t/pod.t000644 000765 000024 00000000433 14155010544 014201 0ustar00damianstaff000000 000000 #!perl -T use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); PPR-0.001010/t/PPR_ERROR_trailing.t000644 000765 000024 00000002016 14155010544 016721 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 5; use PPR; my $OFFSET = __LINE__ + 2; my $source_code = <<'END_SOURCE'; sub foo { my $x = 1; my $y = 2; my $z = 3; } } END_SOURCE # Make sure it's undefined, and won't have global consequences... local $PPR::ERROR; # Attempt the match... $source_code =~ m{ (?&PerlEntireDocument) $PPR::GRAMMAR }x; # Check diagnostics... is $PPR::ERROR->source, '}' => '1: Error source identified'; is $PPR::ERROR->prefix, substr($source_code, 0, -2) => '1: Prefix identified'; is $PPR::ERROR->line, 6 => '1: Line identified'; is $PPR::ERROR->line($OFFSET), 22 => '1: Line with offset identified'; like $PPR::ERROR->diagnostic, qr/\AUnmatched right curly bracket at end of line/ => '1: Diagnostic identified'; done_testing(); PPR-0.001010/t/ppi_statement_compound.t000755 000765 000024 00000005107 14155010544 020205 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... while (1) { } until (1) { } LABEL: while (1) { } LABEL: until (1) { } if (1) { } unless (1) { } for (@foo) { } foreach (@foo) { } for $x (@foo) { } foreach $x (@foo) { } for my $x (@foo) { } foreach my $x (@foo) { } for state $x (@foo) { } foreach state $x (@foo) { } LABEL: for (@foo) { } LABEL: foreach (@foo) { } LABEL: for $x (@foo) { } LABEL: foreach $x (@foo) { } LABEL: for my $x (@foo) { } LABEL: foreach my $x (@foo) { } LABEL: for state $x (@foo) { } LABEL: foreach state $x (@foo) { } for qw{foo} { } foreach qw{foo} { } for $x qw{foo} { } foreach $x qw{foo} { } for my $x qw{foo} { } foreach my $x qw{foo} { } for state $x qw{foo} { } foreach state $x qw{foo} { } LABEL: for qw{foo} { } LABEL: foreach qw{foo} { } LABEL: for $x qw{foo} { } LABEL: foreach $x qw{foo} { } LABEL: for my $x qw{foo} { } LABEL: foreach my $x qw{foo} { } LABEL: for state $x qw{foo} { } LABEL: foreach state $x qw{foo} { } for ( ; ; ) { } foreach ( ; ; ) { } for ($x = 0 ; $x < 1; $x++) { } foreach ($x = 0 ; $x < 1; $x++) { } for (my $x = 0 ; $x < 1; $x++) { } foreach (my $x = 0 ; $x < 1; $x++) { } LABEL: for ( ; ; ) { } LABEL: foreach ( ; ; ) { } LABEL: for ($x = 0 ; $x < 1; $x++) { } LABEL: foreach ($x = 0 ; $x < 1; $x++) { } LABEL: for (my $x = 0 ; $x < 1; $x++) { } LABEL: foreach (my $x = 0 ; $x < 1; $x++) { } #### PPR-0.001010/t/sub_END.t000644 000765 000024 00000001021 14155010544 014670 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; plan tests => 3; use PPR; my $src = q{ my $ __END__ = '__END__'; sub __END__ { print $ __END__ } & __END__ }; ok $src =~ m{ \A (?&PerlEntireDocument) \Z $PPR::GRAMMAR }xms => 'Matched sub __END__'; $src =~ s/__END__/__DATA__/g; ok $src =~ m{ \A (?&PerlEntireDocument) \Z $PPR::GRAMMAR }xms => 'Matched sub __DATA__'; $src =~ s/__DATA_/__OTHER__/g; ok $src =~ m{ \A (?&PerlEntireDocument) \Z $PPR::GRAMMAR }xms => 'Matched sub __OTHER__'; done_testing(); PPR-0.001010/t/heredoc.t000644 000765 000024 00000011033 14155010544 015026 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; local $/ = "\n ####\n"; while ( my $source = readline *DATA ) { chomp $source; my $matched = $source =~ m{ \A (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) \Z $PPR::GRAMMAR }xms; ok $matched => "Matched heredoc'd block $."; diag $source if !$matched; } done_testing(); __DATA__ { say <<'END', '...'; Heredoc text END } More text END say 'done'; } #### { say <<~ "END" Heredoc text } More text END , $foo, <<'ETC', '...'; et cetera ETC say 'done'; } #### { say <<`END`, '...'; Heredoc text END } More text END say 'done'; } #### { say <<"END", '...'; Heredoc text END } More text END say 'done'; } #### { say < 4; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; sub feature; feature 'Can now delete via k/v slices' => q{ delete %hash{'k', 'v', 'slice'} }; feature 'Can initialize array state variables' => q{ state @array = (1,2,3) }; feature 'Can initialize hash state variables' => q{ state %hash = (a=>2, b=>4) }; feature 'Named equivalents for various (?X...) regex constructs' => q{ m{ (*atomic: x ) (*negative_lookahead: X ) (*nla: X ) (*negative_lookbehind: X ) (*nlb: X ) (*positive_lookahead: X ) (*pla: X ) (*positive_lookbehind: X ) (*plb: X ) (*sr: X ) (*asr: X ) } }; done_testing(); sub feature { state $STATEMENT = qr{ \A (?&PerlStatement) \s* \Z $PPR::GRAMMAR }xms; my ($desc, $syntax) = @_; ok $syntax =~ $STATEMENT => $desc; } PPR-0.001010/t/control.t000644 000765 000024 00000005625 14155010544 015107 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s*+ (?&PerlControlBlock) \s*+ \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A \s*+ (?&PerlControlBlock) \s*+ \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... for (my $x = 0 ; $x < 1; $x++) { } #### foreach (my $x = 0 ; $x < 1; $x++) { } #### for ($x = 0 ; $x < 1; $x++) { } #### foreach ($x = 0 ; $x < 1; $x++) { } #### for ( ; ; ) { } #### foreach ( ; ; ) { } #### while (1) { } #### until (1) { } #### if (1) { } #### unless (1) { } #### for (@foo) { } #### foreach (@foo) { } #### for $x (@foo) { } #### foreach $x (@foo) { } #### for my $x (@foo) { } #### foreach my $x (@foo) { } #### for state $x (@foo) { } #### foreach state $x (@foo) { } #### for qw{foo} { } #### foreach qw{foo} { } #### for $x qw{foo} { } #### foreach $x qw{foo} { } #### for my $x qw{foo} { } #### foreach my $x qw{foo} { } #### for state $x qw{foo} { } #### foreach state $x qw{foo} { } #### # THESE SHOULD FAIL... (because of the label) LABEL: while (1) { } #### LABEL: until (1) { } #### LABEL: for (@foo) { } #### LABEL: foreach (@foo) { } #### LABEL: for $x (@foo) { } #### LABEL: foreach $x (@foo) { } #### LABEL: for my $x (@foo) { } #### LABEL: foreach my $x (@foo) { } #### LABEL: for state $x (@foo) { } #### LABEL: foreach state $x (@foo) { } #### LABEL: for qw{foo} { } #### LABEL: foreach qw{foo} { } #### LABEL: for $x qw{foo} { } #### LABEL: foreach $x qw{foo} { } #### LABEL: for my $x qw{foo} { } #### LABEL: foreach my $x qw{foo} { } #### LABEL: for state $x qw{foo} { } #### LABEL: foreach state $x qw{foo} { } #### LABEL: for ( ; ; ) { } #### LABEL: foreach ( ; ; ) { } #### LABEL: for ($x = 0 ; $x < 1; $x++) { } #### LABEL: foreach ($x = 0 ; $x < 1; $x++) { } #### LABEL: for (my $x = 0 ; $x < 1; $x++) { } #### LABEL: foreach (my $x = 0 ; $x < 1; $x++) { } #### PPR-0.001010/t/ppi_statement_include.t000755 000765 000024 00000001607 14155010544 020005 0ustar00damianstaff000000 000000 use strict; use warnings; use 5.010; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... require 5.6; require Module; require 'Module.pm'; use 5.6; use Module; use Module 1.00; no Module; #### PPR-0.001010/t/quotelike_noninerpolating.t000644 000765 000024 00000002646 14305747267 020737 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 8; use PPR::X; use re 'eval'; my $METAREGEX = qr{ \A \s* (?&PerlQuotelike) \s* \Z (?(DEFINE) (? ((?&PerlStdScalarAccessNoSpace)) (?{ fail "$^N should not match a (?&PerlScalarAccessNoSpace)" }) ) (? ((?&PerlStdArrayAccessNoSpace)) (?{ fail "$^N should not match a (?&PerlArrayAccessNoSpace)" }) ) ) $PPR::X::GRAMMAR }xms; ok q{ qr'^([$@%*])(.+)$' } =~ $METAREGEX => 'qr'; ok q{ m'^([$@%*])(.+)$' } =~ $METAREGEX => 'm'; ok q{ s'^([$@%*])(.+)$' $_ 'e } =~ $METAREGEX => 's'; ok q{ qx' cmd $- $[ $etc uncmd ' } =~ $METAREGEX => 'qx'; $METAREGEX = qr{ \A \s* (?&PerlQuotelike) \s* \Z (?(DEFINE) (? ((?&PerlStdScalarAccessNoSpace)) (?{ pass "$^N should match a (?&PerlScalarAccessNoSpace)" }) ) (? ((?&PerlStdArrayAccessNoSpace)) (?{ pass "$^N should match a (?&PerlArrayAccessNoSpace)" }) ) ) $PPR::X::GRAMMAR }xms; ok q{ qq' quote $@ $_ $etc unquote' } =~ $METAREGEX => 'qq'; done_testing(); PPR-0.001010/t/postfix_deref_qq.t000644 000765 000024 00000005473 14274107752 017004 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; plan tests => 82; use PPR::X; use re 'eval'; my @valid_derefs = grep /\S/, split "\n", q{ qq{ $sref->$* } qq{ $aref->$#* } qq{ $aref->@* } qq{ $aref->@[1,2,3] } qq{ $href->@{'a','b'} } qq{ $rref->$* } qq{ $href->{a}[1][2]{z} } }; my @invalid_derefs = grep /\S/, split "\n", q{ qq{ $aref->%[1..3] } qq{ $href->%* } qq{ $href->%{'a','b'} } qq{ $cref->() } qq{ $cref->&* } qq{ $rref->$*->$* } qq{ $rref->$*->@* } qq{ $gref->** } qq{ $gref->**->{IO} } qq{ $gref->**->**->{IO} } qq{ $gref->*{IO} } qq{ $obj->method } qq{ $obj->method() } qq{ $obj->$method } qq{ $obj->$method() } qq{ $href->{a}[1]('arg')[2]{z} } qq{ $href->method->[1]('arg')('arg2')->$method()->[2]{z}->**->$*->&*->$#* } qq{ $aref->@*->[0] } qq{ $aref->@*->%[1..3] } qq{ $aref->@*->%{'k1', 'k2'} } qq{ $aref->@*->method() } qq{ $aref->@*->$* } qq{ $aref->@*->** } qq{ $href->%*->@[1..3] } qq{ $href->%*->@{'k1', 'k2'} } qq{ $href->%*->method() } qq{ $href->%*->$* } qq{ $href->%*->** } qq{ $aref->@*->[1] } qq{ $aref->@*->@[1..3] } qq{ $aref->@*->@{'k1', 'k2'} } qq{ $href->%*->{k} } qq{ $href->%*->%[1..3] } qq{ $href->%*->%{'k1', 'k2'} } }; for my $deref (@valid_derefs) { next if $deref =~ m{\A \s* \#}xms; my ($full_deref) = $deref =~ m{\A \s* qq\{ \s* (.*?) \s* \} \s* \Z}xms; our $postfix = undef; ok $deref =~ qr{ \A \s* (?&PerlQuotelikeQQ) \s* \Z (?(DEFINE) (? ( (?&PerlStdScalarAccessNoSpace) ) (?{ $postfix = $^N; }) ) ) $PPR::X::GRAMMAR }xms => "Valid: $deref"; is $postfix, $full_deref => " and postderef matched appropriately"; } for my $deref (@invalid_derefs) { next if $deref =~ m{\A \s* \#}xms; my ($full_deref) = $deref =~ m{\A \s* qq\{ \s* (.*?) \s* \} \s* \Z}xms; our $postfix = undef; ok $deref =~ qr{ \A \s* (?&PerlQuotelikeQQ) \s* \Z (?(DEFINE) (? ( (?&PerlStdScalarAccessNoSpace) ) (?{ $postfix = $^N; }) ) ) $PPR::X::GRAMMAR }xms => "Invalid: $deref"; isnt $postfix, $full_deref => " and postderef correctly failed to match"; } done_testing(); PPR-0.001010/t/heredoc_large.t000644 000765 000024 00000261073 14155010544 016213 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; local $/ = "\n ####\n"; while ( my $source = readline *DATA ) { chomp $source; my $matched = $source =~ m{ \A (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) \Z $PPR::GRAMMAR }xms; ok $matched => "Matched heredoc'd block $."; diag $source if !$matched; } done_testing(); __DATA__ { say <<'END', '...'; Heredoc text END } More text END say 'done'; } #### { say <<~ "END" Heredoc text } More text END , $foo, <<'ETC', '...'; et cetera ETC say 'done'; } #### { say <<`END`, '...'; Heredoc text END } More text END say 'done'; } #### { say <<"END", '...'; Heredoc text END } More text END say 'done'; } #### { say < 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... -foo, -foo, -Foo::Bar, -Foo::Bar, -Foo'Bar, -Foo::Bar, #### PPR-0.001010/t/decomment.t000644 000765 000024 00000001776 14155010544 015405 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; if ($] >= 5.014 && $] < 5.016) { plan skip_all => 'Decommenting does not work under Perl 5.14'; done_testing(); } else { plan tests => 1; } use PPR; my $text = <<'END_TEXT'; my $x = 1; # A comment my $y = 2; # A comment my $z = q{ # The Z variable }; # A comment say $#; say ${'# Not a comment'}; ! =begin comment ! ! A comment-like component here ! ! =cut $x = $ # A comment y [ # A comment # A comment 0 # A comment ]; say << 'FOO'; # Ceci n'est pas un comment! FOO # A comment format STDERR = # Not a comment . say '#Here'; ! =begin comment ! ! Another comment-like component here ! END_TEXT my $expected = $text; $text =~ s{^[! ] }{}gm; my $decommented = PPR::decomment($text); $expected =~ s{^!.*}{}gm; $expected =~ s{^ }{}gm; $expected =~ s{# A comment\h*}{}g; is $decommented, $expected => 'Decommented correctly'; done_testing(); PPR-0.001010/t/statement_include.t000644 000765 000024 00000004366 14155010544 017137 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A (?&PerlOWS) (?&PerlStatement) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A (?&PerlOWS) (?&PerlStatement) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... use No::Version::With::Arguments 1, 2; #### use Foo qw< bar >, "baz"; #### require 'Module.pm'; #### require 5.014; #### require 5.14.0; #### require 5.014_000; #### require 5.14.0; #### require 5.14; #### require Module; #### require v5.14.0; #### use 5.014; #### use 5.014_000; #### use 5.14.0; #### use 5.14; #### use Float::Version 1.5; #### use Foo 'bar'; # One thing. #### use Foo 5 'bar'; # One thing. #### use Foo 5; # Don't expect anything. #### use Foo; # Don't expect anything. #### use Integer::Version 1; #### use Module 1.00; #### use Module; #### use No::Version::With::Argument 'x'; #### use No::Version; #### use Test::More tests => 5 * 9; #### use Version::With::Argument 1 2; #### use v5.14.0; #### no 5.014; #### no 5.014_000; #### no 5.14.0; #### no 5.14; #### no Float::Version 1.5; #### no Foo 'bar'; # One thing. #### no Foo 5 'bar'; # One thing. #### no Foo 5; # Don't expect anything. #### no Foo qw< bar >, "baz"; #### no Foo; # Don't expect anything. #### no Integer::Version 1; #### no Module 1.00; #### no Module; #### no No::Version::With::Argument 'x'; #### no No::Version::With::Arguments 1, 2; #### no No::Version; #### no Test::More tests => 5 * 9; #### no Version::With::Argument 1 2; #### no v5.14.0; #### PPR-0.001010/t/perl_v5.36.t000644 000765 000024 00000003145 14414427770 015240 0ustar00damianstaff000000 000000 use 5.010; use strict; use warnings; use utf8; use Test::More; plan tests => 6; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; sub feature; feature '(Precheck that "vampire for" is valid)' => q{{ for (;;) {} }}; feature 'Try blocks with finally' => q{{ try { do_something_risky(); } catch ($error) { do_something_catchy($error); } finally { do_something_final(); } for (;;) {} }}; feature 'Defer blocks' => q{{ defer { do_something_later(); } for (;;) {} }}; feature 'Multi-iterator for loops' => q{{ for my ($x, $y) (@list) { do_something_with($x, $y); } for (;;) {} }}; feature 'Unicode double-angle bracket delimiters on quotelikes' => q{{ say q« double angles »; }}; feature 'Other Unicode bracket delimiters on quotelikes' => q{{ say q» double angles «; say qq❲ tortoise shells ❳; say m｢ corner brackets ｣; say s→ arrows ←↪ swoopy arrows ↩s; say tr꧁ Javanese rerenggan ꧂ 👉 check it out! 👈; }}; done_testing(); sub feature { state $STATEMENT = qr{ \A (?&PerlBlock) \s* \Z $PPR::GRAMMAR }xms; my ($desc, $syntax) = @_; ok $syntax =~ $STATEMENT => $desc; } PPR-0.001010/t/heredoc_null_then_shift.t000644 000765 000024 00000000742 14155010544 020300 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 2; use PPR; my $code = <<'_EOT_'; <<<<< (?&PerlStatement)?) 1\n \n 42\n A\n \Z $PPR::GRAMMAR }x => 'Matched'; is $+{statement}, "<<<<< 'Matched correctly'; done_testing(); PPR-0.001010/t/perl_pod.t000644 000765 000024 00000001514 14155010544 015224 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlPod) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlPod) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... =pod Regular POD =cut #### =pod POD terminated by eof #### PPR-0.001010/t/misc_docs.t000644 000765 000024 00000001662 14155010544 015367 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... my $x; =pod Trailing POD =cut #### my $x; =pod Trailing POD terminated by eof #### =pod POD #1 =cut # Comments =pod POD #2 =cut my $x; #### PPR-0.001010/t/for_ref_iterator.t000644 000765 000024 00000005674 14155010544 016766 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $FOR_LOOP = qr{ \A (?&PerlOWS) (?&PerlControlBlock) (?&PerlOWS) \z $PPR::GRAMMAR }xms; my %okay = ( for_no_iterator => q{ for ( 1..10) { say $_; } }, for_def_iterator => q{ for $elem ( 1..10) { say $_; } }, for_my_iterator => q{ for my $elem ( 1..10) { say $_; } }, for_our_iterator => q{ for our $elem ( 1..10) { say $_; } }, for_our_iterator_weird => q{ for our $# ( 1..10) { say $#; } }, for_def_iterator_curly => q{ for ${elem} ( 1..10) { say $_; } }, for_my_iterator_curly => q{ for my ${elem} ( 1..10) { say $_; } }, for_our_iterator_curly => q{ for our ${elem} ( 1..10) { say $_; } }, for_our_iterator_weird_curly => q{ for our ${#} ( 1..10) { say $#; } }, for_state_iterator => q{ for state $elem ( 1..10) { say $_; } }, for_my_prealias => q{ for \ my $elem ( 1..10) { say $_; } }, for_our_prealias => q{ for \ our $elem ( 1..10) { say $_; } }, for_state_prealias => q{ for \ state $elem ( 1..10) { say $_; } }, for_my_postalias => q{ for my \ $elem ( 1..10) { say $_; } }, for_our_postalias => q{ for our\$elem ( 1..10) { say $_; } }, for_state_postalias => q{ for state \$elem ( 1..10) { say $_; } }, for_my_prealias_array => q{ for \ my @elem ( 1..10) { say $_; } }, for_our_prealias_array => q{ for \ our @elem ( 1..10) { say $_; } }, for_state_prealias_array => q{ for \ state @elem ( 1..10) { say $_; } }, for_my_postalias_array => q{ for my \ @elem ( 1..10) { say $_; } }, for_our_postalias_array => q{ for our\@elem ( 1..10) { say $_; } }, for_state_postalias_array => q{ for state \@elem ( 1..10) { say $_; } }, for_my_prealias_hash => q{ for \ my %elem ( 1..10) { say $_; } }, for_our_prealias_hash => q{ for \ our %elem ( 1..10) { say $_; } }, for_state_prealias_hash => q{ for \ state %elem ( 1..10) { say $_; } }, for_my_postalias_hash => q{ for my \ %elem ( 1..10) { say $_; } }, for_our_postalias_hash => q{ for our\%elem ( 1..10) { say $_; } }, for_state_postalias_hash => q{ for state \%elem ( 1..10) { say $_; } }, ); my %not_okay = ( for_no_list => q{ for { say $_; } }, for_local_iterator => q{ for local $elem (1..10) { say $_; } }, ); for my $test (sort keys %okay) { ok $okay{$test} =~ $FOR_LOOP => $test; } for my $test (keys %not_okay) { ok $not_okay{$test} !~ $FOR_LOOP => $test; } done_testing(); PPR-0.001010/t/unpunctuated.t000644 000765 000024 00000002147 14155010544 016142 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 4; use PPR; my $JAPH = <<'END_SOURCE'; not exp log srand xor s qq qx xor s x x length uc ord and print chr ord for qw q join use sub tied qx xor eval xor print qq q q xor int eval lc q m cos and print chr ord for qw y abs ne open tied hex exp ref y m xor scalar srand print qq q q xor int eval lc qq y sqrt cos and print chr ord for qw x printf each return local x y or print qq s s and eval q s undef or oct xor time xor ref print chr int ord lc foreach qw y hex alarm chdir kill exec return y s gt sin sort split END_SOURCE ok $JAPH =~ m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xms => "matched blokhead's wonderful JAPH!"; my $output = do { no warnings; local *STDOUT; my $output; ok open(\*STDOUT, '>', \$output) => 'Redirected output'; ok defined(eval $JAPH) => 'Executed JAPH'; $output; }; is $output, 'just another perl hacker' => 'JAPH is correct'; done_testing(); PPR-0.001010/t/ppi_token_magic.t000755 000765 000024 00000003314 14155010544 016553 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... $[; # Magic $[ #### $$; # Magic $$ #### %-; # Magic %- #### $#-; # Magic $#- #### $$foo; # Symbol $foo Dereference of $foo #### $^W; # Magic $^W #### ${^WIDE_SYSTEM_CALLS}; # Magic ${^WIDE_SYSTEM_CALLS} #### ${^MATCH}; # Magic ${^MATCH} #### @{^_Bar}; # Magic @{^_Bar} #### ${^_Bar}[0]; # Magic @{^_Bar} #### %{^_Baz}; # Magic %{^_Baz} #### ${^_Baz}{burfle}; # Magic %{^_Baz} #### $${^MATCH}; # Magic ${^MATCH} Dereference of ${^MATCH} #### \${^MATCH}; # Magic ${^MATCH} #### $0; # Magic $0 -- program being executed #### $0x2; # Magic $0 -- program being executed #### $10; # Magic $10 -- capture variable #### $1100; # Magic $1100 -- capture variable #### PPR-0.001010/t/perl_v5.32.t000644 000765 000024 00000000757 14271601211 015223 0ustar00damianstaff000000 000000 use 5.010; use strict; use warnings; use Test::More; plan tests => 1; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; sub feature; feature 'New binary infix isa operator' => q{ $invocant isa $class }; done_testing(); sub feature { state $STATEMENT = qr{ \A (?&PerlStatement) \s* \Z $PPR::GRAMMAR }xms; my ($desc, $syntax) = @_; ok $syntax =~ $STATEMENT => $desc; } PPR-0.001010/t/perl_v5.38.t000644 000765 000024 00000006034 14415171245 015234 0ustar00damianstaff000000 000000 use 5.010; use strict; use warnings; use utf8; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; sub feature; feature 'Or-assign in sub signatures' => q{{ sub foo ($x ||= 0) {...} }}; feature 'Or-assign in anon sub signatures' => q{{ sub ($x ||= 0) {...} }}; feature 'Doh-assign in sub signatures' => q{{ sub foo ($x //= 0) {...} }}; feature 'Doh-assign in anon sub signatures' => q{{ sub ($x //= 0) {...} }}; feature 'Optimistic eval in regexes' => q{{ qr/ \A (*{ ... }) \z/ }}; feature 'Class declarations' => q{{ class Foo; }}; feature 'Class declarations with version number' => q{{ class Foo v1.2.3; }}; feature 'Class declaration with attribute' => q{{ class Foo :isa(Bar); }}; feature 'Class declaration with attribute with minimal version' => q{{ class Foo :isa(Bar 1.2345); }}; feature 'Class blocks' => q{{ class Foo {} }}; feature 'Class block with attribute' => q{{ class Foo :isa(Bar) {} }}; feature 'Class block with version numbers' => q{{ class Foo 1.23456 {} }}; feature 'Field declarations' => q{{ field $f; }}; feature 'Field attribute' => q{{ field $f :param; }}; feature 'Field attribute with rename' => q{{ field $f :param(foo); }}; feature 'Field default initializer' => q{{ field $f = 0; }}; feature 'Field default doh initializer' => q{{ field $f //= 0; }}; feature 'Field default or initializer' => q{{ field $f ||= 0; }}; feature 'Field with all-of-the-above' => q{{ field $f :param(foo) = 0; }}; feature 'Array fields' => q{{ field @f; }}; feature 'Array field with initializer' => q{{ field @f = 1..10; }}; feature 'Hash field' => q{{ field %f }}; feature 'Hash field with initializer' => q{{ field %f = (a=>1, z=>26); }}; feature 'Methods' => q{{ method foo {...} method bar {...} }}; feature 'Method with signature' => q{{ method foo ($x) {...}; }}; feature 'Anonymous method' => q{{ method {...}; }}; feature 'Anonymous method with signature' => q{{ method ($x //= 1) {...}; }}; feature 'ADJUST blocks' => q{{ ADJUST { $x = 1 } ADJUST { $y = 1 } }}; feature 'Class with fields, methods, and ADJUST blocks' => q{{ class Basic; class Derived :isa(Basic) {} class WithMethods { field $greetings; field $info : param = 'default'; field @data = get_data(); field %dict = (); ADJUST { $greetings = "Hello"; } ADJUST { shift @data; } method greet($name = "someone") { say "$greetings, $name"; } } }}; done_testing(); sub feature { state $STATEMENT = qr{ \A (?&PerlBlock) \s* \Z $PPR::GRAMMAR }xms; my ($desc, $syntax) = @_; ok $syntax =~ $STATEMENT => $desc; } PPR-0.001010/t/heredoc_same_terminator.t000644 000765 000024 00000001164 14155010544 020303 0ustar00damianstaff000000 000000 use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use re 'eval'; plan tests => 4; use PPR; my $MATCH_DOCUMENT = qr{ \A (?&PerlDocument) \z $PPR::GRAMMAR }x; my $code; $code = <<'_EOT_'; < 'AA'; ok $code =~ $MATCH_DOCUMENT => 'AA again'; $code = <<'_EOT_'; < 'AB'; $code = <<'_EOT_'; < 'AA yet again'; done_testing(); PPR-0.001010/t/ppi_token_operator.t000755 000765 000024 00000002573 14155010544 017334 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... bareword x 3; #### bareword x3; #### $a->package x3; #### sort { $a->package cmp $b->package } (); #### c->d x 3; #### 1 x 3; #### "y" x 3; #### qq{y} x 3; #### "y"x 3; #### $a x 3; #### $a x3; #### $a++x3; #### "y"x 3; #### 'y'x 3; #### (5)x 3; #### 1x0x1; #### 1 x$y; #### $z x=3; #### $z x=$y; #### 1;x =>1; #### 1;x=>1; #### $hash{x}=1; #### x =>1; #### x=>1; #### xx=>1; #### 1=>x; #### 1=>xor 2; #### (1) x 6; #### (1) x6; #### (1)x6; #### foo()x6; #### qw(1)x6; #### qw<1>x6; #### [1]x6; #### 1x$bar; #### 1x@bar; #### sub xyzzy : _5x5 {1;}; #### LABEL: x64; #### 1 => 2; #### foo => 2; #### -foo => 2; #### PPR-0.001010/t/quotelike_s_e.t000644 000765 000024 00000002543 14155010544 016253 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A (?&PerlOWS) (?&PerlStatement) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "FAIL:\n$str"; } else { ok $str =~ m/\A (?&PerlOWS) (?&PerlStatement) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "MATCH:\n$str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... s/${\< 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... (Foo(')')); #### %x = ( try => "this"); #### %x = (); #### %x = ( $try->{this}, "too"); #### %'x = ( $try->{this}, "too"); #### %'x'y = ( $try->{this}, "too"); #### %::x::y = ( $try->{this}, "too"); #### %x = do { $try > 10 }; #### label: %x = (); #### # leading "space" label: %x = (); #### label: # in-between "space" %x = (); #### # leading "space" label: # in-between "space" %x = (); #### split /\s+/,; #### grep {exists $group_of{$_} }; #### # THESE SHOULD FAIL # THESE SHOULD FAIL { $a = /\}/; }; #### { $data[4] =~ /['"]/; }; #### { sub { $_[0] /= $_[1] } }; # / here #### { 1; }; #### { $a = 1; }; #### { $a = $b; # what's this doing here? };' #### { $a = $b; $a =~ /$b/; @a = map /\s/ @b }; #### { $a = $b; # what's this doing here? };' #### { $a = $b; # what's this doing here? ;' #### PPR-0.001010/t/erudil.t000644 000765 000024 00000005642 14155010544 014712 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 1; use PPR; my $camelcode = q{ #!/usr/bin/perl -w # camel code use strict; $_='ev al("seek\040D ATA,0, 0;");foreach(1..3) {;}my @camel1hump;my$camel; my$Camel ;while( ){$_=sprintf("%-6 9s",$_);my@dromedary 1=split(//);if(defined($ _=)){@camel1hum p=split(//);}while(@dromeda ry1){my$camel1hump=0 ;my$CAMEL=3;if(defined($_=shif t(@dromedary1 ))&&/\S/){$camel1hump+=1<<$CAMEL;} $CAMEL--;if(d efined($_=shift(@dromedary1))&&/\S/){ $camel1hump+=1 <<$CAMEL;}$CAMEL--;if(defined($_=shift( @camel1hump))&&/\S/){$camel1hump+=1<<$CAMEL;}$CAMEL--;if( defined($_=shift(@camel1hump))&&/\S/){$camel1hump+=1<<$CAME L;;}$camel.=(split(//,"\040..m`{/J\047\134}L^7FX"))[$camel1h ump];}$camel.="\n";}@camel1hump=split(/\n/,$camel);foreach(@ camel1hump){chomp;$Camel=$_;y/LJF7\173\175`\047/\061\062\063\ 064\065\066\067\070/;y/12345678/JL7F\175\173\047`/;$_=reverse; print"$_\040$Camel\n";}foreach(@camel1hump){chomp;$Camel=$_;y /LJF7\173\175`\047/12345678/;y/12345678/JL7F\175\173\0 47`/; $_=reverse;print"\040$_$Camel\n";}';;s/\s*//g;;eval; eval ("seek\040DATA,0,0;");undef$/;$_=;s/\s*//g;( );;s ;^.*_;;;map{eval"print\"$_\"";}/.{4}/g; __DATA__ \124 \1 50\145\040\165\163\145\040\157\1 46\040\1 41\0 40\143\141 \155\145\1 54\040\1 51\155\ 141 \147\145\0 40\151\156 \040\141 \163\16 3\ 157\143\ 151\141\16 4\151\1 57\156 \040\167 \151\164\1 50\040\ 120\1 45\162\ 154\040\15 1\163\ 040\14 1\040\1 64\162\1 41\144 \145\ 155\14 1\162\ 153\04 0\157 \146\ 040\11 7\047\ 122\1 45\15 1\154\1 54\171 \040 \046\ 012\101\16 3\16 3\15 7\143\15 1\14 1\16 4\145\163 \054 \040 \111\156\14 3\056 \040\ 125\163\145\14 4\040\ 167\1 51\164\1 50\0 40\160\ 145\162 \155\151 \163\163 \151\1 57\156\056 }; ok $camelcode =~ m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xms => "matched Erudil's camelcode"; done_testing(); PPR-0.001010/t/decomment_heredoc_large.t000644 000765 000024 00000226367 14155010544 020255 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; use PPR; plan tests => 1; my $src = do{ local $/; readline *DATA }; SKIP: { skip 'PPR::decomment not available under 5.14', 1 if $] >= 5.014 && $] < 5.016; ok PPR::decomment($src); } done_testing(); __DATA__ #! /usr/bin/env perl # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxx #cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxx # #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx # xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx $output = $#ARGV >= 0 && $ARGV[$#ARGV] =~ m|\.\w+$| ? pop : undef; $flavour = $#ARGV >= 0 && $ARGV[0] !~ m|\.| ? shift : undef; if ($flavour =~ /32/) { $BITS= 32; $BNSZ= $BITS/8; $ISA= "\"ppc\""; $LD= "lwz"; # load $LDU= "lwzu"; # load and update $ST= "stw"; # store $STU= "stwu"; # store and update $UMULL= "mullw"; # unsigned multiply low $UMULH= "mulhwu"; # unsigned multiply high $UDIV= "divwu"; # unsigned divide $UCMPI= "cmplwi"; # unsigned compare with immediate $UCMP= "cmplw"; # unsigned compare $CNTLZ= "cntlzw"; # count leading zeros $SHL= "slw"; # shift left $SHR= "srw"; # unsigned shift right $SHRI= "srwi"; # unsigned shift right by immediate $SHLI= "slwi"; # shift left by immediate $CLRU= "clrlwi"; # clear upper bits $INSR= "insrwi"; # insert right $ROTL= "rotlwi"; # rotate left by immediate $TR= "tw"; # conditional trap } elsif ($flavour =~ /64/) { $BITS= 64; $BNSZ= $BITS/8; $ISA= "\"ppc64\""; # same as above, but 64-bit mnemonics... $LD= "ld"; # load $LDU= "ldu"; # load and update $ST= "std"; # store $STU= "stdu"; # store and update $UMULL= "mulld"; # unsigned multiply low $UMULH= "mulhdu"; # unsigned multiply high $UDIV= "divdu"; # unsigned divide $UCMPI= "cmpldi"; # unsigned compare with immediate $UCMP= "cmpld"; # unsigned compare $CNTLZ= "cntlzd"; # count leading zeros $SHL= "sld"; # shift left $SHR= "srd"; # unsigned shift right $SHRI= "srdi"; # unsigned shift right by immediate $SHLI= "sldi"; # shift left by immediate $CLRU= "clrldi"; # clear upper bits $INSR= "insrdi"; # insert right $ROTL= "rotldi"; # rotate left by immediate $TR= "td"; # conditional trap } else { die "nonsense $flavour"; } $0 =~ m/(.*[\/\\])[^\/\\]+$/; $dir=$1; ( $xlate="${dir}ppc-xlate.pl" and -f $xlate ) or ( $xlate="${dir}../../perlasm/ppc-xlate.pl" and -f $xlate) or die "can't locate ppc-xlate.pl"; open STDOUT,"| $^X $xlate $flavour \"$output\"" or die "can't call $xlate: $!"; $data=< 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... use strict; sub one { 1 } sub two { 2 } sub three { 3 } print one; print "\n"; print three; print "\n"; exit; #### PPR-0.001010/t/ppi_token_prototype.t000755 000765 000024 00000004372 14155010544 017545 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH sub (\ [ $ ]){;}; sub (\\\ [ $ ]){;} #### sub foo(){;} sub foo( ){;} sub foo () {;} sub foo(+@){;} sub foo (+@) {;} sub foo(\[$;$_@]){;} sub foo(\ [ $ ]){;} sub foo(\\\ [ $ ]){;} sub foo($ _ %){;} sub foo (){;} sub foo ( ){;} sub foo () {;} sub foo (+@){;} sub foo (+@) {;} sub foo (\[$;$_@]){;} sub foo (\ [ $ ]){;} sub foo (\\\ [ $ ]){;} sub foo ($ _ %){;} #### sub(){;} #### sub( ){;} #### sub () {;} #### sub(+@){;} #### sub (+@) {;} #### sub(\[$;$_@]){;} #### sub(\ [ $ ]){;} #### sub(\\\ [ $ ]){;} #### sub($ _ %){;} #### sub (){;} #### sub ( ){;} #### sub () {;} #### sub (+@){;} #### sub (+@) {;} #### sub (\[$;$_@]){;} #### sub ($ _ %){;} #### sub DESTROY(){;} sub DESTROY( ){;} sub DESTROY () {;} sub DESTROY(+@){;} sub DESTROY (+@) {;} sub DESTROY(\[$;$_@]){;} sub DESTROY(\ [ $ ]){;} sub DESTROY(\\\ [ $ ]){;} sub DESTROY($ _ %){;} sub DESTROY (){;} sub DESTROY ( ){;} sub DESTROY () {;} sub DESTROY (+@){;} sub DESTROY (+@) {;} sub DESTROY (\[$;$_@]){;} sub DESTROY (\ [ $ ]){;} sub DESTROY (\\\ [ $ ]){;} sub DESTROY ($ _ %){;} sub AUTOLOAD(){;} sub AUTOLOAD( ){;} sub AUTOLOAD () {;} sub AUTOLOAD(+@){;} sub AUTOLOAD (+@) {;} sub AUTOLOAD(\[$;$_@]){;} sub AUTOLOAD(\ [ $ ]){;} sub AUTOLOAD(\\\ [ $ ]){;} sub AUTOLOAD($ _ %){;} sub AUTOLOAD (){;} sub AUTOLOAD ( ){;} sub AUTOLOAD () {;} sub AUTOLOAD (+@){;} sub AUTOLOAD (+@) {;} sub AUTOLOAD (\[$;$_@]){;} sub AUTOLOAD (\ [ $ ]){;} sub AUTOLOAD (\\\ [ $ ]){;} sub AUTOLOAD ($ _ %){;} #### PPR-0.001010/t/trycatch.t000644 000765 000024 00000002340 14272350030 015234 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 1; use PPR; my $MATCH_A_PERL_DOCUMENT = qr{ \A (?&PerlEntireDocument) \Z (?(DEFINE) # Redefine this subrule to match TryCatch syntax... (? try (?>(?&PerlOWS)) (?>(?&PerlBlock)) (?: (?>(?&PerlOWS)) catch (?>(?&PerlOWS)) (?: \( (?>(?&PPR_balanced_parens)) \) (?>(?&PerlOWS)) )?+ (?>(?&PerlBlock)) )*+ ) ) $PPR::GRAMMAR }xms; ok q{ sub foo { try { do_something_risky(); } catch (HTTPError $e where { $_->code >= 400 && $_->code <= 499 } ) { return "4XX error"; } catch (HTTPError $e) { return "other http code"; } catch { return "huh???"; } } } =~ $MATCH_A_PERL_DOCUMENT; PPR-0.001010/t/regex_interpolation.t000644 000765 000024 00000002306 14272134011 017475 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 10; use PPR::X; use re 'eval'; my $METAREGEX = qr{ \A \s* (?&PerlQuotelikeQR) \s* \Z (?{ ok 1 => $_ }) (?(DEFINE) (? ((?&PerlStdScalarAccessNoSpace)) (?{ fail "$^N should not match a (?&PerlScalarAccessNoSpace)" if $^N eq '$(' || $^N eq '$|' || $^N eq '$)'; }) ) (? ((?&PerlStdArrayAccessNoSpace)) (?{ fail "$^N should not match a (?&PerlArrayAccessNoSpace)" if $^N eq '@(' || $^N eq '@|' || $^N eq '@)'; }) ) ) $PPR::X::GRAMMAR; }xms; 'qr{ $( ) }' =~ $METAREGEX; 'qr{ $| }' =~ $METAREGEX; 'qr{ ( $) }' =~ $METAREGEX; 'qr{ $_ }' =~ $METAREGEX; 'qr{ $x }' =~ $METAREGEX; 'qr{ @( ) }' =~ $METAREGEX; 'qr{ @| }' =~ $METAREGEX; 'qr{ ( @) }' =~ $METAREGEX; 'qr{ @_ }' =~ $METAREGEX; 'qr{ @x }' =~ $METAREGEX; done_testing(); PPR-0.001010/t/token_quotelike_words.t000644 000765 000024 00000002206 14155010544 020037 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlQuotelikeQW) \s* \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A \s* (?&PerlQuotelikeQW) \s* \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... qw/foo bar baz/ #### qw/ foo bar baz / #### qw { )foo {bar} 5.020 && $] < 5.022; } plan tests => 15; use PPR; my $OFFSET = __LINE__ + 2; my $source_code = <<'END_SOURCE'; sub foo { my $x = 1; my $y = 2: my $z = 3; } sub foo2 {{ my $x = 1; my $y = 2: my $z = 3; } sub foo3 { my $x = 1; my $y = 2:::: my $z = 3; } sub foo4 { my $x = 1; my $y = 2: my $z = 3;----- } sub foo5 { my $x = 1; my $y = 2: my $z = 3;@$#%^!@ } sub foo6 my $x = 1; my $y = 2: my $z = 3; } sub foo7 { my $x = 1; my $y = : my $z = 3; } sub foo8 { my $x = 1; my $y = 2: my $z = 3; } sub foo9 { my $x = 1; my $y = 2: my $z = 3; } sub foo10 { my $x = 1; my $y = 2: my $z = 3; } END_SOURCE # Make sure it's undefined, and won't have global consequences... local $PPR::ERROR; # Attempt the match... $source_code =~ m{ (? (?&PerlBlock) ) $PPR::GRAMMAR }x; # Check diagnostics... is $PPR::ERROR->source, 'my $y = 2:' => '1: Error source identified'; is $PPR::ERROR->prefix, substr($source_code, 0, 41) => '1: Prefix identified'; is $PPR::ERROR->line, 3 => '1: Line identified'; is $PPR::ERROR->line($OFFSET), 19 => '1: Line with offset identified'; is $PPR::ERROR->diagnostic, 'syntax error near "2:"' => '1: Diagnostic identified'; # Pre-locate the source code fragment... my $error_with_line = $PPR::ERROR->origin(7); is $error_with_line->source, 'my $y = 2:' => '2: Error source identified'; is $error_with_line->prefix, substr($source_code, 0, 41) => '2: Prefix identified'; is $error_with_line->line, 9 => '2: Line identified'; is $error_with_line->line($OFFSET), 9 => '2: Line with offset identified'; is $error_with_line->diagnostic, 'syntax error at line 9, near "2:"' => '2: Diagnostic identified'; # Locate the source code fragment's file as well... my $error_with_file = $PPR::ERROR->origin(7, 'demo.pl'); is $error_with_file->source, 'my $y = 2:' => '3: Error source identified'; is $error_with_file->prefix, substr($source_code, 0, 41) => '3: Prefix identified'; is $error_with_file->line, 9 => '3: Line identified'; is $error_with_file->line($OFFSET), 9 => '3: Line with offset identified'; is $error_with_file->diagnostic, 'syntax error at demo.pl line 9, near "2:"' => '3: Diagnostic identified'; done_testing(); PPR-0.001010/t/postfix_deref.t000644 000765 000024 00000003221 14270711626 016265 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; plan tests => 38; use PPR; my @valid_derefs = grep /\S/, split "\n", q{ $sref->$* $aref->$#* $aref->@* $aref->@[1,2,3] $aref->%[1..3] $href->%* $href->%{'a','b'} $href->@{'a','b'} $cref->() $cref->&* $rref->$*->$* $rref->$*->@* $gref->** $gref->**->{IO} $gref->**->**->{IO} $gref->*{IO} $obj->method $obj->method() $obj->$method $obj->$method() # Composite look-ups, including elided arrows between brackets... $ref->{a}[1]('arg')[2]{z} $ref->method->[1]('arg')('arg2')->$method()->[2]{z}->**->$*->&*->$#* # These are all--believe it or not--legal (at least syntactically)... $aref->@*->%[1..3] $aref->@*->%{'k1', 'k2'} $aref->@*->method() $aref->@*->$* $aref->@*->** $href->%*->@[1..3] $href->%*->@{'k1', 'k2'} $href->%*->method() $href->%*->$* $href->%*->** }; my @invalid_derefs = grep /\S/, split "\n", q{ $aref->@*->[1] $aref->@*->@[1..3] $aref->@*->@{'k1', 'k2'} $href->%*->{k} $href->%*->%[1..3] $href->%*->%{'k1', 'k2'} }; for my $deref (@valid_derefs) { next if $deref =~ m{\A \s* \#}xms; ok $deref =~ qr{ \A \s* (?&PerlPrefixPostfixTerm) \s* \Z $PPR::GRAMMAR}xms => "Valid: $deref"; } for my $deref (@invalid_derefs) { next if $deref =~ m{\A \s* \#}xms; ok $deref !~ qr{ \A \s* (?&PerlPrefixPostfixTerm) \s* \Z $PPR::GRAMMAR}xms => "Invalid: $deref"; } done_testing(); PPR-0.001010/t/token_word.t000644 000765 000024 00000003504 14270731100 015570 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... $bar->method_with_parentheses($a ? $b : $c); #### pack'H*',$data; #### unpack'H*',$data; #### Foo'Bar; #### Foo::Bar; #### F; #### indirect $foo; #### indirect_class_with_colon Foo::; #### $bar->method_with_parentheses; #### $bar->method_with_parentheses(); #### $bar->method_with_parentheses(1,'2',qr{3}); #### print SomeClass->method_without_parentheses + 1; #### print SomeClass->method_with_parentheses() + 1; #### sub_call(); #### $baz->chained_from->chained_to; #### a_first_thing a_middle_thing a_last_thing; #### (first_list_element, second_list_element, third_list_element); #### first_comma_separated_word, second_comma_separated_word, third_comma_separated_word; #### single_bareword_statement; #### { bareword_no_semicolon_end_of_block } #### $buz{hash_key}; #### fat_comma_left_side => $thingy; #### $foo eq'bar'; #### $foo ne'bar'; #### $foo ge'bar'; #### $foo le'bar'; #### $foo gt'bar'; #### $foo lt'bar'; #### q'foo'; #### qq'foo'; #### qx'foo'; #### qw'foo'; #### qr'foo'; #### m'foo'; #### s'foo'bar'; #### tr'fo'ba'; #### y'fo'ba'; #### PPR-0.001010/t/eyedrops.t000644 000765 000024 00000012065 14155010544 015255 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 1; use PPR; my $hello_world = <<'END_SOURCE'; ''=~('(?{'.('`'|'%').('['^'-').('`'|'!').('`'|',').'"'.('['^'.').('['^'(').('`' |+ (( (( (( (( (( (( '%'))))))))))))) .( (( '{'))^'[').('^'^(('`')| (( (( '+')))))).'.'.('^'^('`'|'.')). +( (( '^')) ^((( (( (( '`') ))) )) |+ '/') ).( (( (( '^') ) ))^ +( (( '`') ) |(( (( (( '.') )) ) ))) ). (( ';') ) . ((( (( (( '[' )) )) ))^ (( (( '(' )) ) )). +( (( '`' ))|+ ( '!' )) .( '[' ^'"' ) .+( (( (( '{' )))) ^ '[' ). (( ((( '\\'))))) . '"' .( (( '`' )) ^ (( (( (( '(' )) ) )) )) .( '`' | ( (( (( (( '%' ) ))))) )) .( '`' | (( (( (( ',' ) )))))).('`'|',').('`'|'/').','.(('{')^ (( (( '[' ))))).("\{"^ "\,").( ( ( "\`"))| ( (( (( '/' ) ) ))) ).( (( ( ( (( '[' ))) ) )) ^+ ')' ) . ('`'|"\,").( ( ( '`'))|"\$"). ( (( (( '!' ) ) ) ) ) .+ (( (( ((( ( ( ( (( ( (( (( (( ( '\\') ) ) )) ) )) )) )) ) ) ) ) ) ) )) .+ (( ( '"' ))).';"})');$:= ( '.')^'~';$~= (( (( (( ( ( ( ( (( (( ( ( ( ( ( (( (( ( ( ( '@' ) ) )) )) ) ))) )) ) )) )) ) ) )))))))|'(';$^=(')')^ ( (( (( ( ( '[')))))));$/='`'|'.';$, = (( (( ( ( '('))))))^'}';$\='`'|"\!"; ( $: )= ( ( ')')) ^'}';$~=('*')| '`'; ( $^ )= ( ( '+') ) ^ '_' ; $/ =( (( '&' )))|'@';$,="\["& '~' ;( $\ ) = (( (( ( ( (( (( ( ( (( (( ( ( ( (( (( ( ( ( (( (( ( ( ( (( (( ( ( ( (( (( ( ( ( ( (( (( ( ( ( ( (( (( ( ',' )) ) )) )) ) ))))))))))) ) )) )) )) )) )) )) )) )))))))))))))))))))))))))))^'|';$:='.'^'~';$~='@'|'(';$^=')'^'[';$/='`'|'.';#;# END_SOURCE ok $hello_world =~ m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xms => "matched Acme::Eyedrops Hello, World!"; done_testing(); PPR-0.001010/t/heredoc_and_format.t000644 000765 000024 00000001300 14155010544 017214 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 2; use PPR; my $code = <<'_EOT_'; print <<'EOF'; format STDOUT = Where's that format? EOF Foo bar . write; _EOT_ ok $code =~ m{ \A (?&PerlDocument) \z $PPR::GRAMMAR }x => 'Matched document'; ok $code =~ m{ \A print (?&PerlOWS) (?&PerlHeredoc) ; (?&PerlOWS) (?&PerlFormat) (?&PerlOWS) write; \Z $PPR::GRAMMAR }x => 'Matched pieces'; done_testing(); PPR-0.001010/t/PPR_ERROR.t000644 000765 000024 00000004273 14155010544 015037 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 15; use PPR; my $OFFSET = __LINE__ + 2; my $source_code = <<'END_SOURCE'; sub foo { my $x = 1; my $y = 2: my $z = 3; } END_SOURCE # Make sure it's undefined, and won't have global consequences... local $PPR::ERROR; # Attempt the match... $source_code =~ m{ (? (?&PerlBlock) ) $PPR::GRAMMAR }x; # Check diagnostics... is $PPR::ERROR->source, 'my $y = 2:' => '1: Error source identified'; is $PPR::ERROR->prefix, substr($source_code, 0, 41) => '1: Prefix identified'; is $PPR::ERROR->line, 3 => '1: Line identified'; is $PPR::ERROR->line($OFFSET), 19 => '1: Line with offset identified'; is $PPR::ERROR->diagnostic, 'syntax error near "2:"' => '1: Diagnostic identified'; # Pre-locate the source code fragment... my $error_with_line = $PPR::ERROR->origin(7); is $error_with_line->source, 'my $y = 2:' => '2: Error source identified'; is $error_with_line->prefix, substr($source_code, 0, 41) => '2: Prefix identified'; is $error_with_line->line, 9 => '2: Line identified'; is $error_with_line->line($OFFSET), 9 => '2: Line with offset identified'; is $error_with_line->diagnostic, 'syntax error at line 9, near "2:"' => '2: Diagnostic identified'; # Locate the source code fragment's file as well... my $error_with_file = $PPR::ERROR->origin(7, 'demo.pl'); is $error_with_file->source, 'my $y = 2:' => '3: Error source identified'; is $error_with_file->prefix, substr($source_code, 0, 41) => '3: Prefix identified'; is $error_with_file->line, 9 => '3: Line identified'; is $error_with_file->line($OFFSET), 9 => '3: Line with offset identified'; is $error_with_file->diagnostic, 'syntax error at demo.pl line 9, near "2:"' => '3: Diagnostic identified'; done_testing(); PPR-0.001010/t/blocks.t000644 000765 000024 00000004113 14155010544 014673 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... { func1 / regex /; func1 / regex ; } #### { time / regex; func1 / regex /; } #### { func1 / regex; } #### { func1 / regex /; } #### { func1 / regex /; func1 / regex; } #### { sub { $_[0] /= $_[1] } } # / here #### {$obj->method} #### { %x = () } #### { $a = $b; $x = $a / $b; $a =~ /$b/; /$c/; @a = map /\s/, @b; @a = map {/\s/} @b; $not_pod =head1 (); } #### { $a = $b; $x = $a / $b; =head1 This is pod ...until the next =cut $a =~ /$b/; /$c/; =pod more pod =cut @a = map /\s/, @b; @a = map {/\s/} @b } #### { %x = ( try => "this") } #### {Foo(')')} #### { $data[4] =~ /['"]/; } #### { %x = ( $try->{this}, "too") } #### { %'x = ( $try->{this}, "too") } #### { %'x'y = ( $try->{this}, "too") } #### { %::x::y = ( $try->{this}, "too") } #### { $a = /\}/; } #### { 1; } #### { $a = 1; } #### {$a=1} #### { $a = $b; # what's this doing here? } #### # THESE SHOULD FAIL... < %x = do { $try > 10 } >; #### { $a = $b; # what's this doing here? } #### { $a = $b; # what's this doing here? #### PPR-0.001010/t/quotelike_misc.t000644 000765 000024 00000004351 14272134621 016442 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A (?&PerlOWS) (?&PerlQuotelike) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A (?&PerlOWS) (?&PerlQuotelike) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... /\N{ SPACE } \x{ 20AC } \d{ 1,9 }/ #### m{ x{,9} } #### m{^$DRIVE_RX[\\/]}o #### m/[@#]_ / #### m{^(.*)::(.*)$} #### s(a){b} #### s (a) /b/ #### q(d) #### qq(e) #### qx(f) #### qr(g) #### qw(h i j) #### < pairs and escaped \}'s } #### '' #### "" #### "a" #### 'b' #### `cc` #### "this is a nested $var[$x] {" #### /a/gci #### m/a/gci #### q{d} #### qq{e} #### qx{f} #### qr{g} #### q/slash/ #### q# slash # #### qr qw qx #### s/x/y/ #### s/x/y/cgimsox #### s{a}{b} #### s{a} {b} #### s/'/\\'/g #### s;';\\t#\$d#; #### tr/x/y/ #### y/x/y/ #### # THESE SHOULD FAIL... q # slash # #### s-$self->{pap}-$self->{sub}- # CAN'T HANDLE '-' in '->' #### q<$self->{pat}> #### qq<$self->{pat}> #### qr<$self->{pat}> #### qx<$self->{pat}> #### s<$self->{pat}>{$self->{sub}} #### PPR-0.001010/t/PPR_X.t000644 000765 000024 00000003402 14155010544 014346 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 5; use PPR::X; ok '>> 1 ^^ 2' =~ m{ \A (?&PerlExpression) \Z (?(DEFINE) (? \^\^ | (?&PerlStdInfixBinaryOperator) ) (? >> | (?&PerlStdPrefixUnaryOperator) ) ) $PPR::X::GRAMMAR }xms => 'Extended expression matched'; ok q[ no!!! { say 'failed'; } ] =~ m{ \A (?&PerlOWS) (?&PerlStatement) (?&PerlOWS) \Z (?(DEFINE) (? no [!]++ (?&PerlOWS) (?&PerlBlock) | (?&PerlStdStatement) ) ) $PPR::X::GRAMMAR }xms => 'Extended statement matched'; ok q[ use Discretion; no!!! { say 'failed'; } sub foo { 'bar' } ] =~ m{ \A (?&PerlDocument) \Z (?(DEFINE) (? no [!]++ (?&PerlOWS) (?&PerlBlock) | (?&PerlStdStatement) ) ) $PPR::X::GRAMMAR }xms => 'Extended statement within document matched'; my $GRAMMATICA = qr{ # Verbum sapienti satis est... (?(DEFINE) # Iunctiones... (? atque | vel | aut ) # Contradicetur... (? (?: non (?&PerlOWS) )*+ (?&PerlCommaList) ) ) $PPR::X::GRAMMAR }x; ok '$a and not $b or $y xor $z' !~ m{ \A (?&PerlDocument) \Z $GRAMMATICA }xms, => 'Did not match English connectives'; ok '$a atque non $b vel $y aut $z' =~ m{ \A (?&PerlDocument) \Z $GRAMMATICA }xms, => 'Matched Latin connectives'; done_testing(); PPR-0.001010/t/document_self.t000644 000765 000024 00000000604 14155010544 016246 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 1; use PPR; my $source = do { local (@ARGV, $/) = $INC{'PPR.pm'}; readline; }; ok $source =~ m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xms => 'Matched own document'; done_testing(); PPR-0.001010/t/disapproval.t000644 000765 000024 00000001467 14155010544 015753 0ustar00damianstaff000000 000000 use strict; use utf8; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; plan skip_all => "Perl 5.16 or later required for Acme::LookOfDisapproval" if $] < 5.016; plan skip_all => "Acme::LookOfDisapproval not installed" if !eval { require Acme::LookOfDisapproval }; } plan tests => 2; use PPR; use Acme::LookOfDisapproval; local $SIG{__WARN__} = sub { like shift, qr{ಠ_ಠ} => "Got the look of disapproval!"; }; ಠ_ಠ 'ಠ_ಠ'; open my $own_file, '<:encoding(utf8)', $0 or die $!; my $own_code = do { local $/; readline($own_file); }; ok $own_code =~ m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xm => 'Matched code with the look of disapproval!'; done_testing(); PPR-0.001010/t/regex_self.t000644 000765 000024 00000000773 14272110161 015545 0ustar00damianstaff000000 000000 use strict; use warnings; use utf8; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 1; use PPR; if (open my $src_fh, '<', $INC{'PPR.pm'}) { my $src_code = do { local $/; readline $src_fh; }; ok $src_code =~ m{ (?&PerlEntireDocument) $PPR::GRAMMAR }xms => 'Matched own source'; } else { fail "Can't open PPR source file: $!"; } done_testing(); PPR-0.001010/t/qr_combine.t000644 000765 000024 00000001762 14306262364 015552 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; use PPR::X; use re 'eval'; use warnings FATAL => 'regexp'; sub lives_ok(&;$) { if ($] >= 5.018 && $] <= 5.030) { pass "SKIP: $_[1] (known regex bug in Perl $])"; return; } eval { $_[0]->() }; if (!$@) { pass $_[1]; } else { fail "$_[1]: $@"; } } my $define_block = q{ (?(DEFINE) (? random (?{ 1 }) ) ) }; my $g = $PPR::X::GRAMMAR; lives_ok { qr/ (?(DEFINE) (? random (?{ 1 }) ) ) $g /x; } 'inline DEFINE + interpolated grammar inside of qr//'; lives_ok { qr/ ${define_block} ${g} /x; } 'interpolate DEFINE + interpolate grammar inside of qr'; lives_ok { my $whole = qq{ ${define_block} ${g} }; qr/ ${whole} /x; } 'concatenate regex in string then interpolate inside of qr//'; done_testing; PPR-0.001010/t/token_quote_single.t000644 000765 000024 00000004235 14271724005 017324 0ustar00damianstaff000000 000000 use v5.10; use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $QUOTELIKE = qr{ \A (?&PerlOWS) (?&PerlQuotelikeQ) (?&PerlOWS) \Z $PPR::GRAMMAR }x; my $line_offset; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; my $line = $line_offset + $.; if ($neg) { ok $str !~ $QUOTELIKE => "FAIL [$line]: $str"; } else { ok $str =~ $QUOTELIKE => "MATCH [$line]: $str"; } } done_testing(); BEGIN { $line_offset = __LINE__; } __DATA__ # THESE SHOULD MATCH... '' #### 'f' #### 'f\'b' #### 'f\nb' #### 'f\\b' #### 'f\\\b' #### 'f\\\'' #### q// #### q/f/ #### q/f\'b/ #### q/f\nb/ #### q/f\\b/ #### q/f\\\b/ #### q/f\\'/ #### q/f\\\// #### q!! #### q!f! #### q!f\'b! #### q !f\nb! #### q !f\\b! #### q ! f\\\b ! #### q!f\\'! #### q!f\\\!! #### q{} #### q{f} #### q {f\'b} #### q { {{{f\nb}}} ([< } #### q{f\\b} #### q{f\\\b} #### q{f\\'} #### q{f\\\}} #### q[] #### q[f] #### q [f\'b] #### q [ f\nb ] #### q[f\\b] #### q[f\\\b] #### q[f\\'] #### q[f\\\]] #### q<> #### q #### q #### q < <<<>>> {[( > #### q #### q #### q #### q> #### q() #### q(f) #### q (f\'b) #### q # Comment here ( ((f\nb)) {[< ) #### q(f\\b) #### q(f\\\b) #### q(f\\') #### q(f\\\)) #### # THESE SHOULD FAIL... '\\'' #### '''' #### 'f\\\\'' #### q/\\' #### q{\\' #### q { { } #### q <\\' #### q [\\' #### q(\\' #### q q\\' #### q =\\' #### PPR-0.001010/t/ppi_token_quote_double.t000755 000765 000024 00000002002 14155010544 020153 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... "no interpolations"; "no \@interpolations"; "has $interpolation"; "has @interpolation"; "has \\@interpolation"; "no special characters"; "has \"double\" quotes"; "has 'single' quotes"; "has $interpolation"; "has @interpolation"; ""; #### PPR-0.001010/t/ppi_statement_sub.t000755 000765 000024 00000002420 14155010544 017145 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... DESTROY {} sub BEGIN {} sub foo {} sub foo{} sub FOO {} sub _foo {} sub _0foo {} sub _foo0 {} sub ___ {} sub bar() {} sub baz : method{} sub baz : method lvalue{} sub baz : method:lvalue{} sub baz (*) : method : lvalue{} sub x64 {} sub AUTOLOAD; sub AUTOLOAD {} sub DESTROY; sub DESTROY {} AUTOLOAD; AUTOLOAD {} DESTROY; sub CHECK {} sub UNITCHECK {} sub INIT {} sub END {} sub AUTOLOAD {} sub CLONE_SKIP {} sub __SUB__ {} sub _FOO {} sub FOO9 {} sub FO9O {} sub FOo {} #### PPR-0.001010/t/ppi_statement.t000755 000765 000024 00000001560 14155010544 016300 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... package Foo; use strict; ; while (1) { last; } BEGIN { } sub foo { } state $x; $x = 5; #### PPR-0.001010/t/PPR_GRAMMAR_placement.t000644 000765 000024 00000001160 14155010544 017254 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 3; use PPR; my $source_code = q{ <<<<< '$PPR::GRAMMAR at end'; ok $source_code =~ m{ $PPR::GRAMMAR \A (?&PerlDocument) \Z }x => '$PPR::GRAMMAR at start'; ok $source_code =~ m{ \A $PPR::GRAMMAR (?&PerlDocument) \Z }x => '$PPR::GRAMMAR in middle'; done_testing(); PPR-0.001010/t/perl_v5.34.t000644 000765 000024 00000001426 14272351744 015235 0ustar00damianstaff000000 000000 use 5.010; use strict; use warnings; use Test::More; plan tests => 3; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; sub feature; feature '(Precheck that "vampire for" is valid)' => q{{ for (;;) {} }}; feature 'Octal constants' => q{{ my $x = 0o7777; }}; feature 'Try/catch blocks' => q{{ try { do_something_risky(); } catch ($error) { do_something_catchy($error); } for (;;) {} }}; done_testing(); sub feature { state $STATEMENT = qr{ \A (?&PerlBlock) \s* \Z $PPR::GRAMMAR }xms; my ($desc, $syntax) = @_; ok $syntax =~ $STATEMENT => $desc; } PPR-0.001010/t/merijn_is_evil.t000644 000765 000024 00000001242 14155010544 016414 0ustar00damianstaff000000 000000 use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 1; my $src = <<'END_SRC'; #!./perl use 5.14.2; use warnings; format STDOUT = @<<< @<<< @<<< @<<<<<<<<<<<<<<<<<<<<<<< { map { s/\n$//r } <", \my $format; select $h; local $~ = "format"; write; select STDOUT; $format; } # format END_SRC use PPR; ok $src =~ m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xms; done_testing(); PPR-0.001010/t/substitution_ge.t000755 000765 000024 00000003172 14272344731 016664 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR::X; use re 'eval'; my $METAREGEX = qr{ \A \s* (?&PerlQuotelike) \s* \Z (?(DEFINE) (? ((?&PerlStdInfixBinaryOperator)) (?{ if ($^N eq '//' || $^N eq '||') { pass "Found infix: $^N"; } else { pass "Interim-matched extra infix: $^N"; } }) ) (? ((?&PerlStdBinaryExpression)) (?{ if ( $^N eq q{$var{x} // croak()} || $^N eq q{$var{x} || croak()} ) { pass "Found correct binary expression: $^N"; } else { pass "Interim-matched extra binary expression: $^N"; } }) ) ) $PPR::X::GRAMMAR }xms; for my $src_code () { subtest $src_code => sub { ok $src_code =~ $METAREGEX => 'Matched METAREGEX'; } } done_testing(); __DATA__ s<(RE)>< $var{x} // croak() >ge s[(RE)][ $var{x} // croak() ]ge s{(RE)}{ $var{x} // croak() }ge s((RE))( $var{x} // croak() )ge s"(RE)" $var{x} // croak() "ge s%(RE)% $var{x} // croak() %ge s'(RE)' $var{x} // croak() 'ge s+(RE)+ $var{x} // croak() +ge s,(RE), $var{x} // croak() ,ge s/(RE)/ $var{x} || croak() /ge s@(RE)@ $var{x} // croak() @ge s|(RE)| $var{x} // croak() |ge PPR-0.001010/t/perl_v5.30.t000644 000765 000024 00000001336 14271601055 015221 0ustar00damianstaff000000 000000 use 5.010; use strict; use warnings; use Test::More; plan tests => 3; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; sub feature; feature 'Higher upper limit on counted repetions in regexes' => q{ / x{2,65534} ) / }; feature 'Can specify unicode properties in a regex via a nested regex' => q{ qr( \p{nv=/\A[0-5]\z/} ) }; feature 'Can specify variable-length lookbehinds in regexes' => q{ / (?<= colou?r ) (? $desc; } PPR-0.001010/t/ppi_statement_variable.t000755 000765 000024 00000001751 14155010544 020147 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... package Bar; my $foo = 1; my ( $foo, $bar) = (1, 2); our $foo = 1; local $foo; local $foo = 1; LABEL: my $foo = 1; # As well as those basics, lets also try some harder ones local($foo = $bar->$bar(), $bar); #### PPR-0.001010/t/ppi_token_quote_interpolate.t000755 000765 000024 00000001535 14155010544 021241 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... print qq{foo}, qq!bar!, qq ; print q{foo}, q!bar!, q ; #### PPR-0.001010/t/ppi_token_word.t000755 000765 000024 00000013067 14155010544 016454 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... no strict; #### indirect $foo; #### indirect_class_with_colon Foo::; #### $bar->method_with_parentheses; #### print SomeClass->method_without_parentheses + 1; #### sub_call(); #### $baz->chained_from->chained_to; #### a_first_thing a_middle_thing a_last_thing; #### (first_list_element, second_list_element, third_list_element); #### first_comma_separated_word, second_comma_separated_word, third_comma_separated_word; #### single_bareword_statement; #### { bareword_no_semicolon_end_of_block } $buz{hash_key}; #### fat_comma_left_side => $thingy; #### $foo and'bar'; #### $foo cmp'bar'; #### $foo eq'bar'; #### $foo ge'bar'; #### $foo gt'bar'; #### $foo le'bar'; #### $foo lt'bar'; #### $foo ne'bar'; #### not'bar'; #### $foo or'bar'; #### $foo x'bar'; #### $foo xor'bar'; #### q'foo'; #### qq'foo'; #### qr'foo'; #### qw'foo'; #### qx'foo'; #### m'foo'; #### s'foo'bar'; #### tr'fo'ba'; #### y'fo'ba'; #### abs'3'; #### accept'1234',2345; #### alarm'5'; #### atan2'5'; #### bind'5',""; #### binmode'5'; #### bless'foo', 'bar'; #### break when 1; #### caller'3'; #### chdir'foo'; #### chmod'0777', 'foo'; #### chomp'a'; #### chop'a'; #### chown'a'; #### chr'32'; #### chroot'a'; #### close'1'; #### closedir'1'; #### connect'1234',$foo; #### continue; #### cos'3'; #### crypt'foo', 'bar'; #### dbmclose'foo'; #### dbmopen'foo','bar'; #### default {} defined'foo'; #### delete'foo'; #### die'foo'; #### do'foo'; #### dump'foo'; #### each'foo'; #### else {}; #### elsif {}; #### endgrent; #### endhostent; #### endnetent; #### endprotoent; #### endpwent; #### endservent; #### eof'foo'; #### eval'foo'; #### evalbytes'foo'; #### exec'foo'; #### exists'foo'; #### exit'foo'; #### exp'foo'; #### fc'foo'; #### fcntl'1'; #### fileno'1'; #### flock'1', LOCK_EX; #### fork; #### format = . formline'@',1; #### getc'1'; #### getgrent; #### getgrgid'1'; #### getgrnam'foo'; #### gethostbyaddr'1', AF_INET; #### gethostbyname'foo'; #### gethostent; #### getlogin; #### getnetbyaddr'1', AF_INET; #### getnetbyname'foo'; #### getnetent; #### getpeername'foo'; #### getpgrp'1'; #### getppid; #### getpriority'1',2; #### getprotobyname'tcp'; #### getprotobynumber'6'; #### getprotoent; #### getpwent; #### getpwnam'foo'; #### getpwuid'1'; #### getservbyname'foo', 'bar'; #### getservbyport'23', 'tcp'; #### getservent; #### getsockname'foo'; #### getsockopt'foo', 'bar', TCP_NODELAY; #### glob'foo'; #### gmtime'1'; #### goto'label'; #### hex'1'; #### index'1','foo'; #### int'1'; #### ioctl'1',1; #### join'a',@foo; #### keys'foo'; #### kill'KILL'; #### last'label'; #### lc'foo'; #### lcfirst'foo'; #### length'foo'; #### link'foo','bar'; #### listen'1234',10; #### local'foo'; #### localtime'1'; #### lock'foo'; #### log'foo'; #### lstat'foo'; #### mkdir'foo'; #### msgctl'1','foo',1; #### msgget'1',1; #### msgrcv'1',$foo,1,1,1; #### msgsnd'1',$foo,1; #### my $foo; #### next'label'; #### oct'foo'; #### open'foo'; #### opendir'foo'; #### ord'foo'; #### our $foo; #### pack'H*',$data; #### pipe'in','out'; #### pop'foo'; #### pos'foo'; #### print'foo'; #### printf'foo','bar'; #### prototype'foo'; #### push'foo','bar'; #### quotemeta'foo'; #### rand'1'; #### read'1',$foo,100; #### readdir'1'; #### readline'1'; #### readlink'1'; #### readpipe'1'; #### recv'1',$foo,100,1; #### redo'label'; #### ref'foo'; #### rename'foo','bar'; #### require'foo'; #### reset'f'; #### return'foo'; #### reverse'foo','bar'; #### rewinddir'1'; #### rindex'1','foo'; #### rmdir'foo'; #### say'foo'; #### scalar'foo','bar'; #### seek'1',100,0; #### seekdir'1',100; #### select'1'; #### semctl'1',1,1; #### semget'foo',1,1; #### semop'foo','bar'; #### send'1',$foo'100,1; #### setgrent'foo'; #### sethostent'1'; #### setnetent'1'; #### setpgrp'1',2; #### setpriority'1',2, 3; #### setprotoent'1'; #### setpwent'foo'; #### setservent'1'; #### setsockopt'1',2,'foo',3; #### shift'1','2'; #### shmctl'1',2,$foo; #### shmget'1',2,1; #### shmread'1',$foo,0,10; #### shmwrite'1',$foo,0,10; #### shutdown'1',0; #### sin'1'; #### sleep'1'; #### socket'1',2,3,6; #### socketpair'1',2,3,4,6; #### splice'1',2; #### split'1','foo'; #### sprintf'foo','bar'; #### sqrt'1'; #### srand'1'; #### stat'foo'; #### state $foo; #### study'foo'; #### substr'foo',1; #### symlink'foo','bar'; #### syscall'foo'; #### sysopen'foo','bar',1; #### sysread'1',$bar,1; #### sysseek'1',0,0; #### system'foo'; #### syswrite'1',$bar,1; #### tell'1'; #### telldir'1'; #### tie'foo',$bar; #### tied'foo'; #### time; #### times; #### truncate'foo',1; #### uc'foo'; #### ucfirst'foo'; #### umask'foo'; #### undef'foo'; #### unlink'foo'; #### unpack'H*',$data; #### unshift'1'; #### untie'foo'; #### utime'1','2'; #### values'foo'; #### vec'1',0.0; #### wait; #### waitpid'1',0; #### wantarray; #### warn'foo'; #### when('foo') {} #### write'foo'; #### 1 for'foo'; #### 1 foreach'foo'; #### 1 if'foo'; #### 1 unless'foo'; #### 1 until'foo'; #### 1 while'foo'; #### PPR-0.001010/t/vars.t000644 000765 000024 00000006123 14271111605 014373 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; ok '$#;' =~ m/\A (?&PerlVariable) ; \Z $PPR::GRAMMAR/x => '$# special case'; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; chomp $str; if ($neg) { ok $str !~ m/\A (?&PerlOWS) (?&PerlVariable) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A (?&PerlOWS) (?&PerlVariable) (?&PerlOWS) \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... $# #### $#- #### @{$obj->nextval($cat ? $dog : $fish)} #### @{$obj->nextval($cat?$dog:$fish)->{new}} #### @{$obj->nextval(cat()?$dog:$fish)->{new}} #### @{$obj->nextval} #### @{$obj->nextval($cat,$dog)->{new}} #### $obj->nextval #### $obj->_nextval #### $obj->next_val_ #### $::obj #### %::obj:: #### $a #### $ a #### $ a #### ${a} #### $_ #### $ _ #### ${_} #### $a[1] #### @a[1] #### %a[1] #### @a[1,2,3] #### %a[1,2,3] #### @a[somefunc x 3] #### %a[somefunc x 3] #### $_[1] #### $a{cat} #### @a{cat} #### %a{cat} #### @a{qw} #### %a{'cat',"dog"} #### @a{somefunc $x, $y} #### %a{somefunc($x, $y) x 3} #### $_{cat} #### $a->[1] #### $a->{"cat"}[1] #### @$listref #### @{$listref} #### @{ 'x' x $x } #### $ a {'cat'} #### $ a { x } #### $a::b::c{d}->{$e->()} #### $a'b'c'd{e}->{$e->()} #### $a'b::c'd{e}->{$e->()} #### $#_ #### $#array #### $#{array} #### $var[$#var] #### $1 #### $11 #### $& #### $` #### $' #### $+ #### $* #### $. #### $/ #### $| #### $, #### $" #### $; #### $% #### $= #### $- #### $~ #### $^ #### $: #### $^L #### $^A #### $? #### $! #### $^E #### $@ #### $< #### $> #### $( #### $) #### $[ #### $] #### $^C #### $^D #### $^F #### $^H #### $^I #### $^M #### $^O #### $^P #### $^R #### $^S #### $^T #### $^V #### $^W #### ${^WARNING_BITS} #### ${^WIDE_SYSTEM_CALLS} #### $^X #### $[ #### $$ #### %- #### $$foo #### $^W #### ${^MATCH} #### $${^MATCH} #### @{^_Bar} #### ${^_Bar}[0] #### %{^_Baz} #### ${^_Baz}{burfle} #### # THESE SHOULD FAIL... $^WIDE_SYSTEM_CALLS #### $a-> #### @{$ #### $ a :: b :: c #### $ a ' b ' c #### \${^MATCH} #### *var #### *$var #### *{var} #### *{$var} #### *var{cat} #### \&var #### \&mod::var #### \&mod'var #### $a-> #### $a (1..3) { print $a } #### PPR-0.001010/t/ppi_lexer.t000755 000765 000024 00000003031 14155010544 015406 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... use constant { One => 1 }; #### use constant 1 { One => 1 }; #### $foo->{bar}; #### $foo[1]{bar}; #### $foo{bar}; #### sub {1}; #### grep { $_ } 0 .. 2; #### map { $_ => 1 } 0 .. 2; #### sort { $b <=> $a } 0 .. 2; #### do {foo}; #### $foo = { One => 1 }; #### $foo ||= { One => 1 }; #### 1, { One => 1 }; #### One => { Two => 2 }; #### {foo, bar}; #### {foo => bar}; #### {}; #### +{foo, bar}; #### @foo{'bar', 'baz'}; #### @{$foo}{'bar', 'baz'}; #### ${$foo}{bar}; #### return { foo => 'bar' }; #### bless { foo => 'bar' }; #### $foo &&= { One => 1 }; #### $foo //= { One => 1 }; #### $foo //= { 'a' => 1, 'b' => 2 }; #### 0 || { One => 1 }; #### 1 && { One => 1 }; #### undef // { One => 1 }; #### $x ? {a=>1} : 1; #### $x ? 1 : {a=>1}; #### $x ? {a=>1} : {b=>1}; #### PPR-0.001010/t/trytiny.t000644 000765 000024 00000003416 14415172117 015151 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 6; use PPR::X; use re 'eval'; my $MATCH_A_PERL_DOCUMENT = qr{ \A (?&PerlEntireDocument) \Z (?(DEFINE) # Turn off built-in try/catch syntax... (? (?!) ) # Decanonize 'try' and 'catch' as reserved words ineligible for sub names... (? (?! (?> for(?:each)?+ | while | if | unless | until | given | when | default | sub | format | use | no | my | our | state | defer | finally # Note: Removed 'try' and 'catch' which appear here in the original subrule | (?&PPR_X_named_op) | [msy] | q[wrxq]?+ | tr | __ (?> END | DATA ) __ ) \b ) (?>(?&PerlQualifiedIdentifier)) (?! :: ) ) # Verify that try block is parsed as a sub call... (? ((?&PerlStdCall)) (?{ pass 'try {...} interpreted as sub call' if substr($^N,0,3) eq 'try'; pass 'catch {...} interpreted as sub call' if substr($^N,0,5) eq 'catch'; }) ) ) $PPR::X::GRAMMAR }xms; ok q{ sub foo { try { $x = 'maybe'; } catch { $x = 'maybe not'; }; } } =~ $MATCH_A_PERL_DOCUMENT => 'Try/catch as statement'; ok q{ sub foo { return try { $x = 'maybe'; } catch { $x = 'maybe not'; }; } } =~ $MATCH_A_PERL_DOCUMENT => 'Try/catch as expression'; PPR-0.001010/t/token_quote.t000644 000765 000024 00000002550 14155010544 015756 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlString) \s* \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A \s* (?&PerlString) \s* \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... 'foo' #### "foo" #### q{foo} #### q[foo] #### q #### q(foo) #### q/foo/ #### q#foo# #### q=foo= #### q qfooq #### qq{foo} #### qq[foo] #### qq #### qq(foo) #### qq/foo/ #### qq#foo# #### qq=foo= #### qq qfooq #### q {foo} #### q [foo] #### q #### q (foo) #### q /foo/ #### q =foo= #### qq {foo} #### qq [foo] #### qq #### qq (foo) #### qq /foo/ #### qq =foo= #### # THESE SHOULD FAIL #### q #foo# #### qq #foo# #### PPR-0.001010/t/ppi_statement_package.t000755 000765 000024 00000002017 14155010544 017751 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... { package => "", }; +{ package => "", }; { 'package' => "", }; +{ 'package' => "", }; { 'package' , "", }; +{ 'package' , "", }; package Foo; SCOPE: { package # comment Bar::Baz; 1; } package Other v1.23; package Again 0.09; 1; #### PPR-0.001010/t/selfgol.t000644 000765 000024 00000002567 14271201602 015060 0ustar00damianstaff000000 000000 use strict; use warnings; no warnings 'void'; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 1; use PPR; my $selfgol = <<'END_SELFGOL'; #!/usr/bin/perl -s $;=$/;seek+DATA,undef$/,!$s;$_=;$s&&print||(*{q;::\; ;}=sub{$d=$d-1?$d:$0;s;';\t#$d#;,$_})&&$g&&do{$y=($x||=20)*($y||8);sub l{sleep&f}sub'p{print$;x$=,join$;,$b=~/.{$x}/g,$;}sub'f{pop||1}sub'n{substr($b, &f%$y,3)=~tr,O,O,}sub'g{@_[ ~~@_]=@_;--($f=&f);$m=substr($b,&f,1);($w,$w,$m,O) [n($f-$x)+n($x+$f)-(${m}eq+O=>)+n$f]||$w}$w="\40";$b=join'',@ARGV?<>:$_,$w x$y;$b=~s).)$&=~/\w/?O:$w)gse;substr($b,$y)=q++;$g='$i=0;$i?$b:$c=$b; substr+$c,$i,1,g$i;$g=~s?\d+?($&+1)%$y?e;$i-$y+1?eval$g:do{$b=$c;p;l}'; sub'e{eval$g;&e};e}||eval||die+No.$; __DATA__ $d&&do{{$^W=$|;*_=sub{$=+s=#([A-z])(.*)#=#$+$1#=g}} @s=(q[$_=sprintf+pop@s,@s],";\n"->($_=q[ $d&&do{{$^W=$|;*_=sub{$=+s=#([A-z])(.*)#=#$+$1#=g}}' @s=(q[%s],q[%s])x2;%s;print"\n"x&_,$_;l;eval}; ]))x2;$_=sprintf+pop@s,@s;print"\n"x&_,$_;l;eval};$/=$y;$"=",";print q<#!/usr/bin/perl -sw !$s?do{>,$_=<>,q<}:do{@s=(q[printf+pop@s,@s],q[#!/usr/bin/perl -sw !$s?do{>.(s$%$%%$g,y=[====y=]==||&d,$_).q<}:do{@s=(q[%s],q[%s])x2;%s} ])x2;printf+pop@s,@s} > END_SELFGOL ok $selfgol =~ m{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xms => 'matched selfgol'; done_testing(); PPR-0.001010/t/format.t000644 000765 000024 00000002451 14155010544 014711 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 2; use PPR; my $source = q{ format STDOUT = =================================== | NAME | AGE | ID NUMBER | |----------+------------+-----------| | @<<<<<<< | @||||||||| | @>>>>>>>> | $name, $age, $ID, |===================================| | COMMENTS | |-----------------------------------| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |~~ $comments, =================================== . }; ok $source =~ m{ \A (?&PerlOWS) (?&PerlFormat) (?&PerlOWS) \Z $PPR::GRAMMAR }xms => 'Matched format'; $source = q{ format = =================================== | NAME | AGE | ID NUMBER | |----------+------------+-----------| | @<<<<<<< | @||||||||| | @>>>>>>>> | $name, $age, $ID, |===================================| | COMMENTS | |-----------------------------------| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |~~ $comments, =================================== . }; ok $source =~ m{ \A (?&PerlOWS) (?&PerlFormat) (?&PerlOWS) \Z $PPR::GRAMMAR }xms => 'Matched format'; done_testing(); PPR-0.001010/t/statement_variable.t000644 000765 000024 00000002000 14155010544 017260 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A \s* (?&PerlStatement) \s* \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... package Bar; #### my $foo = 1; #### my ( $foo, $bar) = (1, 2); #### our $foo = 1; #### local $foo; #### local $foo = 1; #### LABEL: my $foo = 1; #### local($foo = $bar->$bar(), $bar); #### PPR-0.001010/t/scalar_attributes.t000644 000765 000024 00000001313 14274306526 017142 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { if (!eval { require Attribute::Types }) { plan skip_all => "Attribute::Types required for this test"; exit(); } } use PPR; package Foo { } use Attribute::Types; use feature qw(state); my @cases = ( q{my Foo $my_count :INTEGER = 12;}, q{our Foo $our_count :INTEGER = 12;}, q{state Foo $state_count :INTEGER = 12;}, ); plan tests => 0+@cases; for my $case (@cases) { subtest "Case : << $case >>" => sub { ok eval "$case; 1", "valid code" or note "error: $@"; ok $case =~ m{ \A (?&PerlEntireDocument) \Z $PPR::GRAMMAR }x, 'PPR matches'; }; } done_testing(); PPR-0.001010/t/00.load.t000644 000765 000024 00000000366 14155010544 014561 0ustar00damianstaff000000 000000 use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } BEGIN { use_ok( 'PPR' ); } plan tests => 1; diag( "Testing PPR $PPR::VERSION" ); PPR-0.001010/t/keywords.t000644 000765 000024 00000006054 14155010544 015273 0ustar00damianstaff000000 000000 use warnings; use strict; use 5.010; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 2; use PPR; $Dios::GRAMMAR = qr{ # Add a keyword rule to support Dios... (?(DEFINE) (? class (?&PerlOWS) (?&PerlQualifiedIdentifier) (?&PerlOWS) (?: is (?&PerlNWS) (?&PerlIdentifier) (?&PerlOWS) )*+ (?&PerlBlock) | method (?&PerlOWS) (?&PerlIdentifier) (?&PerlOWS) (?: (?&kw_balanced_parens) (?&PerlOWS) )?+ (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?&PerlBlock) | has (?&PerlOWS) (?: (?&PerlQualifiedIdentifier) (?&PerlOWS) )?+ [\@\$%][.!]?(?&PerlIdentifier) (?&PerlOWS) (?: (?&PerlAttributes) (?&PerlOWS) )?+ (?: (?: // )?+ = (?&PerlOWS) (?&PerlExpression) (?&PerlOWS) )?+ (?> ; | (?= \} ) | \z ) ) (? \( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) ) # Add all the standard PPR rules... $PPR::GRAMMAR }x; my $source_code = <<'END_CODE'; use Dios; class Foo is Bar { has $.name = 'Damian'; has Int $!ID //= gen_ID($name); has @.attrs; has %private_data = (); method foo ($bar, Int $baz, *@etc) { return undef; } method bar { return map { defined } @attrs; } method other ($name --> Str) { uc $name; } } END_CODE ok $source_code =~ m{ \A (?&PerlDocument) \Z $Dios::GRAMMAR }x => 'Matched Dios code'; my $ORK_GRAMMAR = qr{ # Add a keyword rule to support Object::Result... (?(DEFINE) (? result (?&PerlOWS) \{ (?&PerlOWS) (?: (?> (?&PerlIdentifier) | < [[:upper:]]++ > ) (?&PerlOWS) (?&PerlParenthesesList)?+ (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) )*+ \} ) ) # Add all the standard PPR rules... $PPR::GRAMMAR }x; $source_code = <<'END_CODE'; use Object::Result; sub foo ($config, @data) { my $outcome = get_outcome(@data); result { name { $outcome->name } after ($date) { grep { $_->date > $data } $outcome->list; } has ($what) { $config ~~ $what } { $outcome->as_str; } { scalar $outcome->list; } } } END_CODE # Then parse with it... ok $source_code =~ m{ \A (?&PerlDocument) \Z $ORK_GRAMMAR }x => 'Matched Object::Result code'; done_testing(); PPR-0.001010/t/heredoc_and_quotelike.t000644 000765 000024 00000001156 14155010544 017737 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 2; use PPR; my $code = <<'_EOT_'; < 'Matched document'; ok $code =~ m{ \A (?&PerlHeredoc) , (?&PerlOWS) (?&PerlString) (?&PerlOWS) ; \Z $PPR::GRAMMAR }x => 'Matched pieces'; done_testing(); PPR-0.001010/t/yadayadayada.t000644 000765 000024 00000001066 14155010544 016036 0ustar00damianstaff000000 000000 use warnings; use strict; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } plan tests => 3; use PPR; my $Perl_document = qr{ \A (?&PerlDocument) \Z $PPR::GRAMMAR }xms; ok 'sub foo {...}' =~ $Perl_document => 'Pure yada'; ok 'sub foo { say "partial"; ... ; etcetera; }' =~ $Perl_document => 'Partial yada'; ok 'sub foo { say "partial", ...}' !~ $Perl_document => 'Not an expression'; done_testing(); PPR-0.001010/t/ppi_token_quote_single.t000755 000765 000024 00000001515 14155010544 020172 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } else { ok $str =~ m/\A \s* (?&PerlDocument) \s* \Z $PPR::GRAMMAR/xo => $str; } } done_testing(); __DATA__ # THESE SHOULD MATCH... '', 'f', "f\'b", "f\\nb", "f\\b", "f\\\\b", "f\\'", #### PPR-0.001010/t/token_quote_double.t000644 000765 000024 00000002074 14155010544 017311 0ustar00damianstaff000000 000000 use strict; use warnings; use Test::More; BEGIN{ BAIL_OUT "A bug in Perl 5.20 regex compilation prevents the use of PPR under that release" if $] > 5.020 && $] < 5.022; } use PPR; my $neg = 0; while (my $str = ) { if ($str =~ /\A# TH[EI]SE? SHOULD MATCH/) { $neg = 0; next; } elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } elsif ($str !~ /^####\h*\Z/m) { $str .= ; redo; } $str =~ s/\s*^####\h*\Z//m; if ($neg) { ok $str !~ m/\A \s* (?&PerlQuotelikeQQ) \s* \Z $PPR::GRAMMAR/xo => "FAIL: $str"; } else { ok $str =~ m/\A \s* (?&PerlQuotelikeQQ) \s* \Z $PPR::GRAMMAR/xo => "MATCH: $str"; } } done_testing(); __DATA__ # THESE SHOULD MATCH... "no interpolations" #### "no \@interpolations" #### "has $interpolation" #### "has @interpolation" #### "has \\@interpolation" #### "" #### "no special characters" #### "has \"double\" quotes" #### "has 'single' quotes" #### "has $interpolation" #### "has @interpolation" #### PPR-0.001010/bin/gen_statements.pl000755 000765 000024 00000016243 14700725366 017140 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.014; use warnings; use List::Util 'max'; use PPI; use experimentals; my $MAX_DEPTH = 10; my $PLOT_WIDTH = 50; my $SOURCE_ROOT = glob( shift // '~/src/Perl' ); die "Not a valid root directory: $SOURCE_ROOT" if !-d $SOURCE_ROOT; my $TEST_FILE_NAME = $SOURCE_ROOT; $TEST_FILE_NAME =~ s{/}{_}g; $TEST_FILE_NAME =~ s{\W}{-}g; $TEST_FILE_NAME = 'extended_tests/statements__' . $TEST_FILE_NAME; say "Loading statements from: $SOURCE_ROOT\n" . "into PPR testing file: $TEST_FILE_NAME\n"; # The following modules mess with standard Perl syntax, # so standard PPR can't understand the code... my $IGNORE_FILES = join '|', qw{ /Language/Pythonesque/ /Perl6/Classes/ /Keyword-Declare/ /PPR/ prob\d*\.pl minimize_bug.t }; my $IGNORE_USERS_OF = join '|', qw{ Dios Kavorka Keyword::Declare Method::Signatures NewMultimethods Object::InsideOut::Declare Class::Contract Object::Result List::Gather Perl6:: }, q{Attribute::Handlers::Prospective \s++ 'Perl6'} ; # PPI has some problems too... my @PPI_BUGS = ( q{{ $_->translate($_[0]{V}) } @{$_[0]{A}}}, qr{Local::Null::Logger}, qr{META_OPTIONS}, qr{sub bin_uncompress}, qr{sub scalar }, qr{package Language::Basic}, qr{package Object::InsideOut;}, qr{MTIME_A}, qr{Object::InsideOut::MODIFY_SCALAR_ATTRIBUTES = sub}, qr{^undef %/;}, q{->{$_}}, qr{package DemonStration::Sandbox1;}, qr{package Demon::Stration::Sandbox1;}, qr{sub enlighten\(\@\)}, ); # Where to start... my $rootdir = $ARGV[0] // $SOURCE_ROOT; # Grab all the Perl files... my @filelist = glob join q{ }, map { $rootdir . ('/*' x $_) . '/*.{pm,pl,t}' } 1..$MAX_DEPTH; # Create the test file... my $testfile = IO::File->new($TEST_FILE_NAME, 'w') or die "Could not open test file '$TEST_FILE_NAME' for writing\n"; # Set up the test... print {$testfile} <<'TEST_FILE_HEADER'; use warnings; use strict; use Test::More; use PPR; my $source_sample = q{}; my $start_line; while (my $line = ) { if ($line =~ /^#<>>>>/) { if ($source_sample =~ /\S/) { my $matched = $source_sample =~ m{ \A (?&PerlOWS) (?&PerlStatement) (?&PerlOWS) \Z $PPR::GRAMMAR }x; ok $matched => "Statement starting at line $start_line"; note $source_sample if !$matched; } $source_sample = q{}; $start_line = undef; } else { $start_line //= $.; $source_sample .= $line; } } done_testing(); __DATA__ TEST_FILE_HEADER # Draw the progress bar... my $scale = @filelist / $PLOT_WIDTH; print {*STDERR} '0% |' . (' ' x $PLOT_WIDTH) . " | 100%\r0% |"; my %seen; my $count = 0; FILE: for my $n ( keys @filelist ) { # Report progress... print {*STDERR} '=' if $n % $scale == 0; # Skip weird places... next FILE if $filelist[$n] =~ $IGNORE_FILES; # Parse the file... my $document = eval{ PPI::Document->new( $filelist[$n] ) }; next FILE if !eval{ $document->complete } || $document =~ m{ \b use \s++ (?> $IGNORE_USERS_OF ) | \b use_ok \s++ (?: qq?\{ | ['"] )?+ (?> $IGNORE_USERS_OF ) }xms; my $statements_ref = eval { $document->find('PPI::Statement') } or next FILE; my @statements = map { s{ is export\b}{ :export}g; $_ } grep { !$seen{$_} && !$_->isa('PPI::Statement::End') && !$_->isa('PPI::Statement::Data') && !$_->find('PPI::Token::HereDoc') && $_ !~ / \A (?> , | => ) /xms && $_ !~ / \A \s* - (?> [mys] | tr | q[qrwx] ) \s* \Z /xms && $_ !~ / \A \s* :? \w+ \s* \Z /xms && $_ !~ / \A \s* \{ .* [^\}] \s* \Z /xms && $_ !~ / [:*][\$\@%] | --> | \$\w+ (?: : (?! [:] ) | [!?] ) /xms } @{$statements_ref} or next FILE; say {$testfile} "#<>>>> $filelist[$n]"; STATEMENT: for my $statement (@statements) { no warnings; next STATEMENT if $statement->isa('PPI::Statement::Expression') && !defined eval "sub { $statement }"; my $statement_text = "$statement"; for my $bug (@PPI_BUGS) { next STATEMENT if $statement_text ~~ $bug; } next STATEMENT if $statement =~ m{ \A \s* print \s+ form [^\n]* << | \A \s* \{ \s* form }xms; if ($statement =~ m{ ^ format \s }xms) { $statement =~ s{ ^ \. \n \K .*}{}xms; } elsif ($statement =~ s{ ^ (?> package | sub ) [^\n]* \{ [^\n*]* \} \h* \n \K .* }{}xms) { # THE TEST ACTUALLY FIXES IT } elsif ($statement =~ m{ ^ package [^\n]* \{ }xms) { $statement =~ s{ ^ \} \K .*}{}xms; } say {$testfile} $statement; say {$testfile} "#<>>>>"; $count += 1 + $statement =~ s/^#<>>>>/#<>>>>/; } } say "\n"; say "Found $count statements"; __END__ =head1 NAME gen_statements.pl - Generate test of statement matching by scouring a source tree =head1 VERSION This documentation refers to gen_statements.pl version 0.0.1 =head1 USAGE gen_statements.pl [options] =head1 REQUIRED ARGUMENTS =over None =back =head1 OPTIONS =over None =back =head1 DIAGNOSTICS None. =head1 CONFIGURATION AND ENVIRONMENT Requires no configuration files or environment variables. =head1 DEPENDENCIES None. =head1 BUGS None reported. Bug reports and other feedback are most welcome. =head1 AUTHOR Damian Conway C<< DCONWAY@cpan.org >> =head1 COPYRIGHT Copyright (c) 2017, Damian Conway C<< >>. All rights reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. PPR-0.001010/bin/gen_builtin_expr.pl000755 000765 000024 00000014713 14155010544 017442 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.022; use warnings; use experimentals; use Regexp::Optimizer; my @builtins; my $builtins_regex = join '|', reverse sort @builtins; $builtins_regex = qr{$builtins_regex}; my $optimized_regex = Regexp::Optimizer->new->optimize($builtins_regex); say $optimized_regex; #use Benchmark qw( cmpthese ); # #say $]; #cmpthese 100000, { # std => sub { for (@builtins) { m/$builtins_regex/ or die } }, # opt => sub { for (@builtins) { m/$optimized_regex/ or die } }, #}; BEGIN { @builtins = ( 'abs', 'accept', 'alarm', 'atan2', 'bind', 'binmode', 'bless', 'break', 'caller', 'chdir', 'chmod', 'chomp', 'chop', 'chown', 'chr', 'chroot', 'close', 'closedir', 'connect', 'continue', 'cos', 'crypt', 'dbmclose', 'dbmopen', # 'default', 'defined', 'delete', 'die', 'do', 'dump', 'each', 'endgrent', 'endhostent', 'endnetent', 'endprotoent', 'endpwent', 'endservent', 'eof', 'eval', 'evalbytes', 'exec', 'exists', 'exit', 'exp', 'fc', 'fcntl', 'fileno', 'flock', 'fork', 'format', 'formline', 'getc', 'getgrent', 'getgrgid', 'getgrnam', 'gethostbyaddr', 'gethostbyname', 'gethostent', 'getlogin', 'getnetbyaddr', 'getnetbyname', 'getnetent', 'getpeername', 'getpgrp', 'getppid', 'getpriority', 'getprotobyname', 'getprotobynumber', 'getprotoent', 'getpwent', 'getpwnam', 'getpwuid', 'getservbyname', 'getservbyport', 'getservent', 'getsockname', 'getsockopt', # 'given', 'glob', 'gmtime', 'goto', 'grep', 'hex', 'import', 'index', 'int', 'ioctl', 'join', 'keys', 'kill', 'last', 'lc', 'lcfirst', 'length', 'link', 'listen', 'local', 'localtime', 'lock', 'log', 'lstat', 'map', 'mkdir', 'msgctl', 'msgget', 'msgrcv', 'msgsnd', # 'my', 'next', # 'no', 'oct', 'open', 'opendir', 'ord', # 'our', 'pack', 'package', 'pipe', 'pop', 'pos', 'print', 'printf', 'prototype', 'push', 'quotemeta', 'rand', 'read', 'readdir', 'readline', 'readlink', 'readpipe', 'recv', 'redo', 'ref', 'rename', 'require', 'reset', 'return', 'reverse', 'rewinddir', 'rindex', 'rmdir', 'say', 'scalar', 'seek', 'seekdir', 'select', 'semctl', 'semget', 'semop', 'send', 'setgrent', 'sethostent', 'setnetent', 'setpgrp', 'setpriority', 'setprotoent', 'setpwent', 'setservent', 'setsockopt', 'shift', 'shmctl', 'shmget', 'shmread', 'shmwrite', 'shutdown', 'sin', 'sleep', 'socket', 'socketpair', 'sort', 'splice', 'split', 'sprintf', 'sqrt', 'srand', 'stat', 'state', 'study', # 'sub', 'substr', 'symlink', 'syscall', 'sysopen', 'sysread', 'sysseek', 'system', 'syswrite', 'tell', 'telldir', 'tie', 'tied', 'time', 'times', 'truncate', 'uc', 'ucfirst', 'umask', 'undef', 'unlink', 'unpack', 'unshift', 'untie', # 'use', 'utime', 'values', 'vec', 'wait', 'waitpid', 'wantarray', 'warn', # 'when', 'write', '-r', # File is readable by effective uid/gid. '-w', # File is writable by effective uid/gid. '-x', # File is executable by effective uid/gid. '-o', # File is owned by effective uid. '-R', # File is readable by real uid/gid. '-W', # File is writable by real uid/gid. '-X', # File is executable by real uid/gid. '-O', # File is owned by real uid. '-e', # File exists. '-z', # File has zero size (is empty). '-s', # File has nonzero size (returns size in bytes). '-f', # File is a plain file. '-d', # File is a directory. '-l', # File is a symbolic link. '-p', # File is a named pipe (FIFO), or Filehandle is a pipe. '-S', # File is a socket. '-b', # File is a block special file. '-c', # File is a character special file. '-t', # Filehandle is opened to a tty. '-u', # File has setuid bit set. '-g', # File has setgid bit set. '-k', # File has sticky bit set. '-T', # File is an ASCII text file (heuristic guess). '-B', # File is a "binary" file (opposite of ?T). '-M', # Script start time minus file modification time, in days. '-A', # Same for access time. '-C', # Same for inode change time (Unix, may differ for other platforms) ); } PPR-0.001010/bin/gen_nullary_builtin_expr.pl000755 000765 000024 00000001121 14155010544 021175 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.014; use warnings; use experimentals; use Regexp::Optimizer; my $builtins; say Regexp::Optimizer->new->optimize($builtins); BEGIN { $builtins = qr{ fork | endgrent | endhostent | endnetent | endprotoent | endpwent | endservent | getgrent | gethostent | getlogin | getnetent | getppid | getprotoent | getpwent | getservent | time | times | wait | wantarray }x; } PPR-0.001010/bin/gen_blocks.pl000755 000765 000024 00000012422 14700725417 016216 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.014; use warnings; use List::Util 'max'; use PPI; use experimentals; my $MAX_DEPTH = 10; my $PLOT_WIDTH = 50; my $SOURCE_ROOT = '~/src/Perl'; my $TEST_FILE_NAME = 'dt/real_blocks.t'; # The following modules mess with standard Perl syntax, # so standard PPR can't understand the code... my $IGNORE_FILES = join '|', qw{ /Language/Pythonesque/ /Perl6/Classes/ /Keyword-Declare/ /PPR/ prob\d*\.pl minimize_bug.t }; my $IGNORE_USERS_OF = join '|', qw{ Dios Kavorka Keyword::Declare Method::Signatures NewMultimethods Object::InsideOut::Declare Class::Contract Object::Result List::Gather Perl6:: }, q{Attribute::Handlers::Prospective \s++ 'Perl6'} ; # PPI has some problems too... my @PPI_BUGS = ( qr{\\%/}, ); # Where to start... my $rootdir = $ARGV[0] // $SOURCE_ROOT; # Grab all the Perl files... my @filelist = glob join q{ }, map { $rootdir . ('/*' x $_) . '/*.{pm,pl,t}' } 1..$MAX_DEPTH; # Create the test file... my $testfile = IO::File->new($TEST_FILE_NAME, 'w') or die "Could not open test file '$TEST_FILE_NAME' for writing\n"; # Set up the test... print {$testfile} <<'TEST_FILE_HEADER'; use warnings; use strict; use Test::More; use PPR; my $source_sample = q{}; my $start_line; while (my $line = ) { if ($line =~ /^####/) { if ($source_sample =~ /\S/) { my $matched = $source_sample =~ m{ \A (?&PerlOWS) (?&PerlBlock) (?&PerlOWS) \Z $PPR::GRAMMAR }x; ok $matched => "Block starting at line $start_line"; note $source_sample if !$matched; } $source_sample = q{}; $start_line = undef; } else { $start_line //= $.; $source_sample .= $line; } } done_testing(); __DATA__ TEST_FILE_HEADER # Draw the progress bar... my $scale = @filelist / $PLOT_WIDTH; print {*STDERR} '0% |' . (' ' x $PLOT_WIDTH) . " | 100%\r0% |"; my %seen; my $count = 0; FILE: for my $n ( keys @filelist ) { # Report progress... print {*STDERR} '=' if $n % $scale == 0; # Skip weird places... next FILE if $filelist[$n] =~ $IGNORE_FILES; # Parse the file... my $document = eval{ PPI::Document->new( $filelist[$n] ) }; next FILE if !eval{ $document->complete } || $document =~ m{ \b use \s++ (?> $IGNORE_USERS_OF ) | \b use_ok \s++ (?: qq?\{ | ['"] )?+ (?> $IGNORE_USERS_OF ) }xms; my $blocks_ref = eval { $document->find('PPI::Structure::Block') } or next FILE; my @blocks = map { s{ is export\b}{ :export}g; $_ } grep { !$seen{$_} && $_ !~ / ^ \{ .* [^\}] $ /x && !$_->find('PPI::Token::HereDoc') } @{$blocks_ref} or next FILE; say {$testfile} "#### $filelist[$n]"; for my $block (@blocks) { no warnings; next if "$block" ~~ @PPI_BUGS; next if $block =~ m{ \A \s* \{ \s* form }xms; say {$testfile} $block; say {$testfile} "####"; $count += 1 + $block =~ s/^####/####/; } } say "\n"; say "Found $count blocks"; __END__ =head1 NAME gen_blocks.pl - Generate test of block matching by scouring a source tree =head1 VERSION This documentation refers to gen_blocks.pl version 0.0.1 =head1 USAGE gen_blocks.pl [options] =head1 REQUIRED ARGUMENTS =over None =back =head1 OPTIONS =over None =back =head1 DIAGNOSTICS None. =head1 CONFIGURATION AND ENVIRONMENT Requires no configuration files or environment variables. =head1 DEPENDENCIES None. =head1 BUGS None reported. Bug reports and other feedback are most welcome. =head1 AUTHOR Damian Conway C<< DCONWAY@cpan.org >> =head1 COPYRIGHT Copyright (c) 2017, Damian Conway C<< >>. All rights reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. PPR-0.001010/demo/validator.pl000755 000765 000024 00000004140 14700725356 016251 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.010; use warnings; use IO::File; use PPR; for my $filename (@ARGV) { my $file = slurp($filename); printf("$filename is%s a valid Perl file\n", $file =~ m{\A $PPR::GRAMMAR (?&PerlDocument) \Z }x ? "" : " not" ); } sub slurp { my $filename = shift; my $file = IO::File->new($filename, 'r'); local $/; return readline $file; } __END__ =head1 NAME demo/validator.pl - Validate one or more perl source files =head1 VERSION This documentation refers to demo/validator.pl version 0.0.1 =head1 USAGE demo/validator.pl filename... =head1 AUTHOR Damian Conway C<< DCONWAY@cpan.org >> =head1 COPYRIGHT Copyright (c) 2017, Damian Conway C<< >>. All rights reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. PPR-0.001010/demo/strip_code.pl000755 000765 000024 00000000711 14155010544 016405 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.010; use warnings; # Load the grammar use PPR; # For each specified file... for my $filename (@ARGV) { # Report... say # ...meaningful... grep {defined} # ...contents... slurp($filename) # ...that match whitespace... =~ m{ ((?&PerlNWS)) $PPR::GRAMMAR }gx; } sub slurp { use IO::File; local $/; readline IO::File->new(shift, 'r'); } PPR-0.001010/demo/strip_comments.pl000755 000765 000024 00000004122 14700725320 017321 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.010; use warnings; use PPR; for my $filename (@ARGV) { my $file = slurp($filename); my $source_code = slurp($filename); $source_code =~ s{ (?&PerlNWS) $PPR:: }{ }gx; say $source_code; } sub slurp { use IO::File; my $filename = shift; my $file = IO::File->new($filename, 'r'); local $/; return readline $file; } __END__ =head1 NAME demo/validator.pl - Validate one or more perl source files =head1 VERSION This documentation refers to demo/validator.pl version 0.0.1 =head1 USAGE demo/validator.pl filename... =head1 AUTHOR Damian Conway C<< DCONWAY@cpan.org >> =head1 COPYRIGHT Copyright (c) 2017, Damian Conway C<< >>. All rights reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. PPR-0.001010/demo/strip_comments_v5.14.pl000755 000765 000024 00000003772 14700725406 020175 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.014; use warnings; use PPR; for my $filename (@ARGV) { say slurp($filename) =~ s{(?&PerlNWS) $PPR:: }{ }gxr; } sub slurp { use IO::File; my $filename = shift; my $file = IO::File->new($filename, 'r'); local $/; return readline $file; } __END__ =head1 NAME demo/validator.pl - Validate one or more perl source files =head1 VERSION This documentation refers to demo/validator.pl version 0.0.1 =head1 USAGE demo/validator.pl filename... =head1 AUTHOR Damian Conway C<< DCONWAY@cpan.org >> =head1 COPYRIGHT Copyright (c) 2017, Damian Conway C<< >>. All rights reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. PPR-0.001010/demo/count_statements.pl000755 000765 000024 00000000621 14155010544 017651 0ustar00damianstaff000000 000000 #! /usr/bin/env perl use 5.010; use warnings; use IO::File; use PPR; @ARGV = $0; for my $filename (@ARGV) { my $file = slurp($filename); my $count = $file =~ s/(?&PerlStatement) $PPR::GRAMMAR//gx; printf("$filename contains %d statements\n", $count); } sub slurp { my $filename = shift; my $file = IO::File->new($filename, 'r'); local $/; return readline $file; }