vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/CodeLayout/RequireConsistentNewlines.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/CodeLayout/RequireConsistentNewlines.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities };
  16 use PPI::Token::Whitespace;
  17 use English qw(-no_match_vars);
  18 use base 'Perl::Critic::Policy';
  19
  20 our $VERSION = '1.088';
  21
  22 Readonly::Scalar my $LINE_END => qr/\015{1,2}\012|\012|\015/mxs;
  23
  24 #-----------------------------------------------------------------------------
  25
  26 Readonly::Scalar my $DESC => q{Use the same newline through the source};
  27 Readonly::Scalar my $EXPL => q{Change your newlines to be the same throughout};
  28
  29 #-----------------------------------------------------------------------------
  30
  31 sub supported_parameters { return ()              }
  32 sub default_severity     { return $SEVERITY_HIGH  }
  33 sub default_themes       { return qw( core bugs ) }
  34 sub applies_to           { return 'PPI::Document' }
  35
  36 #-----------------------------------------------------------------------------
  37
  38 sub violates {
  39     my ( $self, undef, $doc ) = @_;
  40
  41     my $filename = $doc->filename();
  42     return if !$filename;
  43
  44     my $fh;
  45     return if !open $fh, '<', $filename;
  46     local $RS = undef;
  47     my $source = <$fh>;
  48     close $fh or return;
  49
  50     my $newline; # undef until we find the first one
  51     my $line = 1;
  52     my @v;
  53     while ( $source =~ m/\G([^\012\015]*)($LINE_END)/cgmxs ) {
  54         my $code = $1;
  55         my $nl = $2;
  56         my $col = length $code;
  57         $newline ||= $nl;
  58         if ( $nl ne $newline ) {
  59             my $token = PPI::Token::Whitespace->new( $nl );
  60             $token->{_location} = [$line, $col, $col];
  61             push @v, $self->violation( $DESC, $EXPL, $token );
  62         }
  63         $line++;
  64     }
  65     return @v;
  66 }
  67
  68 1;
  69
  70 #-----------------------------------------------------------------------------
  71
  72 __END__
  73
  74 =pod
  75
  76 =for stopwords GnuPG
  77
  78 =head1 NAME
  79
  80 Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines - Use the same newline through the source.
  81
  82
  83 =head1 CONFIGURATION
  84
  85 This Policy is not configurable except for the standard options.
  86
  87
  88 =head1 CAVEAT
  89
  90 This policy works outside of PPI because PPI automatically normalizes
  91 source code to local newline conventions.  So, this will only work if
  92 we know the filename of the source code.
  93
  94 =head1 AFFILIATION
  95
  96 This Policy is part of the core L<Perl::Critic> distribution.
  97
  98
  99 =head1 DESCRIPTION
 100
 101 Source code files are divided into lines with line endings of C<\r>,
 102 C<\n> or C<\r\n>.  Mixing these different line endings causes problems
 103 in many text editors and, notably, Module::Signature and GnuPG.
 104
 105 =head1 AUTHOR
 106
 107 Chris Dolan <cdolan@cpan.org>
 108
 109 =head1 COPYRIGHT
 110
 111 Copyright (C) 2006 Chris Dolan.  All rights reserved.
 112
 113 This program is free software; you can redistribute it and/or modify
 114 it under the same terms as Perl itself.
 115
 116 =cut
 117
 118 # Local Variables:
 119 #   mode: cperl
 120 #   cperl-indent-level: 4
 121 #   fill-column: 78
 122 #   indent-tabs-mode: nil
 123 #   c-indentation-style: bsd
 124 # End:
 125 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :