diff options
author | Stefan Radomski <radomski@tk.informatik.tu-darmstadt.de> | 2015-01-19 16:41:18 (GMT) |
---|---|---|
committer | Stefan Radomski <radomski@tk.informatik.tu-darmstadt.de> | 2015-01-19 16:41:18 (GMT) |
commit | ff86d690dc02d7dd495000331d378e7d8eb688ac (patch) | |
tree | 5214786f7e575952d3cba0919e5071f3a783050b /contrib/local | |
parent | 42437db418574f2a80d098e568b9498a21343800 (diff) | |
download | uscxml-ff86d690dc02d7dd495000331d378e7d8eb688ac.zip uscxml-ff86d690dc02d7dd495000331d378e7d8eb688ac.tar.gz uscxml-ff86d690dc02d7dd495000331d378e7d8eb688ac.tar.bz2 |
Plenty of smaller fixes and adaptations
Diffstat (limited to 'contrib/local')
-rwxr-xr-x | contrib/local/annotate-xml-lineno.pl | 43 | ||||
-rwxr-xr-x | contrib/local/create-random-scxml.pl | 214 |
2 files changed, 257 insertions, 0 deletions
diff --git a/contrib/local/annotate-xml-lineno.pl b/contrib/local/annotate-xml-lineno.pl new file mode 100755 index 0000000..f7e1a79 --- /dev/null +++ b/contrib/local/annotate-xml-lineno.pl @@ -0,0 +1,43 @@ +#!/usr/bin/perl -w + +use strict; +use File::Spec; +use File::Basename; +use XML::LibXML; +use Data::Dumper; + +my $xmlIn = shift or die("Expected *.xml file as input"); + +# absolutize and split into components +$xmlIn = File::Spec->rel2abs($xmlIn) or die($!); +my($filename, $dirs, $suffix) = fileparse($xmlIn) or die($!); + +my $parser = XML::LibXML->new({'line_numbers' => 1 }); +# my $xml = $parser->parse_file($xmlIn); +my $doc = $parser->load_xml('location' => $xmlIn, 'line_numbers' => 1) ; + +my $lineOffset = 0; + +sub lineNoNodes { + my $node = shift; + + if ($node->nodeType == XML_ELEMENT_NODE) { + $node->setAttribute("line_start", $node->line_number() + $lineOffset); + } + + my $prevElem; + for my $child ($node->childNodes()) { + lineNoNodes($child); + if ($prevElem) { + $prevElem->setAttribute("line_end", $child->line_number() - 1 + $lineOffset); + undef($prevElem); + } + if ($child->nodeType == XML_ELEMENT_NODE) { + $prevElem = $child; + } + } +} + +&lineNoNodes($doc->getDocumentElement()); + +print $doc->toString();
\ No newline at end of file diff --git a/contrib/local/create-random-scxml.pl b/contrib/local/create-random-scxml.pl new file mode 100755 index 0000000..7c6a3b8 --- /dev/null +++ b/contrib/local/create-random-scxml.pl @@ -0,0 +1,214 @@ +#!/usr/bin/perl -w + +use strict; +use List::Util qw[min max sum]; + +use Getopt::Long qw(GetOptions); +use Data::Dumper; + +my %options = (); + +GetOptions( + \%options, + "depth-max=i", + "child-max=i", + "events-max=i", + "states-max=i", + "trans-max=i", + "random-seed=i" +); + +my $seed = $options{'random-seed'} || int(rand(2**31)); +my $maxDepth = $options{'depth-max'} || 6; +my $maxChilds = $options{'child-max'} || 6; +my $maxStates = $options{'states-max'} || 60; +my $maxTrans = $options{'trans-max'} || 6; +my $maxEvents = $options{'trans-max'} || int($maxStates / 3) + 1; + +srand($seed); + +my $machine; +my $stateId = 0; + +my $probs = { + 'state' => { + 'type' => { + 'history' => 1, + 'parallel' => 2, + 'state' => 6, + 'final' => 1 + } + }, + 'transition' => { + 'target' => 0.8, + 'event' => 0.7, + 'cond' => 0.9, + 'execContent' => 0.7, + }, + 'history' => { + 'deep' => 0.2 + } +}; + +my $sumChildProbs = sum( values(%{$probs->{'state'}->{'type'}})); + +sub putMachine { + my $where = shift; + + $$where->{'name'} = 'test'; + $$where->{'type'} = 'scxml'; + $$where->{'datamodel'} = 'ecmascript'; + + putState(\$$where->{'children'}, 0); + putTransition(\$$where); +} + +sub putTransition { + my $where = shift; + + return if $$where->{'type'} eq 'final'; + + my $nrTrans = int(rand($maxTrans + 1)); + $nrTrans = min($nrTrans, 1) if $$where->{'type'} eq 'history'; + + for (my $i = 0; $i < $nrTrans; $i++) { + + my $trans; + if (rand(1) < $probs->{'transition'}->{'target'}) { + # has a target - pick one at random + $trans->{'target'} = 'id' . int(rand($stateId)); + } + + if (rand(1) < $probs->{'transition'}->{'event'}) { + # has an event + $trans->{'event'} = 'e' . int(rand($maxEvents + 1)); + } + + if (rand(1) < $probs->{'transition'}->{'cond'}) { + # has a condition + if (int(rand(2)) > 0) { + $trans->{'cond'} = 'true'; + } else { + $trans->{'cond'} = 'false'; + } + } + + if (rand(1) < $probs->{'transition'}->{'execContent'}) { + # has a executable content + push @{$trans->{'execContent'}}, '<log label="foo" />'; + } + + push @{$$where->{'transitions'}}, $trans; + } + + # continue with childs + foreach (@{$$where->{'children'}}) { + putTransition(\$_); + } +} + +sub putState { + my $where = shift; + my $depth = shift; + my $minStates = shift || 0; + my $r; + + return if ($stateId > $maxStates); + return if ($depth > $maxDepth); + my $nrChilds = int(rand($maxChilds + 1)); + $nrChilds = max($minStates, $nrChilds); + + for (my $i = 0; $i < $nrChilds; $i++) { + my $r = rand($sumChildProbs); + + my $state; + foreach my $type (keys %{$probs->{'state'}->{'type'}}) { + my $prob = $probs->{'state'}->{'type'}->{$type}; + if ($r < $prob) { + $state->{'type'} = $type; + last; + } + $r -= $prob; + } + + $state->{'id'} = "id".$stateId++; + + if ($state->{'type'} eq 'parallel') { + putState(\$state->{'children'}, $depth + 1, 2); + } elsif ($state->{'type'} eq 'state') { + putState(\$state->{'children'}, $depth + 1); + } elsif ($state->{'type'} eq 'history') { + if (rand(1) < $probs->{'history'}->{'deep'}) { + $state->{'deep'} = 1; + } + } + + push @{$$where}, $state; + } +}; + +sub writeState { + my $state = shift; + + print STDOUT '<'.$state->{'type'}; + print STDOUT ' id="'.$state->{'id'} . '"'; + print STDOUT ' type="deep"' if exists $state->{'deep'}; + print STDOUT '>'; + + foreach (@{$state->{'children'}}) { + writeState($_); + } + + foreach (@{$state->{'transitions'}}) { + writeTransition($_); + } + + print STDOUT '</'.$state->{'type'} . '>'; + +}; + +sub writeTransition { + my $trans = shift; + + print STDOUT '<transition'; + print STDOUT ' target="' . $trans->{'target'} . '"' if $trans->{'target'}; + print STDOUT ' event="' . $trans->{'event'} . '"' if $trans->{'event'}; + print STDOUT ' cond="' . $trans->{'cond'} . '"' if $trans->{'cond'}; + + if ($trans->{'execContent'}) { + print STDOUT '>'; + foreach (@{$trans->{'execContent'}}) { + print STDOUT $_; + } + print STDOUT '</transition>'; + } else { + print STDOUT '/>'; + } + +}; + +sub writeMachine { + my $machine = shift; + print STDOUT '<scxml'; + print STDOUT ' datamodel="' . $machine->{'datamodel'} . '"' if $machine->{'datamodel'}; + print STDOUT ' seed="' . $seed . '"'; + print STDOUT ' name="' . $machine->{'name'} . '"' if $machine->{'name'}; + print STDOUT '>'; + + foreach (@{$machine->{'children'}}) { + writeState($_); + } + + print STDOUT '</scxml>'; +} + +putMachine(\$machine); +# print Dumper($machine); + +writeMachine($machine); + + +#print Dumper($machine); + + +# writeState($machine); |