/[A3C]/lib/A3C/PHP.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /lib/A3C/PHP.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 133 by dpavlin, Fri May 30 20:04:23 2008 UTC revision 140 by dpavlin, Fri May 30 22:02:19 2008 UTC
# Line 4  use strict; Line 4  use strict;
4  use Parse::RecDescent;  use Parse::RecDescent;
5  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
6  use File::Slurp;  use File::Slurp;
7    use Encode qw/decode/;
8    
9  =head1 NAME  =head1 NAME
10    
# Line 14  A3C::PHP Line 15  A3C::PHP
15  For integration with php application there is simple php config  For integration with php application there is simple php config
16  parser based on L<PHP::Include::Vars>  parser based on L<PHP::Include::Vars>
17    
18    It currently ignores C<include> PHP function.
19    
20    =head1 CONFIG
21    
22      $A3C::PHP::debug = 0;
23      $A3C::PHP::charset = 'iso-8859-2';
24    
25  =head1 METHODS  =head1 METHODS
26    
27  =cut  =cut
28    
29  my $debug = 0;  our $debug = 0;
30    our $charset = 'iso-8859-2';
31    
32  our $perl = '';  our $perl = '';
33  our $data;  our $data;
# Line 32  php_start:     /\s*<\?(php)?\s*/ Line 41  php_start:     /\s*<\?(php)?\s*/
41    
42  php_end:        /\s*\?>\s*/  php_end:        /\s*\?>\s*/
43    
44  statement:      comment | assignment  statement:      comment | assignment | function
45    
46  comment:        /\s*(\#|\/\/).*/  comment:        /\s*(\#|\/\/).*/
47    
48    function:       /(include)\(.*?\)\s*;/
49                    {
50                            $return = "## ignored $1\n";
51                    }
52    
53  assignment:     ( var_assign | hash_assign | array_assign | constant ) /;/  assignment:     ( var_assign | hash_assign | array_assign | constant ) /;/
54                  {                  {
55                      $A3C::PHP::perl .= $item[1];                          $A3C::PHP::perl .= $item[1];
56                  }                  }
57    
58  var_assign:     variable /=/ scalar  var_assign:     variable /=/ scalar
59                  {                  {
60                      $item[1] =~ s/^\$//;                          $item[1] =~ s/^\$//;
61                      $return = "\$data->{ $item[1] } = $item[3]; # scalar\n";                          $return = "\$data->{ $item[1] } = $item[3]; # scalar\n";
62                  }                  }
63    
64  hash_assign:    variable /=/ /Array\s*\(/i pair(s /,/) /\s*(,\s*)?\)/  hash_assign:    variable /=/ /Array\s*\(/i pair(s /,/) /\s*(,\s*)?\)/
65                  {                  {
66                      $item[1] =~ s/^\$//;                          $item[1] =~ s/^\$//;
67                      $return = "\$data->{ $item[1] } = $item[4]; # hash\n";                          $return = "\$data->{ $item[1] } = $item[4]; # hash\n";
68                      $return = "\%{\$data->{ $item[1] }} =(" . join( ',', @{$item[4]} ) . ");\t# hash\n";                          $return = "\%{\$data->{ $item[1] }} =(" . join( ',', @{$item[4]} ) . ");\t# hash\n";
69                  }                  }
70    
71  array_assign:   variable /=/ /Array\s*\(/i element(s /,/) /\s*(,\s*)?\)/  array_assign:   variable /=/ /Array\s*\(/i element(s /,/) /\s*(,\s*)?\)/
72                  {                  {
73                      $item[1] =~ s/^\$//;                          $item[1] =~ s/^\$//;
74                      $return = "\@{\$data->{ $item[1] }}=(" . join( ',', @{$item[4]} ) . ");\t# array\n"                          $return = "\@{\$data->{ $item[1] }}=(" . join( ',', @{$item[4]} ) . ");\t# array\n"
75                  }                  }
76    
77  scalar:         string | number  scalar:         string | number | constant
78    
79    constant:   true | false
80    
81    true:           'true'
82                    {
83                            $return = '1';
84                    }
85    false:          'false'
86                    {
87                            $return = '0';
88                    }
89    
90  variable:       /\$[a-zA-Z_][0-9a-zA-Z_]*/  variable:       /\$[a-zA-Z_][0-9a-zA-Z_]*/
91    
# Line 69  number:                /-?[0-9.]+/ Line 94  number:                /-?[0-9.]+/
94  string:         double_quoted | single_quoted  string:         double_quoted | single_quoted
95    
96  double_quoted:  /".*?"/  double_quoted:  /".*?"/
97                    {
98                            $item[1] =~ s/\@/\\\@/g;
99                            $return = $item[1];
100                    }
101    
102  single_quoted:  /'.*?'/  single_quoted:  /'.*?'/
103    
# Line 76  element:       scalar | bareword Line 105  element:       scalar | bareword
105    
106  pair:           scalar /=>/ ( scalar | bareword )  pair:           scalar /=>/ ( scalar | bareword )
107                  {                  {
108                      $return = $item[1] . '=>' . $item[3];                          $return = $item[1] . '=>' . $item[3];
109                  }                  }
110    
111  bareword:       /[0-9a-zA-Z_]+/  bareword:       /[0-9a-zA-Z_]+/
112                                                
113  constant:       /define\s*\(/ string /,/ scalar /\)/  constant:       /define\s*\(/ string /,/ scalar /\)/
114                  {                  {
115                      $return =  "use constant $item[2] => $item[4];\n";                          $return =  "use constant $item[2] => $item[4];\n";
116                  }                  }
117    
118  comments:       /^#.*$/  comments:       /^#.*$/
# Line 101  GRAMMAR Line 130  GRAMMAR
130  sub parse {  sub parse {
131          my $self = shift;          my $self = shift;
132          my $php = shift or die "no php?";          my $php = shift or die "no php?";
133      $perl = '';          $perl = '';
134          $::RD_TRACE = 1 if $debug;          if ( $debug ) {
135                    $::RD_TRACE = 1;
136                    warn "PHP [$charset]: $php\n";
137            }
138          my $parser = Parse::RecDescent->new( $grammar );          my $parser = Parse::RecDescent->new( $grammar );
139      warn dump( $parser->php_vars( $php ) );          $parser->php_vars( decode($charset,$php) );
140      print STDERR "\n\nGENERATED PERL:\n\n", $perl, "\n\n" if $debug;          warn "## GENERATED PERL:\n\n", $perl, "\n\n" if $debug;
141          my $data;          my $data;
142          eval $perl;          eval $perl;
143          die "$@" if $@;          die "$@" if $@;
Legend:
Removed from v.133  
changed lines
  Added in v.140
  ViewVC Help
Powered by ViewVC 1.1.26