xpp: sysfs access cleanups
[dahdi/tools.git] / xpp / perl_modules / Dahdi / Xpp / Xbus.pm
1 package Dahdi::Xpp::Xbus;
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::Hardware;
13 use Dahdi::Xpp::Xpd;
14
15 sub xpds($) {
16         my $xbus = shift;
17         return @{$xbus->{XPDS}};
18 }
19
20 sub by_number($) {
21         my $busnumber = shift;
22         die "Missing xbus number parameter" unless defined $busnumber;
23         my @xbuses = Dahdi::Xpp::xbuses();
24
25         my ($xbus) = grep { $_->num == $busnumber } @xbuses;
26         return $xbus;
27 }
28
29 sub by_label($) {
30         my $label = shift;
31         die "Missing xbus label parameter" unless defined $label;
32         my @xbuses = Dahdi::Xpp::xbuses();
33
34         my ($xbus) = grep { $_->label eq $label } @xbuses;
35         return $xbus;
36 }
37
38 sub get_xpd_by_number($$) {
39         my $xbus = shift;
40         my $xpdid = shift;
41         die "Missing XPD id parameter" unless defined $xpdid;
42         $xpdid = sprintf("%02d", $xpdid);
43         my @xpds = $xbus->xpds;
44         my ($wanted) = grep { $_->id eq $xpdid } @xpds;
45         return $wanted;
46 }
47
48 sub xbus_getattr($$) {
49         my $xbus = shift || die;
50         my $attr = shift || die;
51         $attr = lc($attr);
52         my $file = sprintf "%s/%s", $xbus->sysfs_dir, $attr;
53
54         open(F, $file) || die "Failed opening '$file': $!";
55         my $val = <F>;
56         close F;
57         chomp $val;
58         return $val;
59 }
60
61 sub read_attrs() {
62         my $xbus = shift || die;
63         my @attrnames = qw(CONNECTOR LABEL STATUS);
64         my @attrs;
65
66         foreach my $attr (@attrnames) {
67                 my $val = xbus_getattr($xbus, $attr);
68                 if($attr eq 'STATUS') {
69                         # Some values are in all caps as well
70                         $val = uc($val);
71                 } elsif($attr eq 'CONNECTOR') {
72                         $val =~ s/^/@/; # Add prefix
73                 } elsif($attr eq 'LABEL') {
74                         # Fix badly burned labels.
75                         $val =~ s/[[:^print:]]/_/g;
76                 }
77                 $xbus->{$attr} = $val;
78         }
79 }
80
81 sub transport_type($$) {
82         my $xbus = shift || die;
83         my $xbus_dir = shift;
84         my $transport = "$xbus_dir/transport";
85         if(-e "$transport/ep_00") {     # It's USB
86                 $xbus->{TRANSPORT_TYPE} = 'USB';
87         } else {
88                 warn "Unkown transport in $xbus_dir\n";
89                 undef $xbus->{TRANSPORT_TYPE};
90         }
91         return $xbus->{TRANSPORT_TYPE};
92 }
93
94 sub read_xpdnames($) {
95         my $xbus_dir = shift or die;
96         my $pat = sprintf "%s/[0-9][0-9]:[0-9]:[0-9]", $xbus_dir;
97         my @xpdnames;
98
99         #printf STDERR "read_xpdnames(%s): $pat\n", $xbus_dir;
100         foreach (glob $pat) {
101                 die "Bad /sys entry: '$_'" unless m/^.*\/([0-9][0-9]):([0-9]):([0-9])$/;
102                 my ($busnum, $unit, $subunit) = ($1, $2, $3);
103                 my $name = sprintf("%02d:%1d:%1d", $1, $2, $3);
104                 #print STDERR "\t> $_ ($name)\n";
105                 push(@xpdnames, $name);
106         }
107         return @xpdnames;
108 }
109
110 sub read_num($) {
111         my $self = shift or die;
112         my $xbus_dir = $self->sysfs_dir;
113         my @xpdnames = read_xpdnames($xbus_dir);
114         my $first = shift @xpdnames or die "No XPDs for '$xbus_dir'\n";
115         $first =~ /^(\d+\d+).*/;
116         return $1;
117 }
118
119 sub new($$) {
120         my $pack = shift or die "Wasn't called as a class method\n";
121         my $parent_dir = shift or die;
122         my $entry_dir = shift or die;
123         my $xbus_dir = "$parent_dir/$entry_dir";
124         my $self = {};
125         bless $self, $pack;
126         $self->{SYSFS_DIR} = $xbus_dir;
127         my $num = $self->read_num;
128         $self->{NUM} = $num;
129         $self->{NAME} = "XBUS-$num";
130         $self->read_attrs;
131         # Get transport related info
132         my $transport = "$xbus_dir/transport";
133         die "OLD DRIVER: missing '$transport'\n" unless -e $transport;
134         my $transport_type = $self->transport_type($xbus_dir);
135         if(defined $transport_type) {
136                 my $tt = "Dahdi::Hardware::$transport_type";
137                 my $hw = $tt->set_transport($self, $xbus_dir);
138                 #printf STDERR "Xbus::new transport($transport_type): %s\n", $hw->{HARDWARE_NAME};
139         }
140         my @xpdnames;
141         my @xpds;
142         @xpdnames = read_xpdnames($self->sysfs_dir);
143         foreach my $xpdstr (@xpdnames) {
144                 my $xpd = Dahdi::Xpp::Xpd->new($self, $xpdstr);
145                 push(@xpds, $xpd);
146         }
147         @{$self->{XPDS}} = sort { $a->id <=> $b->id } @xpds;
148         return $self;
149 }
150
151 sub pretty_xpds($) {
152                 my $xbus = shift;
153                 my @xpds = sort { $a->id <=> $b->id } $xbus->xpds();
154                 my @xpd_types = map { $_->type } @xpds;
155                 my $last_type = '';
156                 my $mult = 0;
157                 my $xpdstr = '';
158                 foreach my $curr (@xpd_types) {
159                         if(!$last_type || ($curr eq $last_type)) {
160                                 $mult++;
161                         } else {
162                                 if($mult == 1) {
163                                         $xpdstr .= "$last_type ";
164                                 } elsif($mult) {
165                                         $xpdstr .= "$last_type*$mult ";
166                                 }
167                                 $mult = 1;
168                         }
169                         $last_type = $curr;
170                 }
171                 if($mult == 1) {
172                         $xpdstr .= "$last_type ";
173                 } elsif($mult) {
174                         $xpdstr .= "$last_type*$mult ";
175                 }
176                 $xpdstr =~ s/\s*$//;    # trim trailing space
177                 return $xpdstr;
178 }
179
180 1;