File Coverage

blib/lib/Device/Gsm.pm
Criterion Covered Total %
statement 24 507 4.7
branch 0 200 0.0
condition 0 99 0.0
subroutine 8 35 22.8
pod 19 24 79.1
total 51 865 5.9


line stmt bran cond sub pod time code
1             # Device::Gsm - a Perl class to interface GSM devices as AT modems
2             # Copyright (C) 2002-2016 Cosimo Streppone, cosimo@cpan.org
3             # Copyright (C) 2006-2015 Grzegorz Wozniak, wozniakg@gmail.com
4             # Copyright (C) 2016 Joel Maslak, jmaslak@antelope.net
5              
6             # This program is free software; you can redistribute it and/or modify
7             # it only under the terms of Perl itself.
8             #
9             # This program is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # Perl licensing terms for more details.
13              
14             package Device::Gsm;
15              
16             $Device::Gsm::VERSION = '1.61';
17              
18 7     7   37819 use strict;
  7         10  
  7         208  
19 7     7   4332 use Device::Modem 1.47;
  7         175730  
  7         176  
20 7     7   2980 use Device::Gsm::Sms;
  7         15  
  7         151  
21 7     7   33 use Device::Gsm::Pdu;
  7         6  
  7         103  
22 7     7   21 use Device::Gsm::Charset;
  7         8  
  7         100  
23 7     7   20 use Device::Gsm::Sms::Token;
  7         7  
  7         103  
24 7     7   3076 use Time::HiRes qw(sleep);
  7         7066  
  7         25  
25 7     7   1028 use constant USSD_DCS => 15;
  7         14  
  7         31647  
