1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
package Zaptel::Hardware;
#
# Written by Oron Peled <oron@actcom.co.il>
# Copyright (C) 2007, Xorcom
# This program is free software; you can redistribute and/or
# modify it under the same terms as Perl itself.
#
# $Id$
#
use strict;
=head1 NAME
Zaptel::Hardware - Perl interface to a Zaptel devices listing
use Zaptel::Hardware;
my $hardware = Zaptel::Hardware->scan;
# mini zaptel_hardware:
foreach my $device ($hardware->device_list) {
print "Vendor: device->{VENDOR}, Product: $device->{PRODUCT}\n"
}
# let's see if there are devices without loaded drivers, and sugggest
# drivers to load:
my @to_load = ();
foreach my $device ($hardware->device_list) {
if (! $device->{LOADED} ) {
push @to_load, ($device->${DRIVER});
}
}
if (@to_load) {
print "To support the extra devices you probably need to run:\n"
print " modprobe ". (join ' ', @to_load). "\n";
}
This module provides information about available Zaptel devices on the
system. It identifies devices by (USB/PCI) bus IDs.
=head1 Device Attributes
As usual, object attributes can be used in either upp-case or
lower-case, or lower-case functions.
=head2 bus_type
'PCI' or 'USB'.
=head2 description
A one-line description of the device.
=head2 driver
Name of a Zaptel device driver that should handle this device. This is
based on a pre-made list.
=head2 vendor, product, subvendor, subproduct
The PCI and USB vendor ID, product ID, sub-vendor ID and sub-product ID.
(The standard short lspci and lsusb listings show only vendor and
product IDs).
=head2 loaded
If the device is handled by a module - the name of the module. Else -
undef.
=head2 priv_device_name
A string that shows the "location" of that device on the bus.
=head2 is_astribank
True if the device is a Xorcom Astribank (which may provide some extra
attributes).
=head2 serial
(Astribank-specific attrribute) - the serial number string of the
Astribank.
=cut
#
# A global hardware handle
#
my %hardware_list = (
'PCI' => [],
'USB' => [],
);
sub new($$) {
my $pack = shift || die "Wasn't called as a class method\n";
my $name = shift || die "$0: Missing device name";
my $type = shift || die "$0: Missing device type";
my $dev = {};
$dev->{'BUS_TYPE'} = $type;
$dev->{IS_ASTRIBANK} = 0 unless defined $dev->{'IS_ASTRIBANK'};
$dev->{'HARDWARE_NAME'} = $name;
return $dev;
}
=head1 device_list()
Returns a list of the hardware devices on the system.
You must run scan() first for this function to run meaningful output.
=cut
sub device_list($) {
my $pack = shift || die;
my @types = @_;
my @list;
@types = qw(USB PCI) unless @types;
foreach my $t (@types) {
my $lst = $hardware_list{$t};
@list = ( @list, @{$lst} );
}
return @list;
}
sub device_by_hwname($$) {
my $pack = shift || die;
my $name = shift || die;
my @list = device_list('localcall');
my @good = grep { $_->hardware_name eq $name } @list;
return undef unless @good;
@good > 1 && die "$pack: Multiple matches for '$name': @good";
return $good[0];
}
=head1 drivers()
Returns a list of drivers (currently sorted by name) that are used by
the devices in the current system (regardless to whether or not they are
loaded.
=cut
sub drivers($) {
my $self = shift || die;
my @devs = device_list('localcall');
my @drvs = map { $_->{DRIVER} } @devs;
# Make unique
my %drivers;
@drivers{@drvs} = 1;
return sort keys %drivers;
}
=head1 scan()
Scan the system for Zaptel devices (PCI and USB). Returns nothing but
must be run to initialize the module.
=cut
my $hardware_scanned;
sub scan($) {
my $pack = shift || die;
return if $hardware_scanned++;
foreach my $type (qw(PCI USB)) {
eval "use Zaptel::Hardware::$type";
die $@ if $@;
$hardware_list{$type} = [ "Zaptel::Hardware::$type"->scan_devices ];
}
}
sub import {
Zaptel::Hardware->scan unless grep(/\bnoscan\b/i, @_);
}
sub showall {
my $pack = shift || die;
my @devs;
my $printer = sub {
my $title = shift;
my @devs = @_;
return unless @devs;
printf "%s:\n", $title;
foreach my $dev (@devs) {
printf "\t%s\n", $dev->hardware_name;
foreach my $k (sort keys %{$dev}) {
my $v = $dev->{$k};
if($k eq 'MPPINFO') {
printf "\t\tMPPINFO:\n";
eval "use Zaptel::Xpp::Mpp";
die $@ if $@;
$v->showinfo("\t\t ");
} else {
printf "\t\t%-20s %s\n", $k, $v;
}
}
}
};
foreach my $type (qw(USB PCI)) {
my $lst = $hardware_list{$type};
&$printer("$type devices", @{$lst});
}
}
1;
|
