[mirrors/Kyberia-bloodline.git] / scripts / phpindent.pl

#!/usr/bin/perl -w

# php indenter
#  Reformats your php source code
#
# $Id: phpindent,v 1.1 2002/05/20 12:54:03 weasel Exp $
#
#
# Depends: Parse::RecDescent
# 
#
# (c) 2002 Florian Reitmeir <squat@riot.org>
#          Peter Palfrader <peter@palfrader.org>
#
#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 2 of the License, or
#     (at your option) any later version.
#     
#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
#     
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
#
# Usage: phpindent < orig.php > new.php
#
#
# - It might corrupt your code
# - It might not even work at all
# - It does not understand all of php
# - It's damn slow (several hours for one of our 800 line examples on a gHz
#       CPU)
# - But it was fun to write and merely to test out Parse::RecDescent
#
# It was just a proof of concept - don't use it in production
#
# Did I mention it was slow?
#
#
# Q: So why did you write it?
# A: It was an ad hoc quick hack which went out of control but was
#    real fun.
#
# Q: So are there any real php indenters?
# A: We didn't find any which is why we tried this nonsense at all.
#    If you find any just let us know and we will link to them.
#
# Q: Will you improve this indenter/fix bugs I report?
# A: Probably not. But if you happen to have lots of time we would
#    welcome a patch or two.
#
# Q: You know your grammar sucks?
# A: yepp.
#

#######################################################################
package MyToken;

sub new
{
	my ($class, %args) = @_;
	bless \%args, $class;
}

#######################################################################
package MyBinaryOperator;
@ISA = qw( MyToken );

sub reprint
{
	my ($self) = @_;
	return
	sprintf "%s %s %s",
		$self->{left}->reprint(),
		$self->{'operator'},
		$self->{right}->reprint();
};

#######################################################################
package MyPostOperator;
@ISA = qw( MyToken );

sub reprint
{
	my ($self) = @_;
	return
	sprintf "%s %s",
		$self->{left}->reprint(),
		$self->{'operator'};
};

#######################################################################
package MyPreOperator;
@ISA = qw( MyToken );

sub reprint
{
	my ($self) = @_;
	return
	sprintf "%s %s",
		$self->{'operator'},
		$self->{right}->reprint();
};

#######################################################################
package MyAtom;
@ISA = qw( MyToken );

sub reprint
{
	my ($self) = @_;

	return
	sprintf "%s",
		$self->{'value'};
};

#######################################################################
package MyStatement;
@ISA = qw( MyToken );

sub reprint
{
	my ($self) = @_;

	return
	sprintf "%s;\n",
		$self->{'value'};
};

#######################################################################
package MyComment;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;
	my $il = $args{'indent'} || 1;
	my $i = "\t" x ($il -1 );

	my $value = $self->{'value'};
	$value =~ s,#\s*,# ,;
	$value =~ s,//\s*,\n\n$i// ,;
	return
		$value."\n";
};

#######################################################################
package MyCommentMultiLine;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;
    my $il = $args{'indent'}-1 || 0;
	my $i = "\t" x $il;

	my $value = $self->{'value'};
	$value =~ s,/\*\s*\n?,,;
	$value =~ s,\n?\s*\*/,,;
	my @lines = map { s/^\s*\*?[ \t]*/$i * /; $_ } split /\n/, $value;
	unshift @lines, "/*";
	push @lines, "$i */";
	
	return
	sprintf "%s\n",
		join ("\n", @lines)
};

#######################################################################
package MyCommentDoc;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;
    my $il = $args{'indent'}-1 || 0;
	my $i = "\t" x $il;

	my $value = $self->{'value'};
	$value =~ s,^/\*\*[ \t]*\n?,,;
	$value =~ s,\n?[ \t]*\*/$,,;
	$value =~ s/\t/        /g;
	my @lines = split /\n/, $value;

	my $maxwhitespace;
	for (@lines) {
		my ($leadwhitespace) = ($_ =~ /^(\s*)/);
		$maxwhitespace = (!defined ($maxwhitespace) || length($leadwhitespace) < $maxwhitespace) ?
			length($leadwhitespace) :
			$maxwhitespace;
	};
	my $leadwhitespace = " " x $maxwhitespace;
	@lines = map { s/^$leadwhitespace//; s/^/$i   /; $_ } @lines;

	unshift @lines, "/**";
	push @lines, "$i */";
	
	return
	sprintf "%s\n",
		join ("\n", @lines)
};

