File Coverage

lib/PHP/Decode.pm

Criterion	Covered	Total	%
statement	31	44	70.4
branch	17	34	50.0
condition			n/a
subroutine	8	11	72.7
pod	5	5	100.0
total	61	94	64.8

#
# parse and transform PHP source files
#
package PHP::Decode;

use strict;
use warnings;
use PHP::Decode::Parser;
use PHP::Decode::Transformer;

our $VERSION = '0.302';

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

	my $parser = PHP::Decode::Parser->new(strmap => {},
		exists $args{inscript} ? (inscript => $args{inscript}) : (),
		exists $args{filename} ? (filename => $args{filename}) : (),
		exists $args{max_strlen} ? (max_strlen => $args{max_strlen}) : (),
		exists $args{log} ? (log => $args{log}) : (),
		exists $args{debug} ? (debug => $args{debug}) : (),
		exists $args{warn} ? (warn => $args{warn}) : ());

	my $ctx = PHP::Decode::Transformer->new(parser => $parser,
		exists $args{skip} ? (skip => $args{skip}) : (),
		exists $args{with} ? (with => $args{with}) : (),
		exists $args{max_loop} ? (max_loop => $args{max_loop}) : (),
		exists $args{log} ? (log => \&_log_cb) : (),
		exists $args{warn} ? (warn => \&_warn_cb) : ());

	return bless {
		ctx => $ctx,
	}, $class;
}

sub _log_cb {
	my ($ctx, $action, $stmt, $fmt) = (shift, shift, shift, shift);

	my $parser = $ctx->{parser};
	my $flg = $ctx->{skipundef} ? '! ' : '';
	if ($ctx->{incall}) {
		$parser->{log}->($flg . "[$ctx->{infunction}] $action $stmt", $fmt, @_);
	} elsif ($ctx->{infunction}) {
		$parser->{log}->("<$ctx->{infunction}> $action $stmt", $fmt, @_);
	} else {
		$parser->{log}->($flg . "$action $stmt", $fmt, @_);
	}
}

sub _warn_cb {
	my ($ctx, $action, $stmt, $fmt) = (shift, shift, shift, shift);

	my $parser = $ctx->{parser};
	my $flg = $ctx->{skipundef} ? '! ' : '';
	if ($ctx->{incall}) {
		$parser->{warn}->($flg . "[$ctx->{infunction}] $action $stmt", $fmt, @_);
	} elsif ($ctx->{infunction}) {
		$parser->{warn}->("<$ctx->{infunction}> $action $stmt", $fmt, @_);
	} else {
		$parser->{warn}->($flg . "$action $stmt", $fmt, @_);
	}
}

sub parse {
	my ($self, $line) = @_;
	my $parser = $self->{ctx}{parser};
	my $str = $parser->setstr($line);

	return $self->{ctx}->parse_eval($str);
}

sub exec {
	my ($self, $stmt) = @_;

	return $self->{ctx}->exec_eval($stmt);
}

sub eval {
	my ($self, $line) = @_;
	my $parser = $self->{ctx}{parser};
	my $str = $parser->setstr($line);

	my $stmt = $self->{ctx}->parse_eval($str);
	return $self->{ctx}->exec_eval($stmt);
}

sub format {
	my ($self, $stmt, $fmt) = @_;
	my $parser = $self->{ctx}{parser};

	return $parser->format_stmt($stmt, $fmt);
}

1;

__END__