PPR

 view release on metacpan or  search on metacpan

lib/PPR.pm  view on Meta::CPAN

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<perl -c> if the source code were compiled.

B<I<Warning:>> The diagnostic is obtained by partially eval'ing
the source code. This means that run-time code will not be executed,
but C<BEGIN> and C<CHECK> blocks will run. Do B<I<not>> 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{ (?<Block> (?&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<PPR::decomment()>

The module provides (but does not export) a C<decomment()>
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<undef> 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<decomment()> subroutine is not available when running under
these releases.


=head2 Examples

I<Note:> In each of the following examples, the subroutine C<slurp()> is
used to acquire the source code from a file whose name is passed as its
argument. The C<slurp()> 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<except> 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



( run in 0.469 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )