diff options
author | tzafrir <tzafrir@5390a7c7-147a-4af0-8ec9-7488f05a26cb> | 2008-08-04 15:43:32 +0000 |
---|---|---|
committer | tzafrir <tzafrir@5390a7c7-147a-4af0-8ec9-7488f05a26cb> | 2008-08-04 15:43:32 +0000 |
commit | 10f75475fe7b91e89ad2fedb91d595a0aba95f44 (patch) | |
tree | c44d0e72be1305e29ef941fa8a0a2fa59902f6d0 /xpp/utils/zconf/Zaptel/Chans.pm | |
parent | 8ab1922741746b37897f0d487d02697e46aeb203 (diff) |
Add channel alarms in Zaptel-perl and lszaptel specifically.
* Zaptel::Chans now provides a method alarms() for a list (or number of)
alarms.
* lszaptel uses it for a more correct display of channel status.
* Also update PCI hardware list.
git-svn-id: http://svn.digium.com/svn/zaptel/branches/1.2@4455 5390a7c7-147a-4af0-8ec9-7488f05a26cb
Diffstat (limited to 'xpp/utils/zconf/Zaptel/Chans.pm')
-rw-r--r-- | xpp/utils/zconf/Zaptel/Chans.pm | 32 |
1 files changed, 29 insertions, 3 deletions
diff --git a/xpp/utils/zconf/Zaptel/Chans.pm b/xpp/utils/zconf/Zaptel/Chans.pm index 6f83f77..aa552a2 100644 --- a/xpp/utils/zconf/Zaptel/Chans.pm +++ b/xpp/utils/zconf/Zaptel/Chans.pm @@ -17,6 +17,12 @@ Zaptel::Chans - Perl interface to a Zaptel channel information This package allows access from perl to information about a Zaptel channel. It is part of the Zaptel Perl package. +=head1 alarms() + +In an array context returns a list of alarm strings (RED, BLUE, etc.) +for this channel (an empty list == false if there are no alarms). +In scalar context returns the number of alarms for a specific channel. + =head1 battery() Returns 1 if channel reports to have battery (A remote PBX connected to @@ -54,6 +60,8 @@ Returns the type of the channel: 'FXS', 'FXO', 'EMPTY', etc. =cut +my @alarm_types = qw(BLUE YELLOW RED LOOP RECOVERING NOTOPEN); + sub new($$$$$$) { my $pack = shift or die "Wasn't called as a class method\n"; my $span = shift or die "Missing a span parameter\n"; @@ -69,18 +77,29 @@ sub new($$$$$$) { $num or die "Missing a channel number parameter\n"; $fqn or die "Missing a channel fqn parameter\n"; my $signalling = ''; + my @alarms = (); my $info = ''; if(defined $rest) { + # remarks in parenthesis (In use), (no pcm) + while($rest =~ s/(\([^)]+\))\s*//) { + $info .= " $1"; + } + # Alarms + foreach my $alarm (@alarm_types) { + if($rest =~ s/\s*(\b${alarm}\b)\s*//) { + push(@alarms, $1); + } + } if($rest =~ s/^\s*(\w+)\s*//) { $signalling = $1; } - if($rest =~ s/(.*)//) { - $info = $1; - } + die "Unrecognized garbage '$rest' in $fqn\n" + if length($rest); } $self->{NUM} = $num; $self->{FQN} = $fqn; $self->{SIGNALLING} = $signalling; + $self->{ALARMS} = \@alarms; $self->{INFO} = $info; my $type; if($fqn =~ m|\bXPP_(\w+)/.*$|) { @@ -184,6 +203,13 @@ sub battery($) { return $line->battery; } +sub alarms($) { + my $self = shift or die; + my @alarms = @{$self->{ALARMS}}; + + return @alarms; +} + sub blink($$) { my $self = shift or die; my $on = shift; |