#######################################################################
package MyConditionalBlock;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;
    my $il = $args{'indent'} || 0;
	my $i = "\t" x $il;

	my $block = $self->{block}->reprint(indent => $il, noend=>1);
	if ($block =~ /^\s*\{/) {
		$block = "\t" x ($il-1) . $block;
		$isblock = 1;
	} else {
		$block = "\t" x ($il) . $block;
		$isblock = 0;
	};


	my $elseblock;
	if ($self->{type} eq 'ifelse') {
		$elseblock = $self->{elseblock}->reprint(indent => $il, noend=>1);
		if ($elseblock =~ /^\s*\{/) {
			$elseblock = "\t" x ($il-1) . $elseblock;
			$elseisblock = 1;
		} else {
			$elseblock = "\t" x ($il) . $elseblock;
			$elseisblock = 0;
		};
	};

	if ($self->{type} eq 'if' || $self->{type} eq 'while') {
		return
			$self->{type}.
			" (".
			$self->{condition}->reprint().
			")\n".
			$block.
			($isblock ? ";\n" : "");
	} elsif ($self->{type} eq 'ifelse') {
		return
			"if".
			" (".
			$self->{condition}->reprint().
			")\n".
			$block.
			($elseisblock ? "\n" : "").
			"\t"x($il-1)  .  "else\n".
			$elseblock.
			($elseisblock ? ";\n" : "");
	} elsif ($self->{type} eq 'dowhile') {
		return
			"do\n".
			$block.
			" while (".
			$self->{condition}->reprint().
			");\n";
	} elsif ($self->{type} eq 'for') {
		return
			$self->{type}.
			" (".
			$self->{part1}->reprint().
			"; ".
			$self->{part2}->reprint().
			"; ".
			$self->{part3}->reprint().
			")\n".
			$block.
			($isblock ? ";\n" : "");
	} elsif ($self->{type} eq 'foreach') {
		return
			$self->{type}.
			" (".
			$self->{part1}->reprint().
			" as ".
			$self->{part2}->reprint().
			")\n".
			$block.
			($isblock ? ";\n" : "");
	};
	
};

#######################################################################
package MyParam;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;
	my $il = $args{'indent'} || 1;
	my $i = "\t" x $il;

	my $statements = join (", ", map { $_->reprint() } @{$self->{'statements'}});

	return
		$statements;
};

#######################################################################
package MyFunction;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;
	my $il = $args{'indent'} || 1;
	my $i = "\t" x $il;

	return
		$self->{name}->reprint().
		" (".
		((defined $self->{params}) ? $self->{params}->reprint() : "").
		")";
};

#######################################################################
package MyBlock;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;
	my $il = $args{'indent'} || 1;
	my $i = "\t" x $il;

	my $statements = join ($i, map { $_->reprint(indent => $il + 1) } @{$self->{'statements'}});

	$statements = $i.$statements if ( substr($statements,0,1) ne "\n" );
	
	return
		((defined $args{'nobraces'}) ? "" : "{\n").
		$statements.
		"\t" x ($il-1).
		((defined $args{'nobraces'}) ? "" : "}").
		((defined $args{'noend'}) ? "" : ";\n");
};

#######################################################################
package MyFunctionDefinition;
@ISA = qw( MyToken );

sub reprint
{
	my ($self, %args) = @_;

	my $il = $args{'indent'} || 1;
	my $i = "\t" x ($il-1);

	return
		"\n".
		$i."function ".
		$self->{'header'}->reprint().  "\n".
		$i.$self->{'block'}->reprint(indent => $il)."\n";
};


#######################################################################
package main;

use strict;
use Parse::RecDescent;


my $input;
local $/ = undef;
$input = <>;

