unit Unit2;
interface
uses
System.SysUtils,
stateless;
type
TRow =
record
public
Level : Integer;
Reference:
string;
Tag :
string;
Value :
string;
RefValue :
string;
public
class function Parse(
const AStr:
string ): TRow;
static;
function ToString( ):
string;
end;
implementation
uses
System.StrUtils;
class function TRow.Parse(
const AStr:
string ): TRow;
type
{$SCOPEDENUMS ON}
TParserState = ( Level, ReferenceOrTag, Reference, TagStart, Tag, ValueOrRefValue, Value, RefValue, Finished, Error );
TParseerTrigger = ( ParseChar, ParseFinish );
{$SCOPEDENUMS OFF}
TRowParserSM = TStateMachine<TParserState, TParseerTrigger>;
var
sm : TRowParserSM;
pc : TRowParserSM.TTriggerWithParameters<Char>;
buffer :
string;
c : Char;
res : TRow;
errorTransition: TRowParserSM.TTransition;
begin
buffer := '
';
sm := TRowParserSM.Create( TParserState.Level );
try
pc := sm.SetTriggerParameters<Char>( TParseerTrigger.ParseChar );
{$REGION 'Configuration'}
{ Level }
sm.Configure( TParserState.Level )
{} .OnEntryFrom<Char>( pc,
procedure(
const c: Char;
const t: TRowParserSM.TTransition )
begin
if t.IsReentry
then
buffer := buffer + c;
end )
{} .OnExit(
procedure(
const t: TRowParserSM.TTransition )
begin
if not t.IsReentry
then
begin
res.Level := StrToInt( buffer );
buffer := '
';
end;
end )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Error )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
0' .. '
9':
Result := TParserState.Level;
'
':
begin
if buffer.IsEmpty
then
Result := TParserState.Error
else
begin
Result := TParserState.ReferenceOrTag;
end;
end;
else
Result := TParserState.Error;
end;
end );
{ ReferenceOrTag }
sm.Configure( TParserState.ReferenceOrTag )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Error )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
@':
Result := TParserState.Reference;
'
':
Result := TParserState.ReferenceOrTag;
'
A' .. '
Z':
Result := TParserState.Tag;
else
Result := TParserState.Error;
end;
end );
{ Reference }
sm.Configure( TParserState.Reference )
{} .OnEntryFrom<Char>( pc,
procedure(
const c: Char;
const t: TRowParserSM.TTransition )
begin
if t.IsReentry
then
buffer := buffer + c;
end )
{} .OnExit(
procedure(
const t: TRowParserSM.TTransition )
begin
if not t.IsReentry
then
begin
res.Reference := buffer;
buffer := '
';
end;
end )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Error )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
@':
if buffer.IsEmpty
then
Result := TParserState.Error
else
Result := TParserState.TagStart;
else
Result := TParserState.Reference;
end;
end );
{ TagStart }
sm.Configure( TParserState.TagStart )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Error )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
':
Result := TParserState.TagStart;
'
A' .. '
Z':
Result := TParserState.Tag;
else
Result := TParserState.Error;
end;
end );
{ Tag }
sm.Configure( TParserState.Tag )
{} .OnEntryFrom<Char>( pc,
procedure(
const c: Char )
begin
buffer := buffer + c;
end )
{} .OnExit(
procedure(
const t: TRowParserSM.TTransition )
begin
if not t.IsReentry
then
begin
res.Tag := buffer;
buffer := '
';
end;
end )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Finished )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
A' .. '
Z':
if buffer.Length >= 4
then
Result := TParserState.Error
else
Result := TParserState.Tag;
'
':
Result := TParserState.ValueOrRefValue;
else
Result := TParserState.Error;
end;
end );
{ ValueOrRefValue }
sm.Configure( TParserState.ValueOrRefValue )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Finished )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
@':
Result := TParserState.RefValue;
'
':
Result := TParserState.ValueOrRefValue;
else
Result := TParserState.Value;
end;
end );
{ Value }
sm.Configure( TParserState.Value )
{} .OnEntryFrom<Char>( pc,
procedure(
const c: Char;
const t: TRowParserSM.TTransition )
begin
buffer := buffer + c;
end )
{} .OnExit(
procedure(
const t: TRowParserSM.TTransition )
begin
if not t.IsReentry
then
begin
res.Value := buffer;
buffer := '
';
end;
end )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Finished )
{} .PermitReentry( TParseerTrigger.ParseChar );
{ RefValue }
sm.Configure( TParserState.RefValue )
{} .OnEntryFrom<Char>( pc,
procedure(
const c: Char;
const t: TRowParserSM.TTransition )
begin
if t.IsReentry
then
buffer := buffer + c;
end )
{} .OnExit(
procedure(
const t: TRowParserSM.TTransition )
begin
if not t.IsReentry
then
begin
res.RefValue := buffer;
buffer := '
';
end;
end )
{} .Permit( TParseerTrigger.ParseFinish, TParserState.Error )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
@':
if buffer.IsEmpty
then
Result := TParserState.Error
else
Result := TParserState.Finished;
else
Result := TParserState.RefValue;
end;
end );
{ Finished }
sm.Configure( TParserState.Finished )
{} .PermitReentry( TParseerTrigger.ParseFinish )
{} .PermitDynamic<Char>( pc,
function(
const c: Char ): TParserState
begin
case c
of
'
':
Result := TParserState.Finished;
else
Result := TParserState.Error;
end;
end );
{ Error }
sm.Configure( TParserState.Error )
{} .OnEntry(
procedure(
const t: TRowParserSM.TTransition )
begin
errorTransition := t;
end );
{$ENDREGION}
{ Parse the string }
for c
in AStr
do
begin
if not sm.CanFire( TParseerTrigger.ParseChar )
then
break;
sm.Fire<Char>( pc, c );
end;
{ Fire Finish Trigger }
if sm.CanFire( TParseerTrigger.ParseFinish )
then
sm.Fire( TParseerTrigger.ParseFinish );
{ Check the final state }
if sm.State <> TParserState.Finished
then
raise Exception.Create( errorTransition.ToString );
Result := res;
finally
sm.Free;
end;
end;
function TRow.ToString:
string;
begin
Result := Level.ToString( )
{} + IfThen( Reference.IsEmpty, '
', '
@' + Reference + '
@' )
{} + '
' + Tag.ToUpperInvariant( )
{} + IfThen( Value.IsEmpty, '
', '
' + Value )
{} + IfThen( RefValue.IsEmpty, '
', '
@' + RefValue + '
@' );
end;
end.