7edfc58acc48845c96b5d4631ab4ea398526c824
[dahdi/tools.git] / xpp / perl_modules / Dahdi / Xpp / Xpd.pm
1 package Dahdi::Xpp::Xpd;
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::Xpp;
13 use Dahdi::Xpp::Line;
14
15 =head1 NAME
16
17 Dahdi::Xpp::Xpd - Perl interface to the Xorcom Astribank XPDs (spans)
18
19 =head1 SYNOPSIS
20
21   # Listing all Astribanks:
22   use Dahdi::Xpp;
23   # scans hardware:
24   my @xbuses = Dahdi::Xpp::xbuses("SORT_CONNECTOR");
25   for my $xbus (@xbuses) {
26     print $xbus->name." (".$xbus->label .", ". $xbus->connector .")\n";
27     for my $xpd ($xbus->xpds) {
28       print " - ".$xpd->fqn,"\n";
29     }
30   }
31
32 =head1 xbus
33
34 The parent L<Dahdi::Xpp::Xbus>
35
36 =head1 id
37
38 The two-digit ID in the Xbus. Normally 0I<x> for digital spans and 
39 I<x>0 for analog ones (for some digit, I<x>).
40
41 =head1 unit
42
43 First digit of the ID. Zero-based number of the module inside the
44 Astribank,
45
46 =head1 subunit
47
48 Second digit of the ID. Zero-based sub-part inside the module.
49 Applicable only to digital (BRI/PRI) modules and always 0 for others.
50
51 =head1 FQN
52
53 Textual name: E.g. C<XPD-10>.
54
55 =head1 sysfs_dir
56
57 The SysFS directory with information about the module. E.g.
58 C</sys/bus/astribanks/devices/xbus-00/00:1:0>.
59
60 =head1 channels
61
62 A list of L<Dahdi::Xpp:Chan> channels of this span. In a scalar context
63 this will be the number of channels in the span.
64
65 =head1 spanno
66
67 0 if not registered with Dahdi. Otherwise, the number of the span it is
68 registered as.
69
70 =head1 type
71
72 The type of the XPD. One of: C<FXS>, C<FXO>, C<BRI_TE>, C<BRI_NT>,
73 C<E1>, C<T1>.
74
75 =head1 is_bri
76
77 True if this XPD is BRI.
78
79 =head1 is_pri
80
81 True if this XPD is PRI (E1/T1).
82
83 =head1 is_digital
84
85 True if this XPD is a digital port (BRI / PRI).
86
87 =head1 termtype
88
89 For a digital span: C<TE> or C<NT>.
90
91 =head1 dchan_hardhdlc
92
93 For a BRI port: true if the driver with hardhdlc support (rather than
94 bri_dchan).
95
96 =cut
97
98 my %file_warned;        # Prevent duplicate warnings about same file.
99
100 sub xpd_attr_path($@) {
101         my $self = shift || die;
102         my ($busnum, $unitnum, $subunitnum, @attr) = (
103                 $self->xbus->num,
104                 $self->unit,
105                 $self->subunit,
106                 @_);
107         foreach my $attr (@attr) {
108                 my $file = sprintf "$Dahdi::Xpp::sysfs_xpds/%02d:%1d:%1d/$attr",
109                    $busnum, $unitnum, $subunitnum;
110                 next unless -f $file;
111                 return $file;
112         }
113         return undef;
114 }
115
116 my %attr_missing_warned;        # Prevent duplicate warnings
117
118 sub xpd_driver_getattr($$) {
119         my $xpd = shift || die;
120         my $attr = shift || die;
121         $attr = lc($attr);
122         my ($busnum, $unitnum, $subunitnum) = ($xpd->xbus->num, $xpd->unit, $xpd->subunit);
123         my $file = sprintf "$Dahdi::Xpp::sysfs_xpds/%02d:%1d:%1d/driver/$attr",
124                         $busnum, $unitnum, $subunitnum;
125         if(!defined($file)) {
126                 warn "$0: xpd_driver_getattr($attr) -- Missing attribute.\n" if
127                         $attr_missing_warned{$attr};
128                 return undef;
129         }
130         open(F, $file) || return undef;
131         my $val = <F>;
132         close F;
133         chomp $val;
134         return $val;
135 }
136
137 sub xpd_getattr($$) {
138         my $xpd = shift || die;
139         my $attr = shift || die;
140         $attr = lc($attr);
141         my $file = $xpd->xpd_attr_path(lc($attr));
142
143         if(!defined($file)) {
144                 warn "$0: xpd_getattr($attr) -- Missing attribute.\n" if
145                         $attr_missing_warned{$attr};
146                 return undef;
147         }
148         open(F, $file) || return undef;
149         my $val = <F>;
150         close F;
151         chomp $val;
152         return $val;
153 }
154
155 sub xpd_setattr($$$) {
156         my $xpd = shift || die;
157         my $attr = shift || die;
158         my $val = shift;
159         $attr = lc($attr);
160         my $file = xpd_attr_path($xpd, $attr);
161         my $oldval = $xpd->xpd_getattr($attr);
162         open(F, ">$file") or die "Failed to open $file for writing: $!";
163         print F "$val";
164         if(!close(F)) {
165                 if($! == 17) {  # EEXISTS
166                         # good
167                 } else {
168                         return undef;
169                 }
170         }
171         return $oldval;
172 }
173
174 sub blink($$) {
175         my $self = shift;
176         my $on = shift;
177         my $result = $self->xpd_getattr("blink");
178         if(defined($on)) {              # Now change
179                 $self->xpd_setattr("blink", ($on)?"0xFFFF":"0");
180         }
181         return $result;
182 }
183
184 sub dahdi_registration($$) {
185         my $self = shift;
186         my $on = shift;
187         my $result;
188         my $file = $self->xpd_attr_path("span", "dahdi_registration");
189         die "$file is missing" unless -f $file;
190         # First query
191         open(F, "$file") or die "Failed to open $file for reading: $!";
192         $result = <F>;
193         chomp $result;
194         close F;
195         if(defined($on) and $on ne $result) {           # Now change
196                 open(F, ">$file") or die "Failed to open $file for writing: $!";
197                 print F ($on)?"1":"0";
198                 if(!close(F)) {
199                         if($! == 17) {  # EEXISTS
200                                 # good
201                         } else {
202                                 undef $result;
203                         }
204                 }
205         }
206         return $result;
207 }
208
209 sub xpds_by_spanno() {
210         my @xbuses = Dahdi::Xpp::xbuses();
211         my @xpds = map { $_->xpds } @xbuses;
212         @xpds = grep { $_->spanno } @xpds;
213         @xpds = sort { $a->spanno <=> $b->spanno } @xpds;
214         my @spanno = map { $_->spanno } @xpds;
215         my @idx;
216         @idx[@spanno] = @xpds;  # The spanno is the index now
217         return @idx;
218 }
219
220 sub new($$$$$) {
221         my $pack = shift or die "Wasn't called as a class method\n";
222         my $xbus = shift || die;
223         my $unit = shift;       # May be zero
224         my $subunit = shift;    # May be zero
225         my $sysfsdir = shift || die;
226         my $self = {
227                 XBUS            => $xbus,
228                 ID              => sprintf("%1d%1d", $unit, $subunit),
229                 FQN             => $xbus->name . "/" . "XPD-$unit$subunit",
230                 UNIT            => $unit,
231                 SUBUNIT         => $subunit,
232                 SYSFS_DIR       => $sysfsdir,
233                 };
234         bless $self, $pack;
235         my @offhook = split / /, ($self->xpd_getattr('offhook'));
236         $self->{CHANNELS} = @offhook;
237         my $type = $self->xpd_getattr('type');
238         my $span = $self->xpd_getattr('span');
239         my $timing_priority = $self->xpd_getattr('timing_priority');
240         $self->{SPANNO} = $span;
241         $self->{TYPE} = $type;
242         $self->{TIMING_PRIORITY} = $timing_priority;
243         if($type =~ /BRI_(NT|TE)/) {
244                 $self->{IS_BRI} = 1;
245                 $self->{TERMTYPE} = $1;
246                 $self->{DCHAN_HARDHDLC} = $self->xpd_driver_getattr('dchan_hardhdlc');
247         } elsif($type =~ /[ETJ]1/) {
248                 $self->{IS_PRI} = 1;
249                 # older drivers may not have 'timing_priority'
250                 # attribute. Preserve original behaviour:
251                 if(defined($timing_priority) && ($timing_priority == 0)) {
252                         $self->{TERMTYPE} = 'NT';
253                 } else {
254                         $self->{TERMTYPE} = 'TE';
255                 }
256         }
257         $self->{IS_DIGITAL} = ( $self->{IS_BRI} || $self->{IS_PRI} );
258         Dahdi::Xpp::Line->create_all($self);
259         return $self;
260 }
261
262 #------------------------------------
263 # static xpd related helper functions
264 #------------------------------------
265
266 # Returns only the telephony XPD's from a list
267 # of one or more XPD's.
268 # I.e: Filters-out ECHO cancelers
269 sub telephony_devs {
270         my @devs = grep { $_->channels } @_;
271         return @devs;
272 }
273
274 sub format_rank($$) {
275         my ($rank, $prio) = @_;
276         my $width = 2;
277         # 0 is replaced with a character that is sorted *AFTER* numbers.
278         $prio = '_' x $width unless defined $prio && $prio;
279         return sprintf "%${width}s-%s", $prio, $rank;
280 }
281
282 sub sync_priority_rank($) {
283         my $xpd = shift || die;
284         my $prio = $xpd->timing_priority;
285         # The @rank array is ordered by priority of sync (good to bad)
286         # It is used when timing_priority is not defined (analog) or
287         # is 0 (NT).
288         my @rank = (
289                 ($xpd->is_pri and defined($xpd->termtype) and $xpd->termtype eq 'TE'),
290                 ($xpd->is_bri and defined($xpd->termtype) and $xpd->termtype eq 'TE'),
291                 ($xpd->type eq 'FXO'),
292                 ($xpd->is_pri),
293                 ($xpd->is_bri),
294                 ($xpd->type eq 'FXS'),
295                 );
296         my $i;
297         for($i = 0; $i < @rank; $i++) {
298                 last if $rank[$i];
299         }
300         return format_rank($i, $prio);
301 }
302
303 # An XPD sync priority comparator for sort()
304 sub sync_priority_compare() {
305         my $rank_a = sync_priority_rank($a);
306         my $rank_b = sync_priority_rank($b);
307         #print STDERR "DEBUG(rank): $rank_a (", $a->fqn, ") $rank_b (", $b->fqn, ")\n";
308         return $rank_a cmp $rank_b;     # The easy case
309 }
310
311 # For debugging: show a list of XPD's with relevant sync info.
312 sub show_xpd_rank(@) {
313         print STDERR "XPD's by rank\n";
314         foreach my $xpd (@_) {
315                 my $type = $xpd->type;
316                 my $extra = "";
317                 my $rank = sync_priority_rank($xpd);
318                 if($xpd->is_digital) {
319                         $extra .= " termtype " . ($xpd->termtype || "UNKNOWN");
320                 }
321                 printf STDERR "%3s %-15s %s\n", $rank, $xpd->fqn, $extra;
322         }
323 }
324
325 sub xpds_by_rank(@) {
326         my @xpd_prio = sort sync_priority_compare @_;
327         #show_xpd_rank(@xpd_prio);
328         return @xpd_prio;
329 }
330
331 1;