Joachim Klein
7 years ago
committed by
Joachim Klein
Joachim Klein
1 changed files with 234 additions and 0 deletions
@ -0,0 +1,234 @@ |
|||
#! /usr/bin/perl -w |
|||
|
|||
use strict; |
|||
use Getopt::Long; |
|||
|
|||
my @property_term_files; |
|||
my @model_term_files; |
|||
my @both_term_files; |
|||
my $outfile = '/dev/stdout'; |
|||
my $verbose = 0; |
|||
my $mark_start = 0; |
|||
|
|||
if (!GetOptions("prop-regexp|p=s" => \@property_term_files, |
|||
"model-regexp|m=s" => \@model_term_files, |
|||
"both-regexp|b=s" => \@both_term_files, |
|||
"mark-start|s" => \$mark_start, |
|||
"output|o=s" => \$outfile, |
|||
"verbose" => \$verbose, |
|||
)) { |
|||
usage(); |
|||
} |
|||
|
|||
sub usage { |
|||
print "prismlog2csv [arguments] [log-file]\n\n"; |
|||
print " --prop-regexp file read additional regular expressions matching per property from file\n"; |
|||
print " --model-regexp file read additional regular expressions matching per model build from file\n"; |
|||
print " --both-regexp file read additional regular expressions matching either per model or per property from file\n"; |
|||
exit(1); |
|||
} |
|||
|
|||
# regular expressions for synching from the log file |
|||
my $re_prism_start = qr/PRISM$/; |
|||
my $re_property = qr/^Model checking: (.+)$/; |
|||
my $re_model_file = qr/^Parsing model file "(.+)"...$/; |
|||
my $re_properties_file = qr/^Parsing properties file "(.+)".../; |
|||
my $re_command_line = qr/^Command line: (.+)$/; |
|||
my $re_property_constants = qr/^Property constants: (.+)$/; |
|||
my $re_model_constants = qr/^Model constants: (.+)$/; |
|||
my $re_error = qr/^Error: (.+)$/; |
|||
|
|||
|
|||
my @model_terms_standard = |
|||
( |
|||
[model_build_time => qr/^Time for model construction: (.+) seconds/], |
|||
[model_states => qr/^States: (\d+) \(\d+ initial\)/], |
|||
[model_states_initial => qr/^States: \d+ \((\d+) initial\)/], |
|||
[model_transitions => qr/^Transitions: (\d+)/], |
|||
[model_matrix_dd => qr/^(?:Rate|Transition) matrix: (\d+) nodes/], |
|||
); |
|||
|
|||
|
|||
my @property_terms_standard = |
|||
( |
|||
[property_mc_time => qr/^Time for model checking: (.+) seconds/], |
|||
[property_result => qr/^Result: ([^(]+)/], |
|||
); |
|||
|
|||
my @model_terms = @model_terms_standard; |
|||
my @property_terms = @property_terms_standard; |
|||
my @both_terms = (); |
|||
|
|||
|
|||
for my $model_term_file (@model_term_files) { |
|||
load_regexps_from_file($model_term_file, \@model_terms); |
|||
} |
|||
|
|||
for my $property_term_file (@property_term_files) { |
|||
load_regexps_from_file($property_term_file, \@property_terms); |
|||
} |
|||
|
|||
for my $both_term_file (@both_term_files) { |
|||
load_regexps_from_file($both_term_file, \@both_terms); |
|||
} |
|||
|
|||
if ($verbose) { |
|||
print STDERR "Model regular expressions:\n"; |
|||
print STDERR "--------------------------\n"; |
|||
foreach (@model_terms) { |
|||
print STDERR " ", $_->[0], ":\n ", $_->[1], "\n\n"; |
|||
} |
|||
|
|||
print STDERR "\nProperty regular expressions:\n"; |
|||
print STDERR "-----------------------------\n"; |
|||
foreach (@property_terms) { |
|||
print STDERR " ", $_->[0], ":\n ", $_->[1], "\n\n"; |
|||
} |
|||
|
|||
print STDERR "\nBoth regular expressions:\n"; |
|||
print STDERR "-------------------------\n"; |
|||
foreach (@both_terms) { |
|||
print STDERR " ", $_->[0], ":\n ", $_->[1], "\n\n"; |
|||
} |
|||
} |
|||
|
|||
|
|||
open(OUT, ">", $outfile) or die "Can not open $outfile: $!\n"; |
|||
|
|||
my %current; |
|||
|
|||
while (my $line=<>) { |
|||
chomp($line); |
|||
if ($line =~ $re_prism_start) { |
|||
%current = (); |
|||
} |
|||
if ($line =~ $re_model_file) { |
|||
$current{model_file} = $1; |
|||
print OUT "# Model file: $1\n"; |
|||
if ($mark_start) { |
|||
print OUT get_model_key(), ";;start-model", "\n"; |
|||
} |
|||
} |
|||
if ($line =~ $re_properties_file) { |
|||
$current{properties_file} = $1; |
|||
print OUT "# Properties file: $1\n"; |
|||
} |
|||
if ($line =~ $re_command_line) { |
|||
$current{command_line} = $1; |
|||
print OUT "# Command line: $1\n"; |
|||
} |
|||
if ($line =~ $re_property) { |
|||
$current{property} = $1; |
|||
if ($mark_start) { |
|||
print OUT get_property_key(), ";start-check", "\n"; |
|||
} |
|||
$current{seen} = {}; |
|||
} |
|||
if ($line =~ $re_model_constants) { |
|||
$current{model_constants} = $1; |
|||
$current{model_constants} =~ s/\s//g; #remove whitespace |
|||
} |
|||
if ($line =~ $re_property_constants) { |
|||
$current{property_constants} = $1; |
|||
$current{property_constants} =~ s/\s//g; #remove whitespace |
|||
} |
|||
if ($line =~ $re_error) { |
|||
if (defined $current{property}) { |
|||
# we are in a property... |
|||
print OUT get_property_key(), ";error;", quote_semicolon($1), "\n"; |
|||
} else { |
|||
print OUT get_model_key(), ";;error;", quote_semicolon($1), "\n"; |
|||
} |
|||
} |
|||
|
|||
# custom regexps |
|||
foreach my $term (@model_terms) { |
|||
match_term($line, $term, 0); |
|||
} |
|||
|
|||
foreach my $term (@property_terms) { |
|||
match_term($line, $term, 1); |
|||
} |
|||
|
|||
foreach my $term (@both_terms) { |
|||
match_term($line, $term, defined $current{property}); |
|||
} |
|||
} |
|||
|
|||
sub match_term { |
|||
my $line = shift; |
|||
my $term = shift; |
|||
my $is_property = shift; |
|||
|
|||
my $id = $term->[0]; |
|||
if ($line =~ $term->[1]) { |
|||
my $xid; |
|||
if ($is_property) { |
|||
$xid = get_property_key() . ";" . $id; |
|||
} else { |
|||
$xid = get_model_key() . ";;" . $id; |
|||
} |
|||
|
|||
while (defined $current{seen}->{$xid}) { |
|||
if ($xid =~ /^(.+)-(\d+)$/) { |
|||
$xid = "$1-".($2+1); |
|||
} else { |
|||
$xid.="-2"; |
|||
} |
|||
} |
|||
$current{seen}->{$xid}=1; |
|||
|
|||
print OUT $xid, ";", quote_semicolon($1), "\n"; |
|||
} |
|||
} |
|||
|
|||
|
|||
sub quote_semicolon { |
|||
my $s = shift; |
|||
|
|||
$s=~ s/;/_/g; |
|||
return $s; |
|||
} |
|||
|
|||
sub get_model_key { |
|||
my $model_file = $current{model_file} || ""; |
|||
$model_file .= (defined $current{model_constants} ? "@".$current{model_constants} : ""); |
|||
|
|||
return quote_semicolon($model_file); |
|||
} |
|||
|
|||
sub get_property_key { |
|||
my $model_file = get_model_key(); |
|||
|
|||
my $property = $current{property} || ""; |
|||
$property .= (defined $current{property_constants} ? "@".$current{property_constants} : ""); |
|||
|
|||
return quote_semicolon($model_file) . ";" . quote_semicolon($property); |
|||
} |
|||
|
|||
sub load_regexps_from_file { |
|||
my $term_file = shift; |
|||
my $terms = shift; |
|||
|
|||
open(IN, "<", $term_file) or die "Can not open $term_file: $!\n"; |
|||
my $cur_key = undef; |
|||
while (<IN>) { |
|||
chomp; |
|||
s/^\s*//; #remove whitespace |
|||
s/\s*$//; |
|||
next if /^#$/ || /^$/; |
|||
|
|||
if (defined $cur_key) { |
|||
my $regexp = $_; |
|||
push @{ $terms }, [ $cur_key, qr/$regexp/ ]; |
|||
$cur_key = undef; |
|||
} else { |
|||
$cur_key = $_; |
|||
} |
|||
} |
|||
|
|||
if (defined $cur_key) { |
|||
die "Lonely key $cur_key at end of $term_file\n"; |
|||
} |
|||
return 1; |
|||
} |
|||
Write
Preview
Loading…
Cancel
Save
Reference in new issue