recdescent.pm

来自「视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.」· PM 代码 · 共 2,532 行 · 第 1/5 页

		"line"       => $_[4],
	}, $class;
}

sub code($$$$)
{
	my ($self, $namespace, $rule) = @_;
	
	my $action = '';
	
	if ($self->{"msg"})  # ERROR MESSAGE SUPPLIED
	{
		#WAS: $action .= "Parse::RecDescent::_error(qq{$self->{msg}}" .  ',$thisline);'; 
		$action .= 'push @{$thisparser->{errors}}, [qq{'.$self->{msg}.'},$thisline];'; 

	}
	else	  # GENERATE ERROR MESSAGE DURING PARSE
	{
		$action .= '
		my $rule = $item[0];
		   $rule =~ s/_/ /g;
		#WAS: Parse::RecDescent::_error("Invalid $rule: " . $expectation->message() ,$thisline);
		push @{$thisparser->{errors}}, ["Invalid $rule: " . $expectation->message() ,$thisline];
		'; 
	}

	my $dir =
	      new Parse::RecDescent::Directive('if (' .
		($self->{"commitonly"} ? '$commit' : '1') . 
		") { do {$action} unless ".' $_noactions; undef } else {0}',
	        			$self->{"lookahead"},0,$self->describe); 
	$dir->{hashname} = $self->{hashname};
	return $dir->code($namespace, $rule, 0);
}

1;

package Parse::RecDescent::Token;

sub sethashname { $_[0]->{hashname} = '__PATTERN' . ++$_[1]->{patcount} . '__'; }

sub issubrule { undef }
sub isterminal { 1 }
sub describe ($) { shift->{'description'}}