my $grammar = q
{
	Script:				/<\?(php)?/ Block '?>'		{ MyAtom->new ( value => "<?\n" . $item[2]->reprint(nobraces=>1) ."?>\n" ) }

	GroupedBlock:		'{'	Block '}' /;?/			{ MyBlock->new ( statements => [ @{$item[2]->{'statements'}} ] ) }

	Block:				Statement Block			{ MyBlock->new ( statements => [ $item[1], @{$item[2]->{'statements'}} ] ) }
					|	Statement				{ MyBlock->new ( statements => [ $item[1] ] ) }

	Statement:			Expression ';'			{ MyStatement->new ( value => $item[1]->reprint() ) }
					|	';'						{ MyStatement->new ( value => '' ) }
					|	GroupedBlock ';'		{ $item[1] }
					|	GroupedBlock
					|	Comment
					|	IfThenElseBlock
					|	IfBlock
					|	WhileBlock
					|	DoWhileBlock
					|	ForLoop
					|	ForEachLoop
					|	FunctionDefinition

	FunctionDefinition:	"function" FunctionCall GroupedBlock
													{ MyFunctionDefinition->new ( header => $item[2], block => $item[3] ) }


	IfThenElseBlock:	"if" "(" Expression ")" Statement "else" Statement
												{ MyConditionalBlock->new ( type      => 'ifelse',
												                            condition => $item[3],
												                            block   => $item[5],
												                            elseblock => $item[7] ) }
	IfBlock:			"if" "(" Expression ")" Statement
												{ MyConditionalBlock->new ( type      => 'if',
												                            condition => $item[3],
												                            block     => $item[5] ) }
	WhileBlock:			"while" "(" Expression ")" Statement
												{ MyConditionalBlock->new ( type      => 'while',
												                            condition => $item[3],
												                            block     => $item[5] ) }
	DoWhileBlock:		"do" GroupedBlock "while" "(" Expression ")" ";"
												{ MyConditionalBlock->new ( type      => 'dowhile',
												                            condition => $item[5],
												                            block     => $item[2] ) }
	ForLoop:			"for" "(" Expression ";" Expression ";" Expression ")" Statement
												{ MyConditionalBlock->new ( type      => 'for',
												                            part1     => $item[3],
												                            part2     => $item[5],
												                            part3     => $item[7],
												                            block     => $item[9] ) }
	ForEachLoop:		"foreach" "(" Expression "as" Expression ")" Statement
												{ MyConditionalBlock->new ( type      => 'foreach',
												                            part1     => $item[3],
												                            part2     => $item[5],
												                            block     => $item[7] ) }
	Expression:			"(" Expression ")"		{ $item[2] }
					|	FunctionCall Operator Expression
												{ MyBinaryOperator->new ( left=>$item[1], operator=>$item[2], right=>$item[3] ) }
					|	Atom Operator Expression
												{ MyBinaryOperator->new ( left=>$item[1], operator=>$item[2], right=>$item[3] ) }
					|	Atom Operator			{ MyPostOperator->new ( left=>$item[1], operator=>$item[2] ) }
					|	PreOperator Expression	{ MyPreOperator->new ( right=>$item[2], operator=>$item[1] ) }
					|	FunctionCall
					|	Atom

												
	Comment:			CommentHash
					|	CommentSlash
					|	CommentDoc
					|	CommentMultiLine

	CommentHash:		/#.*?$/m				{ MyComment->new ( value => $item[1] ) }
	CommentSlash:		/\/\/.*?$/m				{ MyComment->new ( value => $item[1] ) }
	CommentDoc:			/\/\*\*.*?\*\//s		{ MyCommentDoc->new ( value => $item[1] ) }
	CommentMultiLine:	/\/\*.*?\*\//s			{ MyCommentMultiLine->new ( value => $item[1] ) }

	Operator:			 '==='
					|	'!=='
					|	'+='
					|	'-='
					|	'=='
					|	'!='
					|	'=>'
					|	'<='
					|	'>='
					|	'++'
					|	'--'
					|	'&&'
					|	'.='
					|	'||'
					|	'&'
					|	'|'
					|	'>'
					|	'<'
					|	'='
					|	'/'
					|	'+'
					|	'-'
					|	'*'
					|	'.'
					|	':'
					|	'?'

	PreOperator: 		"new"
					|	"print"
					|	"return"
					|	"echo"
					|	"not"
					|	"++"
					|	"--"
					|	"-"
					|	"+"
					|	"1"
					|	"!"


	FunctionCall:		Atom "(" FunctionParameter ")"
												{ MyFunction->new ( name => $item[1], params => $item[3] ) }
					|	Atom "(" ")"
												{ MyFunction->new ( name => $item[1] ) }

	Atom:				Variable
					|	String
					|	Identifier
					|	Numerical


	FunctionParameter:	Expression "," FunctionParameter
												{ MyParam->new ( statements => [ $item[1], @{$item[3]->{'statements'}} ] ) }
					|	Expression				{ MyParam->new ( statements => [ $item[1] ] ) }

	
	Variable:			'$'	Identifier Array
												{ MyAtom->new ( value => '$'.$item[2]->reprint() . $item[3]->reprint() ) }
					|	'$' Identifier			{ MyAtom->new ( value => '$'.$item[2]->reprint() ) }


	Array:				"[" "]" Array			{ MyAtom->new ( value => '[]'.$item[3]->reprint() ) }
					|	"[" Expression "]" Array
												{ MyAtom->new ( value => '['.$item[2]->reprint().']'.$item[4]->reprint() ) }
					|	"[" Expression "]"		{ MyAtom->new ( value => '['.$item[2]->reprint().']' ) }
					|	"[" "]"					{ MyAtom->new ( value => '[]' ) }


	Identifier:			SimpleIdentifier "->" Identifier
												{ MyAtom->new ( value => $item[1]->reprint() ."->" .$item[3]->reprint() ) }
					|	SimpleIdentifier

	SimpleIdentifier:	/[a-zA-Z][a-zA-Z0-9_]*/	{ MyAtom->new ( value => $item[1] ) }

	Numerical:			/[\d]+(\.[\d+])?/		{ MyAtom->new ( value => $item[1] ) }

	String:				EmptyDQString
					|	NotEmptyDQString
					|	EmptySQString
					|	NotEmptySQString
	NotEmptyDQString:		/".*?[^\\\\]"/s		{ MyAtom->new ( value => $item[1] ) }
	EmptyDQString:		'""'					{ MyAtom->new ( value => '""' ) }
	NotEmptySQString:		/'.*?[^\\\\]'/s		{ MyAtom->new ( value => $item[1] ) }
	EmptySQString:		"''"					{ MyAtom->new ( value => "''" ) }
};

