summaryrefslogtreecommitdiff
path: root/xpp/perl_modules/Dahdi/Span.pm
diff options
context:
space:
mode:
authorTzafrir Cohen <tzafrir.cohen@xorcom.com>2008-06-19 17:34:36 +0000
committerTzafrir Cohen <tzafrir.cohen@xorcom.com>2008-06-19 17:34:36 +0000
commitda10e87bd6c69c4374de470b7b286c36c823fdc2 (patch)
tree8ae3ddc2b5eff066497697c0c6ec1bc7ee6433ad /xpp/perl_modules/Dahdi/Span.pm
parentc1ae88873823bdc2d884f72cc2b06eab017b97b1 (diff)
XPP tools rename: part 2.
Removed obsolete astribank_hook (not needed) and print_modes (moved to kernel). git-svn-id: http://svn.asterisk.org/svn/dahdi/tools/trunk@4416 a0bf4364-ded3-4de4-8d8a-66a801d63aff
Diffstat (limited to 'xpp/perl_modules/Dahdi/Span.pm')
-rw-r--r--xpp/perl_modules/Dahdi/Span.pm300
1 files changed, 300 insertions, 0 deletions
diff --git a/xpp/perl_modules/Dahdi/Span.pm b/xpp/perl_modules/Dahdi/Span.pm
new file mode 100644
index 0000000..e8faa9b
--- /dev/null
+++ b/xpp/perl_modules/Dahdi/Span.pm
@@ -0,0 +1,300 @@
+package Dahdi::Span;
+#
+# 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 Dahdi::Utils;
+use Dahdi::Chans;
+use Dahdi::Xpp::Xpd;
+
+=head1 NAME
+
+Dahdi::Spans - Perl interface to a Dahdi span information
+
+This package allows access from perl to information about a Dahdi
+channel. It is part of the Dahdi Perl package.
+
+A span is a logical unit of Dahdi channels. Normally a port in a
+digital card or a whole analog card.
+
+See documentation of module L<Dahdi> for usage example. Specifically
+C<Dahdi::spans()> must be run initially.
+
+=head1 by_number()
+
+Get a span by its Dahdi span number.
+
+=head1 Span Properties
+
+=head2 num()
+
+The span number.
+
+=head2 name()
+
+The name field of a Dahdi span. E.g.:
+
+ TE2/0/1
+
+=head2 description()
+
+The description field of the span. e.g:
+
+ "T2XXP (PCI) Card 0 Span 1" HDB3/CCS/CRC4 RED
+
+=head2 chans()
+
+The list of the channels (L<Dahdi::Chan> objects) of this span.
+In a scalar context returns the number of channels this span has.
+
+=head2 bchans()
+
+Likewise a list of bchannels (or a count in a scalar context).
+
+=head2 is_sync_master()
+
+Is this span the source of timing for Dahdi?
+
+=head2 type()
+
+Type of span, or "UNKNOWN" if could not be detected. Current known
+types:
+
+BRI_TE, BRI_NT, E1_TE, E1_NT, J1_TE, J1_NT, T1_TE, T1_NT, FXS, FXO
+
+=head2 is_pri()
+
+Is this an E1/J1/T1 span?
+
+=head2 is_bri()
+
+Is this a BRI span?
+
+=head2 is_digital()
+
+Is this a digital (as opposed to analog) span?
+
+=head2 termtype()
+
+Set for digital spans. "TE" or "NT". Will probably be assumed to be "TE"
+if there's no information pointing either way.
+
+=head2 coding()
+
+Suggested sane coding type (e.g.: "hdb3", "b8zs") for this type of span.
+
+=head2 framing()
+
+Suggested sane framing type (e.g.: "ccs", "esf") for this type of span.
+
+=head2 yellow(), crc4()
+
+Likewise, suggestions ofr the respective fields in the span= line in
+dahdi.conf for this span.
+
+=head2 signalling()
+
+Suggested chan_dahdi.conf signalling for channels of this span.
+
+=head2 switchtype()
+
+Suggested chan_dahdi.conf switchtype for channels of this span.
+
+=head1 Note
+
+Most of those properties are normally used as lower-case functions, but
+actually set in the module as capital-letter propeties. To look at e.g.
+"signalling" is set, look for "SIGNALLING".
+
+=cut
+
+my $proc_base = "/proc/dahdi";
+
+sub chans($) {
+ my $span = shift;
+ return @{$span->{CHANS}};
+}
+
+sub by_number($) {
+ my $span_number = shift;
+ die "Missing span number" unless defined $span_number;
+ my @spans = Dahdi::spans();
+
+ my ($span) = grep { $_->num == $span_number } @spans;
+ return $span;
+}
+
+my @bri_strings = (
+ 'BRI_(NT|TE)',
+ '(?:quad|octo)BRI PCI ISDN Card.* \[(NT|TE)\]\ ',
+ 'octoBRI \[(NT|TE)\] ',
+ 'HFC-S PCI A ISDN.* \[(NT|TE)\] '
+ );
+
+my @pri_strings = (
+ '(E1|T1|J1)_(NT|TE)',
+ 'Tormenta 2 .*Quad (E1|T1)', # tor2.
+ 'Digium Wildcard .100P (T1|E1)/', # wct1xxp
+ 'ISA Tormenta Span 1', # torisa
+ 'TE110P T1/E1', # wcte11xp
+ 'Wildcard TE120P', # wcte12xp
+ 'Wildcard TE121', # wcte12xp
+ 'Wildcard TE122', # wcte12xp
+ 'T[24]XXP \(PCI\) Card ', # wct4xxp
+ );
+
+our $DAHDI_BRI_NET = 'bri_net';
+our $DAHDI_BRI_CPE = 'bri_cpe';
+
+our $DAHDI_PRI_NET = 'pri_net';
+our $DAHDI_PRI_CPE = 'pri_cpe';
+
+sub init_proto($$) {
+ my $self = shift;
+ my $proto = shift;
+
+ $self->{PROTO} = $proto;
+ if($proto eq 'E1') {
+ $self->{DCHAN_IDX} = 15;
+ $self->{BCHAN_LIST} = [ 0 .. 14, 16 .. 30 ];
+ } elsif($proto eq 'T1') {
+ $self->{DCHAN_IDX} = 23;
+ $self->{BCHAN_LIST} = [ 0 .. 22 ];
+ }
+ $self->{TYPE} = "${proto}_$self->{TERMTYPE}";
+}
+
+sub new($$) {
+ my $pack = shift or die "Wasn't called as a class method\n";
+ my $num = shift or die "Missing a span number parameter\n";
+ my $self = { NUM => $num };
+ bless $self, $pack;
+ $self->{TYPE} = "UNKNOWN";
+ my @xpds = Dahdi::Xpp::Xpd::xpds_by_spanno;
+ my $xpd = $xpds[$num];
+ if(defined $xpd) {
+ die "Spanno mismatch: $xpd->spanno, $num" unless $xpd->spanno == $num;
+ $self->{XPD} = $xpd;
+ }
+ open(F, "$proc_base/$num") or die "Failed to open '$proc_base/$num\n";
+ my $head = <F>;
+ chomp $head;
+ $self->{IS_DIGITAL} = 0;
+ $self->{IS_BRI} = 0;
+ $self->{IS_PRI} = 0;
+ foreach my $cardtype (@bri_strings) {
+ if($head =~ m/$cardtype/) {
+ $self->{IS_DIGITAL} = 1;
+ $self->{IS_BRI} = 1;
+ $self->{TERMTYPE} = $1;
+ $self->{TYPE} = "BRI_$1";
+ $self->{DCHAN_IDX} = 2;
+ $self->{BCHAN_LIST} = [ 0, 1 ];
+ last;
+ }
+ }
+ foreach my $cardtype (@pri_strings) {
+ if($head =~ m/$cardtype/) {
+ my @info;
+
+ push(@info, $1) if defined $1;
+ push(@info, $2) if defined $2;
+ my ($proto) = grep(/(E1|T1|J1)/, @info);
+ $proto = 'UNKNOWN' unless defined $proto;
+ my ($termtype) = grep(/(NT|TE)/, @info);
+ $termtype = 'TE' unless defined $termtype;
+
+ $self->{IS_DIGITAL} = 1;
+ $self->{IS_PRI} = 1;
+ $self->{TERMTYPE} = $termtype;
+ $self->init_proto($proto);
+ last;
+ }
+ }
+ die "$0: Unkown TERMTYPE [NT/TE]\n"
+ if $self->is_digital and !defined $self->{TERMTYPE};
+ ($self->{NAME}, $self->{DESCRIPTION}) = (split(/\s+/, $head, 4))[2, 3];
+ $self->{IS_DAHDI_SYNC_MASTER} =
+ ($self->{DESCRIPTION} =~ /\(MASTER\)/) ? 1 : 0;
+ $self->{CHANS} = [];
+ my @channels;
+ my $index = 0;
+ while(<F>) {
+ chomp;
+ s/^\s*//;
+ s/\s*$//;
+ next unless /\S/;
+ next unless /^\s*\d+/; # must be a real channel string.
+ my $c = Dahdi::Chans->new($self, $index, $_);
+ push(@channels, $c);
+ $index++;
+ }
+ close F;
+ if($self->is_pri()) {
+ # Check for PRI with unknown type strings
+ if($index == 31) {
+ if($self->{PROTO} eq 'UNKNOWN') {
+ $self->init_proto('E1');
+ } elsif($self->{PROTO} ne 'E1') {
+ die "$index channels in a $self->{PROTO} span";
+ }
+ } elsif($index == 24) {
+ if($self->{PROTO} eq 'UNKNOWN') {
+ $self->init_proto('T1'); # FIXME: J1?
+ } elsif($self->{PROTO} ne 'T1') {
+ die "$index channels in a $self->{PROTO} span";
+ }
+ }
+ }
+ @channels = sort { $a->num <=> $b->num } @channels;
+ $self->{CHANS} = \@channels;
+ $self->{YELLOW} = undef;
+ $self->{CRC4} = undef;
+ if($self->is_bri()) {
+ $self->{CODING} = 'ami';
+ $self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}];
+ $self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ];
+ # Infer some info from channel name:
+ my $first_chan = ($self->chans())[0] || die "$0: No channels in span #$num\n";
+ my $chan_fqn = $first_chan->fqn();
+ if($chan_fqn =~ m(ZTHFC.*/|ztqoz.*/|XPP_BRI_.*/)) { # BRI
+ $self->{FRAMING} = 'ccs';
+ $self->{SWITCHTYPE} = 'euroisdn';
+ $self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $DAHDI_BRI_NET : $DAHDI_BRI_CPE ;
+ } elsif($chan_fqn =~ m(ztgsm.*/)) { # Junghanns's GSM cards.
+ $self->{FRAMING} = 'ccs';
+ $self->{SIGNALLING} = 'gsm';
+ }
+ }
+ if($self->is_pri()) {
+ $self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}];
+ $self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ];
+ if($self->{PROTO} eq 'E1') {
+ $self->{CODING} = 'hdb3';
+ $self->{FRAMING} = 'ccs';
+ $self->{SWITCHTYPE} = 'euroisdn';
+ $self->{CRC4} = 'crc4';
+ } elsif($self->{PROTO} eq 'T1') {
+ $self->{CODING} = 'b8zs';
+ $self->{FRAMING} = 'esf';
+ $self->{SWITCHTYPE} = 'national';
+ } else {
+ die "'$self->{PROTO}' unsupported yet";
+ }
+ $self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $DAHDI_PRI_NET : $DAHDI_PRI_CPE ;
+ }
+ return $self;
+}
+
+sub bchans($) {
+ my $self = shift || die;
+
+ return @{$self->{BCHANS}};
+}
+
+1;