Assorted away-tpope updates
[tpope-extra.git] / perl / Device / Nokia.pm
1 # Device::Nokia
2 # Author: Tim Pope
3
4 # A Perl class to interface GSM devices as AT modems
5 # Basically just a few enhancements to Device::Gsm
6
7 package Device::Nokia;
8 $Device$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
9
10 use strict;
11 use Device::Gsm;
12
13 @Device::Nokia::ISA = ('Device::Gsm');
14
15 #
16 # Who is the manufacturer of this device?
17 #
18 sub manufacturer() {
19         my $self = shift;
20         my($ok, $man);
21
22         # Test if manufacturer code command is supported
23         if( $self->test_command('+CGMI') ) {
24
25                 $self->atsend( 'AT+CGMI' . Device::Modem::CR );
26                 ($ok, $man) = $self->parse_answer();
27
28                 $self->log->write('info', 'manufacturer of this device appears to be ['.$man.']');
29
30         }
31
32         return $man || $ok;
33
34 }
35 #
36 # What is the model of this device?
37 #
38 sub model() {
39         my $self = shift;
40         my($code, $model);
41
42         # Test if manufacturer code command is supported
43         if( $self->test_command('+CGMM') ) {
44
45                 $self->atsend( 'AT+CGMM' . Device::Modem::CR );
46                 ($code, $model) = $self->parse_answer();
47
48                 $self->log->write('info', 'model of this device is ['.$model.']');
49
50         }
51
52         return $model || $code;
53 }
54
55 #
56 # Get mobile phone indicators
57 #
58 sub indicators() {
59         my $self = shift;
60         my($supported,$values,%results);
61
62         # Test if manufacturer code command is supported
63         if( $self->test_command('+CIND') ) {
64                 $self->atsend( 'AT+CIND=?' . Device::Modem::CR );
65                 ($_, $supported) = $self->parse_answer();
66                 $supported =~ s/^\+CIND: //;
67                 $self->atsend( 'AT+CIND?' . Device::Modem::CR );
68                 ($_, $values) = $self->parse_answer();
69                 $values =~ s/^\+CIND: //;
70                 #@values = split (/,/, $values);
71                 foreach (split (/,/, $values)) {
72                     $supported =~ s/\("([^"]*)",\([^)]*\)\),?//;
73                     $results{$1} = $_;
74                 }
75                 $self->log->write('info', 'Indicator data retrieved (' . scalar(keys(%results)) . 'values)');
76
77         }
78         return %results;
79 }
80
81 #
82 # Get mobile phone battery strength
83 #
84 sub battery_strength() {
85         my $self = shift;
86         # Error code, dBm (signal power), bit error rate
87         my($code, $strength, $line_power);
88
89         # Test if signal quality command is implemented
90         if( $self->test_command('+CBC') ) {
91
92                 $self->atsend( 'AT+CBC' . Device::Modem::CR );
93                 ($code, $strength) = $self->parse_answer();
94
95                 if( $strength =~ /\+CBC: (\d+),(\d+)/ ) {
96
97                         ($line_power, $strength) = ($1, $2);
98
99                         $self->log->write('info', 'battery strength is ['.$strength.'], line power ['.$line_power.']');
100
101                 } else {
102
103                         $self->log->write('warn', 'cannot obtain battery strength');
104
105                 }
106
107         } else {
108
109                 $self->log->write('warn', 'battery strength command not supported!');
110
111         }
112
113         return wantarray ? ($line_power, $strength) : $strength;
114
115 }
116
117 1;
118
119 __END__