xpp: sysfs access cleanups
[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 $xbus = $self->xbus;
103         my ($busnum, $unitnum, $subunitnum, @attr) = (
104                 $xbus->num,
105                 $self->unit,
106                 $self->subunit,
107                 @_);
108         foreach my $attr (@attr) {
109                 my $file = sprintf "%s/%02d:%1d:%1d/$attr",
110                    $xbus->sysfs_dir, $busnum, $unitnum, $subunitnum;
111                 next unless -f $file;
112                 return $file;
113         }
114         return undef;
115 }
116
117 my %attr_missing_warned;        # Prevent duplicate warnings
118
119 sub xpd_driver_getattr($$) {
120         my $xpd = shift || die;
121         my $attr = shift || die;
122         $attr = lc($attr);
123         my ($busnum, $unitnum, $subunitnum) = ($xpd->xbus->num, $xpd->unit, $xpd->subunit);
124         my $file = sprintf "$Dahdi::Xpp::sysfs_xpds/%02d:%1d:%1d/driver/$attr",
125                         $busnum, $unitnum, $subunitnum;
126         if(!defined($file)) {
127                 warn "$0: xpd_driver_getattr($attr) -- Missing attribute.\n" if
128                         $attr_missing_warned{$attr};
129                 return undef;
130         }
131         open(F, $file) || return undef;
132         my $val = <F>;
133         close F;
134         chomp $val;
135         return $val;
136 }
137
138 sub xpd_getattr($$) {
139         my $xpd = shift || die;
140         my $attr = shift || die;
141         $attr = lc($attr);
142         my $file = $xpd->xpd_attr_path(lc($attr));
143
144         if(!defined($file)) {
145                 warn "$0: xpd_getattr($attr) -- Missing attribute.\n" if
146                         $attr_missing_warned{$attr};
147                 return undef;
148         }
149         open(F, $file) || return undef;
150         my $val = <F>;
151         close F;
152         chomp $val;
153         return $val;
154 }
155
156 sub xpd_setattr($$$) {
157         my $xpd = shift || die;
158         my $attr = shift || die;
159         my $val = shift;
160         $attr = lc($attr);
161         my $file = xpd_attr_path($xpd, $attr);
162         my $oldval = $xpd->xpd_getattr($attr);
163         open(F, ">$file") or die "Failed to open $file for writing: $!";
164         print F "$val";
165         if(!close(F)) {
166                 if($! == 17) {  # EEXISTS
167                         # good
168                 } else {
169                         return undef;
170                 }
171         }
172         return $oldval;
173 }
174
175 sub blink($$) {
176         my $self = shift;
177         my $on = shift;
178         my $result = $self->xpd_getattr("blink");
179         if(defined($on)) {              # Now change
180                 $self->xpd_setattr("blink", ($on)?"0xFFFF":"0");
181         }
182         return $result;
183 }
184
185 sub dahdi_registration($$) {
186         my $self = shift;
187         my $on = shift;
188         my $result;
189         my $file = $self->xpd_attr_path("span", "dahdi_registration");
190         die "$file is missing" unless -f $file;
191         # First query
192         open(F, "$file") or die "Failed to open $file for reading: $!";
193         $result = <F>;
194         chomp $result;
195         close F;
196         if(defined($on) and $on ne $result) {           # Now change
197                 open(F, ">$file") or die "Failed to open $file for writing: $!";
198                 print F ($on)?"1":"0";
199                 if(!close(F)) {
200                         if($! == 17) {  # EEXISTS
201                                 # good
202                         } else {
203                                 undef $result;
204                         }
205                 }
206         }
207         return $result;
208 }
209
210 sub xpds_by_spanno() {
211         my @xbuses = Dahdi::Xpp::xbuses();
212         my @xpds = map { $_->xpds } @xbuses;
213         @xpds = grep { $_->spanno } @xpds;
214         @xpds = sort { $a->spanno <=> $b->spanno } @xpds;
215         my @spanno = map { $_->spanno } @xpds;
216         my @idx;
217         @idx[@spanno] = @xpds;  # The spanno is the index now
218         return @idx;
219 }
220
221 sub new($$$) {
222         my $pack = shift or die "Wasn't called as a class method\n";
223         my $xbus = shift or die;
224         my $xpdstr = shift or die;
225         my $sysfsdir = sprintf "%s/%s", $xbus->sysfs_dir, $xpdstr;
226         my ($busnum, $unit, $subunit) = split(/:/, $xpdstr);
227         my $self = {
228                 XBUS            => $xbus,
229                 ID              => sprintf("%1d%1d", $unit, $subunit),
230                 FQN             => $xbus->name . "/" . "XPD-$unit$subunit",
231                 UNIT            => $unit,
232                 SUBUNIT         => $subunit,
233                 SYSFS_DIR       => $sysfsdir,
234                 };
235         bless $self, $pack;
236         my @offhook = split / /, ($self->xpd_getattr('offhook'));
237         $self->{CHANNELS} = @offhook;
238         my $type = $self->xpd_getattr('type');
239         my $span = $self->xpd_getattr('span');
240         my $timing_priority = $self->xpd_getattr('timing_priority');
241         $self->{SPANNO} = $span;
242         $self->{TYPE} = $type;
243         $self->{TIMING_PRIORITY} = $timing_priority;
244         if($type =~ /BRI_(NT|TE)/) {
245                 $self->{IS_BRI} = 1;
246                 $self->{TERMTYPE} = $1;
247                 $self->{DCHAN_HARDHDLC} = $self->xpd_driver_getattr('dchan_hardhdlc');
248         } elsif($type =~ /[ETJ]1/) {
249                 $self->{IS_PRI} = 1;
250                 # older drivers may not have 'timing_priority'
251                 # attribute. Preserve original behaviour:
252                 if(defined($timing_priority) && ($timing_priority == 0)) {
253                         $self->{TERMTYPE} = 'NT';
254                 } else {
255                         $self->{TERMTYPE} = 'TE';
256                 }
257         }
258         $self->{IS_DIGITAL} = ( $self->{IS_BRI} || $self->{IS_PRI} );
259         Dahdi::Xpp::Line->create_all($self);
260         return $self;
261 }
262
263 #------------------------------------
264 # static xpd related helper functions
265 #------------------------------------
266
267 # Returns only the telephony XPD's from a list
268 # of one or more XPD's.
269 # I.e: Filters-out ECHO cancelers
270 sub telephony_devs {
271         my @devs = grep { $_->channels } @_;
272         return @devs;
273 }
274
275 sub format_rank($$) {
276         my ($rank, $prio) = @_;
277         my $width = 2;
278         # 0 is replaced with a character that is sorted *AFTER* numbers.
279         $prio = '_' x $width unless defined $prio && $prio;
280         return sprintf "%${width}s-%s", $prio, $rank;
281 }
282
283 sub sync_priority_rank($) {
284         my $xpd = shift || die;
285         my $prio = $xpd->timing_priority;
286         # The @rank array is ordered by priority of sync (good to bad)
287         # It is used when timing_priority is not defined (analog) or
288         # is 0 (NT).
289         my @rank = (
290                 ($xpd->is_pri and defined($xpd->termtype) and $xpd->termtype eq 'TE'),
291                 ($xpd->is_bri and defined($xpd->termtype) and $xpd->termtype eq 'TE'),
292                 ($xpd->type eq 'FXO'),
293                 ($xpd->is_pri),
294                 ($xpd->is_bri),
295                 ($xpd->type eq 'FXS'),
296                 );
297         my $i;
298         for($i = 0; $i < @rank; $i++) {
299                 last if $rank[$i];
300         }
301         return format_rank($i, $prio);
302 }
303
304 # An XPD sync priority comparator for sort()
305 sub sync_priority_compare() {
306         my $rank_a = sync_priority_rank($a);
307         my $rank_b = sync_priority_rank($b);
308         #print STDERR "DEBUG(rank): $rank_a (", $a->fqn, ") $rank_b (", $b->fqn, ")\n";
309         return $rank_a cmp $rank_b;     # The easy case
310 }
311
312 # For debugging: show a list of XPD's with relevant sync info.
313 sub show_xpd_rank(@) {
314         print STDERR "XPD's by rank\n";
315         foreach my $xpd (@_) {
316                 my $type = $xpd->type;
317                 my $extra = "";
318                 my $rank = sync_priority_rank($xpd);
319                 if($xpd->is_digital) {
320                         $extra .= " termtype " . ($xpd->termtype || "UNKNOWN");
321                 }
322                 printf STDERR "%3s %-15s %s\n", $rank, $xpd->fqn, $extra;
323         }
324 }
325
326 sub xpds_by_rank(@) {
327         my @xpd_prio = sort sync_priority_compare @_;
328         #show_xpd_rank(@xpd_prio);
329         return @xpd_prio;
330 }
331
332 1;