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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
package Smokeping::matchers::base;
=head1 NAME
Smokeping::matchers::base - Base Class for implementing SmokePing Matchers
=head1 OVERVIEW
This is the base class for writing SmokePing matchers. Every matcher must
inherit from the base class and provide it's own methods for the 'business'
logic.
Note that the actual matchers must have at least one capital letter in their
name, to differentiate them from the base class(es).
=head1 DESCRIPTION
Every matcher must provide the following methods:
=cut
use vars qw($VERSION);
use Carp;
$VERSION = 1.0;
use strict;
=head2 new
The new method expects hash elements as an argument
eg new({x=>'\d+',y=>'\d+'},x=>1,y=>2). The first part is
a syntax rule for the arguments it should expect and the second part
are the arguments itself. The first part will be supplied
by the child class as it calls the parent method.
=cut
sub new(@)
{
my $this = shift;
my $class = ref($this) || $this;
my $rules = shift;
my $self = { param => { @_ } };
foreach my $key (keys %{$self->{param}}){
my $regex = $rules->{$key};
croak "key '$key' is not known by this matcher" unless defined $rules->{$key};
croak "key '$key' contains invalid data: '$self->{param}{$key}'" unless $self->{param}{$key} =~ m/^$regex$/;
}
bless $self, $class;
return $self;
}
=head2 Length
The Length method returns the number of values the
matcher will expect from SmokePing. This method must
be overridden by the children of the base class.
=cut
sub Length($)
{
my $self = shift;
croak "SequenceLength must be overridden by the subclass";
}
=head2 Desc
Simply return the description of the function. This method must
be overwritten by a children of the base class.
=cut
sub Desc ($) {
croak "MatcherDesc must be overridden by the subclass";
}
=head2 Test
Run the matcher and return true or false. The Test method is called
with a hash containing two arrays giving it access to both rtt and loss values.
my $data=shift;
my @rtt = @{$data->{rtt}};
my @loss = @{$data->{loss}};
The arrays are ordered from old to new.
@rdd[old..new]
There may be more than the expected number of elements in this array. Address them with
$x[-1] to $x[-max].
There's also a key called 'prevmatch' in the hash. It contains the
value returned by the previous call of the 'Test' method. This allows
for somewhat more intelligent alerting due to state awareness.
my $prevmatch = $data->{prevmatch};
=cut
sub Test($$)
{ my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
croak "Match must be overridden by the subclass";
}
=head1 COPYRIGHT
Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved.
=head1 LICENSE
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 2 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
=head1 AUTHOR
Tobias Oetiker <tobi@oetiker.ch>
=cut
|
