drupal/scripts/code-style.pl

#!/usr/bin/perl -w
# $Id: code-style.pl,v 1.16 2009/01/13 22:39:11 dries Exp $

use Pod::Usage;
use Getopt::Long qw(GetOptions);
Getopt::Long::Configure ("bundling");

my %opt = (  "help" => 0,
    'debug' => 0,
  );

if(!GetOptions(\%opt,
    'help|?',
    'debug',
    )) {
  pod2usage(-exitval => 1, 'verbose'=>0);
}

pod2usage(-exitval => 0, -verbose => 2) if($opt{'help'});

$debug = $opt{'debug'};

$comment = 0; #flag used to signal we're inside /* */
$program = 0; #flag used to signal we're inside <?php ?>
#read the file
while (<>) {
  $org=$_;
  s/\\["']//g;
  # please don't use nested comments for now... thanks!
  # handles comments // style, but don't mess with http://
  s/\/\/[^:].*//;
  # handles comments /**/ on a single line
  s/\/\*.*\*\///g;
  # handles comments /**/ over several lines
  if ($comment == 1) {
    if (s/.*\*\///) {
      $comment = 0;
    }
    else {
      next;
    }
  }
  if (s/\/\*.*//) {
    $comment = 1;
  }
  if (/^\s*#/) {
    next;
  }

  if (s/<\?php//) {
    $program = 1;
  }
  if (/\?>/) {
    $program = 0;
  }

  # enforce "bar". foo() ."bar" syntax
  if (/^("[^"]*"|[^"])*("[^"]*")\.[^ ]/ && $program) {
    $msg = "'\".' -> '\". '";
  }
  elsif (/^("[^"]*"|[^"])*("[^"]*")\s+\./ && $program) {
    $msg = "'\" .' -> '\".'";
  }
  # enforce "bar". foo() ."bar" syntax
  elsif (/^("[^"]*"|[^"])*[^ "]\.("[^"]*")/ && $program) {
    $msg = "'.\"' -> '.\"'";
  }
  elsif (/^("[^"]*"|[^"])*[^ "]\.\s+("[^"]*")/ && $program) {
    $msg = "'. \"' -> '.\"'";
  }
  # XHTML requires closing tag
  elsif (/<br>/i) {
    $msg = "'<br>' -> '<br />'";
  }
  elsif (/\$REQUEST_URI/i) {
    $msg = "the use of REQUEST_URI is prone to XSS exploits and does not work on IIS; use request_uri() instead";
  }
  elsif (/\"REQUEST_URI\"/i) {
    $msg = "the use of REQUEST_URI is prone to XSS exploits and does not work on IIS; use request_uri() instead";
  }

  # XHTML compatibility mode suggests a blank before /
  # i.e. <br />
  elsif (/<[a-z][^>]*[^ >]\/>/i) {
    $msg = "'<foo/".">' -> '<foo />'";
  }
  # we write '{' on the same line, not on the next
  elsif (/^\s*{/ && $program) {
    $msg = "take '{' to previous line";
  }
  elsif (/([a-z])([A-Z])/) {
    $msg = "no mixed case function or variable names, use lower case and _";
  }
  elsif (/<[\/]*[A-Z]+[^>]*>/) {
    $msg = "XHTML demands tags to be lowercase";
  }

  # trying to recognize splitted lines
  # there are only a few valid last characters in programming mode,
  # only sometimes it is ( if you use if/else with a single statement

  # from here on we need no more strings
  while (s/^([^"]*)"[^"]*"/$1#/) {};
  while (s/^([^']*)'[^']*'/$1#/) {};

  # it should be 'if (' all the time
  if (/(^|[^a-zA-Z])(if|else|elseif|while|foreach|switch|return|for)\(/) {
    $msg = "'(' -> ' ('";
  }
  #elsif (/[^;{}:\s\n]\s*\n*$/ && $program && !/^[\s}]*(if|else)/) {
  #  $msg = "don't split lines";
  #}
  elsif (/\}\s*else/) {
    $msg = "'} else' -> '}\\nelse'";
  }
  elsif (/[^{\s\n]\s*\n*$/ && $program && /^\s*(if|else)/) {
    $msg = "every if/else needs a { at eol";
  }
  elsif (/([\(\[]) / && $program) {
    $msg = "'$1 ' -> '$1'";
  }
  elsif (/\S ([\)\]])/ && $program) {
    $msg = "' $1' -> '$1'";
  }
  # but no brackets
  elsif (/([a-z-A-Z_][a-zA-Z0-9_-]*)\s+\(/ && $program) {
    if ($1 ne "switch" and $1 ne "if" and $1 ne "while" and $1 ne "foreach" and $1 ne "return" and $1 ne "for" and $1 ne "elseif") {
      $msg = "'$1 (' -> '$1('";
    }
  }
  # there should be a space before '{'
  if (/[^ ]{/ && $program) {
    $msg = "missing space before '{'";
  }
  # there should be a space after ','
  elsif (/[,][^ \n\r]/ && $program) {
    $msg = "missing space after ','";
  }
  # spaces before and after, only foreach may use $foo=>bar
  elsif (/[^ =|\-|\+](\+|\-)[^ =>|\-|\+]/ && $program && !/foreach/) {
    $msg = "'$1' -> ' $1 '";
  }
  elsif (/[^ =](\*|==|\.=|=>|=|\|\|)[^ =>]/ && $program && !/foreach/) {
    $msg = "'$1' -> ' $1 '";
  }
  # ensure $bar["foo"] and $bar[$foo] and $bar[0]
  elsif (/\[[^#][^\]]*\]/ && !/\[[0-9\$][^\]]*\]/ && !/\[\]/) {
    $msg = "only [\"foo\"], [\$foo] or [0] is allowed";
  }
  # first try to find missing quotes after = in (X)HTML tags
  elsif (/<[^>]*=[a-zA-Z0-9][^>]*>/) {
    $msg = "=... -> =\"...\"";
  }
  if (defined $msg) {
    if ($debug==0) {
      print $ARGV .":". $. .": $msg : ". $org;
    }
    undef $msg;
  }
  elsif ($debug==1) {
    print $org;
  }
} continue {
  close ARGV if eof;
}

__END__

=head1 NAME

code-style.pl - Review Drupal code for style

=head1 SYNOPSIS

  code-style.pl [options] <filename>

  Options:

  -? --help  detailed help message

=head1 DESCRIPTION

Originally written for Drupal (http://drupal.org/) to ensure stylish
code. This program reviews PHP code, and tries to show as many code
improvements as possible with no false positives.

=head1 OPTIONS

  --comment

=head1 EXAMPLES

 ./code-style.pl ../index.php

=cut
1	dries	1.1	#!/usr/bin/perl -w
2	dries	1.17	# $Id: code-style.pl,v 1.16 2009/01/13 22:39:11 dries Exp $
3	dries	1.1
4	dries	1.13	use Pod::Usage;
5			use Getopt::Long qw(GetOptions);
6			Getopt::Long::Configure ("bundling");
7
8			my %opt = ( "help" => 0,
9			'debug' => 0,
10			);
11
12			if(!GetOptions(\%opt,
13			'help\|?',
14			'debug',
15			)) {
16			pod2usage(-exitval => 1, 'verbose'=>0);
17	dries	1.1	}
18	dries	1.13
19			pod2usage(-exitval => 0, -verbose => 2) if($opt{'help'});
20
21			$debug = $opt{'debug'};
22
23			$comment = 0; #flag used to signal we're inside /* */
24			$program = 0; #flag used to signal we're inside <?php ?>
25			#read the file
26	dries	1.1	while (<>) {
27			$org=$_;
28			s/\\["']//g;
29			# please don't use nested comments for now... thanks!
30			# handles comments // style, but don't mess with http://
31	dries	1.3	s/\/\/[^:].*//;
32	dries	1.1	# handles comments /**/ on a single line
33			s/\/\.\*\///g;
34			# handles comments /**/ over several lines
35			if ($comment == 1) {
36			if (s/.\\///) {
37	dries	1.2	$comment = 0;
38			}
39	dries	1.1	else {
40	dries	1.2	next;
41	dries	1.1	}
42			}
43			if (s/\/\.//) {
44			$comment = 1;
45			}
46			if (/^\s*#/) {
47			next;
48			}
49
50			if (s/<\?php//) {
51			$program = 1;
52			}
53			if (/\?>/) {
54			$program = 0;
55			}
56	dries	1.2
57	dries	1.9	# enforce "bar". foo() ."bar" syntax
58	dries	1.1	if (/^("[^"]"\|[^"])("[^"]*")\.[^ ]/ && $program) {
59			$msg = "'\".' -> '\". '";
60			}
61			elsif (/^("[^"]"\|[^"])("[^"]*")\s+\./ && $program) {
62			$msg = "'\" .' -> '\".'";
63			}
64	dries	1.9	# enforce "bar". foo() ."bar" syntax
65	dries	1.1	elsif (/^("[^"]"\|[^"])[^ "]\.("[^"]*")/ && $program) {
66			$msg = "'.\"' -> '.\"'";
67			}
68			elsif (/^("[^"]"\|[^"])[^ "]\.\s+("[^"]*")/ && $program) {
69			$msg = "'. \"' -> '.\"'";
70			}
71			# XHTML requires closing tag
72	dries	1.3	elsif (/<br>/i) {
73			$msg = "'<br>' -> '<br />'";
74	dries	1.1	}
75	dries	1.8	elsif (/\$REQUEST_URI/i) {
76			$msg = "the use of REQUEST_URI is prone to XSS exploits and does not work on IIS; use request_uri() instead";
77	dries	1.6	}
78	dries	1.8	elsif (/\"REQUEST_URI\"/i) {
79			$msg = "the use of REQUEST_URI is prone to XSS exploits and does not work on IIS; use request_uri() instead";
80	dries	1.6	}
81
82	dries	1.2	# XHTML compatibility mode suggests a blank before /
83	dries	1.1	# i.e. <br />
84			elsif (/<[a-z][^>]*[^ >]\/>/i) {
85			$msg = "'<foo/".">' -> '<foo />'";
86			}
87			# we write '{' on the same line, not on the next
88			elsif (/^\s*{/ && $program) {
89	dries	1.2	$msg = "take '{' to previous line";
90	dries	1.1	}
91	dries	1.7	elsif (/([a-z])([A-Z])/) {
92			$msg = "no mixed case function or variable names, use lower case and _";
93	dries	1.1	}
94	dries	1.7	elsif (/<[\/][A-Z]+[^>]>/) {
95			$msg = "XHTML demands tags to be lowercase";
96			}
97
98	dries	1.1	# trying to recognize splitted lines
99			# there are only a few valid last characters in programming mode,
100			# only sometimes it is ( if you use if/else with a single statement
101	dries	1.2
102	dries	1.1	# from here on we need no more strings
103			while (s/^([^"])"[^"]"/$1#/) {};
104			while (s/^([^'])'[^']'/$1#/) {};
105
106			# it should be 'if (' all the time
107			if (/(^\|[^a-zA-Z])(if\|else\|elseif\|while\|foreach\|switch\|return\|for)\(/) {
108	dries	1.3	$msg = "'(' -> ' ('";
109	dries	1.1	}
110	dries	1.8	#elsif (/[^;{}:\s\n]\s\n$/ && $program && !/^[\s}]*(if\|else)/) {
111			# $msg = "don't split lines";
112			#}
113	dries	1.1	elsif (/\}\s*else/) {
114			$msg = "'} else' -> '}\\nelse'";
115			}
116			elsif (/[^{\s\n]\s\n$/ && $program && /^\s*(if\|else)/) {
117			$msg = "every if/else needs a { at eol";
118			}
119			elsif (/([\(\[]) / && $program) {
120			$msg = "'$1 ' -> '$1'";
121			}
122	dries	1.12	elsif (/\S ([\)\]])/ && $program) {
123	dries	1.1	$msg = "' $1' -> '$1'";
124			}
125	dries	1.2	# but no brackets
126	dries	1.1	elsif (/([a-z-A-Z_][a-zA-Z0-9_-]*)\s+\(/ && $program) {
127			if ($1 ne "switch" and $1 ne "if" and $1 ne "while" and $1 ne "foreach" and $1 ne "return" and $1 ne "for" and $1 ne "elseif") {
128			$msg = "'$1 (' -> '$1('";
129			}
130			}
131			# there should be a space before '{'
132	dries	1.3	if (/[^ ]{/ && $program) {
133	dries	1.1	$msg = "missing space before '{'";
134			}
135			# there should be a space after ','
136	kjartan	1.4	elsif (/[,][^ \n\r]/ && $program) {
137	dries	1.1	$msg = "missing space after ','";
138			}
139			# spaces before and after, only foreach may use $foo=>bar
140	dries	1.10	elsif (/[^ =\|\-\|\+](\+\|\-)[^ =>\|\-\|\+]/ && $program && !/foreach/) {
141	kjartan	1.4	$msg = "'$1' -> ' $1 '";
142			}
143			elsif (/[^ =](\*\|==\|\.=\|=>\|=\|\\|\\|)[^ =>]/ && $program && !/foreach/) {
144	dries	1.3	$msg = "'$1' -> ' $1 '";
145			}
146			# ensure $bar["foo"] and $bar[$foo] and $bar[0]
147			elsif (/\[[^#][^\]]\]/ && !/\[[0-9\$][^\]]\]/ && !/\[\]/) {
148			$msg = "only [\"foo\"], [\$foo] or [0] is allowed";
149			}
150			# first try to find missing quotes after = in (X)HTML tags
151			elsif (/<[^>]=[a-zA-Z0-9][^>]>/) {
152			$msg = "=... -> =\"...\"";
153	dries	1.1	}
154			if (defined $msg) {
155			if ($debug==0) {
156			print $ARGV .":". $. .": $msg : ". $org;
157			}
158			undef $msg;
159	dries	1.2	}
160	dries	1.1	elsif ($debug==1) {
161			print $org;
162			}
163			} continue {
164			close ARGV if eof;
165			}
166	dries	1.13
167			__END__
168
169			=head1 NAME
170
171	dries	1.16	code-style.pl - Review Drupal code for style
172	dries	1.13
173			=head1 SYNOPSIS
174
175			code-style.pl [options] <filename>
176
177			Options:
178
179			-? --help detailed help message
180
181			=head1 DESCRIPTION
182
183			Originally written for Drupal (http://drupal.org/) to ensure stylish
184	dries	1.15	code. This program reviews PHP code, and tries to show as many code
185	dries	1.13	improvements as possible with no false positives.
186
187			=head1 OPTIONS
188
189			--comment
190
191			=head1 EXAMPLES
192
193			./code-style.pl ../index.php
194
195			=cut