# ARGS ARE: $self, $pattern, $left_delim, $modifiers, $lookahead, $linenum
sub new ($$$$$$)
{
	my $class = ref($_[0]) || $_[0];
	my $pattern = $_[1];
	my $pat = $_[1];
	my $ldel = $_[2];
	my $rdel = $ldel;
	$rdel =~ tr/{[(</}])>/;

	my $mod = $_[3];

	my $desc;

	if ($ldel eq '/') { $desc = "$ldel$pattern$rdel$mod" }
	else		  { $desc = "m$ldel$pattern$rdel$mod" }
	$desc =~ s/\\/\\\\/g;
	$desc =~ s/\$$/\\\$/g;
	$desc =~ s/}/\\}/g;
	$desc =~ s/{/\\{/g;

	if (!eval "no strict;
		   local \$SIG{__WARN__} = sub {0};
		   '' =~ m$ldel$pattern$rdel" and $@)
	{
		Parse::RecDescent::_warn(3, "Token pattern \"m$ldel$pattern$rdel\"
					     may not be a valid regular expression",
					   $_[5]);
		$@ =~ s/ at \(eval.*/./;
		Parse::RecDescent::_hint($@);
	}

	# QUIETLY PREVENT (WELL-INTENTIONED) CALAMITY
	$mod =~ s/[gc]//g;
	$pattern =~ s/(\A|[^\\])\\G/$1/g;

	bless 
	{
		"pattern"   => $pattern,
		"ldelim"      => $ldel,
		"rdelim"      => $rdel,
		"mod"         => $mod,
		"lookahead"   => $_[4],
		"line"        => $_[5],
		"description" => $desc,
	}, $class;
}


sub code($$$$)
{
	my ($self, $namespace, $rule, $check) = @_;
	my $ldel = $self->{"ldelim"};
	my $rdel = $self->{"rdelim"};
	my $sdel = $ldel;
	my $mod  = $self->{"mod"};

	$sdel =~ s/[[{(<]/{}/;
	
my $code = '
		Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
					  . ']}, Parse::RecDescent::_tracefirst($text),
					  q{' . $rule->{name} . '},
					  $tracelevel)
						if defined $::RD_TRACE;
		$lastsep = "";
		$expectation->is(q{' . ($rule->hasleftmost($self) ? ''
				: $self->describe ) . '})->at($text);
		' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '

		' . ($self->{"lookahead"}<0?'if':'unless')
		. ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
		. ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
		. '  $text =~ s' . $ldel . '\A(?:' . $self->{"pattern"} . ')'
				 . $rdel . $sdel . $mod . ')
		{
			'.($self->{"lookahead"} ? '$text = $_savetext;' : '').'
			$expectation->failed();
			Parse::RecDescent::_trace(q{<<Didn\'t match terminal>>},
						  Parse::RecDescent::_tracefirst($text))
					if defined $::RD_TRACE;

			last;
		}
		Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
						. $& . q{])},
						  Parse::RecDescent::_tracefirst($text))
					if defined $::RD_TRACE;
		push @item, $item{'.$self->{hashname}.'}=$&;
		' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
';

	return $code;
}

1;

package Parse::RecDescent::Literal;

sub sethashname { $_[0]->{hashname} = '__STRING' . ++$_[1]->{strcount} . '__'; }

sub issubrule { undef }
sub isterminal { 1 }
sub describe ($) { shift->{'description'} }

sub new ($$$$)
{
	my $class = ref($_[0]) || $_[0];

	my $pattern = $_[1];

	my $desc = $pattern;
	$desc=~s/\\/\\\\/g;
	$desc=~s/}/\\}/g;
	$desc=~s/{/\\{/g;

	bless 
	{
		"pattern"     => $pattern,
		"lookahead"   => $_[2],
		"line"        => $_[3],
		"description" => "'$desc'",
	}, $class;
}


sub code($$$$)
{
	my ($self, $namespace, $rule, $check) = @_;
	
my $code = '
		Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
					  . ']},
					  Parse::RecDescent::_tracefirst($text),
					  q{' . $rule->{name} . '},
					  $tracelevel)
						if defined $::RD_TRACE;
		$lastsep = "";
		$expectation->is(q{' . ($rule->hasleftmost($self) ? ''
				: $self->describe ) . '})->at($text);
		' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '

		' . ($self->{"lookahead"}<0?'if':'unless')
		. ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
		. ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
		. '  $text =~ s/\A' . quotemeta($self->{"pattern"}) . '//)
		{
			'.($self->{"lookahead"} ? '$text = $_savetext;' : '').'
			$expectation->failed();
			Parse::RecDescent::_trace(qq{<<Didn\'t match terminal>>},
						  Parse::RecDescent::_tracefirst($text))
							if defined $::RD_TRACE;
			last;
		}
		Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
						. $& . q{])},
						  Parse::RecDescent::_tracefirst($text))
							if defined $::RD_TRACE;
		push @item, $item{'.$self->{hashname}.'}=$&;
		' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
';

	return $code;
}

1;

package Parse::RecDescent::InterpLit;

sub sethashname { $_[0]->{hashname} = '__STRING' . ++$_[1]->{strcount} . '__'; }

sub issubrule { undef }
sub isterminal { 1 }
sub describe ($) { shift->{'description'} }

sub new ($$$$)
{
	my $class = ref($_[0]) || $_[0];

	my $pattern = $_[1];
	$pattern =~ s#/#\\/#g;

	my $desc = $pattern;
	$desc=~s/\\/\\\\/g;
	$desc=~s/}/\\}/g;
	$desc=~s/{/\\{/g;

	bless 
	{
		"pattern"   => $pattern,
		"lookahead" => $_[2],
		"line"      => $_[3],
		"description" => "'$desc'",
	}, $class;
}

sub code($$$$)
{
	my ($self, $namespace, $rule, $check) = @_;
	
my $code = '
		Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
					  . ']},
					  Parse::RecDescent::_tracefirst($text),
					  q{' . $rule->{name} . '},
					  $tracelevel)
						if defined $::RD_TRACE;
		$lastsep = "";
		$expectation->is(q{' . ($rule->hasleftmost($self) ? ''
				: $self->describe ) . '})->at($text);
		' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '

		' . ($self->{"lookahead"}<0?'if':'unless')
		. ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
		. ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
		. '  do { $_tok = "' . $self->{"pattern"} . '"; 1 } and
		     substr($text,0,length($_tok)) eq $_tok and
		     do { substr($text,0,length($_tok)) = ""; 1; }
		)
		{
			'.($self->{"lookahead"} ? '$text = $_savetext;' : '').'
			$expectation->failed();
			Parse::RecDescent::_trace(q{<<Didn\'t match terminal>>},
						  Parse::RecDescent::_tracefirst($text))
							if defined $::RD_TRACE;
			last;
		}
		Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
						. $_tok . q{])},
						  Parse::RecDescent::_tracefirst($text))
							if defined $::RD_TRACE;
		push @item, $item{'.$self->{hashname}.'}=$_tok;
		' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
