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