view release on metacpan or  search on metacpan

lib/PPR.pm  view on Meta::CPAN

  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)

        (?<PerlEntireDocument>
            \A
            (?&PerlDocument)
            (?:
                \Z
            |
                (?(?{ !defined $PPR::ERROR })
                    (?>(?&PerlOWSOrEND))  (?{pos()})  ([^\n]++)
                    (?{ $PPR::ERROR = PPR::ERROR->new(source => "$^N", prefix => substr($_, 0, $^R) ) })
                    (?!)
                )
            )
        ) # End of rule (?<PerlEntireDocument>)

        (?<PerlDocument>
            \x{FEFF}?+                      # Optional BOM marker
            (?&PerlStatementSequence)
            (?&PerlOWSOrEND)
        ) # End of rule (?<PerlDocument>)

        (?<PerlStatementSequence>
            (?>(?&PerlPodSequence))
            (?:
                (?&PerlStatement)
                (?&PerlPodSequence)
            )*+
        ) # End of rule (?<PerlStatementSequence>)

        (?<PerlStatement>
            (?>
                (?>(?&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))
                    (?>