lib/A3C/PHP.pm

package A3C::PHP;
use warnings;
use strict;
use Parse::RecDescent;
use Data::Dump qw/dump/;
use File::Slurp;

=head1 NAME

A3C::PHP

=head1 DESCRIPTION

For integration with php application there is simple php config
parser based on L<PHP::Include::Vars>

It currently ignores C<include> PHP function.

=head1 METHODS

=cut

our $debug = 0;

our $perl = '';
our $data;
my $grammar = 

<<'GRAMMAR';

php_vars:       php_start statement(s) php_end

php_start:      /\s*<\?(php)?\s*/

php_end:        /\s*\?>\s*/

statement:      comment | assignment | function

comment:        /\s*(\#|\/\/).*/

function:       /(include)\(.*?\)\s*;/
                {
                        $return = "## ignored $1\n";
                }

assignment:     ( var_assign | hash_assign | array_assign | constant ) /;/
                {
                        $A3C::PHP::perl .= $item[1];
                }

var_assign:     variable /=/ scalar 
                {
                        $item[1] =~ s/^\$//;
                        $return = "\$data->{ $item[1] } = $item[3]; # scalar\n"; 
                }

hash_assign:    variable /=/ /Array\s*\(/i pair(s /,/) /\s*(,\s*)?\)/
                { 
                        $item[1] =~ s/^\$//;
                        $return = "\$data->{ $item[1] } = $item[4]; # hash\n";
                        $return = "\%{\$data->{ $item[1] }} =(" . join( ',', @{$item[4]} ) . ");\t# hash\n";
                }

array_assign:   variable /=/ /Array\s*\(/i element(s /,/) /\s*(,\s*)?\)/
                {
                        $item[1] =~ s/^\$//;
                        $return = "\@{\$data->{ $item[1] }}=(" . join( ',', @{$item[4]} ) . ");\t# array\n"
                }

scalar:         string | number | constant

constant:   true | false

true:           'true'
                {
                        $return = '1';
                }
false:          'false'
                {
                        $return = '0';
                }

variable:       /\$[a-zA-Z_][0-9a-zA-Z_]*/ 

number:         /-?[0-9.]+/

string:         double_quoted | single_quoted

double_quoted:  /".*?"/
                {
                        $item[1] =~ s/\@/\\\@/g;
                        $return = $item[1];
                }

single_quoted:  /'.*?'/

element:        scalar | bareword

pair:           scalar /=>/ ( scalar | bareword )
                { 
                        $return = $item[1] . '=>' . $item[3];
                }

bareword:       /[0-9a-zA-Z_]+/
                        
constant:       /define\s*\(/ string /,/ scalar /\)/ 
                { 
                        $return =  "use constant $item[2] => $item[4];\n";
                }

comments:       /^#.*$/

whitespace:     /^\s+$/

GRAMMAR

=head1 parse

  my $data = A3C::PHP->parse( $php_code );

=cut

sub parse {
        my $self = shift;
        my $php = shift or die "no php?";
        $perl = '';
        if ( $debug ) {
                $::RD_TRACE = 1;
                warn "PHP: $php\n";
        }
        my $parser = Parse::RecDescent->new( $grammar );
        $parser->php_vars( $php );
        warn "## GENERATED PERL:\n\n", $perl, "\n\n" if $debug;
        my $data;
        eval $perl;
        die "$@" if $@;
        return $data;
}

=head1 parse_file

  my $data = A3C::PHP->parse_file( '/path/to/code.php' );

=cut

sub parse_file {
        my $self = shift;
        $self->parse( scalar read_file( shift ));
}

=head1 SEE ALSO

=over 4 

=item * PHP::Include

=item * Parse::RecDescent

=head1 AUTHORS

=over 4

=item * Ed Summers <ehs@pobox.com> wrote L<PHP::Include> on which this code is based

=cut

1;
1	dpavlin	133	package A3C::PHP;
2			use warnings;
3			use strict;
4			use Parse::RecDescent;
5			use Data::Dump qw/dump/;
6			use File::Slurp;
7
8			=head1 NAME
9
10			A3C::PHP
11
12			=head1 DESCRIPTION
13
14			For integration with php application there is simple php config
15			parser based on L<PHP::Include::Vars>
16
17	dpavlin	136	It currently ignores C<include> PHP function.
18
19	dpavlin	133	=head1 METHODS
20
21			=cut
22
23	dpavlin	136	our $debug = 0;
24	dpavlin	133
25			our $perl = '';
26			our $data;
27			my $grammar =
28
29			<<'GRAMMAR';
30
31			php_vars: php_start statement(s) php_end
32
33			php_start: /\s<\?(php)?\s/
34
35			php_end: /\s\?>\s/
36
37	dpavlin	136	statement: comment \| assignment \| function
38	dpavlin	133
39	dpavlin	136	comment: /\s(\#\|\/\/)./
40	dpavlin	133
41	dpavlin	136	function: /(include)\(.?\)\s;/
42			{
43			$return = "## ignored $1\n";
44			}
45
46	dpavlin	133	assignment: ( var_assign \| hash_assign \| array_assign \| constant ) /;/
47			{
48	dpavlin	136	$A3C::PHP::perl .= $item[1];
49	dpavlin	133	}
50
51			var_assign: variable /=/ scalar
52			{
53	dpavlin	136	$item[1] =~ s/^\$//;
54			$return = "\$data->{ $item[1] } = $item[3]; # scalar\n";
55	dpavlin	133	}
56
57			hash_assign: variable /=/ /Array\s\(/i pair(s /,/) /\s(,\s*)?\)/
58			{
59	dpavlin	136	$item[1] =~ s/^\$//;
60			$return = "\$data->{ $item[1] } = $item[4]; # hash\n";
61			$return = "\%{\$data->{ $item[1] }} =(" . join( ',', @{$item[4]} ) . ");\t# hash\n";
62	dpavlin	133	}
63
64			array_assign: variable /=/ /Array\s\(/i element(s /,/) /\s(,\s*)?\)/
65			{
66	dpavlin	136	$item[1] =~ s/^\$//;
67			$return = "\@{\$data->{ $item[1] }}=(" . join( ',', @{$item[4]} ) . ");\t# array\n"
68	dpavlin	133	}
69
70	dpavlin	136	scalar: string \| number \| constant
71	dpavlin	133
72	dpavlin	136	constant: true \| false
73
74			true: 'true'
75			{
76			$return = '1';
77			}
78			false: 'false'
79			{
80			$return = '0';
81			}
82
83	dpavlin	133	variable: /\$[a-zA-Z_][0-9a-zA-Z_]*/
84
85			number: /-?[0-9.]+/
86
87			string: double_quoted \| single_quoted
88
89			double_quoted: /".*?"/
90	dpavlin	136	{
91			$item[1] =~ s/\@/\\\@/g;
92			$return = $item[1];
93			}
94	dpavlin	133
95			single_quoted: /'.*?'/
96
97			element: scalar \| bareword
98
99			pair: scalar /=>/ ( scalar \| bareword )
100			{
101	dpavlin	136	$return = $item[1] . '=>' . $item[3];
102	dpavlin	133	}
103
104			bareword: /[0-9a-zA-Z_]+/
105	dpavlin	136
106	dpavlin	133	constant: /define\s*\(/ string /,/ scalar /\)/
107			{
108	dpavlin	136	$return = "use constant $item[2] => $item[4];\n";
109	dpavlin	133	}
110
111			comments: /^#.*$/
112
113			whitespace: /^\s+$/
114
115			GRAMMAR
116
117			=head1 parse
118
119			my $data = A3C::PHP->parse( $php_code );
120
121			=cut
122
123			sub parse {
124			my $self = shift;
125			my $php = shift or die "no php?";
126	dpavlin	136	$perl = '';
127			if ( $debug ) {
128			$::RD_TRACE = 1;
129			warn "PHP: $php\n";
130			}
131	dpavlin	133	my $parser = Parse::RecDescent->new( $grammar );
132	dpavlin	136	$parser->php_vars( $php );
133			warn "## GENERATED PERL:\n\n", $perl, "\n\n" if $debug;
134	dpavlin	133	my $data;
135			eval $perl;
136			die "$@" if $@;
137			return $data;
138			}
139
140			=head1 parse_file
141
142			my $data = A3C::PHP->parse_file( '/path/to/code.php' );
143
144			=cut
145
146			sub parse_file {
147			my $self = shift;
148			$self->parse( scalar read_file( shift ));
149			}
150
151			=head1 SEE ALSO
152
153			=over 4
154
155			=item * PHP::Include
156
157			=item * Parse::RecDescent
158
159			=head1 AUTHORS
160
161			=over 4
162
163			=item * Ed Summers <ehs@pobox.com> wrote L<PHP::Include> on which this code is based
164
165			=cut
166
167			1;