File Coverage

blib/lib/Parse/Java.pm

Criterion	Covered	Total	%
statement	194	235	82.5
branch	47	62	75.8
condition	22	30	73.3
subroutine	40	43	93.0
pod	3	4	75.0
total	306	374	81.8

package Parse::Java;

require 5.006;

use warnings;
use strict;

use Carp qw(croak);
use File::Spec;
use Parse::Yapp;

our $VERSION = "0.01_01";

BEGIN {
	# Load grammar when we use the module
	my $base_dir = __FILE__;
	$base_dir =~ s/Java\.pm$//;

	open my $grammar_io, "<", File::Spec->catfile($base_dir, 'Java.yp') || die $!;
	my $grammar_src = do { local $/; <$grammar_io>; };
	close $grammar_io;

	my $parser = Parse::Yapp->new(input => $grammar_src);
	my $parser_src = $parser->Output(
		classname => __PACKAGE__,
		standalone => 0,
		linenumbers => 0,
		template => undef,
	);

	if (!eval $parser_src) {
		# Ohooh.. grammar error.. need to debug
		my ($line) = $@ =~ /line (\d+)/;
		my $first = $line - 3 >= 0 ? $line - 3 : 0;
		my $last = $line + 3;
		my $line_no = 0;

		print STDERR "Got error: $@";
		my @src_lines = split/\n/, $parser_src;
		for my $src_line (@src_lines) {
			$src_line = ($line_no == $line ? '>>' : '  ') . $src_line;
			print STDERR $src_line, "\n", if ($line_no >= $first);
			last if $line_no > $last;
			$line_no++;
		}
	}

	if ($ENV{PARSE_JAVA_DEBUG}) {
		my $output = "Java.output";
		my $tmp;

		open(OUT, ">$output") || croak $!;

		$tmp = $parser->Warnings() || "";
		print OUT "Warnings:\n---------\n$tmp\n";
		$tmp = $parser->Conflicts() || "";
		print OUT "Conflicts:\n----------\n$tmp\n";
		print OUT "Rules:\n------\n";
		print OUT $parser->ShowRules()."\n";
		print OUT "States:\n-------\n";
		print OUT $parser->ShowDfa()."\n";
		print OUT "Summary:\n--------\n";
		print OUT $parser->Summary();

		close(OUT);
	}
}

sub parse_file {
	my ($pkg, $file) = @_;

	open my $io, "<", $file || croak $!;
	my $source = do { local $/;  <$io>; };
	close $io;

	return $pkg->parse_string($source);
}

# This routine flattens Parse::Java::Tokens
sub detokenize {
	my $ast = pop;

	if (ref $ast eq 'Parse::Java::Token') {
		return $ast->as_string;
	}

	if (ref $ast eq 'ARRAY') {
		$_ = detokenize($_) for @$ast;
	}
	elsif(ref $ast) {
		for (keys %$ast) {
			$ast->{$_} = detokenize($ast->{$_});
		}
	}

	return $ast;
}

sub parse_string {
	my ($pkg, $source) = @_;

	my $parser = Parse::Java->new();
	$parser->_set_input($source);
	my $ast = $parser->_run();

	return $ast;
}

1; # Magic true value required at end of module
__END__