#$::RD_HINT = 1;
my $parser = new Parse::RecDescent ($grammar);
my $tree = $parser->Script($input);

print $tree->reprint();


# vim:set ts=4:
# vim:set shiftwidth=4:
Commit	Line	Data
a6540423 H	1	#!/usr/bin/perl -w
	2
	3	# php indenter
	4	# Reformats your php source code
	5	#
	6	# $Id: phpindent,v 1.1 2002/05/20 12:54:03 weasel Exp $
	7	#
	8	#
	9	# Depends: Parse::RecDescent
	10	#
	11	#
	12	# (c) 2002 Florian Reitmeir <squat@riot.org>
	13	# Peter Palfrader <peter@palfrader.org>
	14	#
	15	# This program is free software; you can redistribute it and/or modify
	16	# it under the terms of the GNU General Public License as published by
	17	# the Free Software Foundation; either version 2 of the License, or
	18	# (at your option) any later version.
	19	#
	20	# This program is distributed in the hope that it will be useful,
	21	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	22	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	23	# GNU General Public License for more details.
	24	#
	25	# You should have received a copy of the GNU General Public License
	26	# along with this program; if not, write to the Free Software
	27	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	28	#
	29	#
	30	#
	31	# Usage: phpindent < orig.php > new.php
	32	#
	33	#
	34	# - It might corrupt your code
	35	# - It might not even work at all
	36	# - It does not understand all of php
	37	# - It's damn slow (several hours for one of our 800 line examples on a gHz
	38	# CPU)
	39	# - But it was fun to write and merely to test out Parse::RecDescent
	40	#
	41	# It was just a proof of concept - don't use it in production
	42	#
	43	# Did I mention it was slow?
	44	#
	45	#
	46	# Q: So why did you write it?
	47	# A: It was an ad hoc quick hack which went out of control but was
	48	# real fun.
	49	#
	50	# Q: So are there any real php indenters?
	51	# A: We didn't find any which is why we tried this nonsense at all.
	52	# If you find any just let us know and we will link to them.
	53	#
	54	# Q: Will you improve this indenter/fix bugs I report?
	55	# A: Probably not. But if you happen to have lots of time we would
	56	# welcome a patch or two.
	57	#
	58	# Q: You know your grammar sucks?
	59	# A: yepp.
	60	#
	61
	62	#######################################################################
	63	package MyToken;
	64