26              
27             @Device::Gsm::ISA = ('Device::Modem');
28              
29             %Device::Gsm::USSD_RESPONSE_CODES = (
30             0 =>
31             'No further user action required (network initiated USSD-Notify, or no further information needed after mobile Initiated operation)',
32             1 =>
33             'Further user action required (network initiated USSD-Request, or further information needed after mobile initiated operation)',
34             2 =>
35             'USSD terminated by network. the reason for the termination is indicated by the index stored in %Device::Gsm::USSD_TERMINATION_CODES',
36             3 => 'Other local client has responded',
37             4 => 'Operation not supported',
38             5 => 'Network time out'
39             );
40             %Device::Gsm::USSD_TERMINATION_CODES = (
41             0 => 'NO_CAUSE',
42             1 => 'CC_BUSY',
43             2 => 'PARAMETER_ERROR',
44             3 => 'INVALID_NUMBER',
45             4 => 'OUTGOING_CALL_BARRED',
46             5 => 'TOO_MANY_CALLS_ON_HOLD',
47             6 => 'NORMAL',
48             10 => 'DROPPED',
49             12 => 'NETWORK',
50             13 => 'INVALID_CALL_ID',
51             14 => 'NORMAL_CLEARING',
52             16 => 'TOO_MANY_ACTIVE_CALLS',
53             17 => 'UNASSIGNED_NUMBER',
54             18 => 'NO_ROUTE_TO_DEST',
55             19 => 'RESOURCE_UNAVAILABLE',
56             20 => 'CALL_BARRED',
57             21 => 'USER_BUSY',
58             22 => 'NO_ANSWER',
59             23 => 'CALL_REJECTED',
60             24 => 'NUMBER_CHANGED',
61             25 => 'DEST_OUT_OF_ORDER',
62             26 => 'SIGNALING_ERROR',
63             27 => 'NETWORK_ERROR',
64             28 => 'NETWORK_BUSY',
65             29 => 'NOT_SUBSCRIBED',
66             31 => 'SERVICE_UNAVAILABLE',
67             32 => 'SERVICE_NOT_SUPPORTED',
68             33 => 'PREPAY_LIMIT_REACHED',
69             35 => 'INCOMPATIBLE_DEST',
70             43 => 'ACCESS_DENIED',
71             45 => 'FEATURE_NOT_AVAILABLE',
72             46 => 'WRONG_CALL_STATE',
73             47 => 'SIGNALING_TIMEOUT',
74             48 => 'MAX_MPTY_PARTICIPANTS_EXCEEDED',
75             49 => 'SYSTEM_FAILURE',
76             50 => 'DATA_MISSING',
77             51 => 'BASIC_SERVICE_NOT_PROVISIONED',
78             52 => 'ILLEGAL_SS_OPERATION',
79             53 => 'SS_INCOMPATIBILITY',
80             54 => 'SS_NOT_AVAILABLE',
81             55 => 'SS_SUBSCRIPTION_VIOLATION',
82             56 => 'INCORRECT_PASSWORD',
83             57 => 'TOO_MANY_PASSWORD_ATTEMPTS',
84             58 => 'PASSWORD_REGISTRATION_FAILURE',
85             59 => 'ILLEGAL_EQUIPMENT',
86             60 => 'UNKNOWN_SUBSCRIBER',
87             61 => 'ILLEGAL_SUBSCRIBER',
88             62 => 'ABSENT_SUBSCRIBER',
89             63 => 'USSD_BUSY',
90             65 => 'CANNOT_TRANSFER_MPTY_CALL',
91             66 => 'BUSY_WITH_UNANSWERED_CALL',
92             68 => 'UNANSWERED_CALL_PENDING',
93             69 => 'USSD_CANCELED',
94             70 => 'PRE_EMPTION',
95             71 => 'OPERATION_NOT_ALLOWED',
96             72 => 'NO_FREE_BEARER_AVAILABLE',
97             73 => 'NBR_SN_EXCEEDED',
98             74 => 'NBR_USER_EXCEEDED',
99             75 => 'NOT_ALLOWED_BY_CC',
100             76 => 'MODIFIED_TO_SS_BY_CC',
101             77 => 'MODIFIED_TO_CALL_BY_CC',
102             78 => 'CALL_MODIFIED_BY_CC',
103             90 => 'FDN_FAILURE'
104             );
105              
106             # Connection defaults to 19200 baud. This seems to be the optimal
107             # rate for serial links to new gsm phones.
108             $Device::Gsm::BAUDRATE = 19200;
109              
110             # Time to wait after network register command (secs)
111             $Device::Gsm::REGISTER_DELAY = 2;
112              
113             # Connect on serial port to gsm device
114             # see parameters on Device::Modem::connect()
115             sub connect {
116 0     0 1   my $me = shift;
117 0           my %aOpt;
118 0 0         %aOpt = @_ if (@_);
119              
120             #
121             # If you have problems with bad characters being trasmitted across serial link,
122             # try different baud rates, as below...
123             #
124             # .---------------------------------.
125             # | Model (phone/modem) | Baudrate |
126             # |---------------------+-----------|
127             # | Falcom Swing (A2D) | 9600 |
128             # | Siemens C35/C45 | 19200 |
129             # | Nokia phones | 19200 |
130             # | Nokia Communicator | 9600 |
131             # | Digicom | 9600 |
132             # `---------------------------------'
133             #
134             # GSM class defaults to 19200 baud
135             #
136 0   0       $aOpt{'baudrate'} ||= $Device::Gsm::BAUDRATE;
137              
138 0           $me->{_test_cache} = {}; # We clear the list of commands supported,
139             # in case the user disconnects one phone
140             # and connects a different kind of phone
141              
142 0           $me->SUPER::connect(%aOpt);
143             }
144              
145             sub disconnect {
146 0     0 1   my $me = shift;
147 0           $me->{_test_cache} = {}; # Not strictly needed, but this is safety code
148 0           $me->SUPER::disconnect();
149 0           sleep 0.05;
150             }
151              
152             #
153             # Get/set phone date and time
154             #
155             sub datetime {
156 0     0 1   my $self = shift;
157 0           my $ok = undef; # ok/err flag
158 0           my $datetime = undef; # datetime string
159 0           my @time = (); # array in "localtime" format
160              
161             # Test support for clock function
162 0 0         if ($self->test_command('+CCLK')) {
163              
164 0 0         if (@_) {
165              
166             # If called with "$self->datetime(time())" format
167 0 0         if (@_ == 1) {
168              
169             # $_[0] must be result of `time()' func
170 0           @time = localtime($_[0]);
171             }
172             else {
173              
174             # If called with "$self->datetime(localtime())" format
175             # @_ here is the result of `localtime()' func
176 0           @time = @_;
177             }
178              
179 0           $datetime = sprintf(
180             '%02d/%02d/%02d,%02d:%02d:%02d',
181             $time[5] - 100, # year
182             1 + $time[4], # month
183             $time[3], # day
184             @time[ 2, 1, 0 ], # hr,min,secs
185             );
186              
187             # Set time of phone
188 0           $self->atsend(qq{AT+CCLK="$datetime"} . Device::Modem::CR);
189 0           $ok = $self->parse_answer($Device::Modem::STD_RESPONSE);
190              
191 0 0         $self->log->write(
192             'info',
193             "write datetime ($datetime) to phone => ("
194             . ($ok ? 'OK' : 'FAILED') . ")"
195             );
196              
197             }
198             else {
199              
200 0           $self->atsend('AT+CCLK?' . Device::Modem::CR);
201 0           ($ok, $datetime)
202             = $self->parse_answer($Device::Modem::STD_RESPONSE);
203              
204             #warn('datetime='.$datetime);
205 0 0 0       if ( $ok
206             && $datetime
207             =~ m|\+CCLK:\s*"?(\d\d)/(\d\d)/(\d\d)\,(\d\d):(\d\d):(\d\d)"?|
208             )
209             {
210 0           $datetime = "$1/$2/$3 $4:$5:$6";
211 0           $self->log->write(
212             'info',
213             "read datetime from phone ($datetime)"
214             );
215             }
216             else {
217 0           $self->log->write(
218             'warn',
219             "datetime format ($datetime) not recognized"
220             );
221 0           $datetime = undef;
222             }
223              
224             }
225              
226             }
227              
228 0           return $datetime;
229              
230             }
231              
232             #
233             # Delete a message from sim card
234             #
235             sub delete_sms {
236 0     0 1   my $self = shift;
237 0           my $msg_index = shift;
238 0           my $storage = shift;
239 0           my $ok;
240              
241 0 0 0       if (!defined $msg_index || $msg_index eq '') {
242 0           $self->log->write(
243             'warn',
244             'undefined message number. cannot delete sms message'
245             );
246 0           return 0;
247             }
248              
249             # Set default SMS storage if supported
250 0           $self->storage($storage);
251              
252 0           $self->atsend(qq{AT+CMGD=$msg_index} . Device::Modem::CR);
253              
254 0           my $ans = $self->parse_answer($Device::Modem::STD_RESPONSE);
255 0 0 0       if (index($ans, 'OK') > -1 || $ans =~ /\+CMGD/) {
256 0           $ok = 1;
257             }
258              
259             $self->log->write(
260 0 0 0       'info',
261             "deleting sms n.$msg_index from storage "
262             . ($storage || "default")
263             . " (result: `$ans') => "
264             . ($ok ? 'ok' : '*FAILED*')
265             );
266              
267 0           return $ok;
268             }
269              
270             #
271             # Call forwarding
272             #
273             sub forward {
274 0     0 1   my ($self, $reason, $mode, $number) = @_;
275              
276 0   0       $reason = lc $reason || 'unconditional';
277 0   0       $mode = lc $mode || 'register';
278 0   0       $number ||= '';
279              
280 0           my %reasons = (
281             'unconditional' => 0,
282             'busy' => 1,
283             'no reply' => 2,
284             'unreachable' => 3
285             );
286              
287 0           my %modes = (
288             'disable' => 0,
289             'enable' => 1,
290             'query' => 2,
291             'register' => 3,
292             'erase' => 4
293             );
294              
295 0           my $reasoncode = $reasons{$reason};
296 0           my $modecode = $modes{$mode};
297              
298 0           $self->log->write(
299             'info',
300             qq{setting $reason call forwarding to [$number]}
301             );
302 0           $self->atsend(
303             qq{AT+CCFC=$reasoncode,$modecode,"$number"} . Device::Modem::CR);
304              
305 0           return $self->parse_answer($Device::Modem::STD_RESPONSE, 15000);
306             }
307              
308             #
309             # Hangup and terminate active call(s)
310             # this overrides the `Device::Modem::hangup()' method
311             #
312             sub hangup {
313 0     0 1   my $self = shift;
314 0           $self->log->write('info', 'hanging up...');
315 0           $self->attention();
316 0           $self->atsend('AT+CHUP' . Device::Modem::CR);
317 0           $self->flag('OFFHOOK', 0);
318 0           $self->answer(undef, 5000);
319             }
320              
321             #
322             # Who is the manufacturer of this device?
323             #
324             sub manufacturer {
325 0     0 1   my $self = shift;
326 0           my ($ok, $man);
327              
328             # We can't test for command support, because some phones, mainly Motorola
329             # will spit out an error, instead of telling if CGMI is supported.
330 0           $self->atsend('AT+CGMI' . Device::Modem::CR);
331 0           ($ok, $man) = $self->parse_answer($Device::Modem::STD_RESPONSE);
332              
333 0 0         if ($ok ne 'OK') {
334 0           $self->log->write(
335             'warn',
336             'manufacturer command ended with error [' . $ok . $man . ']'
337             );
338 0           return undef;
339             }
340              
341             # Again, seems that Motorola phones will re-echo
342             # the CGMI command header, instead of giving us the
343             # manufacturer info we want. Thanks to Niolay Shaplov
344             # for reporting (RT #31540)
345 0 0         if ($man =~ /\+CGMI:\ \"(.*)\"/s) {
346 0           $man = $1;
347             }
348              
349             $self->log->write(
350 0           'info',
351             'manufacturer of this device appears to be [' . $man . ']'
352             );
353              
354 0   0       return $man || $ok;
355             }
356              
357             #
358             # Set text or pdu mode for gsm devices. If no parameter passed, returns current mode
359             #
360             sub mode {
361 0     0 1   my $self = shift;
362              
363 0 0         if (@_) {
364 0           my $mode = lc $_[0];
365 0 0         if ($mode eq 'text') {
366 0           $mode = 1;
367             }
368             else {
369 0           $mode = 0;
370             }
371 0 0         $self->{'_mode'} = $mode ? 'text' : 'pdu';
372             $self->log->write(
373             'info',
374 0           'setting mode to [' . $self->{'_mode'} . ']'
375             );
376 0           $self->atsend(qq{AT+CMGF=$mode} . Device::Modem::CR);
377              
378 0           return $self->parse_answer($Device::Modem::STD_RESPONSE);
379             }
380              
381 0   0       return ($self->{'_mode'} || '');
382              
383             }
384              
385             #
386             # What is the model of this device?
387             #
388             sub model {
389 0     0 1   my $self = shift;
390 0           my ($code, $model);
391              
392             # Test if manufacturer code command is supported
393 0 0         if ($self->test_command('+CGMM')) {
394              
395 0           $self->atsend('AT+CGMM' . Device::Modem::CR);
396 0           ($code, $model) = $self->parse_answer($Device::Modem::STD_RESPONSE);
397              
398 0   0       $self->log->write(
399             'info',
400             'model of this device is [' . ($model || '') . ']'
401             );
402              
403             }
404              
405 0   0       return $model || $code;
406             }
407              
408             #
409             # Get handphone serial number (IMEI number)
410             #
411             sub imei {
412 0     0 1   my $self = shift;
413 0           my ($code, $imei);
414              
415             # Test if manufacturer code command is supported
416 0 0         if ($self->test_command('+CGSN')) {
417              
418 0           $self->atsend('AT+CGSN' . Device::Modem::CR);
419 0           ($code, $imei) = $self->parse_answer($Device::Modem::STD_RESPONSE);
420              
421 0           $self->log->write('info', 'IMEI code is [' . $imei . ']');
422              
423             }
424 0   0       return $imei || $code;
425             }
426              
427             # Alias for `imei()' is `serial_number()'
428             *serial_number = *imei;
429              
430             #
431             # Get mobile phone signal quality (expressed in dBm)
432             #
433             sub signal_quality {
434 0     0 1   my $self = shift;
435              
436             # Error code, dBm (signal power), bit error rate
437 0           my ($code, @dBm, $dBm, $ber);
438              
439             # Test if signal quality command is implemented
440 0 0         if ($self->test_command('+CSQ')) {
441              
442 0           $self->atsend('AT+CSQ' . Device::Modem::CR);
443 0           ($code, @dBm)
444             = $self->parse_answer($Device::Modem::STD_RESPONSE, 15000);
445              
446             # Vodafone data cards send out response to commands with
447             # many empty lines in between, so +CSQ response is not the very
448             # first line of answer.
449 0           for (@dBm) {
450 0 0         if (/\+CSQ:/) {
451 0           $dBm = $_;
452 0           last;
453             }
454             }
455              
456             # Some gsm software send CSQ command result as "+CSQ: xx,yy"
457 0 0         if ($dBm =~ /\+CSQ:\s*(\d+),(\d+)/) {
    0          
458              
459 0           ($dBm, $ber) = ($1, $2);
460              
461             # Further process dBm number to obtain real dB power
462 0 0         if ($dBm > 30) {
463 0           $dBm = -51;
464             }
465             else {
466 0           $dBm = -113 + ($dBm << 1);
467             }
468              
469 0           $self->log->write(
470             'info',
471             'signal dBm power is ['
472             . $dBm
473             . '], bit error rate ['
474             . $ber . ']'
475             );
476              
477             # Other versions put out "+CSQ: xx" only...
478             }
479             elsif ($dBm =~ /\+CSQ:\s*(\d+)/) {
480              
481 0           $dBm = $1;
482              
483 0           $self->log->write('info', 'signal is [' . $dBm . '] "bars"');
484              
485             }
486             else {
487              
488 0           $self->log->write('warn', 'cannot obtain signal dBm power');
489              
490             }
491              
492             }
493             else {
494              
495 0           $self->log->write('warn', 'signal quality command not supported!');
496              
497             }
498              
499 0           return $dBm;
500              
501             }
502              
503             #
504             # Get the GSM software version on this device
505             #
506             sub software_version {
507 0     0 1   my $self = shift;
508 0           my ($code, $ver);
509              
510             # Test if manufacturer code command is supported
511 0 0         if ($self->test_command('+CGMR')) {
512              
513 0           $self->atsend('AT+CGMR' . Device::Modem::CR);
514 0           ($code, $ver) = $self->parse_answer($Device::Modem::STD_RESPONSE);
515              
516 0           $self->log->write('info', 'GSM version is [' . $ver . ']');
517              
518             }
519              
520 0   0       return $ver || $code;
521             }
522              
523             #
524             # Test support for a specific command
525             #
526             sub test_command {
527 0     0 1   my ($self, $command) = @_;
528              
529 0 0         if (!exists($self->{_test_cache})) { $self->{_test_cache} = {} }
  0            
530 0 0         if (exists($self->{_test_cache}{$command})) {
531 0           return $self->{_test_cache}{$command};
532             }
533              
534             # Support old code adding a `+' if not specified
535             # TODO to be removed in 1.30 ?
536 0 0         if ($command =~ /^[a-zA-Z]/) {
537 0           $command = '+' . $command;
538             }
539              
540             # Standard test procedure for every command
541             $self->log->write(
542 0           'info',
543             'testing support for command [' . $command . ']'
544             );
545 0           $self->atsend("AT$command=?" . Device::Modem::CR);
546              
547             # If answer is ok, command is supported
548 0   0       my $ok = ($self->answer($Device::Modem::STD_RESPONSE) || '') =~ /OK/o;
549 0 0         $self->log->write(
550             'info',
551             'command [' . $command . '] is ' . ($ok ? '' : 'not ') . 'supported'
552             );
553              
554 0           $self->{_test_cache}{$command} = $ok;
555 0           return $ok;
556             }
557              
558             #
559             # Read all messages on SIM card (XXX must be registered on network)
560             #
561             sub messages {
562 0     0 1   my ($self, $storage) = @_;
563 0           my @messages;
564              
565             # By default (old behaviour) messages are read from sim card
566 0   0       $storage ||= 'SM';
567              
568 0 0         $self->log->write('info', 'Reading messages on '
569             . ($storage eq 'SM' ? 'Sim card' : 'phone memory'));
570              
571             # Register on network (give your PIN number for this!)
572             #return undef unless $self->register();
573 0           $self->register();
574              
575             #
576             # Read messages (TODO need to check if device supports CMGL with `stat'=4)
577             #
578 0 0         if ($self->mode() eq 'text') {
579 0           warn 'Read messages in text mode is not implemented yet.';
580              
581             #@messages = $self->_read_messages_text();
582             }
583             else {
584              
585             # Set default storage if supported
586 0           $self->storage($storage);
587              
588 0           push @messages, $self->_read_messages_pdu();
589             }
590              
591 0           return @messages;
592             }
593              
594             sub storage {
595 0     0 1   my $self = shift;
596 0           my $ok = 0;
597              
598             # Set default SMS storage if supported by phone
599 0 0 0       if (@_ && (my $storage = uc $_[0])) {
600 0 0         return unless $self->test_command('+CPMS');
601 0           $self->atsend(qq{AT+CPMS="$storage"} . Device::Modem::CR);
602              
603             # Read and discard the answer
604 0           $self->answer($Device::Modem::STD_RESPONSE, 5000);
605 0           $self->{_storage} = $storage;
606             }
607              
608 0           return $self->{_storage};
609             }
610              
611             #
612             # Register to GSM service provider network
613             #
614             sub register {
615 0     0 1   my $me = shift;
616 0           my $lOk = 0;
617              
618             # Check for connection
619 0 0         if (!$me->{'CONNECTED'}) {
620 0           $me->log->write('info', 'Not yet connected. Doing it now...');
621 0 0         if (!$me->connect()) {
622 0           $me->log->write('warning', 'No connection!');
623 0           return $lOk;
624             }
625             }
626              
627             # On some phones, registration doesn't work, so you can skip it entirely
628             # by passing 'assume_registered => 1' to the new() constructor
629 0 0 0       if (exists $me->{'assume_registered'} && $me->{'assume_registered'}) {
630 0           return $me->{'REGISTERED'} = 1;
631             }
632              
633             # Send PIN status query
634 0           $me->log->write('info', 'PIN status query');
635 0           $me->atsend('AT+CPIN?' . Device::Modem::CR);
636              
637             # Get answer
638 0           my $cReply = $me->answer($Device::Modem::STD_RESPONSE, 10000);
639              
640 0 0 0       if (!defined $cReply || $cReply eq "") {
641 0           $me->log->write('warn',
642             'Could not get a reply for the AT+CPIN command');
643 0           return;
644             }
645              
646 0 0         if ($cReply =~ /(READY|SIM PIN2)/) {
    0          
647              
648             # Iridium satellite phones rest saying "SIM PIN2" when they are registered...
649              
650 0           $me->log->write(
651             'info',
652             'Already registered on network. Ready to send.'
653             );
654 0           $lOk = 1;
655              
656             }
657             elsif ($cReply =~ /SIM PIN/) {
658              
659             # Pin request, sending PIN code
660 0           $me->log->write('info', 'PIN requested: sending...');
661 0           $me->atsend(qq[AT+CPIN="$$me{'pin'}"] . Device::Modem::CR);
662              
663             # Get reply
664 0           $cReply = $me->answer($Device::Modem::STD_RESPONSE, 10000);
665              
666             # Test reply
667 0 0         if ($cReply !~ /ERROR/) {
668 0           $me->log->write('info', 'PIN accepted. Ready to send.');
669 0           $lOk = 1;
670             }
671             else {
672 0           $me->log->write('warning', 'PIN rejected');
673 0           $lOk = 0;
674             }
675              
676             }
677              
678             # Store status in object and return
679 0           $me->{'REGISTERED'} = $lOk;
680              
681 0           return $lOk;
682             }
683              
684             # send_sms( %options )
685             #
686             # recipient => '+39338101010'
687             # class => 'flash' | 'normal'
688             # validity => [ default = 24 hours ]
689             # content => 'text-only for now'
690             # mode => 'text' | 'pdu' (default = 'pdu')
691             #
692             sub send_sms {
693              
694 0     0 1   my ($me, %opt) = @_;
695              
696 0           my $lOk = 0;
697 0           my $mr;
698 0 0 0       return unless $opt{'recipient'} and $opt{'content'};
699              
700             # Check if registered to network
701 0 0         if (!$me->{'REGISTERED'}) {
702 0           $me->log->write('info', 'Not yet registered, doing now...');
703 0           $me->register();
704              
705             # Wait some time to allow SIM registering to network
706 0           $me->wait($Device::Gsm::REGISTER_DELAY << 10);
707             }
708              
709             # Again check if now registered
710 0 0         if (!$me->{'REGISTERED'}) {
711              
712 0           $me->log->write('warning', 'ERROR in registering to network');
713 0           return $lOk;
714              
715             }
716              
717             # Ok, registered. Select mode to send SMS
718 0   0       $opt{'mode'} ||= 'PDU';
719 0 0         if (uc $opt{'mode'} ne 'TEXT') {
720              
721 0           ($lOk, $mr) = $me->_send_sms_pdu(%opt);
722              
723             }
724             else {
725              
726 0           ($lOk, $mr) = $me->_send_sms_text(%opt);
727             }
728              
729             # Return result of sending
730 0 0         return wantarray ? ($lOk, $mr) : $lOk;
731             }
732              
733             # send_csms( %options )
734             #
735             # recipient => '+39338101010'
736             # class => 'flash' | 'normal'
737             # validity => [ default = 24 hours ]
738             # content => 'text-only above 160 chars'
739             #
740             sub send_csms {
741              
742 0     0 0   my ($me, %opt) = @_;
743              
744 0           my $lOk = 0;
745 0           my @mrs;
746 0 0 0       return unless $opt{'recipient'} and $opt{'content'};
747              
748             # Check if registered to network
749 0 0         if (!$me->{'REGISTERED'}) {
750 0           $me->log->write('info', 'Not yet registered, doing now...');
751 0           $me->register();
752              
753             # Wait some time to allow SIM registering to network
754 0           $me->wait($Device::Gsm::REGISTER_DELAY << 10);
755             }
756              
757             # Again check if now registered
758 0 0         if (!$me->{'REGISTERED'}) {
759              
760 0           $me->log->write('warning', 'ERROR in registering to network');
761 0           return 0;
762              
763             }
764              
765             # Ok, registered. Select mode to send SMS
766 0   0       $opt{'mode'} ||= 'PDU';
767              
768 0 0         if (uc $opt{'mode'} eq 'TEXT') {
769 0           $me->log->write('warning', 'CSMS only in PDU mode, switching');
770 0           until (uc($me->{'_mode'}) ne 'PDU') {
771 0 0         $me->mode('pdu') or sleep 0.05;
772             }
773             }
774 0           my @text_parts;
775              
776             #ensure we have to send CSMS
777 0 0         if (Device::Gsm::Charset::gsm0338_length($opt{'content'}) <= 160) {
778 0           my @send_return = $me->_send_sms_pdu(%opt);
779 0 0         if ($send_return[0]) {
780 0           $lOk++;
781 0           push(@mrs, $send_return[1]);
782             }
783             else {
784 0           $lOk = 0;
785 0           $#mrs = -1;
786             }
787             }
788             else {
789 0           my $udh = new Sms::Token("UDH");
790 0           my $ref_num = sprintf("%02X", (int(rand(255))));
791 0           my @text_parts = Device::Gsm::Charset::gsm0338_split($opt{'content'});
792 0           my $parts = scalar(@text_parts);
793 0           $parts = sprintf("%02X", $parts);
794 0           my $padding
795             = Sms::Token::UDH::calculate_padding(Sms::Token::UDH::IEI_T_8_L);
796 0           my $part_count = 1;
797 0           foreach my $text_part (@text_parts) {
798 0           my $part = sprintf("%02X", $part_count);
799 0           my ($len_hex, $encoded_text)
800             = Device::Gsm::Pdu::encode_text7_udh($text_part, $padding);
801 0           $part_count++;
802 0           $opt{'content'} = $text_part;
803 0           $opt{'pdu_msg'}
804             = sprintf("%02X",
805             hex($len_hex) + Sms::Token::UDH::IEI_T_8_L + 2)
806             . $udh->encode(
807             Sms::Token::UDH::IEI_T_8 => $ref_num . $parts . $part)
808             . $encoded_text;
809 0           my @send_return = $me->send_sms_pdu_long(%opt);
810 0 0         if ($send_return[0]) {
811 0           $lOk++;
812 0           push(@mrs, $send_return[1]);
813              
814             }
815             else {
816 0           $lOk = 0;
817 0           $#mrs = -1;
818 0           last;
819             }
820 0           sleep 0.05;
821             }
822             }
823              
824             # Return result of sending
825 0 0         return wantarray ? ($lOk, @mrs) : $lOk;
826             }
827              
828             #
829             #
830             # read messages in pdu mode
831             #
832             #
833             sub _read_messages_pdu {
834 0     0     my $self = shift;
835              
836 0           $self->mode('pdu');
837              
838 0           $self->atsend(q{AT+CMGL=4} . Device::Modem::CR);
839 0           my ($messages) = $self->answer($Device::Modem::STD_RESPONSE, 5000);
840              
841             # Catch the case that the msgs are returned with gaps between them
842 0           while (my $more = $self->answer($Device::Modem::STD_RESPONSE, 200)) {
843              
844             #-- $self->answer will chomp trailing newline, add it back
845 0           $messages .= "\n";
846 0           $messages .= $more;
847             }
848              
849             # Ok, messages read, now convert from PDU and store in object
850 0           $self->log->write('debug', 'Messages=' . $messages);
851              
852 0           my @data = split /[\r\n]+/m, $messages;
853              
854             # Check for errors on SMS reading
855 0           my $code;
856 0 0         if (($code = pop @data) =~ /ERROR/) {
857 0           $self->log->write(
858             'error',
859             'cannot read SMS messages on SIM: [' . $code . ']'
860             );
861 0           return ();
862             }
863              
864 0           my @message = ();
865 0           my $current;
866              
867             # Current sms storage memory (ME or SM)
868 0           my $storage = $self->storage();
869              
870             #
871             # Parse received data (result of +CMGL command)
872             #
873 0           while (@data) {
874              
875 0           $self->log->write('debug', 'data[] = ', $data[0]);
876 0           my $header = shift @data;
877 0           my $pdu = shift @data;
878              
879             # Instance new message object
880 0           my $msg = new Device::Gsm::Sms(
881             header => $header,
882             pdu => $pdu,
883              
884             # XXX mode => $self->mode(),
885             storage => $storage,
886             parent => $self # Ref to parent Device::Gsm class
887             );
888              
889             # Check if message has been instanced correctly
890 0 0         if (ref $msg) {
891 0           push @message, $msg;
892             }
893             else {
894 0           $self->log->write(
895             'info',
896             "could not instance message $header $pdu!"
897             );
898             }
899              
900             }
901              
902             $self->log->write(
903 0           'info',
904             'found ' . (scalar @message) . ' messages on SIM. Reading.'
905             );
906              
907 0           return @message;
908              
909             }
910              
911             #
912             # _send_sms_text( %options ) : sends message in text mode
913             #
914             sub _send_sms_text {
915 0     0     my ($me, %opt) = @_;
916              
917 0           my $num = $opt{'recipient'};
918 0           my $text = $opt{'content'};
919              
920 0 0 0       return 0 unless $num and $text;
921              
922 0           my $lOk = 0;
923 0           my $mr;
924             my $cReply;
925              
926             # Select text format for messages
927 0           $me->mode('text');
928 0           $me->log->write('info', 'Selected text format for message sending');
929              
930             # Send sms in text mode
931 0           $me->atsend(qq[AT+CMGS="$num"] . Device::Modem::CR);
932              
933             # Wait a bit before sending the text. Some GSM software needs it.
934 0           $me->wait($Device::Modem::WAITCMD);
935              
936             # Complete message sending
937 0           $text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
938 0           $me->atsend($text . Device::Modem::CTRL_Z);
939              
940             # Get reply and check for errors
941 0           $cReply = $me->answer('+CMGS', 2000);
942 0 0         if ($cReply =~ /OK$/i) {
943 0           $cReply =~ /\+CMGS:\s*(\d+)/i;
944 0           $me->log->write('info', "Sent SMS (text mode) to $num!");
945 0           $lOk = 1;
946 0           $mr = $1;
947             }
948             else {
949 0           $me->log->write('warning', "ERROR in sending SMS");
950             }
951              
952 0 0         return wantarray ? ($lOk, $mr) : $lOk;
953             }
954              
955             #
956             # _send_sms_pdu( %options ) : sends message in PDU mode
957             #
958             sub _send_sms_pdu {
959 0     0     my ($me, %opt, $is_gsm0338) = @_;
960              
961             # Get options
962 0           my $num = $opt{'recipient'};
963 0           my $text = $opt{'content'};
964              
965 0 0 0       return 0 unless $num and $text;
966              
967 0           $me->atsend(q[ATE1] . Device::Modem::CR);
968 0           $me->answer($Device::Modem::STD_RESPONSE);
969              
970             # Select class of sms (normal or *flash sms*)
971 0   0       my $class = $opt{'class'} || 'normal';
972 0 0         $class = $class eq 'normal' ? '00' : 'F0';
973              
974             #Validity period value
975             #0 to 143 (TP-VP + 1) * 5 minutes (i.e. 5 minutes intervals up to 12 hours)
976             #144 to 167 12 hours + ((TP-VP - 143) * 30 minutes)
977             #168 to 196 (TP-VP - 166) * 1 day
978             #197 to 255 (TP-VP - 192) * 1 week
979             #default 24h
980 0           my $vp = 'A7';
981 0 0         if (defined $opt{'validity_period'}) {
982 0           $vp = sprintf("%02X", $opt{'validity_period'});
983             }
984              
985             # Status report requested?
986 0           my $status_report = 0;
987 0 0 0       if (exists $opt{'status_report'} && $opt{'status_report'}) {
988 0           $status_report = 1;
989             }
990              
991 0           my $lOk = 0;
992 0           my $mr = undef;
993 0           my $cReply;
994              
995             # Send sms in PDU mode
996              
997             #
998             # Example of sms send in PDU mode
999             #
1000             #AT+CMGS=22
1001             #> 0011000A8123988277190000AA0AE8329BFD4697D9EC37
1002             #+CMGS: 111
1003             #
1004             #OK
1005              
1006             # Encode DA
1007 0           my $enc_da = Device::Gsm::Pdu::encode_address($num);
1008 0           $me->log->write('info', 'encoded dest. address is [' . $enc_da . ']');
1009              
1010             # Encode text
1011 0 0         $is_gsm0338 or $text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
1012 0           my $enc_msg = Device::Gsm::Pdu::encode_text7($text);
1013 0           $me->log->write(
1014             'info',
1015             'encoded 7bit text (w/length) is [' . $enc_msg . ']'
1016             );
1017              
1018             # Build PDU data
1019 0 0         my $pdu = uc join(
1020             '',
1021             '00',
1022             ($status_report ? '31' : '11'),
1023             '00',
1024             $enc_da,
1025             '00',
1026             $class,
1027             $vp,
1028             $enc_msg
1029             );
1030              
1031 0           $me->log->write('info', 'due to send PDU [' . $pdu . ']');
1032              
1033             # Sending main SMS command ( with length )
1034 0           my $len = ((length $pdu) >> 1) - 1;
1035              
1036             #$me->log->write('info', 'AT+CMGS='.$len.' string sent');
1037              
1038             # Select PDU format for messages
1039 0           $me->atsend(q[AT+CMGF=0] . Device::Modem::CR);
1040 0           $me->answer($Device::Modem::STD_RESPONSE);
1041 0           $me->log->write('info', 'Selected PDU format for msg sending');
1042              
1043             # Send SMS length
1044 0           $me->atsend(qq[AT+CMGS=$len] . Device::Modem::CR);
1045 0           $me->answer($Device::Modem::STD_RESPONSE);
1046              
1047             # Sending SMS content encoded as PDU
1048 0           $me->log->write('info', 'PDU sent [' . $pdu . ' + CTRLZ]');
1049 0           $me->atsend($pdu . Device::Modem::CTRL_Z);
1050              
1051             # Get reply and check for errors
1052 0           $cReply = $me->answer($Device::Modem::STD_RESPONSE, 30000);
1053 0           $me->log->write('debug', "SMS reply: $cReply\r\n");
1054              
1055 0 0         if ($cReply =~ /OK$/i) {
1056 0           $cReply =~ /\+CMGS:\s*(\d+)/i;
1057 0           $me->log->write('info', "Sent SMS (pdu mode) to $num!");
1058 0           $lOk = 1;
1059 0           $mr = $1;
1060              
1061             }
1062             else {
1063 0           $cReply =~ /(\+CMGS:.*)/;
1064 0           $me->log->write('warning', "ERROR in sending SMS: $1");
1065             }
1066              
1067 0 0         return wantarray ? ($lOk, $mr) : $lOk;
1068             }
1069              
1070             sub send_sms_pdu_long {
1071 0     0 0   my ($me, %opt) = @_;
1072              
1073             # Get options
1074 0           my $num = $opt{'recipient'};
1075 0           my $text = $opt{'content'};
1076 0           my $pdu_msg = $opt{'pdu_msg'};
1077              
1078 0 0 0       return 0 unless $num and $text and $pdu_msg;
      0        
1079              
1080 0           $me->atsend(q[ATE1] . Device::Modem::CR);
1081 0           $me->answer($Device::Modem::STD_RESPONSE);
1082              
1083             # Select class of sms (normal or *flash sms*)
1084 0   0       my $class = $opt{'class'} || 'normal';
1085 0 0         $class = $class eq 'normal' ? '00' : 'F0';
1086              
1087             #Validity period value
1088             #0 to 143 (TP-VP + 1) * 5 minutes (i.e. 5 minutes intervals up to 12 hours)
1089             #144 to 167 12 hours + ((TP-VP - 143) * 30 minutes)
1090             #168 to 196 (TP-VP - 166) * 1 day
1091             #197 to 255 (TP-VP - 192) * 1 week
1092             #default 24h
1093 0           my $vp = 'A7';
1094 0 0         if (defined $opt{'validity_period'}) {
1095 0           $vp = sprintf("%02X", $opt{'validity_period'});
1096             }
1097              
1098             # Status report requested?
1099 0           my $status_report = 0;
1100 0 0 0       if (exists $opt{'status_report'} && $opt{'status_report'}) {
1101 0           $status_report = 1;
1102             }
1103              
1104 0           my $lOk = 0;
1105 0           my $mr = undef;
1106 0           my $cReply;
1107              
1108             # Send sms in PDU mode
1109              
1110             #
1111             # Example of sms send in PDU mode
1112             #
1113             #AT+CMGS=22
1114             #> 0011000A8123988277190000AA0AE8329BFD4697D9EC37
1115             #+CMGS: 111
1116             #
1117             #OK
1118              
1119             # Encode DA
1120 0           my $enc_da = Device::Gsm::Pdu::encode_address($num);
1121 0           $me->log->write('info', 'encoded dest. address is [' . $enc_da . ']');
1122              
1123             # Encode text
1124             #$text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
1125             #my $enc_msg = Device::Gsm::Pdu::encode_text7($text);
1126 0           $me->log->write(
1127             'info',
1128             'encoded 7bit text (w/length) is [' . $pdu_msg . ']'
1129             );
1130              
1131             # Build PDU data
1132 0 0         my $pdu = uc join(
1133             '',
1134              
1135             #we use default SMSC address(don supply one)
1136             '00',
1137              
1138             #as you can see when UDH is present we set 6 bit of of first octet, you can recognize CSM that way, I prefer regex :) (se UD.pm)
1139             ($status_report ? '71' : '51'),
1140              
1141             #message reference, my G24 returns own MR after successful sending, setting this value did nothing in that case, but other modems may behave differently
1142             '00',
1143             $enc_da,
1144              
1145             #protocol identifier (0x00 use default)
1146             '00',
1147              
1148             # data coding scheme (flash sms or normal, coding etc. more about
1149             # http://en.wikipedia.org/wiki/Data_Coding_Scheme)
1150             $class,
1151             $vp,
1152             $pdu_msg
1153             );
1154              
1155 0           $me->log->write('info', 'due to send PDU [' . $pdu . ']');
1156              
1157             # Sending main SMS command ( with length )
1158 0           my $len = ((length $pdu) >> 1) - 1;
1159              
1160             #$me->log->write('info', 'AT+CMGS='.$len.' string sent');
1161              
1162             # Select PDU format for messages
1163 0           $me->atsend(q[AT+CMGF=0] . Device::Modem::CR);
1164 0           $me->answer($Device::Modem::STD_RESPONSE);
1165 0           $me->log->write('info', 'Selected PDU format for msg sending');
1166              
1167             # Send SMS length
1168 0           $me->atsend(qq[AT+CMGS=$len] . Device::Modem::CR);
1169 0           $me->answer($Device::Modem::STD_RESPONSE);
1170              
1171             # Sending SMS content encoded as PDU
1172 0           $me->log->write('info', 'PDU sent [' . $pdu . ' + CTRLZ]');
1173 0           $me->atsend($pdu . Device::Modem::CTRL_Z);
1174              
1175             # Get reply and check for errors
1176 0           $cReply = $me->answer($Device::Modem::STD_RESPONSE, 30000);
1177 0           $me->log->write('debug', "SMS reply: $cReply\r\n");
1178              
1179 0 0         if ($cReply =~ /OK$/i) {
1180 0           $cReply =~ /\+CMGS:\s*(\d+)/i;
1181 0           $me->log->write('info', "Sent SMS (pdu mode) to $num!");
1182 0           $lOk = 1;
1183 0           $mr = $1;
1184             }
1185             else {
1186 0           $cReply =~ /(\+CMGS:.*)/;
1187 0           $me->log->write('warning', "ERROR in sending SMS: $1");
1188             }
1189              
1190 0 0         return wantarray ? ($lOk, $mr) : $lOk;
1191             }
1192              
1193             #
1194             # Set or request service center number
1195             #
1196             sub service_center {
1197              
1198 0     0 1   my $self = shift;
1199 0           my $nCenter;
1200 0           my $lOk = 1;
1201 0           my $code;
1202              
1203             # If additional parameter is supplied, store new message center number
1204 0 0         if (@_) {
1205 0           $nCenter = shift();
1206              
1207             # Remove all non numbers or `+' sign
1208 0           $nCenter =~ s/[^0-9+]//g;
1209              
1210             # Send AT command
1211 0           $self->atsend(qq[AT+CSCA="$nCenter"] . Device::Modem::CR);
1212              
1213             # Check for modem answer
1214 0           $lOk = ($self->answer($Device::Modem::STD_RESPONSE) =~ /OK/);
1215              
1216 0 0         if ($lOk) {
1217 0           $self->log->write(
1218             'info',
1219             'service center number [' . $nCenter . '] stored'
1220             );
1221             }
1222             else {
1223 0           $self->log->write(
1224             'warning',
1225             'unexpected response for "service_center" command'
1226             );
1227             }
1228              
1229             }
1230             else {
1231              
1232 0           $self->log->write('info', 'requesting service center number');
1233 0           $self->atsend('AT+CSCA?' . Device::Modem::CR);
1234              
1235             # Get answer and check for errors
1236 0           ($code, $nCenter) = $self->parse_answer($Device::Modem::STD_RESPONSE);
1237              
1238 0 0         if ($code =~ /ERROR/) {
1239 0           $self->log->write(
1240             'warning',
1241             'error status for "service_center" command'
1242             );
1243 0           $lOk = 0;
1244             }
1245             else {
1246              
1247             # $nCenter =~ tr/\r\nA-Z//s;
1248 0           $self->log->write(
1249             'info',
1250             'service center number is [' . $nCenter . ']'
1251             );
1252              
1253             # Return service center number
1254 0           $lOk = $nCenter;
1255             }
1256              
1257             }
1258              
1259             # Status flag or service center number
1260 0           return $lOk;
1261              
1262             }
1263              
1264             sub network {
1265 0     0 1   my $self = $_[0];
1266 0           my $network;
1267              
1268             #if( ! $self->test_command('COPS') )
1269             #{
1270             # print 'NO COMMAND';
1271             # return undef;
1272             #}
1273              
1274 0           $self->atsend('AT+COPS?' . Device::Modem::CR);
1275              
1276             # Parse COPS answer, the 3rd string is the network name
1277 0           my $ans = $self->answer();
1278 0 0         if ($ans =~ /"([^"]*)"/) {
1279 0           $network = $1;
1280 0           $self->log->write('info', 'Received network name [' . $network . ']');
1281             }
1282             else {
1283 0           $self->log->write('info', 'Received no network name');
1284             }
1285              
1286             # Try to decode the network name
1287 0           require Device::Gsm::Networks;
1288 0           my $netname = Device::Gsm::Networks::name($network);
1289 0 0 0       if (!defined $netname || $netname eq 'unknown') {
1290 0           $netname = undef;
1291             }
1292             return wantarray
1293 0 0         ? ($netname, $network)
1294             : $netname;
1295              
1296             }
1297              
1298             #
1299             #returns simcard MSISDN
1300             #
1301             sub selfnum {
1302 0     0 0   my $self = shift;
1303 0           my @selfnum;
1304             my $selfnum;
1305 0 0         if ($self->test_command('CNUM')) {
1306 0           $self->atsend('AT+CNUM' . Device::Modem::CR);
1307 0           my $ans = $self->answer($Device::Modem::STD_RESPONSE);
1308 0           my @answer = split /[\r\n]+/m, $ans;
1309 0           foreach (@answer) {
1310 0 0         if ($_ =~ /^\+CNUM: /) {
1311 0           my @temp = split /,/, $';
1312 0           $temp[1] =~ s/"//g;
1313 0 0         if ($temp[1] =~ /\d{9,}/) {
1314 0 0         !$selfnum and $selfnum = $temp[1];
1315 0           push(@selfnum, $temp[1]);
1316             }
1317             }
1318             }
1319 0 0         if ($selfnum) {
1320 0           $self->log->write('info', 'Received number [' . "@selfnum" . ']');
1321             return wantarray
1322             ? @selfnum
1323 0 0         : $selfnum;
1324             }
1325             else {
1326 0           $self->log->write('info', 'Received no numbers');
1327 0           return "";
1328             }
1329              
1330             }
1331              
1332             #
1333             #On my motorola G24 for messages with alphanumeric sender sender() returns malformed characters
1334             #on globetrotter option 505 everything is all right. I wrote this at beggining of playng with you module,
1335             #and almost forgot about it. I'll investigate this bug in future.
1336             #
1337             }
1338              
1339             sub get_literal_header {
1340 0     0 0   my ($self, $index) = @_;
1341 0           my $header = '';
1342              
1343             #set text mode
1344 0           $self->atsend('AT+CMGF=1' . Device::Modem::CR);
1345 0           sleep 0.05;
1346 0 0         if ($self->answer($Device::Modem::STD_RESPONSE) =~ /OK/) {
1347 0           $self->log->write('warning', 'Text mode set');
1348             }
1349             else {
1350 0           $self->log->write('warning', 'Text mode not set');
1351 0           $self->log->write('warning', 'Trying restore PDU mode');
1352 0           $self->atsend('AT+CMGF=0' . Device::Modem::CR);
1353 0           sleep 0.05;
1354 0 0         $self->answer($Device::Modem::STD_RESPONSE) =~ /OK/
1355             and $self->log->write('warning', 'PDU mode restored');
1356 0           return;
1357             }
1358 0           $self->atsend('AT+MMGR=' . $index . Device::Modem::CR);
1359 0           my $ans = $self->answer();
1360 0 0         if ($ans =~ /\+MMGR:/) {
1361 0           my @temp = split(/,/, $');
1362 0           $header = $temp[1];
1363 0           $header =~ s/\"|\'//g;
1364             }
1365 0           $self->atsend('AT+CMGF=0' . Device::Modem::CR);
1366 0           sleep 0.05;
1367 0 0 0       $self->answer($Device::Modem::STD_RESPONSE) =~ /OK/
1368             and $self->log->write('warning', 'PDU mode Set')
1369             or return;
1370 0           return $header;
1371             }
1372              
1373             sub send_ussd {
1374 0     0 0   my ($self, $message) = @_;
1375 0           my $answer = '';
1376 0           my $encoded = Device::Gsm::Pdu::encode_text7_ussd($message);
1377 0 0         if ($self->test_command("CUSD")) {
1378 0           my $at_command
1379             = 'AT+CUSD=1,"' . $encoded . '",' . USSD_DCS . Device::Modem::CR;
1380 0           $self->atsend($at_command);
1381 0           my $expect = qr/ERROR|OK|\+CUSD:/;
1382 0           my $cReadChars = $Device::Modem::READCHARS;
1383 0           $Device::Modem::READCHARS = 300;
1384 0           my $response = '';
1385 0           $response = $self->answer($expect, 1000);
1386              
1387             # Catch the case that the msgs are returned with gaps between them
1388 0 0         $response =~ m/OK/
1389             and $response .= "\n" . $self->answer($expect, 15000);
1390 0           $Device::Modem::READCHARS = $cReadChars;
1391 0 0         if ($response =~ m/OK/) {
1392 0           $self->log->write('warning',
1393             'send_ussd command: "'
1394             . $message
1395             . '" OK, AT: '
1396             . $at_command . " "
1397             . 'response: '
1398             . $response);
1399 0 0         if ($response =~ m/\+CUSD:\s*(\d+)\s*,/) {
1400 0           my $response_code = $1;
1401             $self->log->write('warning',
1402             "Have a ussd_response code: $response_code=>"
1403 0           . $Device::Gsm::USSD_RESPONSE_CODES{$1});
1404 0           $response = $';
1405 0 0         if ($response_code < 2) {
    0          
1406 0 0         if ($response =~ m/\s*\"?([0-9A-F]+)\"?\s*,\s*(\d*)\s*/) {
1407 0           my $ussd_response = $1;
1408 0 0         my $ussd_dcs = length($2) ? $2 : USSD_DCS;
1409 0           $self->log->write('warning',
1410             "Have a ussd_response message: $ussd_response, dcs: $ussd_dcs"
1411             );
1412 0 0 0       ($ussd_dcs == 15 or $ussd_dcs == 0)
      0        
1413             and $answer
1414             = Device::Gsm::Pdu::decode_text7_ussd(
1415             $ussd_response)
1416             and $ussd_dcs = -1;
1417 0 0 0       $ussd_dcs == 72
1418             and $answer
1419             = Device::Gsm::Pdu::decode_text_UCS2(
1420             $ussd_response)
1421             and $ussd_dcs = -1;
1422 0 0 0       $ussd_dcs == 68
1423             and $answer
1424             = Device::Gsm::Pdu::decode_text8($ussd_response)
1425             and $ussd_dcs = -1;
1426 0 0         $ussd_dcs != -1
1427             and $self->log->write('warning',
1428             "Cant decode ussd_response message with dcs: $ussd_dcs"
1429             );
1430              
1431             }
1432              
1433             }
1434             elsif ($response_code == 2) {
1435             $response =~ m/\s*(\d+)\s*/
1436             and $self->log->write('warning',
1437             "Have a ussd_termintion code: $1=>"
1438 0 0         . $Device::Gsm::USSD_TERMINATION_CODES{$1});
1439             }
1440             }
1441             }
1442             else {
1443 0           $self->log->write('warning',
1444             'Error send_ussd command: '
1445             . $at_command
1446             . ", returned: "
1447             . $response);
1448 0           return '';
1449              
1450             }
1451             }
1452             else {
1453 0           $self->log->write('warning',
1454             'Error send_ussd AT+CUSD command not supported');
1455 0           return '';
1456             }
1457 0           return $answer;
1458             }
1459             1;
1460              
1461             __END__