';

	return $code;
}

1;

package Parse::RecDescent::Subrule;

sub issubrule ($) { return $_[0]->{"subrule"} }
sub isterminal { 0 }
sub sethashname {}

sub describe ($)
{
	my $desc = $_[0]->{"implicit"} || $_[0]->{"subrule"};
	$desc = "<matchrule:$desc>" if $_[0]->{"matchrule"};
	return $desc;
}

sub callsyntax($$)
{
	if ($_[0]->{"matchrule"})
	{
		return "&{'$_[1]'.qq{$_[0]->{subrule}}}";
	}
	else
	{
		return $_[1].$_[0]->{"subrule"};
	}
}

sub new ($$$$;$$$)
{
	my $class = ref($_[0]) || $_[0];
	bless 
	{
		"subrule"   => $_[1],
		"lookahead" => $_[2],
		"line"      => $_[3],
		"implicit"  => $_[4] || undef,
		"matchrule" => $_[5],
		"argcode"   => $_[6] || undef,
	}, $class;
}


sub code($$$$)
{
	my ($self, $namespace, $rule) = @_;
	
'
		Parse::RecDescent::_trace(q{Trying subrule: [' . $self->{"subrule"} . ']},
				  Parse::RecDescent::_tracefirst($text),
				  q{' . $rule->{"name"} . '},
				  $tracelevel)
					if defined $::RD_TRACE;
		if (1) { no strict qw{refs};
		$expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
				# WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
				: 'q{'.$self->describe.'}' ) . ')->at($text);
		' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' )
		. ($self->{"lookahead"}<0?'if':'unless')
		. ' (defined ($_tok = '
		. $self->callsyntax($namespace.'::')
		. '($thisparser,$text,$repeating,'
		. ($self->{"lookahead"}?'1':'$_noactions')
		. ($self->{argcode} ? ",sub { return $self->{argcode} }"
				   : ',sub { \\@arg }')
		. ')))
		{
			'.($self->{"lookahead"} ? '$text = $_savetext;' : '').'
			Parse::RecDescent::_trace(q{<<Didn\'t match subrule: ['
			. $self->{subrule} . ']>>},
						  Parse::RecDescent::_tracefirst($text),
						  q{' . $rule->{"name"} .'},
						  $tracelevel)
							if defined $::RD_TRACE;
			$expectation->failed();
			last;
		}
		Parse::RecDescent::_trace(q{>>Matched subrule: ['
					. $self->{subrule} . ']<< (return value: [}
					. $_tok . q{]},
					  
					  Parse::RecDescent::_tracefirst($text),
					  q{' . $rule->{"name"} .'},
					  $tracelevel)
						if defined $::RD_TRACE;
		$item{q{' . $self->{subrule} . '}} = $_tok;
		push @item, $_tok;
		' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
		}
'
}

package Parse::RecDescent::Repetition;

sub issubrule ($) { return $_[0]->{"subrule"} }
sub isterminal { 0 }
sub sethashname {  }

