[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
	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: