1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
package testparser;
our @EXPORT = (
qw(parsetest)
);
##################################################
# Parse in the test
sub parsetest {
my ($filename) = @_;
my %testprops = ();
my ($in_multiline, $multi_key, $multi_val) = (
0,
undef,
undef
);
open my $infile, '<', $filename or die "bad input file";
while (my $ln = <$infile>) {
next if $ln =~ /^\#/; # comments
if ($ln eq "\n") {
if ($in_multiline) {
if (defined($testprops{$multi_key})) {
if (ref($testprops{$multi_key}) eq "ARRAY") {
push(@{$testprops{$multi_key}}, $multi_val);
} else {
$testprops{$multi_key} = [$testprops{$multi_key}, $multi_val];
}
} else {
$testprops{$multi_key} = $multi_val;
}
$in_multiline = 0;
}
next;
}
if ($in_multiline) {
$multi_val = $multi_val . substr($ln, 2);
} else {
my $colon = index($ln, ':');
my $key = substr($ln, 0, $colon);
# detect multiline stuff
if (length($ln) == $colon + 2) {
$in_multiline = 1;
$multi_key = $key;
$multi_val = "";
next;
}
chomp $ln;
my $val = substr($ln, $colon + 2);
if (defined($testprops{$key})) {
if (ref($testprops{$key}) eq "ARRAY") {
push(@{$testprops{$key}}, $val);
} else {
$testprops{$key} = [$testprops{$key}, $val];
}
} else {
$testprops{$key} = $val;
}
}
}
$infile->close();
return %testprops;
}
1;
|
