diff options
Diffstat (limited to 'drivers/dahdi/xpp/utils/zconf/Zaptel/Chans.pm')
| -rw-r--r-- | drivers/dahdi/xpp/utils/zconf/Zaptel/Chans.pm | 202 |
1 files changed, 0 insertions, 202 deletions
diff --git a/drivers/dahdi/xpp/utils/zconf/Zaptel/Chans.pm b/drivers/dahdi/xpp/utils/zconf/Zaptel/Chans.pm deleted file mode 100644 index 6f83f77..0000000 --- a/drivers/dahdi/xpp/utils/zconf/Zaptel/Chans.pm +++ /dev/null @@ -1,202 +0,0 @@ -package Zaptel::Chans; -# -# Written by Oron Peled <oron@actcom.co.il> -# Copyright (C) 2007, Xorcom -# This program is free software; you can redistribute and/or -# modify it under the same terms as Perl itself. -# -# $Id$ -# -use strict; -use Zaptel::Utils; - -=head1 NAME - -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 battery() - -Returns 1 if channel reports to have battery (A remote PBX connected to -an FXO port), 0 if channel reports to not have battery and C<undef> -otherwise. - -Currently only wcfxo and Astribank FXO modules report battery. For the -rest of the channels - -=head1 fqn() - -(Fully Qualified Name) Returns the full "name" of the channel. - -=head1 index() - -Returns the number of this channel (in the span). - -=head1 num() - -Returns the number of this channel as a Zaptel channel. - -=head signalling() - -Returns the signalling set for this channel through /etc/zaptel.conf . -This is always empty before ztcfg was run. And shows the "other" type -for FXS and for FXO. - -=head1 span() - -Returns a reference to the span to which this channel belongs. - -=head1 type() - -Returns the type of the channel: 'FXS', 'FXO', 'EMPTY', etc. - -=cut - -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"; - my $index = shift; - my $line = shift or die "Missing an input line\n"; - defined $index or die "Missing an index parameter\n"; - my $self = { - 'SPAN' => $span, - 'INDEX' => $index, - }; - bless $self, $pack; - my ($num, $fqn, $rest) = split(/\s+/, $line, 3); - $num or die "Missing a channel number parameter\n"; - $fqn or die "Missing a channel fqn parameter\n"; - my $signalling = ''; - my $info = ''; - if(defined $rest) { - if($rest =~ s/^\s*(\w+)\s*//) { - $signalling = $1; - } - if($rest =~ s/(.*)//) { - $info = $1; - } - } - $self->{NUM} = $num; - $self->{FQN} = $fqn; - $self->{SIGNALLING} = $signalling; - $self->{INFO} = $info; - my $type; - if($fqn =~ m|\bXPP_(\w+)/.*$|) { - $type = $1; # An Astribank - } elsif ($fqn =~ m{\bWCFXO/.*}) { - $type = "FXO"; # wcfxo - x100p and relatives. - # A single port card. The driver issue RED alarm when - # There's no better - $self->{BATTERY} = !($span->description =~ /\bRED\b/); - } elsif ($fqn =~ m{\bFXS/.*}) { - $type = "FXS"; # likely Rhino - } elsif ($fqn =~ m{\bFXO/.*}) { - $type = "FXO"; # likely Rhino - } elsif ($fqn =~ m{\b---/.*}) { - $type = "EMPTY"; # likely Rhino, empty slot. - } elsif ($fqn =~ m{\b(TE[24]|WCT1|Tor2|TorISA|WP[TE]1|cwain[12])/.*}) { - # TE[24]: Digium wct4xxp - # WCT1: Digium single span card drivers? - # Tor2: Tor PCI cards - # TorISA: ISA ones (still used?) - # WP[TE]1: Sangoma. TODO: this one tells us if it is TE or NT. - # cwain: Junghanns E1 card. - $type = "PRI"; - } elsif ($fqn =~ m{\b(ZTHFC%d*|ztqoz\d*)/.*}) { - # ZTHFC: HFC-s single-port card (zaphfc/vzaphfc) - # ztqoz: qozap (Junghanns) multi-port HFC card - $type = "BRI"; - } elsif ($fqn =~ m{\bztgsm/.*}) { - # Junghanns GSM card - $type = "GSM"; - } elsif(defined $signalling) { - $type = 'FXS' if $signalling =~ /^FXS/; - $type = 'FXO' if $signalling =~ /^FXO/; - } else { - $type = undef; - } - $self->type($type); - $self->span()->type($type) - if ! defined($self->span()->type()) || - $self->span()->type() eq 'UNKNOWN'; - return $self; -} - -=head1 probe_type() - -In the case of some cards, the information in /proc/zaptel is not good -enough to tell the type of each channel. In this case an extra explicit -probe is needed. - -Currently this is implemented by using some invocations of ztcfg(8). - -It may later be replaced by ztscan(8). - -=cut - -my $ztcfg = $ENV{ZTCFG} || '/sbin/ztcfg'; -sub probe_type($) { - my $self = shift; - my $fqn = $self->fqn; - my $num = $self->num; - my $type; - - if($fqn =~ m:WCTDM/| WRTDM/|OPVXA1200/:) { - my %maybe; - - undef %maybe; - foreach my $sig (qw(fxo fxs)) { - my $cmd = "echo ${sig}ks=$num | $ztcfg -c /dev/fd/0"; - - $maybe{$sig} = system("$cmd >/dev/null 2>&1") == 0; - } - if($maybe{fxo} and $maybe{fxs}) { - $type = 'EMPTY'; - } elsif($maybe{fxo}) { - $type = 'FXS'; - } elsif($maybe{fxs}) { - $type = 'FXO'; - } else { - $type = 'EMPTY'; - } - } else { - $type = $self->type; - } - return $type; -} - -sub battery($) { - my $self = shift or die; - my $span = $self->span or die; - - return undef unless $self->type eq 'FXO'; - return $self->{BATTERY} if defined $self->{BATTERY}; - - my $xpd = $span->xpd; - my $index = $self->index; - return undef if !$xpd; - - # It's an XPD (FXO) - my @lines = @{$xpd->lines}; - my $line = $lines[$index]; - return $line->battery; -} - -sub blink($$) { - my $self = shift or die; - my $on = shift; - my $span = $self->span or die; - - my $xpd = $span->xpd; - my $index = $self->index; - return undef if !$xpd; - - my @lines = @{$xpd->lines}; - my $line = $lines[$index]; - return $line->blink($on); -} - - -1; |