dbfab003b2329de8b2c848e8003439d83bc56293
[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 my %file_warned;        # Prevent duplicate warnings about same file.
49
50 sub xbus_attr_path($$) {
51         my ($busnum, @attr) = @_;
52         foreach my $attr (@attr) {
53                 my $file = sprintf "$Dahdi::Xpp::sysfs_astribanks/xbus-%02d/$attr", $busnum;
54                 next unless -f $file;
55                 return $file;
56         }
57         return undef;
58 }
59
60 sub xbus_getattr($$) {
61         my $xbus = shift || die;
62         my $attr = shift || die;
63         $attr = lc($attr);
64         my $file = xbus_attr_path($xbus->num, lc($attr));
65
66         open(F, $file) || die "Failed opening '$file': $!";
67         my $val = <F>;
68         close F;
69         chomp $val;
70         return $val;
71 }
72
73 sub read_attrs() {
74         my $xbus = shift || die;
75         my @attrnames = qw(CONNECTOR LABEL STATUS);
76         my @attrs;
77
78         foreach my $attr (@attrnames) {
79                 my $val = xbus_getattr($xbus, $attr);
80                 if($attr eq 'STATUS') {
81                         # Some values are in all caps as well
82                         $val = uc($val);
83                 } elsif($attr eq 'CONNECTOR') {
84                         $val =~ s/^/@/; # Add prefix
85                 } elsif($attr eq 'LABEL') {
86                         # Fix badly burned labels.
87                         $val =~ s/[[:^print:]]/_/g;
88                 }
89                 $xbus->{$attr} = $val;
90         }
91 }
92
93 sub transport_type($$) {
94         my $xbus = shift || die;
95         my $xbus_dir = shift;
96         my $transport = "$xbus_dir/transport";
97         if(-e "$transport/ep_00") {     # It's USB
98                 $xbus->{TRANSPORT_TYPE} = 'USB';
99         } else {
100                 warn "Unkown transport in $xbus_dir\n";
101                 undef $xbus->{TRANSPORT_TYPE};
102         }
103         return $xbus->{TRANSPORT_TYPE};
104 }
105
106 sub read_xpdnames($) {
107         my $xbus_num = shift || die;
108         my $xbus_dir = "$Dahdi::Xpp::sysfs_astribanks/xbus-$xbus_num";
109         my $pat = sprintf "%s/xbus-%02d/[0-9][0-9]:[0-9]:[0-9]", $Dahdi::Xpp::sysfs_astribanks, $xbus_num;
110         my @xpdnames;
111
112         #print STDERR "read_xpdnames($xbus_num): $pat\n";
113         foreach (glob $pat) {
114                 die "Bad /sys entry: '$_'" unless m/^.*\/([0-9][0-9]):([0-9]):([0-9])$/;
115                 my ($busnum, $unit, $subunit) = ($1, $2, $3);
116                 my $name = sprintf("%02d:%1d:%1d", $1, $2, $3);
117                 #print STDERR "\t> $_ ($name)\n";
118                 push(@xpdnames, $name);
119         }
120         return @xpdnames;
121 }
122
123 sub new($$) {
124         my $pack = shift or die "Wasn't called as a class method\n";
125         my $num = shift;
126         my $xbus_dir = "$Dahdi::Xpp::sysfs_astribanks/xbus-$num";
127         my $self = {
128                 NUM             => $num,
129                 NAME            => "XBUS-$num",
130                 SYSFS_DIR       => $xbus_dir,
131                 };
132         bless $self, $pack;
133         $self->read_attrs;
134         # Get transport related info
135         my $transport = "$xbus_dir/transport";
136         my $transport_type = $self->transport_type($xbus_dir);
137         if(defined $transport_type) {
138                 my $tt = "Dahdi::Hardware::$transport_type";
139                 my $hw = $tt->set_transport($self, $xbus_dir);
140                 #printf STDERR "Xbus::new transport($transport_type): %s\n", $hw->{HARDWARE_NAME};
141         }
142         my @xpdnames;
143         my @xpds;
144         die "OLD DRIVER: missing '$transport'\n" unless -e $transport;
145         @xpdnames = read_xpdnames($num);
146         foreach my $xpdstr (@xpdnames) {
147                 my ($busnum, $unit, $subunit) = split(/:/, $xpdstr);
148                 my $xpd = Dahdi::Xpp::Xpd->new($self, $unit, $subunit, "$xbus_dir/$xpdstr");
149                 push(@xpds, $xpd);
150         }
151         @{$self->{XPDS}} = sort { $a->id <=> $b->id } @xpds;
152         return $self;
153 }
154
155 sub pretty_xpds($) {
156                 my $xbus = shift;
157                 my @xpds = sort { $a->id <=> $b->id } $xbus->xpds();
158                 my @xpd_types = map { $_->type } @xpds;
159                 my $last_type = '';
160                 my $mult = 0;
161                 my $xpdstr = '';
162                 foreach my $curr (@xpd_types) {
163                         if(!$last_type || ($curr eq $last_type)) {
164                                 $mult++;
165                         } else {
166                                 if($mult == 1) {
167                                         $xpdstr .= "$last_type ";
168                                 } elsif($mult) {
169                                         $xpdstr .= "$last_type*$mult ";
170                                 }
171                                 $mult = 1;
172                         }
173                         $last_type = $curr;
174                 }
175                 if($mult == 1) {
176                         $xpdstr .= "$last_type ";
177                 } elsif($mult) {
178                         $xpdstr .= "$last_type*$mult ";
179                 }
180                 $xpdstr =~ s/\s*$//;    # trim trailing space
181                 return $xpdstr;
182 }
183
184 1;