65	sub new
66	{
67	my ($class, %args) = @_;
68	bless \%args, $class;
69	}
70
71	#######################################################################
72	package MyBinaryOperator;
73	@ISA = qw( MyToken );
74
75	sub reprint
76	{
77	my ($self) = @_;
78	return
79	sprintf "%s %s %s",
80	$self->{left}->reprint(),
81	$self->{'operator'},
82	$self->{right}->reprint();
83	};
84
85	#######################################################################
86	package MyPostOperator;
87	@ISA = qw( MyToken );
88
89	sub reprint
90	{
91	my ($self) = @_;
92	return
93	sprintf "%s %s",
94	$self->{left}->reprint(),
95	$self->{'operator'};
96	};
97
98	#######################################################################
99	package MyPreOperator;
100	@ISA = qw( MyToken );
101
102	sub reprint
103	{
104	my ($self) = @_;
105	return
106	sprintf "%s %s",
107	$self->{'operator'},
108	$self->{right}->reprint();
109	};
110
111	#######################################################################
112	package MyAtom;
113	@ISA = qw( MyToken );
114
115	sub reprint
116	{
117	my ($self) = @_;
118
119	return
120	sprintf "%s",
121	$self->{'value'};
122	};
123
124	#######################################################################
125	package MyStatement;
126	@ISA = qw( MyToken );
127
128	sub reprint
129	{
130	my ($self) = @_;
131
132	return
133	sprintf "%s;\n",
134	$self->{'value'};
135	};
136
137	#######################################################################
138	package MyComment;
139	@ISA = qw( MyToken );
140
141	sub reprint
142	{
143	my ($self, %args) = @_;
144	my $il = $args{'indent'} \|\| 1;
145	my $i = "\t" x ($il -1 );
146
147	my $value = $self->{'value'};
148	$value =~ s,#\s*,# ,;
149	$value =~ s,//\s*,\n\n$i// ,;
150	return
151	$value."\n";
152	};
153
154	#######################################################################
155	package MyCommentMultiLine;
156	@ISA = qw( MyToken );
157
158	sub reprint
159	{
160	my ($self, %args) = @_;
161	my $il = $args{'indent'}-1 \|\| 0;
162	my $i = "\t" x $il;
163
164	my $value = $self->{'value'};
165	$value =~ s,/\\s\n?,,;
166	$value =~ s,\n?\s\/,,;
167	my @lines = map { s/^\s\?[ \t]/$i /; $_ } split /\n/, $value;
168	unshift @lines, "/*";
169	push @lines, "$i */";
170
171	return
172	sprintf "%s\n",
173	join ("\n", @lines)
174	};
175
176	#######################################################################
177	package MyCommentDoc;
178	@ISA = qw( MyToken );
179
180	sub reprint
181	{
182	my ($self, %args) = @_;
183	my $il = $args{'indent'}-1 \|\| 0;
184	my $i = "\t" x $il;
185
186	my $value = $self->{'value'};
187	$value =~ s,^/\\[ \t]*\n?,,;
188	$value =~ s,\n?[ \t]\/$,,;
189	$value =~ s/\t/ /g;
190	my @lines = split /\n/, $value;
191
192	my $maxwhitespace;
193	for (@lines) {
194	my ($leadwhitespace) = ($_ =~ /^(\s*)/);
195	$maxwhitespace = (!defined ($maxwhitespace) \|\| length($leadwhitespace) < $maxwhitespace) ?
196	length($leadwhitespace) :
197	$maxwhitespace;
198	};
199	my $leadwhitespace = " " x $maxwhitespace;
200	@lines = map { s/^$leadwhitespace//; s/^/$i /; $_ } @lines;
201
202	unshift @lines, "/**";
203	push @lines, "$i */";
204
205	return
206	sprintf "%s\n",
207	join ("\n", @lines)
208	};
209
210	#######################################################################
211	package MyConditionalBlock;
212	@ISA = qw( MyToken );
213
214	sub reprint
215	{
216	my ($self, %args) = @_;
217	my $il = $args{'indent'} \|\| 0;
218	my $i = "\t" x $il;
219
220	my $block = $self->{block}->reprint(indent => $il, noend=>1);
221	if ($block =~ /^\s*\{/) {
222	$block = "\t" x ($il-1) . $block;
223	$isblock = 1;
224	} else {
225	$block = "\t" x ($il) . $block;
226	$isblock = 0;
227	};
228
229
230	my $elseblock;
231	if ($self->{type} eq 'ifelse') {
232	$elseblock = $self->{elseblock}->reprint(indent => $il, noend=>1);
233	if ($elseblock =~ /^\s*\{/) {
234	$elseblock = "\t" x ($il-1) . $elseblock;
235	$elseisblock = 1;
236	} else {
237	$elseblock = "\t" x ($il) . $elseblock;
238	$elseisblock = 0;
239	};
240	};
241
242	if ($self->{type} eq 'if' \|\| $self->{type} eq 'while') {
243	return
244	$self->{type}.
245	" (".
246	$self->{condition}->reprint().
247	")\n".
248	$block.
249	($isblock ? ";\n" : "");
250	} elsif ($self->{type} eq 'ifelse') {
251	return
252	"if".
253	" (".
254	$self->{condition}->reprint().
255	")\n".
256	$block.
257	($elseisblock ? "\n" : "").
258	"\t"x($il-1) . "else\n".
259	$elseblock.
260	($elseisblock ? ";\n" : "");
261	} elsif ($self->{type} eq 'dowhile') {
262	return
263	"do\n".
264	$block.
265	" while (".
266	$self->{condition}->reprint().
267	");\n";
268	} elsif ($self->{type} eq 'for') {
269	return
270	$self->{type}.
271	" (".
272	$self->{part1}->reprint().
273	"; ".
274	$self->{part2}->reprint().
275	"; ".
276	$self->{part3}->reprint().
277	")\n".
278	$block.
279	($isblock ? ";\n" : "");
280	} elsif ($self->{type} eq 'foreach') {
281	return
282	$self->{type}.
283	" (".
284	$self->{part1}->reprint().
285	" as ".
286	$self->{part2}->reprint().
287	")\n".
288	$block.
289	($isblock ? ";\n" : "");
290	};
291
292	};
293
294	#######################################################################
295	package MyParam;
296	@ISA = qw( MyToken );
297
298	sub reprint
299	{
300	my ($self, %args) = @_;
301	my $il = $args{'indent'} \|\| 1;
302	my $i = "\t" x $il;
303
304	my $statements = join (", ", map { $_->reprint() } @{$self->{'statements'}});
305
306	return
307	$statements;
308	};
309
310	#######################################################################
311	package MyFunction;
312	@ISA = qw( MyToken );
313
314	sub reprint
315	{
316	my ($self, %args) = @_;
317	my $il = $args{'indent'} \|\| 1;
318	my $i = "\t" x $il;
319
320	return
321	$self->{name}->reprint().
322	" (".
323	((defined $self->{params}) ? $self->{params}->reprint() : "").
324	")";
325	};
326
327	#######################################################################
328	package MyBlock;
329	@ISA = qw( MyToken );
330
331	sub reprint
332	{
333	my ($self, %args) = @_;
334	my $il = $args{'indent'} \|\| 1;
335	my $i = "\t" x $il;
336
337	my $statements = join ($i, map { $_->reprint(indent => $il + 1) } @{$self->{'statements'}});
338
339	$statements = $i.$statements if ( substr($statements,0,1) ne "\n" );
340
341	return
342	((defined $args{'nobraces'}) ? "" : "{\n").
343	$statements.
344	"\t" x ($il-1).
345	((defined $args{'nobraces'}) ? "" : "}").
346	((defined $args{'noend'}) ? "" : ";\n");
347	};
348
349	#######################################################################
350	package MyFunctionDefinition;
351	@ISA = qw( MyToken );
352
353	sub reprint
354	{
355	my ($self, %args) = @_;
356
357	my $il = $args{'indent'} \|\| 1;
358	my $i = "\t" x ($il-1);
359
360	return
361	"\n".
362	$i."function ".
363	$self->{'header'}->reprint(). "\n".
364	$i.$self->{'block'}->reprint(indent => $il)."\n";
365	};
366
367
368
369
370	#######################################################################
371	package main;
372
373	use strict;
374	use Parse::RecDescent;
375
376
377	my $input;
378	local $/ = undef;
379	$input = <>;
380
381	my $grammar = q
382	{
383	Script: /<\?(php)?/ Block '?>' { MyAtom->new ( value => "<?\n" . $item[2]->reprint(nobraces=>1) ."?>\n" ) }
384
385	GroupedBlock: '{' Block '}' /;?/ { MyBlock->new ( statements => [ @{$item[2]->{'statements'}} ] ) }
386
387	Block: Statement Block { MyBlock->new ( statements => [ $item[1], @{$item[2]->{'statements'}} ] ) }
388	\| Statement { MyBlock->new ( statements => [ $item[1] ] ) }
389
390	Statement: Expression ';' { MyStatement->new ( value => $item[1]->reprint() ) }
391	\| ';' { MyStatement->new ( value => '' ) }
392	\| GroupedBlock ';' { $item[1] }
393	\| GroupedBlock
394	\| Comment
395	\| IfThenElseBlock
396	\| IfBlock
397	\| WhileBlock
398	\| DoWhileBlock
399	\| ForLoop
400	\| ForEachLoop
401	\| FunctionDefinition
402
403	FunctionDefinition: "function" FunctionCall GroupedBlock
404	{ MyFunctionDefinition->new ( header => $item[2], block => $item[3] ) }
405
406
407	IfThenElseBlock: "if" "(" Expression ")" Statement "else" Statement
408	{ MyConditionalBlock->new ( type => 'ifelse',
409	condition => $item[3],
410	block => $item[5],
411	elseblock => $item[7] ) }
412	IfBlock: "if" "(" Expression ")" Statement
413	{ MyConditionalBlock->new ( type => 'if',
414	condition => $item[3],
415	block => $item[5] ) }
416	WhileBlock: "while" "(" Expression ")" Statement
417	{ MyConditionalBlock->new ( type => 'while',
418	condition => $item[3],
419	block => $item[5] ) }
420	DoWhileBlock: "do" GroupedBlock "while" "(" Expression ")" ";"
421	{ MyConditionalBlock->new ( type => 'dowhile',
422	condition => $item[5],
423	block => $item[2] ) }
424	ForLoop: "for" "(" Expression ";" Expression ";" Expression ")" Statement
425	{ MyConditionalBlock->new ( type => 'for',
426	part1 => $item[3],
427	part2 => $item[5],
428	part3 => $item[7],
429	block => $item[9] ) }
430	ForEachLoop: "foreach" "(" Expression "as" Expression ")" Statement
431	{ MyConditionalBlock->new ( type => 'foreach',
432	part1 => $item[3],
433	part2 => $item[5],
434	block => $item[7] ) }
435	Expression: "(" Expression ")" { $item[2] }
436	\| FunctionCall Operator Expression
437	{ MyBinaryOperator->new ( left=>$item[1], operator=>$item[2], right=>$item[3] ) }
438	\| Atom Operator Expression
439	{ MyBinaryOperator->new ( left=>$item[1], operator=>$item[2], right=>$item[3] ) }
440	\| Atom Operator { MyPostOperator->new ( left=>$item[1], operator=>$item[2] ) }
441	\| PreOperator Expression { MyPreOperator->new ( right=>$item[2], operator=>$item[1] ) }
442	\| FunctionCall
443	\| Atom
444
445
446	Comment: CommentHash
447	\| CommentSlash
448	\| CommentDoc
449	\| CommentMultiLine
450
451	CommentHash: /#.*?$/m { MyComment->new ( value => $item[1] ) }
452	CommentSlash: /\/\/.*?$/m { MyComment->new ( value => $item[1] ) }
453	CommentDoc: /\/\\.?\\//s { MyCommentDoc->new ( value => $item[1] ) }
454	CommentMultiLine: /\/\.?\*\//s { MyCommentMultiLine->new ( value => $item[1] ) }
455
456	Operator: '==='
457	\| '!=='
458	\| '+='
459	\| '-='
460	\| '=='
461	\| '!='
462	\| '=>'
463	\| '<='
464	\| '>='
465	\| '++'
466	\| '--'
467	\| '&&'
468	\| '.='
469	\| '\|\|'
470	\| '&'
471	\| '\|'
472	\| '>'
473	\| '<'
474	\| '='
475	\| '/'
476	\| '+'
477	\| '-'
478	\| '*'
479	\| '.'
480	\| ':'
481	\| '?'
482
483	PreOperator: "new"
484	\| "print"
485	\| "return"
486	\| "echo"
487	\| "not"
488	\| "++"
489	\| "--"
490	\| "-"
491	\| "+"
492	\| "1"
493	\| "!"
494
495
496
497	FunctionCall: Atom "(" FunctionParameter ")"
498	{ MyFunction->new ( name => $item[1], params => $item[3] ) }
499	\| Atom "(" ")"
500	{ MyFunction->new ( name => $item[1] ) }
501
502	Atom: Variable
503	\| String
504	\| Identifier
505	\| Numerical
506
507
508	FunctionParameter: Expression "," FunctionParameter
509	{ MyParam->new ( statements => [ $item[1], @{$item[3]->{'statements'}} ] ) }
510	\| Expression { MyParam->new ( statements => [ $item[1] ] ) }
511
512
513	Variable: '$' Identifier Array
514	{ MyAtom->new ( value => '$'.$item[2]->reprint() . $item[3]->reprint() ) }
515	\| '$' Identifier { MyAtom->new ( value => '$'.$item[2]->reprint() ) }
516
517
518	Array: "[" "]" Array { MyAtom->new ( value => '[]'.$item[3]->reprint() ) }
519	\| "[" Expression "]" Array
520	{ MyAtom->new ( value => '['.$item[2]->reprint().']'.$item[4]->reprint() ) }
521	\| "[" Expression "]" { MyAtom->new ( value => '['.$item[2]->reprint().']' ) }
522	\| "[" "]" { MyAtom->new ( value => '[]' ) }
523
524
525	Identifier: SimpleIdentifier "->" Identifier
526	{ MyAtom->new ( value => $item[1]->reprint() ."->" .$item[3]->reprint() ) }
527	\| SimpleIdentifier
528
529	SimpleIdentifier: /[a-zA-Z][a-zA-Z0-9_]*/ { MyAtom->new ( value => $item[1] ) }
530
531	Numerical: /[\d]+(\.[\d+])?/ { MyAtom->new ( value => $item[1] ) }
532
533	String: EmptyDQString
534	\| NotEmptyDQString
535	\| EmptySQString
536	\| NotEmptySQString
537	NotEmptyDQString: /".*?[^\\\\]"/s { MyAtom->new ( value => $item[1] ) }
538	EmptyDQString: '""' { MyAtom->new ( value => '""' ) }
539	NotEmptySQString: /'.*?[^\\\\]'/s { MyAtom->new ( value => $item[1] ) }
540	EmptySQString: "''" { MyAtom->new ( value => "''" ) }
541	};
542
543	#$::RD_HINT = 1;
544	my $parser = new Parse::RecDescent ($grammar);
545	my $tree = $parser->Script($input);
546
547	print $tree->reprint();
548
549
550
551	# vim:set ts=4:
552	# vim:set shiftwidth=4: