From 538d622c43d5cde57fd7cb790c31359c8783d090 Mon Sep 17 00:00:00 2001
From: Tzafrir Cohen <tzafrir.cohen@xorcom.com>
Date: Tue, 12 Aug 2008 10:21:53 +0000
Subject: Dahdi-perl: Add alarms() method for channels. Use it in lsdahdi.

* Better paring of the /proc/dahdi/N channel lines for alarms
* Provide it as a separate alarms() method.


git-svn-id: http://svn.asterisk.org/svn/dahdi/tools/trunk@4764 a0bf4364-ded3-4de4-8d8a-66a801d63aff
---
 xpp/perl_modules/Dahdi/Chans.pm | 32 +++++++++++++++++++++++++++++---
 1 file changed, 29 insertions(+), 3 deletions(-)

(limited to 'xpp/perl_modules/Dahdi/Chans.pm')

diff --git a/xpp/perl_modules/Dahdi/Chans.pm b/xpp/perl_modules/Dahdi/Chans.pm
index 470893b..86a4da6 100644
--- a/xpp/perl_modules/Dahdi/Chans.pm
+++ b/xpp/perl_modules/Dahdi/Chans.pm
@@ -17,6 +17,12 @@ Dahdi::Chans - Perl interface to a Dahdi channel information
 This package allows access from perl to information about a Dahdi
 channel. It is part of the Dahdi 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;
-- 
cgit v1.2.3