view release on metacpan or  search on metacpan

lib/PHP/Decode/Parser.pm  view on Meta::CPAN

#
# parse PHP source files
#
package PHP::Decode::Parser;
use base 'PHP::Decode::Tokenizer';

use strict;
use warnings;
use Carp 'croak';
use Config;
use PHP::Decode::Array qw(is_int_index);
use Exporter qw(import);
our @EXPORT_OK = qw(is_variable is_symbol is_null is_const is_numval is_strval is_array is_block global_var global_split inst_var inst_split method_name method_split ns_name ns_split);
our %EXPORT_TAGS = (all => \@EXPORT_OK);

our $VERSION = '0.127';

# avoid 'Deep recursion' warnings for depth > 100
#
no warnings 'recursion';

my $stridx = 1;
my $numidx = 1;
my $constidx = 1;
my $funidx = 1;
my $callidx = 1;
my $elemidx = 1;
my $expridx = 1;
my $stmtidx = 1;
my $blkidx = 1;
my $pfxidx = 1;
my $objidx = 1;   # obj->
my $scopeidx = 1; # class::
my $refidx = 1;   # & $var
my $classidx = 1; # class name {}
my $instidx = 1;  # class instance
my $traitidx = 1; # trait name {}
my $nsidx = 1;    # namespace\
my $fhidx = 1;

# Initialize new parser using PHP::Decode::Tokenizer
# {inscript}   - set to indicate already inside of script
# {warn}       - warning message handler
# {log}        - log message handler
# {debug}      - debug message handler
# {filename}   - optional filename (if not stdin or textstr)
# {max_strlen} - max strlen for debug strings
#
sub new {
	my ($class, %args) = @_;
	my $strmap = $args{strmap} or croak __PACKAGE__ . " expects strmap";

	my $self = $class->SUPER::new(%args);
	$self->{max_strlen} = 0 unless exists $self->{max_strlen};
	$self->{tok} = []; # init token list

	# filename is required to decode __FILE__
	$self->{filename} = '__FILE__' unless exists $self->{filename};

	$strmap->{'__LINE__'} = 1 unless exists $strmap->{'__LINE__'};
	$strmap->{'#null'} = '' unless exists $strmap->{'#null'};
	return $self;
}

# A sub parser is always inscript (the parent might have inscript=0)
#
sub subparser {
	my ($self, %args) = @_;
	my $parser = PHP::Decode::Parser->new(strmap => $self->{strmap}, inscript => 1, filename => $self->{filename}, max_strlen => $self->{max_strlen}, warn => $self->{warn});
	$parser->{log} = $self->{log} if exists $self->{log};
	$parser->{debug} = $self->{debug} if exists $self->{debug};

	foreach my $k (keys %args) {

lib/PHP/Decode/Parser.pm  view on Meta::CPAN

# check if statement is empty block
#
sub is_empty_block {
	my ($self, $s) = @_;

	if (is_block($s)) {
		my ($type, $a) = @{$self->{strmap}->{$s}};
		if (scalar @$a == 0) {
			return 1;
		}
	}
	return 0;
}

# flatten block (and remove #null statements)
#
sub flatten_block {
	my ($self, $s, $out) = @_;

	if (is_block($s)) {
		my ($type, $a) = @{$self->{strmap}{$s}};
		foreach my $stmt (@$a) {
			$self->flatten_block($stmt, $out);
		}
	} else {
		if ($s ne '#null') {
			push(@$out, $s); 
		}
	}
	return;
}

# flatten block with single statement
#
sub flatten_block_if_single {
	my ($self, $s) = @_;

	if (is_block($s)) {
		my ($type, $a) = @{$self->{strmap}{$s}};
		if (scalar @$a == 1) {
			return $a->[0];
		}
	}
	return $s;
}

# create and split global var
#
sub global_var {
	my ($global) = @_;
	return '$GLOBALS' . $global;
}

sub global_split {
	my ($var) = @_;
	my ($global) = $var =~ /^\$GLOBALS(\$.*)$/;
	return $global;
}

# create and split method name
#
sub method_name {
	my ($class, $name) = @_;
	return $class . '::' . $name;
}

sub method_split {
	my ($method) = @_;
	# allow namespace prefix
	my ($class, $name) = $method =~ /^(#inst\d+|[\w\x80-\xff\\]+)::([\w\x80-\xff]+)$/;
	return ($class, $name);
}

# create and split instance var
#
sub inst_var {
	my ($inst, $var) = @_;
	return '$' . $inst . $var;
}

sub inst_split {
	my ($instvar) = @_;
	my ($inst, $var) = $instvar =~ /^\$(#inst\d+|[\w\x80-\xff]+)(\$.*)$/;
	return ($inst, $var);
}

# create and split namespace name
#
sub ns_name {
	my ($name, $elem) = @_;
	return $name . '\\' . $elem;
}

sub ns_split {
	my ($name) = @_;
	my ($ns, $elem) = $name =~ /^([^\\]*)\\(.+)$/;
	return ($ns, $elem);
}

# create path from namespace
#
sub ns_to_str {
	my ($self, $var) = @_;

	if ($var =~ /^#ns\d+$/) {
		my ($n, $e) = @{$self->{strmap}{$var}};

		unless (defined $n) {
			$n = ''; # toplevel
		}
		$e = $self->ns_to_str($e);
		if (defined $e) {
			return ns_name($n, $e);
		}
	} elsif (is_strval($var)) {
		return $self->{strmap}{$var};
	} else {
		return $var;
	}
	return;