Add support for Digium's new te13x line of cards
[dahdi/tools.git] / xpp / perl_modules / Dahdi / Span.pm
1 package Dahdi::Span;
2 #
3 # Written by Oron Peled <oron@actcom.co.il>
4 # Copyright (C) 2007, Xorcom
5 # This program is free software; you can redistribute and/or
6 # modify it under the same terms as Perl itself.
7 #
8 # $Id$
9 #
10 use strict;
11 use Dahdi::Utils;
12 use Dahdi::Chans;
13
14 =head1 NAME
15
16 Dahdi::Spans - Perl interface to a Dahdi span information
17
18 This package allows access from perl to information about a Dahdi
19 channel. It is part of the Dahdi Perl package.
20
21 A span is a logical unit of Dahdi channels. Normally a port in a
22 digital card or a whole analog card.
23
24 See documentation of module L<Dahdi> for usage example. Specifically
25 C<Dahdi::spans()> must be run initially.
26
27 =head1 by_number()
28
29 Get a span by its Dahdi span number.
30
31 =head1 Span Properties
32
33 =head2 num()
34
35 The span number.
36
37 =head2 name()
38
39 The name field of a Dahdi span. E.g.:
40
41   TE2/0/1
42
43 =head2 description()
44
45 The description field of the span. e.g:
46
47   "T2XXP (PCI) Card 0 Span 1" HDB3/CCS/CRC4 RED
48
49 =head2 chans()
50
51 The list of the channels (L<Dahdi::Chan> objects) of this span.
52 In a scalar context returns the number of channels this span has.
53
54 =head2 bchans()
55
56 Likewise a list of bchannels (or a count in a scalar context).
57
58 =head2 is_sync_master()
59
60 Is this span the source of timing for Dahdi?
61
62 =head2 type()
63
64 Type of span, or "UNKNOWN" if could not be detected. Current known
65 types: 
66
67 BRI_TE, BRI_NT, E1_TE, E1_NT, J1_TE, J1_NT, T1_TE, T1_NT, FXS, FXO
68
69 =head2 is_pri()
70
71 Is this an E1/J1/T1 span?
72
73 =head2 is_bri()
74
75 Is this a BRI span?
76
77 =head2 is_digital()
78
79 Is this a digital (as opposed to analog) span?
80
81 =head2 termtype()
82
83 Set for digital spans. "TE" or "NT". Will probably be assumed to be "TE"
84 if there's no information pointing either way.
85
86 =head2 coding()
87
88 Suggested sane coding type (e.g.: "hdb3", "b8zs") for this type of span. 
89
90 =head2 framing()
91
92 Suggested sane framing type (e.g.: "ccs", "esf") for this type of span. 
93
94 =head2 yellow(), crc4()
95
96 Likewise, suggestions ofr the respective fields in the span= line in
97 /etc/dahdi/system.conf for this span.
98
99 =head2 signalling()
100
101 Suggested chan_dahdi.conf signalling for channels of this span.
102
103 =head2 switchtype()
104
105 Suggested chan_dahdi.conf switchtype for channels of this span.
106
107 =head1 Note
108
109 Most of those properties are normally used as lower-case functions, but
110 actually set in the module as capital-letter propeties. To look at e.g.
111 "signalling" is set, look for "SIGNALLING".
112
113 =cut
114
115 sub chans($) {
116         my $span = shift;
117         return @{$span->{CHANS}};
118 }
119
120 sub by_number($) {
121         my $span_number = shift;
122         die "Missing span number" unless defined $span_number;
123         my @spans = Dahdi::spans();
124
125         my ($span) = grep { $_->num == $span_number } @spans;
126         return $span;
127 }
128
129 my @bri_strings = (
130                 'BRI_(NT|TE)',
131                 '(?:quad|octo)BRI PCI ISDN Card.* \[(NT|TE)\]',
132                 'octoBRI \[(NT|TE)\] ',
133                 'HFC-S PCI A ISDN.* \[(NT|TE)\] ',
134                 '(B4XXP) \(PCI\) Card', # Use dahdi_scan to determine TE/NT mode
135                 '(WCBRI)', # has selectable NT/TE modes via dahdi_cfg
136                 );
137
138 my @pri_strings = (
139                 'Tormenta 2 .*Quad (E1|T1)',       # tor2.
140                 'Xorcom XPD.*: (E1|T1)',           # Astribank PRI
141                 'Digium Wildcard .100P (T1|E1)/', # wct1xxp
142                 'ISA Tormenta Span 1',             # torisa
143                 'TE110P T1/E1',                    # wcte11xp
144                 'Wildcard TE120P',                 # wcte12xp
145                 'Wildcard TE121',                  # wcte12xp
146                 'Wildcard TE122',                  # wcte12xp
147                 'Wildcard TE133',                  # wcte13xp
148                 'Wildcard TE134',                  # wcte13xp
149                 'T[248]XXP \(PCI\) Card ',          # wct4xxp
150                 'R[24]T1 \(PCI\) Card',            # rxt1
151                 'Rhino R1T1 (E1)/PRA Card',        # r1t1
152                 'Rhino R1T1 (T1)/PRI Card',        # r1t1
153                 'WP(E1|T1)/.* "wanpipe',           # Sangoma E1/T1
154                 );
155
156 my @soft_term_type_strings = (
157                 'Xorcom XPD.*: (E1|T1)',           # Astribank PRI
158                 '(WCBRI)', # has selectable NT/TE modes via dahdi_cfg
159 );
160
161 our $DAHDI_BRI_NET = 'bri_net';
162 our $DAHDI_BRI_CPE = 'bri_cpe';
163
164 our $DAHDI_PRI_NET = 'pri_net';
165 our $DAHDI_PRI_CPE = 'pri_cpe';
166
167 sub init_proto($$) {
168         my $self = shift;
169         my $proto = shift;
170
171         $self->{PROTO} = $proto;
172         if($proto eq 'E1') {
173                 $self->{DCHAN_IDX} = 15;
174                 $self->{BCHAN_LIST} = [ 0 .. 14, 16 .. 30 ];
175         } elsif($proto eq 'T1') {
176                 $self->{DCHAN_IDX} = 23;
177                 $self->{BCHAN_LIST} = [ 0 .. 22 ];
178         }
179         $self->{TYPE} = "${proto}_$self->{TERMTYPE}";
180 }
181
182 sub get_digital_spantype {
183         my $span_no = shift;
184         my @lines = split /\n/, `dahdi_scan`;
185         my $found_span = 0;
186         foreach my $line (@lines) {
187                 if (! $found_span) {
188                         if ($line =~ m/\[$span_no\]/) {
189                                 $found_span = 1;
190                         }
191                 } else {
192                         if ($line !~ m/^\[/) {
193                                 if ($line =~ m/digital-(TE|NT)/ ){
194                                         return $1;
195                                 }
196                         } else {
197                                 $found_span = 0;
198                         }
199                 }
200         }
201         die "Cannot determine digital spantype";
202 }
203
204 sub new($$) {
205         my $pack = shift or die "Wasn't called as a class method\n";
206         my $proc_file = shift or die "Missing a proc file parameter\n";
207         $proc_file =~ m{[^/]*/(\d+)$};
208         my $num = $1 or die " Invalid span file name: $proc_file\n";
209         my $self = { NUM => $num };
210         bless $self, $pack;
211         $self->{TYPE} = "UNKNOWN";
212         open(F, "$proc_file") or die "Failed to open '$proc_file\n";
213         my $head = <F>;
214         chomp $head;
215         $self->{IS_DIGITAL} = 0;
216         $self->{IS_BRI} = 0;
217         $self->{IS_PRI} = 0;
218         $self->{TERMTYPE} = "UNKNOWN";
219         foreach my $cardtype (@bri_strings) {
220                 if($head =~ m/$cardtype/) {
221                         my $termtype = $1;
222                         if ($1 eq 'B4XXP') {
223                                 $termtype = get_digital_spantype($num);
224                         }
225                         if ($1 eq 'WCBRI') {
226                                 $termtype = 'TE';
227                         }
228                         $self->{IS_DIGITAL} = 1;
229                         $self->{IS_BRI} = 1;
230                         $self->{TERMTYPE} = $termtype;
231                         $self->{TYPE} = "BRI_$termtype";
232                         $self->{DCHAN_IDX} = 2;
233                         $self->{BCHAN_LIST} = [ 0, 1 ];
234                         $self->init_proto('BRI');
235                         last;
236                 }
237         }
238         foreach my $cardtype (@pri_strings) {
239                 if($head =~ m/$cardtype/) {
240                         my @info;
241
242                         push(@info, $1) if defined $1;
243                         push(@info, $2) if defined $2;
244                         my ($proto) = grep(/(E1|T1|J1)/, @info);
245                         $proto = 'UNKNOWN' unless defined $proto;
246                         my ($termtype) = grep(/(NT|TE)/, @info);
247                         $termtype = 'UNKNOWN' unless defined $termtype;
248
249                         $self->{IS_DIGITAL} = 1;
250                         $self->{IS_PRI} = 1;
251                         $self->{TERMTYPE} = $termtype;
252                         $self->init_proto($proto);
253                         last;
254                 }
255         }
256         $self->{IS_SOFT_TERM_TYPE} = 0;
257         foreach my $cardtype (@soft_term_type_strings) {
258                 if($head =~ m/$cardtype/) {
259                         $self->{IS_SOFT_TERM_TYPE} = 1;
260                         last;
261                 }
262         }
263
264         if (($self->is_soft_term_type == 0) and ($self->termtype eq "UNKNOWN")) {
265                 $self->{IS_SOFT_TERM_TYPE} = 1;
266         }
267
268         ($self->{NAME}, $self->{DESCRIPTION}) = (split(/\s+/, $head, 4))[2, 3];
269         $self->{IS_DAHDI_SYNC_MASTER} =
270                 ($self->{DESCRIPTION} =~ /\(MASTER\)/) ? 1 : 0;
271         $self->{CHANS} = [];
272         my @channels;
273         my $index = 0;
274         my @channel_lines = <F>;
275         foreach (@channel_lines) {
276                 chomp;
277                 s/^\s*//;
278                 s/\s*$//;
279                 next unless /\S/;
280                 next unless /^\s*\d+/; # must be a real channel string.
281                 my $c = Dahdi::Chans->new($self, $index, $_);
282                 push(@channels, $c);
283                 $index++;
284         }
285         close F;
286         if($self->is_pri()) {
287                 # Check for PRI with unknown type strings
288                 if($index == 31) {
289                         if($self->{PROTO} eq 'UNKNOWN') {
290                                 $self->init_proto('E1');
291                         } elsif($self->{PROTO} ne 'E1')  {
292                                 die "$index channels in a $self->{PROTO} span";
293                         }
294                 } elsif($index == 24) {
295                         if($self->{PROTO} eq 'UNKNOWN') {
296                                 $self->init_proto('T1');        # FIXME: J1?
297                         } elsif($self->{PROTO} ne 'T1') {
298                                 die "$index channels in a $self->{PROTO} span";
299                         }
300                 }
301         }
302         @channels = sort { $a->num <=> $b->num } @channels;
303         $self->{CHANS} = \@channels;
304         $self->{YELLOW} = undef;
305         $self->{CRC4} = undef;
306         $self->{SOFTNTTE} = undef;
307         $self->{TERMINATION} = undef;
308         if($self->is_bri()) {
309                 $self->{CODING} = 'ami';
310                 $self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}];
311                 $self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ];
312                 # Infer some info from channel name:
313                 my $first_chan = ($self->chans())[0] || die "$0: No channels in span #$num\n";
314                 my $chan_fqn = $first_chan->fqn();
315                 if($chan_fqn =~ m(ZTHFC.*/|ztqoz.*/|XPP_BRI_.*|B4/.*|WCBRI/.*)) {               # BRI
316                         if($chan_fqn =~ m(WCBRI/.*)) {          # make sure to set termination resistors on hybrid cards
317                                 $self->{TERMINATION} = 'term';
318                                 $self->{SOFTNTTE} = 'te';
319                         }
320                         $self->{FRAMING} = 'ccs';
321                         $self->{SWITCHTYPE} = 'euroisdn';
322                         $self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $DAHDI_BRI_NET : $DAHDI_BRI_CPE ;
323                 } elsif($chan_fqn =~ m(ztgsm.*/)) {                             # Junghanns's GSM cards. 
324                         $self->{FRAMING} = 'ccs';
325                         $self->{SIGNALLING} = 'gsm';
326                 }
327         }
328         if($self->is_pri()) {
329                 $self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}];
330                 $self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ];
331                 if($self->{PROTO} eq 'E1') {
332                         $self->{CODING} = 'hdb3';
333                         $self->{FRAMING} = 'ccs';
334                         $self->{SWITCHTYPE} = 'euroisdn';
335                         $self->{CRC4} = 'crc4';
336                 } elsif($self->{PROTO} eq 'T1') {
337                         $self->{CODING} = 'b8zs';
338                         $self->{FRAMING} = 'esf';
339                         $self->{SWITCHTYPE} = 'national';
340                 } else {
341                         die "'$self->{PROTO}' unsupported yet";
342                 }
343         }
344         return $self;
345 }
346
347 sub bchans($) {
348         my $self = shift || die;
349
350         return @{$self->{BCHANS}};
351 }
352
353 sub set_termtype($$) {
354         my $span = shift || die;
355         my $termtype = shift || die;
356         $span->{TERMTYPE} = $termtype;
357         if ($span->is_pri) {
358                 $span->{SIGNALLING} = ($termtype eq 'NT') ? $DAHDI_PRI_NET : $DAHDI_PRI_CPE ;
359         } elsif ($span->is_bri) {
360                 $span->{SIGNALLING} = ($termtype eq 'NT') ? $DAHDI_BRI_NET : $DAHDI_BRI_CPE ;
361         }
362         $span->{TYPE} = $span->proto . "_$termtype";
363 }
364
365 sub pri_set_fromconfig($$) {
366         my $span = shift || die;
367         my $genconf = shift || die;
368         my $name = $span->name;
369         return unless $span->is_soft_term_type;
370 #       if(defined $termtype) {
371 #               die "Termtype for $name already defined as $termtype\n";
372 #       }
373         my $pri_termtype = $genconf->{pri_termtype};
374         my @pri_specs;
375         if(defined $pri_termtype) {
376                 @pri_specs = @{$pri_termtype};
377         }
378         push(@pri_specs , 'SPAN/* TE');         # Default
379         my @patlist = ( "SPAN/" . $span->num );
380         my $xpd = Dahdi::Xpp::xpd_of_span($span);
381         if(defined $xpd) {
382                 my $xbus = $xpd->xbus;
383                 my $xbus_name = $xbus->name;
384                 my $xpd_name = "XPD-" . $xpd->id;
385                 my $label = $xbus->label;
386                 my $connector = $xbus->connector;
387                 #print "DEBUG: '$xbus_name/$xpd_name' LABEL='$label' CONNECTOR='$connector'\n";
388                 push(@patlist, "NUM/$xbus_name/$xpd_name");
389                 push(@patlist, "LABEL/$label/$xpd_name");
390                 push(@patlist, "CONNECTOR/$connector/$xpd_name");
391         }
392         #print STDERR "PATLIST=@patlist\n";
393         my $match_termtype;
394 SPEC:
395         for(my $i = 0; $i < @pri_specs; $i++) {
396                 my $spec = $pri_specs[$i];
397                 #print STDERR "spec: $spec\n";
398                 my ($match, $termtype) = split(/\s+/, $spec);
399                 next unless defined $match and defined $termtype;
400                 # Convert "globs" to regex
401                 $match =~ s/\*/.*/g;
402                 $match =~ s/\?/./g;
403                 #print STDERR "match: $match\n";
404                 foreach my $pattern (@patlist) {
405                         #print STDERR "testmatch: $pattern =~ $match\n";
406                         if($pattern =~ /^$match$/) {
407                                 #print STDERR "MATCH '$pattern' ~ '$match' termtype=$termtype\n";
408                                 $match_termtype = $termtype;
409                                 last SPEC;
410                         }
411                 }
412         }
413         die "Unknown pri_termtype" unless defined $match_termtype;
414         $span->set_termtype($match_termtype);
415 }
416
417
418 1;