Mercurial > pub > Impl
view Lib/IMPL/Text/Parser/Player.pm @ 94:79bf75223afe
Fixed security related bugs
author | wizard |
---|---|
date | Thu, 29 Apr 2010 01:31:27 +0400 |
parents | 16ada169ca75 |
children | 4267a2ac3d46 |
line wrap: on
line source
package IMPL::Text::Parser::Player; use strict; use warnings; use base qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Class::Property::Direct; use IMPL::Text::Parser::Chunk; my %opCodesMap = ( IMPL::Text::Parser::Chunk::OP_REGEXP , &MatchRegexp , IMPL::Text::Parser::Chunk::OP_STRING , &MatchString , IMPL::Text::Parser::Chunk::OP_REFERENCE , &MatchReference , IMPL::Text::Parser::Chunk::OP_CHUNK , &PlayChunk , IMPL::Text::Parser::Chunk::OP_SWITCH , &MatchSwitch , IMPL::Text::Parser::Chunk::OP_REPEAT , &MatchRepeat ); BEGIN { private _direct property _data => prop_all; private _direct property _current => prop_all; private _direct property _states => prop_all; private _direct property _document => prop_all; public _direct property errorLast => prop_all; public _direct property Punctuation => prop_all; public _direct property Delimier => prop_all; } sub CTOR { my ($this,$document) = @_; $this->{$_document} = $document or die new IMPL::InvalidArgumentException("The first parameter must be a document"); } sub LoadString { my ($this,$string) = @_; my $rxDelim = /(\s+|[.,;!-+*~$^&|%()`@\\\/])/; my $line = 0; $this->{$_data} = [ map { $line++; map { [$line,$_] } split $rxDelim, $_ } split /\n/, $string ] } sub Play { my ($this) = @_; } sub PlayChunk { my ($this,$chunk) = @_; my $end = 0; my $name = $chunk->chunkName; $this->enter($name) if $name; foreach my $op ( @{$chunk->opStream} ) { $this->leave(0) and return $this->error("no more data") if $end; $opCodesMap{shift @$op}->(@$op) || return $this->leave(0) ; $this->moveNext or $end = 1; } return $this->leave(1); } sub MatchRegexp { my ($this,$rx) = @_; $this->{$_current}{token} =~ $rx ? ($this->data() and return 1) : return $this->error("Expected: $rx"); } sub MatchString { my ($this,$string) = @_; $this->{$_current}{token} eq $string ? ($this->data() and return 1) : return $this->error("Expected: $string"); } sub MatchReference { my ($this,$name) = @_; my $chunk = $this->ResolveChunk($name) || return $this->error("Invalid reference: $name"); return $this->PlayChunk($chunk); } sub MatchSwitch { my ($this,@chunks) = @_; foreach my $chunk (@chunks) { $this->save; if ( $this->PlayChunk($chunk) ) { $this->apply; return 1; } else { $this->restore; } } return 0; # passthrough last error } sub MatchRepeat { my ($this,$chunk, $min, $max) = @_; my $count = 0; $this->save; while (1) { $this->save; if ($this->PlayChunk($chunk)) { $count ++; $this->apply; $this->apply and return 1 if ($count >= $max) } else { $this->restore; $count >= $min ? ($this->apply() and return 1) : ($this->restore() and return $this->error("Expected at least $min occurances, got only $count")); } } # we should never get here die new IMPL::InvalidOperationException("unexpected error"); } sub moveNext { my ($this) = @_; my $pos = $this->{$_current}{pos}; $pos ++; if ($pos < @{$this->{$_data}}) { $this->{$_current} = { pos => $pos, token => $this->{$_data}[$pos][1], line => $this->{$_data} }; } else { $this->{$_current} = {}; return undef; } } sub ResolveChunk { my ($this,$name) = @_; } sub save { my ($this) = @_; push @{$this->{$_states}}, $this->{$_current}; } sub restore { my ($this) = @_; $this->{$_current} = pop @{$this->{$_states}}; } sub apply { my ($this) = @_; pop @{$this->{$_states}}; } sub error { my ($this,$message) = @_; $this->{$errorLast} = { message => $message, line => $this->{$_current}{line}, token => $this->{$_current}{token} }; return 0; } sub __debug { } sub enter { my ($this,$name) = @_; #always return true; return 1; } sub leave { my ($this,$isEmpty) = @_; #always return true; return 1; } sub data { my ($this) = @_; my $data = $this->{$_current}{token}; # always return true; return 1; } 1;