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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#!/usr/bin/perl
# RTFL
#
# Copyright 2014 Sebastian Geerken <sgeerken@dillo.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# Usage: rtfl-objfilter [options]
#
# Filters a stream of RTFL messages by types, aspects and priorities.
# The options -a, -A, -t, -T, and -p are supported and work in the
# same way as for rtfl-objview. By default, nothing is filtered.
#
# N. b. that parsing is incorrect, see <doc/rtfl.html#scripts>.
$LARGE_INT = 1000000000;
sub helpAndExit {
die "Syntax: $0 uses same arguments -a, -A, -t, -T, and -p as rtfl-objview.";
}
sub filter1 {
return $shownTypes{$_[0]};
}
sub filter2 {
return $shownTypes{$_[0]} &&
(($defaultShow && !$hiddenAspects{$_[1]}) ||
(!$defaultShow && !$shownAspects{$_[1]})) &&
$_[2] >= $prio;
}
%shownAspects = {};
%hiddenAspects = {};
$defaultShow = 1;
%shownTypes =
( "i" => 1, "m" => 1, "a" => 1, "f" => 1, "s" => 1, "t" => 1, "d" => 1 );
$prio = $LARGE_INT;
for ($i = 0; $i < scalar @ARGV; $i++) {
$opt = $ARGV[$i];
helpAndExit if ($i == scalar @ARGV -1);
$arg = $ARGV[++$i];
if ($opt eq "-a") {
if (arg eq "*") { $defaultShow = 1; }
else { $shownAspects{$arg} = 1; }
} elsif ($opt eq "-A") {
if (arg eq "*") { $defaultShow = 0; }
else { $hiddenAspects{$arg} = 1; }
} elsif ($opt eq "-t" || $opt eq "-T") {
$show = $opt eq "-t";
for ($i = 0; $i < length ($arg); $i++) {
$shownTypes{substr ($arg, $i, 1)} = $show;
}
} elsif ($opt eq "-p") {
if ($arg eq "*") { $prio = $LARGE_INT; }
else { $prio = $arg; }
} else {
helpAndExit if ($method eq "");
}
}
@shownFuns = ();
while(<STDIN>) {
if (/^\[rtfl[^\]]*\]/) {
if (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?mark:[^:]*:([^:]*):([^:]*):/) {
print if (filter2 ("a", $2, $3));
} elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?msg:[^:]*:([^:]*):([^:]*):/) {
print if (filter2 ("m", $2, $3));
} elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?msg-start:/ ||
/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?msg-end:/) {
print if (filter1 ("i"));
} elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?set:/) {
print if (filter1 ("t"));
} elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?delete:/) {
print if (filter1 ("d"));
} elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?enter:[^:]*:([^:]*):([^:]*):/) {
$shown = filter2 ("f", $2, $3);
print if ($shown);
push @shownFuns, $shown;
} elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?leave:/) {
$show = pop @shownFuns;
print if ($shown);
} elsif (/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?create:/ ||
/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?assoc:/ ||
/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?color:/ ||
/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?class-color:/ ||
/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?object-color:/ ||
/^\[rtfl[^\]]*\][^:]*:[^:]*:[^:]*:(obj-)?ident:/) {
print;
} else {
print STDERR "Invalid line: $_";
}
}
}
|
