1#!/usr/bin/perl -w 2 3# Copyright 2009, 2010, 2013, 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# /usr/share/perl/5.10.1/Dumpvalue.pm -> 22# /usr/share/perl/5.10.1/Test/Builder/Tester.pm C<<Test>> 23 24use 5.005; 25use strict; 26use warnings; 27use Perl6::Slurp; 28 29use lib::abs '.'; 30use MyLocatePerl; 31use MyStuff; 32 33my $verbose = 0; 34 35my $l = MyLocatePerl->new (under_directory => '/usr/share/perl5', 36 # under_directory => '/usr/share/perl/5.14/', 37 ); 38while (my ($filename, $str) = $l->next) { 39 if ($verbose) { print "look at $filename\n"; } 40 41 if ($str =~ /^__END__/m) { 42 substr ($str, $-[0], length($str), ''); 43 } 44 45 my $parser = MyParser->new; 46 $parser->errorsub(sub{1}); # no error prints 47 $parser->parse_from_string ($str, $filename); 48} 49 50package MyParser; 51use strict; 52use warnings; 53use base 'Pod::Parser'; 54 55sub parse_from_string { 56 my ($self, $str, $filename) = @_; 57 58 require IO::String; 59 my $fh = IO::String->new ($str); 60 $self->{_INFILE} = $filename; 61 return $self->parse_from_filehandle ($fh); 62} 63 64sub command { 65 return ''; 66} 67sub verbatim { 68 return ''; 69} 70sub textblock { 71 my ($self, $text, $linenum, $paraobj) = @_; 72 ### textblock 73 74 # while ($text =~ /->[^[:space:]]/g) { 75 # my $pos = pos($text); 76 # my ($line, $col) = MyStuff::pos_to_line_and_column ($text, $pos); 77 # $line += $linenum - 1; 78 # 79 # my $filename = $self->{_INFILE}; 80 # print "$filename:$line:$col: bad -> markup\n", 81 # MyStuff::line_at_pos($text, $pos); 82 # } 83 # return ''; 84 85 my $tree = $self->parse_text ($text, $linenum); 86 87 my @pending = reverse $tree->children; 88 my $prev = ''; 89 my $next = ''; 90 for ( ; @pending; $prev = $next) { 91 $next = pop @pending; 92 if (ref $next && $next->isa('Pod::ParseTree')) { 93 push @pending, reverse $next->children; 94 next; 95 } 96 next if ref $next; 97 98 { 99 while ($next =~ /([IBCLFSX]<<+[^ \n])/g) { 100 my $bad = $1; 101 my $filename = $self->output_file; 102 print "$filename:$linenum:1: no space after << markup\n$bad\n"; 103 } 104 } 105 106 { 107 ref $prev or next; 108 $prev->isa('Pod::InteriorSequence') or next; 109 my $prev_text = $prev->raw_text; 110 111 $prev_text =~ /->$/ or next; 112 $next =~ /^[_[:alpha:]]/ or next; 113 114 my ($filename, $line) = $prev->file_line; 115 116 my $pos = length($prev_text); 117 my ($offset_line, $col) 118 = MyStuff::pos_to_line_and_column ($prev_text, $pos); 119 $line += $offset_line - 1; 120 $col = 1; # col not right if $prev not at start of line 121 122 my $str = $prev_text . $next; 123 print "$filename:$line:$col: probable unescaped -> markup\n", 124 MyStuff::line_at_pos($str, $pos); 125 126 print "prev ",$prev_text,"\n"; 127 print "next ",$next,"\n"; 128 } 129 } 130 131 return ''; 132} 133 134exit 0; 135