1#!/usr/bin/perl -w 2 3# Copyright 2009, 2010, 2011, 2014 Kevin Ryde 4 5# This file is part of Perl-Critic-Pulp. 6# 7# Perl-Critic-Pulp is free software; you can redistribute it and/or 8# modify it under the terms of the GNU General Public License as published 9# by the Free Software Foundation; either version 3, or (at your option) any 10# later version. 11# 12# Perl-Critic-Pulp is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 15# Public License for more details. 16# 17# You should have received a copy of the GNU General Public License along 18# with Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>. 19 20 21# various 22# some DB<1> debugger prompts 23 24use 5.005; 25use strict; 26use warnings; 27use Perl6::Slurp; 28 29use lib::abs '.'; 30use MyLocatePerl; 31use MyStuff; 32 33use FindBin; 34my $script_filename = File::Spec->catfile ($FindBin::Bin, $FindBin::Script); 35 36# uncomment this to run the ### lines 37#use Smart::Comments; 38 39my $verbose = 0; 40 41my $parser = MyParser->new; 42$parser->errorsub(sub{1}); # no error prints 43 44$parser->parse_from_file ($script_filename); 45#exit 0; 46 47my $l = MyLocatePerl->new (include_pod => 1, 48 exclude_t => 1); 49while (my ($filename, $str) = $l->next) { 50 if ($verbose) { print "look at $filename\n"; } 51 52 if ($str =~ /^__END__/m) { 53 substr ($str, $-[0], length($str), ''); 54 } 55 $parser->parse_from_string ($str, $filename); 56} 57 58package MyParser; 59use strict; 60use warnings; 61use base 'Pod::Parser'; 62 63sub parse_from_string { 64 my ($self, $str, $filename) = @_; 65 66 require IO::String; 67 my $fh = IO::String->new ($str); 68 $self->{_INFILE} = $filename; 69 return $self->parse_from_filehandle ($fh); 70} 71sub command { 72 my ($self, $command) = @_; 73 if ($command eq 'begin') { 74 $self->{'in_begin'} = 1; 75 } elsif ($command eq 'end') { 76 $self->{'in_begin'} = 0; 77 } 78 return ''; 79} 80sub verbatim { 81 my ($self, $text, $linenum, $paraobj) = @_; 82 ### verbatim: $text 83 return if $self->{'in_begin'}; 84 85 if ($text =~ /\n=[^\n]*/g) { 86 my $pos = pos($text); 87 my $initial = substr($text,0,$pos); 88 my $filename = $self->{_INFILE}; 89 print "$filename:$linenum:1: verbatim runs over directive:\n$initial\n"; 90 } 91 if ($text =~ /\n\S[^\n]*/g) { 92 my $pos = pos($text); 93 my $initial = substr($text,0,$pos); 94 my $filename = $self->{_INFILE}; 95 print "$filename:$linenum:1: unindented verbatim:\n$initial\n"; 96 } 97} 98sub textblock { 99 my ($self, $text, $linenum, $paraobj) = @_; 100 return ''; 101} 102 103exit 0; 104 105=pod 106 107 fjksds 108djksf 109 110=cut 111