#!/usr/bin/perl
use lib './perl';
use strict;
use File::Spec;
use File::Basename;
use Cwd 'abs_path';
use JSON qw(from_json to_json);
use LWP;
use HTTP::Request::Common qw(POST GET);
use Data::Dumper;
my $scxmlBin = abs_path(shift);
die ("First argument needs to be path to uscxml-browser binary") if (!$scxmlBin);
die("'" . $scxmlBin . "' is not an executable file") if (! -x $scxmlBin);
my $baseDir = File::Spec->canonpath(dirname($0));
chdir $baseDir;
my $ua = LWP::UserAgent->new;
my $request;
my $response;
my $data;
my @breakpointSeq;
my $pid = fork;
if (!$pid) {
# exec("$scxmlBin -t4088 -d");
exit;
}
# my $baseURL = 'http://localhost:4088/debug';
my $baseURL = 'http://localhost:5080/debug';
sub assertSuccess {
my $response = shift;
my $message = shift;
from_json($response->content())->{'status'} eq "success" or die($message);
}
sub popAndCompare {
my $qualified = shift;
my $bp = shift(@breakpointSeq);
for my $key (keys %{$bp}) {
if (! exists($qualified->{$key}) || $qualified->{$key} ne $bp->{$key}) {
print Dumper($qualified);
print Dumper($bp);
die("Expected different breakpoint");
}
}
print "SUCCESS\n";
}
sub testSimpleStepping {
my $xml = << 'END_SCXML';
END_SCXML
@breakpointSeq = (
{ subject => "microstep", when => "before" },
{ subject => "state", when => "before", action => "enter" },
{ subject => "state", when => "after", action => "enter" },
{ subject => "state", when => "before", action => "enter", stateId => "s1" },
{ subject => "executable", when => "before", execName => "log" },
{ subject => "executable", when => "after", execName => "log" },
{ subject => "state", when => "after", action => "enter", stateId => "s1" },
{ subject => "microstep", when => "after" },
{ subject => "microstep", when => "before" },
{ subject => "state", when => "before", action => "exit", stateId => "s1" },
{ subject => "state", when => "after", action => "exit", stateId => "s1" },
{ subject => "transition", when => "before", source => "s1", target => "s2"},
{ subject => "transition", when => "after", source => "s1", target => "s2"},
{ subject => "state", when => "before", action => "enter", stateId => "s2" },
{ subject => "state", when => "after", action => "enter", stateId => "s2" },
{ subject => "microstep", when => "after" },
{ subject => "microstep", when => "before" },
{ subject => "state", when => "before", action => "exit", stateId => "s2" },
{ subject => "state", when => "after", action => "exit", stateId => "s2" },
{ subject => "transition", when => "before", source => "s2", target => "pass"},
{ subject => "transition", when => "after", source => "s2", target => "pass"},
{ subject => "state", when => "before", action => "enter", stateId => "pass" },
{ subject => "state", when => "after", action => "enter", stateId => "pass" },
{ subject => "microstep", when => "after" },
);
### Get a session
$request = GET $baseURL.'/connect';
$response = $ua->request($request);
assertSuccess($response, "Could not connect");
my $session = from_json($response->content())->{'session'};
die("Cannot acquire session from server") if (!$session);
### Prepare an SCXML interpreter
$request = POST $baseURL.'/prepare',
[
'session' => $session,
'url' => 'http://localhost/test152.scxml',
'xml' => $xml
];
$response = $ua->request($request);
assertSuccess($response, "Could not prepare SCXML");
while(@breakpointSeq > 0) {
### Take a step
$request = POST $baseURL.'/step', ['session' => $session];
$response = $ua->request($request);
assertSuccess($response, "Could not step");
# this will cause the interpreter to pause execution
### Get the pending messages
$request = POST $baseURL.'/poll', ['session' => $session];
$response = $ua->request($request);
assertSuccess($response, "Could not get breakpoint after step");
# compare to what we expect
$data = from_json($response->content());
popAndCompare($data->{'qualified'});
}
### last step will finalize the interpreter
$request = POST $baseURL.'/step', ['session' => $session];
$response = $ua->request($request);
assertSuccess($response, "Could not get breakpoint after step");
### get the pending server push reply
$request = POST $baseURL.'/poll', ['session' => $session];
$response = $ua->request($request);
assertSuccess($response, "Could not get breakpoint after step");
$data = from_json($response->content());
die("Machine not yet finished") if ($data->{'replyType'} ne "finished");
}
sub testBreakpoint {
my $xml = << 'END_SCXML';
END_SCXML
### Get a session
$request = GET $baseURL.'/connect';
$response = $ua->request($request);
assertSuccess($response, "Could not connect");
my $session = from_json($response->content())->{'session'};
die("Cannot acquire session from server") if (!$session);
### Prepare an SCXML interpreter
$request = POST $baseURL.'/prepare',
[
'session' => $session,
'url' => 'http://localhost/test154.scxml',
'xml' => $xml
];
$response = $ua->request($request);
assertSuccess($response, "Could not prepare SCXML");
### Skip to breakpoint
$request = POST $baseURL.'/breakpoint/skipto',
[
'session' => $session,
'when' => 'after',
'action' => 'enter',
'subject' => 'state',
'stateId' => 's1'
];
$response = $ua->request($request);
assertSuccess($response, "Could not add breakpoint");
### get the pending server push reply
$request = POST $baseURL.'/poll', ['session' => $session];
$response = $ua->request($request);
assertSuccess($response, "Could not get breakpoint after step");
$data = from_json($response->content());
print Dumper($data);
}
# &testSimpleStepping();
&testBreakpoint();
kill('TERM', $pid);