sub describe ($)
{
	my $desc = $_[0]->{"expected"} || $_[0]->{"subrule"};
	$desc = "<matchrule:$desc>" if $_[0]->{"matchrule"};
	return $desc;
}

sub callsyntax($$)
{
	if ($_[0]->{matchrule})
		{ return "sub { goto &{''.qq{$_[1]$_[0]->{subrule}}} }"; }
	else
		{ return "\\&$_[1]$_[0]->{subrule}"; }
}

sub new ($$$$$$$$$$)
{
	my ($self, $subrule, $repspec, $min, $max, $lookahead, $line, $parser, $matchrule, $argcode) = @_;
	my $class = ref($self) || $self;
	($max, $min) = ( $min, $max) if ($max<$min);

	my $desc;
	if ($subrule=~/\A_alternation_\d+_of_production_\d+_of_rule/)
		{ $desc = $parser->{"rules"}{$subrule}->expected }

	if ($lookahead)
	{
		if ($min>0)
		{
		   return new Parse::RecDescent::Subrule($subrule,$lookahead,$line,$desc,$matchrule,$argcode);
		}
		else
		{
			Parse::RecDescent::_error("Not symbol (\"!\") before
				            \"$subrule\" doesn't make
					    sense.",$line);
			Parse::RecDescent::_hint("Lookahead for negated optional
					   repetitions (such as
					   \"!$subrule($repspec)\" can never
					   succeed, since optional items always
					   match (zero times at worst). 
					   Did you mean a single \"!$subrule\", 
					   instead?");
		}
	}
	bless 
	{
		"subrule"   => $subrule,
		"repspec"   => $repspec,
		"min"       => $min,
		"max"       => $max,
		"lookahead" => $lookahead,
		"line"      => $line,
		"expected"  => $desc,
		"argcode"   => $argcode || undef,
		"matchrule" => $matchrule,
	}, $class;
}

sub code($$$$)
{
	my ($self, $namespace, $rule) = @_;
	
	my ($subrule, $repspec, $min, $max, $lookahead) =
		@{$self}{ qw{subrule repspec min max lookahead} };

'
		Parse::RecDescent::_trace(q{Trying repeated subrule: [' . $self->describe . ']},
				  Parse::RecDescent::_tracefirst($text),
				  q{' . $rule->{"name"} . '},
				  $tracelevel)
					if defined $::RD_TRACE;
		$expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
				# WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
				: 'q{'.$self->describe.'}' ) . ')->at($text);
		' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'
		unless (defined ($_tok = $thisparser->_parserepeat($text, '
		. $self->callsyntax($namespace.'::')
		. ', ' . $min . ', ' . $max . ', '
		. ($self->{"lookahead"}?'1':'$_noactions')
		. ',$expectation,'
		. ($self->{argcode} ? "sub { return $self->{argcode} }"
				   : 'undef')
		. '))) 
		{
			Parse::RecDescent::_trace(q{<<Didn\'t match repeated subrule: ['
			. $self->describe . ']>>},
						  Parse::RecDescent::_tracefirst($text),
						  q{' . $rule->{"name"} .'},
						  $tracelevel)
							if defined $::RD_TRACE;
			last;
		}
		Parse::RecDescent::_trace(q{>>Matched repeated subrule: ['
					. $self->{subrule} . ']<< (}
					. @$_tok . q{ times)},
					  
					  Parse::RecDescent::_tracefirst($text),
					  q{' . $rule->{"name"} .'},
					  $tracelevel)
						if defined $::RD_TRACE;
		$item{q{' . "$self->{subrule}($self->{repspec})" . '}} = $_tok;
		push @item, $_tok;
		' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'

'
}

package Parse::RecDescent::Result;

sub issubrule { 0 }
sub isterminal { 0 }
sub describe { '' }

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

	bless {}, $class;
}

sub code($$$$)
{
	my ($self, $namespace, $rule) = @_;
	
	'