@@ -1,13 +1,5 @@
Revision history for Perl extension Device::Gsm.
-1.60 Fri Mar 16 12:14:07 CET 2012
- - Removed the syslog test. Was artificial and pointless,
- and it failed on Windows and Solaris. Thanks to CPAN testers reports.
-
-1.59 Thu Mar 8 10:13:30 CET 2012
- - Fixed RT #75619, POD fixes to make the POD clean for Debian packaging.
- - Applied .perltidyrc to all source files. Watch out if you had patches :)
-
1.58 Mon Mar 7 22:31:22 EST 2011
- Fixed RT #48229, an uninitialized value when registering to the network
but getting no answer from the phone.
@@ -0,0 +1,1453 @@
+# Device::Gsm - a Perl class to interface GSM devices as AT modems
+# Copyright (C) 2002-2011 Cosimo Streppone, cosimo@cpan.org
+#
+# This program is free software; you can redistribute it and/or modify
+# it only under the terms of Perl itself.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# Perl licensing terms for more details.
+
+package Device::Gsm;
+
+$Device::Gsm::VERSION = '1.58';
+
+use strict;
+use Device::Modem 1.47;
+use Device::Gsm::Sms;
+use Device::Gsm::Pdu;
+use Device::Gsm::Charset;
+
+@Device::Gsm::ISA = ('Device::Modem');
+
+# Connection defaults to 19200 baud. This seems to be the optimal
+# rate for serial links to new gsm phones.
+$Device::Gsm::BAUDRATE = 19200;
+
+# Time to wait after network register command (secs)
+$Device::Gsm::REGISTER_DELAY = 2;
+
+# Connect on serial port to gsm device
+# see parameters on Device::Modem::connect()
+sub connect {
+ my $me = shift;
+ my %aOpt;
+ %aOpt = @_ if (@_);
+
+ #
+ # If you have problems with bad characters being trasmitted across serial link,
+ # try different baud rates, as below...
+ #
+ # .---------------------------------.
+ # | Model (phone/modem) | Baudrate |
+ # |---------------------+-----------|
+ # | Falcom Swing (A2D) | 9600 |
+ # | Siemens C35/C45 | 19200 |
+ # | Nokia phones | 19200 |
+ # | Nokia Communicator | 9600 |
+ # | Digicom | 9600 |
+ # `---------------------------------'
+ #
+ # GSM class defaults to 19200 baud
+ #
+ $aOpt{'baudrate'} ||= $Device::Gsm::BAUDRATE;
+
+ $me->SUPER::connect(%aOpt);
+}
+
+#
+# Get/set phone date and time
+#
+sub datetime {
+ my $self = shift;
+ my $ok = undef; # ok/err flag
+ my $datetime = undef; # datetime string
+ my @time = (); # array in "localtime" format
+
+ # Test support for clock function
+ if ($self->test_command('+CCLK')) {
+
+ if (@_) {
+
+ # If called with "$self->datetime(time())" format
+ if (@_ == 1) {
+
+ # $_[0] must be result of `time()' func
+ @time = localtime($_[0]);
+ }
+ else {
+
+ # If called with "$self->datetime(localtime())" format
+ # @_ here is the result of `localtime()' func
+ @time = @_;
+ }
+
+ $datetime = sprintf(
+ '%02d/%02d/%02d,%02d:%02d:%02d',
+ $time[5] - 100, # year
+ 1 + $time[4], # month
+ $time[3], # day
+ @time[ 2, 1, 0 ], # hr,min,secs
+ );
+
+ # Set time of phone
+ $self->atsend(qq{AT+CCLK="$datetime"} . Device::Modem::CR);
+ $ok = $self->parse_answer($Device::Modem::STD_RESPONSE);
+
+ $self->log->write('info',
+ "write datetime ($datetime) to phone => ("
+ . ($ok ? 'OK' : 'FAILED')
+ . ")");
+
+ }
+ else {
+
+ $self->atsend('AT+CCLK?' . Device::Modem::CR);
+ ($ok, $datetime)
+ = $self->parse_answer($Device::Modem::STD_RESPONSE);
+
+ #warn('datetime='.$datetime);
+ if ( $ok
+ && $datetime
+ =~ m|\+CCLK:\s*"?(\d\d)/(\d\d)/(\d\d)\,(\d\d):(\d\d):(\d\d)"?|
+ )
+ {
+ $datetime = "$1/$2/$3 $4:$5:$6";
+ $self->log->write('info',
+ "read datetime from phone ($datetime)");
+ }
+ else {
+ $self->log->write('warn',
+ "datetime format ($datetime) not recognized");
+ $datetime = undef;
+ }
+
+ }
+
+ }
+
+ return $datetime;
+
+}
+
+#
+# Delete a message from sim card
+#
+sub delete_sms {
+ my $self = shift;
+ my $msg_index = shift;
+ my $storage = shift;
+ my $ok;
+
+ if (!defined $msg_index || $msg_index eq '') {
+ $self->log->write('warn',
+ 'undefined message number. cannot delete sms message');
+ return 0;
+ }
+
+ # Set default SMS storage if supported
+ $self->storage($storage);
+
+ $self->atsend(qq{AT+CMGD=$msg_index} . Device::Modem::CR);
+
+ my $ans = $self->parse_answer($Device::Modem::STD_RESPONSE);
+ if (index($ans, 'OK') > -1 || $ans =~ /\+CMGD/) {
+ $ok = 1;
+ }
+
+ $self->log->write('info',
+ "deleting sms n.$msg_index from storage "
+ . ($storage || "default")
+ . " (result: `$ans') => "
+ . ($ok ? 'ok' : '*FAILED*'));
+
+ return $ok;
+}
+
+#
+# Call forwarding
+#
+sub forward {
+ my ($self, $reason, $mode, $number) = @_;
+
+ $reason = lc $reason || 'unconditional';
+ $mode = lc $mode || 'register';
+ $number ||= '';
+
+ my %reasons = (
+ 'unconditional' => 0,
+ 'busy' => 1,
+ 'no reply' => 2,
+ 'unreachable' => 3
+ );
+
+ my %modes = (
+ 'disable' => 0,
+ 'enable' => 1,
+ 'query' => 2,
+ 'register' => 3,
+ 'erase' => 4
+ );
+
+ my $reasoncode = $reasons{$reason};
+ my $modecode = $modes{$mode};
+
+ $self->log->write('info',
+ qq{setting $reason call forwarding to [$number]});
+ $self->atsend(
+ qq{AT+CCFC=$reasoncode,$modecode,"$number"} . Device::Modem::CR);
+
+ return $self->parse_answer($Device::Modem::STD_RESPONSE, 15000);
+}
+
+#
+# Hangup and terminate active call(s)
+# this overrides the `Device::Modem::hangup()' method
+#
+sub hangup {
+ my $self = shift;
+ $self->log->write('info', 'hanging up...');
+ $self->attention();
+ $self->atsend('AT+CHUP' . Device::Modem::CR);
+ $self->flag('OFFHOOK', 0);
+ $self->answer(undef, 5000);
+}
+
+#
+# Who is the manufacturer of this device?
+#
+sub manufacturer {
+ my $self = shift;
+ my ($ok, $man);
+
+ # We can't test for command support, because some phones, mainly Motorola
+ # will spit out an error, instead of telling if CGMI is supported.
+ $self->atsend('AT+CGMI' . Device::Modem::CR);
+ ($ok, $man) = $self->parse_answer($Device::Modem::STD_RESPONSE);
+
+ if ($ok ne 'OK') {
+ $self->log->write('warn',
+ 'manufacturer command ended with error [' . $ok . $man . ']');
+ return undef;
+ }
+
+ # Again, seems that Motorola phones will re-echo
+ # the CGMI command header, instead of giving us the
+ # manufacturer info we want. Thanks to Niolay Shaplov
+ # for reporting (RT #31540)
+ if ($man =~ /\+CGMI:\ \"(.*)\"/s) {
+ $man = $1;
+ }
+
+ $self->log->write('info',
+ 'manufacturer of this device appears to be [' . $man . ']');
+
+ return $man || $ok;
+}
+
+#
+# Set text or pdu mode for gsm devices. If no parameter passed, returns current mode
+#
+sub mode {
+ my $self = shift;
+
+ if (@_) {
+ my $mode = lc $_[0];
+ if ($mode eq 'text') {
+ $mode = 1;
+ }
+ else {
+ $mode = 0;
+ }
+ $self->{'_mode'} = $mode ? 'text' : 'pdu';
+ $self->log->write('info',
+ 'setting mode to [' . $self->{'_mode'} . ']');
+ $self->atsend(qq{AT+CMGF=$mode} . Device::Modem::CR);
+
+ return $self->parse_answer($Device::Modem::STD_RESPONSE);
+ }
+
+ return ($self->{'_mode'} || '');
+
+}
+
+#
+# What is the model of this device?
+#
+sub model {
+ my $self = shift;
+ my ($code, $model);
+
+ # Test if manufacturer code command is supported
+ if ($self->test_command('+CGMM')) {
+
+ $self->atsend('AT+CGMM' . Device::Modem::CR);
+ ($code, $model) = $self->parse_answer($Device::Modem::STD_RESPONSE);
+
+ $self->log->write('info',
+ 'model of this device is [' . ($model || '') . ']');
+
+ }
+
+ return $model || $code;
+}
+
+#
+# Get handphone serial number (IMEI number)
+#
+sub imei {
+ my $self = shift;
+ my ($code, $imei);
+
+ # Test if manufacturer code command is supported
+ if ($self->test_command('+CGSN')) {
+
+ $self->atsend('AT+CGSN' . Device::Modem::CR);
+ ($code, $imei) = $self->parse_answer($Device::Modem::STD_RESPONSE);
+
+ $self->log->write('info', 'IMEI code is [' . $imei . ']');
+
+ }
+
+ return $imei || $code;
+}
+
+# Alias for `imei()' is `serial_number()'
+*serial_number = *imei;
+
+#
+# Get mobile phone signal quality (expressed in dBm)
+#
+sub signal_quality {
+ my $self = shift;
+
+ # Error code, dBm (signal power), bit error rate
+ my ($code, @dBm, $dBm, $ber);
+
+ # Test if signal quality command is implemented
+ if ($self->test_command('+CSQ')) {
+
+ $self->atsend('AT+CSQ' . Device::Modem::CR);
+ ($code, @dBm)
+ = $self->parse_answer($Device::Modem::STD_RESPONSE, 15000);
+
+ # Vodafone data cards send out response to commands with
+ # many empty lines in between, so +CSQ response is not the very
+ # first line of answer.
+ for (@dBm) {
+ if (/\+CSQ:/) {
+ $dBm = $_;
+ last;
+ }
+ }
+
+ # Some gsm software send CSQ command result as "+CSQ: xx,yy"
+ if ($dBm =~ /\+CSQ:\s*(\d+),(\d+)/) {
+
+ ($dBm, $ber) = ($1, $2);
+
+ # Further process dBm number to obtain real dB power
+ if ($dBm > 30) {
+ $dBm = -51;
+ }
+ else {
+ $dBm = -113 + ($dBm << 1);
+ }
+
+ $self->log->write('info',
+ 'signal dBm power is ['
+ . $dBm
+ . '], bit error rate ['
+ . $ber
+ . ']');
+
+ # Other versions put out "+CSQ: xx" only...
+ }
+ elsif ($dBm =~ /\+CSQ:\s*(\d+)/) {
+
+ $dBm = $1;
+
+ $self->log->write('info', 'signal is [' . $dBm . '] "bars"');
+
+ }
+ else {
+
+ $self->log->write('warn', 'cannot obtain signal dBm power');
+
+ }
+
+ }
+ else {
+
+ $self->log->write('warn', 'signal quality command not supported!');
+
+ }
+
+ return $dBm;
+
+}
+
+#
+# Get the GSM software version on this device
+#
+sub software_version {
+ my $self = shift;
+ my ($code, $ver);
+
+ # Test if manufacturer code command is supported
+ if ($self->test_command('+CGMR')) {
+
+ $self->atsend('AT+CGMR' . Device::Modem::CR);
+ ($code, $ver) = $self->parse_answer($Device::Modem::STD_RESPONSE);
+
+ $self->log->write('info', 'GSM version is [' . $ver . ']');
+
+ }
+
+ return $ver || $code;
+}
+
+#
+# Test support for a specific command
+#
+sub test_command {
+ my ($self, $command) = @_;
+
+ # Support old code adding a `+' if not specified
+ # TODO to be removed in 1.30 ?
+ if ($command =~ /^[a-zA-Z]/) {
+ $command = '+' . $command;
+ }
+
+ # Standard test procedure for every command
+ $self->log->write('info',
+ 'testing support for command [' . $command . ']');
+ $self->atsend("AT$command=?" . Device::Modem::CR);
+
+ # If answer is ok, command is supported
+ my $ok = ($self->answer($Device::Modem::STD_RESPONSE) || '') =~ /OK/o;
+ $self->log->write('info',
+ 'command [' . $command . '] is ' . ($ok ? '' : 'not ') . 'supported');
+
+ $ok;
+}
+
+#
+# Read all messages on SIM card (XXX must be registered on network)
+#
+sub messages {
+ my ($self, $storage) = @_;
+ my @messages;
+
+ # By default (old behaviour) messages are read from sim card
+ $storage ||= 'SM';
+
+ $self->log->write('info', 'Reading messages on '
+ . ($storage eq 'SM' ? 'Sim card' : 'phone memory'));
+
+ # Register on network (give your PIN number for this!)
+ #return undef unless $self->register();
+ $self->register();
+
+ #
+ # Read messages (TODO need to check if device supports CMGL with `stat'=4)
+ #
+ if ($self->mode() eq 'text') {
+ warn 'Read messages in text mode is not implemented yet.';
+
+ #@messages = $self->_read_messages_text();
+ }
+ else {
+
+ # Set default storage if supported
+ $self->storage($storage);
+
+ push @messages, $self->_read_messages_pdu();
+ }
+
+ return @messages;
+}
+
+sub storage {
+ my $self = shift;
+ my $ok = 0;
+
+ # Set default SMS storage if supported by phone
+ if (@_ && (my $storage = uc $_[0])) {
+ return unless $self->test_command('+CPMS');
+ $self->atsend(qq{AT+CPMS="$storage"} . Device::Modem::CR);
+
+ # Read and discard the answer
+ $self->answer($Device::Modem::STD_RESPONSE, 5000);
+ $self->{_storage} = $storage;
+ }
+
+ return $self->{_storage};
+}
+
+#
+# Register to GSM service provider network
+#
+sub register {
+ my $me = shift;
+ my $lOk = 0;
+
+ # Check for connection
+ if (!$me->{'CONNECTED'}) {
+ $me->log->write('info', 'Not yet connected. Doing it now...');
+ if (!$me->connect()) {
+ $me->log->write('warning', 'No connection!');
+ return $lOk;
+ }
+ }
+
+ # On some phones, registration doesn't work, so you can skip it entirely
+ # by passing 'assume_registered => 1' to the new() constructor
+ if (exists $me->{'assume_registered'} && $me->{'assume_registered'}) {
+ return $me->{'REGISTERED'} = 1;
+ }
+
+ # Send PIN status query
+ $me->log->write('info', 'PIN status query');
+ $me->atsend('AT+CPIN?' . Device::Modem::CR);
+
+ # Get answer
+ my $cReply = $me->answer($Device::Modem::STD_RESPONSE, 10000);
+
+ if (! defined $cReply || $cReply eq "") {
+ $me->log->write('warn', 'Could not get a reply for the AT+CPIN command');
+ return;
+ }
+
+ if ($cReply =~ /(READY|SIM PIN2)/) {
+
+ # Iridium satellite phones rest saying "SIM PIN2" when they are registered...
+
+ $me->log->write('info',
+ 'Already registered on network. Ready to send.');
+ $lOk = 1;
+
+ }
+ elsif ($cReply =~ /SIM PIN/) {
+
+ # Pin request, sending PIN code
+ $me->log->write('info', 'PIN requested: sending...');
+ $me->atsend(qq[AT+CPIN="$$me{'pin'}"] . Device::Modem::CR);
+
+ # Get reply
+ $cReply = $me->answer($Device::Modem::STD_RESPONSE, 10000);
+
+ # Test reply
+ if ($cReply !~ /ERROR/) {
+ $me->log->write('info', 'PIN accepted. Ready to send.');
+ $lOk = 1;
+ }
+ else {
+ $me->log->write('warning', 'PIN rejected');
+ $lOk = 0;
+ }
+
+ }
+
+ # Store status in object and return
+ $me->{'REGISTERED'} = $lOk;
+
+ return $lOk;
+}
+
+# send_sms( %options )
+#
+# recipient => '+39338101010'
+# class => 'flash' | 'normal'
+# validity => [ default = 4 days ]
+# content => 'text-only for now'
+# mode => 'text' | 'pdu' (default = 'pdu')
+#
+sub send_sms {
+
+ my ($me, %opt) = @_;
+
+ my $lOk = 0;
+
+ return unless $opt{'recipient'} and $opt{'content'};
+
+ # Check if registered to network
+ if (!$me->{'REGISTERED'}) {
+ $me->log->write('info', 'Not yet registered, doing now...');
+ $me->register();
+
+ # Wait some time to allow SIM registering to network
+ $me->wait($Device::Gsm::REGISTER_DELAY << 10);
+ }
+
+ # Again check if now registered
+ if (!$me->{'REGISTERED'}) {
+
+ $me->log->write('warning', 'ERROR in registering to network');
+ return $lOk;
+
+ }
+
+ # Ok, registered. Select mode to send SMS
+ $opt{'mode'} ||= 'PDU';
+ if (uc $opt{'mode'} ne 'TEXT') {
+
+ $lOk = $me->_send_sms_pdu(%opt);
+
+ }
+ else {
+
+ $lOk = $me->_send_sms_text(%opt);
+ }
+
+ # Return result of sending
+ return $lOk;
+}
+
+#
+#
+# read messages in pdu mode
+#
+#
+sub _read_messages_pdu {
+ my $self = shift;
+
+ $self->mode('pdu');
+
+ $self->atsend(q{AT+CMGL=4} . Device::Modem::CR);
+ my ($messages) = $self->answer($Device::Modem::STD_RESPONSE, 5000);
+
+ # Catch the case that the msgs are returned with gaps between them
+ while (my $more = $self->answer($Device::Modem::STD_RESPONSE, 200)) {
+
+ #-- $self->answer will chomp trailing newline, add it back
+ $messages .= "\n";
+ $messages .= $more;
+ }
+
+ # Ok, messages read, now convert from PDU and store in object
+ $self->log->write('debug', 'Messages=' . $messages);
+
+ my @data = split /[\r\n]+/m, $messages;
+
+ # Check for errors on SMS reading
+ my $code;
+ if (($code = pop @data) =~ /ERROR/) {
+ $self->log->write('error',
+ 'cannot read SMS messages on SIM: [' . $code . ']');
+ return ();
+ }
+
+ my @message = ();
+ my $current;
+
+ # Current sms storage memory (ME or SM)
+ my $storage = $self->storage();
+
+ #
+ # Parse received data (result of +CMGL command)
+ #
+ while (@data) {
+
+ $self->log->write('debug', 'data[] = ', $data[0]);
+ my $header = shift @data;
+ my $pdu = shift @data;
+
+ # Instance new message object
+ my $msg = new Device::Gsm::Sms(
+ header => $header,
+ pdu => $pdu,
+
+ # XXX mode => $self->mode(),
+ storage => $storage,
+ parent => $self # Ref to parent Device::Gsm class
+ );
+
+ # Check if message has been instanced correctly
+ if (ref $msg) {
+ push @message, $msg;
+ }
+ else {
+ $self->log->write('info',
+ "could not instance message $header $pdu!");
+ }
+
+ }
+
+ $self->log->write('info',
+ 'found ' . (scalar @message) . ' messages on SIM. Reading.');
+
+ return @message;
+
+}
+
+#
+# _send_sms_text( %options ) : sends message in text mode
+#
+sub _send_sms_text {
+ my ($me, %opt) = @_;
+
+ my $num = $opt{'recipient'};
+ my $text = $opt{'content'};
+
+ return 0 unless $num and $text;
+
+ my $lOk = 0;
+ my $cReply;
+
+ # Select text format for messages
+ $me->mode('text');
+ $me->log->write('info', 'Selected text format for message sending');
+
+ # Send sms in text mode
+ $me->atsend(qq[AT+CMGS="$num"] . Device::Modem::CR);
+
+ # Wait a bit before sending the text. Some GSM software needs it.
+ $me->wait($Device::Modem::WAITCMD);
+
+ # Complete message sending
+ $text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
+ $me->atsend($text . Device::Modem::CTRL_Z);
+
+ # Get reply and check for errors
+ $cReply = $me->answer('+CMGS', 2000);
+ if ($cReply =~ /OK$/i) {
+ $me->log->write('info', "Sent SMS (text mode) to $num!");
+ $lOk = 1;
+ }
+ else {
+ $me->log->write('warning', "ERROR in sending SMS");
+ }
+
+ return $lOk;
+}
+
+#
+# _send_sms_pdu( %options ) : sends message in PDU mode
+#
+sub _send_sms_pdu {
+ my ($me, %opt) = @_;
+
+ # Get options
+ my $num = $opt{'recipient'};
+ my $text = $opt{'content'};
+
+ return 0 unless $num and $text;
+
+ $me->atsend(q[ATE1] . Device::Modem::CR);
+ $me->answer($Device::Modem::STD_RESPONSE);
+
+ # Select class of sms (normal or *flash sms*)
+ my $class = $opt{'class'} || 'normal';
+ $class = $class eq 'normal' ? '00' : 'F0';
+
+ # TODO Validity period (now fixed to 4 days)
+ my $vp = 'AA';
+
+ # Status report requested?
+ my $status_report = 0;
+ if (exists $opt{'status_report'} && $opt{'status_report'}) {
+ $status_report = 1;
+ }
+
+ my $lOk = 0;
+ my $cReply;
+
+ # Send sms in PDU mode
+
+ #
+ # Example of sms send in PDU mode
+ #
+ #AT+CMGS=22
+ #> 0011000A8123988277190000AA0AE8329BFD4697D9EC37
+ #+CMGS: 111
+ #
+ #OK
+
+ # Encode DA
+ my $enc_da = Device::Gsm::Pdu::encode_address($num);
+ $me->log->write('info', 'encoded dest. address is [' . $enc_da . ']');
+
+ # Encode text
+ $text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
+ my $enc_msg = Device::Gsm::Pdu::encode_text7($text);
+ $me->log->write('info',
+ 'encoded 7bit text (w/length) is [' . $enc_msg . ']');
+
+ # Build PDU data
+ my $pdu = uc join(
+ '',
+ '00',
+ ($status_report ? '31' : '11'),
+ '00',
+ $enc_da,
+ '00',
+ $class,
+ $vp,
+ $enc_msg
+ );
+
+ $me->log->write('info', 'due to send PDU [' . $pdu . ']');
+
+ # Sending main SMS command ( with length )
+ my $len = ((length $pdu) >> 1) - 1;
+
+ #$me->log->write('info', 'AT+CMGS='.$len.' string sent');
+
+ # Select PDU format for messages
+ $me->atsend(q[AT+CMGF=0] . Device::Modem::CR);
+ $me->answer($Device::Modem::STD_RESPONSE);
+ $me->log->write('info', 'Selected PDU format for msg sending');
+
+ # Send SMS length
+ $me->atsend(qq[AT+CMGS=$len] . Device::Modem::CR);
+ $me->answer($Device::Modem::STD_RESPONSE);
+
+ # Sending SMS content encoded as PDU
+ $me->log->write('info', 'PDU sent [' . $pdu . ' + CTRLZ]');
+ $me->atsend($pdu . Device::Modem::CTRL_Z);
+
+ # Get reply and check for errors
+ $cReply = $me->answer($Device::Modem::STD_RESPONSE, 30000);
+ $me->log->write('debug', "SMS reply: $cReply\r\n");
+
+ if ($cReply =~ /OK$/i) {
+ $me->log->write('info', "Sent SMS (pdu mode) to $num!");
+ $lOk = 1;
+ }
+ else {
+ $cReply =~ /(\+CMGS:.*)/;
+ $me->log->write('warning', "ERROR in sending SMS: $1");
+ }
+
+ return $lOk;
+}
+
+#
+# Set or request service center number
+#
+sub service_center {
+
+ my $self = shift;
+ my $nCenter;
+ my $lOk = 1;
+ my $code;
+
+ # If additional parameter is supplied, store new message center number
+ if (@_) {
+ $nCenter = shift();
+
+ # Remove all non numbers or `+' sign
+ $nCenter =~ s/[^0-9+]//g;
+
+ # Send AT command
+ $self->atsend(qq[AT+CSCA="$nCenter"] . Device::Modem::CR);
+
+ # Check for modem answer
+ $lOk = ($self->answer($Device::Modem::STD_RESPONSE) =~ /OK/);
+
+ if ($lOk) {
+ $self->log->write('info',
+ 'service center number [' . $nCenter . '] stored');
+ }
+ else {
+ $self->log->write('warning',
+ 'unexpected response for "service_center" command');
+ }
+
+ }
+ else {
+
+ $self->log->write('info', 'requesting service center number');
+ $self->atsend('AT+CSCA?' . Device::Modem::CR);
+
+ # Get answer and check for errors
+ ($code, $nCenter) = $self->parse_answer($Device::Modem::STD_RESPONSE);
+
+ if ($code =~ /ERROR/) {
+ $self->log->write('warning',
+ 'error status for "service_center" command');
+ $lOk = 0;
+ }
+ else {
+
+ # $nCenter =~ tr/\r\nA-Z//s;
+ $self->log->write('info',
+ 'service center number is [' . $nCenter . ']');
+
+ # Return service center number
+ $lOk = $nCenter;
+ }
+
+ }
+
+ # Status flag or service center number
+ return $lOk;
+
+}
+
+sub network {
+ my $self = $_[0];
+ my $network;
+
+ #if( ! $self->test_command('COPS') )
+ #{
+ # print 'NO COMMAND';
+ # return undef;
+ #}
+
+ $self->atsend('AT+COPS?' . Device::Modem::CR);
+
+ # Parse COPS answer, the 3rd string is the network name
+ my $ans = $self->answer();
+ if ($ans =~ /"([^"]*)"/) {
+ $network = $1;
+ $self->log->write('info', 'Received network name [' . $network . ']');
+ }
+ else {
+ $self->log->write('info', 'Received no network name');
+ }
+
+ # Try to decode the network name
+ require Device::Gsm::Networks;
+ my $netname = Device::Gsm::Networks::name($network);
+ if (!defined $netname || $netname eq 'unknown') {
+ $netname = undef;
+ }
+
+ return wantarray
+ ? ($netname, $network)
+ : $netname;
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Device::Gsm - Perl extension to interface GSM phones / modems
+
+=head1 SYNOPSIS
+
+ use Device::Gsm;
+
+ my $gsm = new Device::Gsm( port => '/dev/ttyS1', pin => 'xxxx' );
+
+ if( $gsm->connect() ) {
+ print "connected!\n";
+ } else {
+ print "sorry, no connection with gsm phone on serial port!\n";
+ }
+
+ # Register to GSM network (you must supply PIN number in above new() call)
+ # See 'assume_registered' in the new() method documentation
+ $gsm->register();
+
+ # Send quickly a short text message
+ $gsm->send_sms(
+ recipient => '+3934910203040',
+ content => 'Hello world! from Device::Gsm'
+ );
+
+ # Get list of Device::Gsm::Sms message objects
+ # see `examples/read_messages.pl' for all the details
+ my @messages = $gsm->messages();
+
+=head1 DESCRIPTION
+
+C<Device::Gsm> class implements basic GSM functions, network registration and SMS sending.
+
+This class supports also C<PDU> mode to send C<SMS> messages, and should be
+fairly usable. In the past, I have developed and tested it under Linux RedHat 7.1
+with a 16550 serial port and Siemens C35i/C45 GSM phones attached with
+a Siemens-compatible serial cable. Currently, I'm developing and testing this stuff
+with Linux Slackware 10.2 and a B<Cambridge Silicon Radio> (CSR) USB
+bluetooth dongle, connecting to a Nokia 6600 phone.
+
+Please be kind to the universe and contact me if you have troubles or you are
+interested in this.
+
+Please be monstruosly kind to the universe and (if you don't mind spending an SMS)
+use the C<examples/send_to_cosimo.pl> script to make me know that Device::Gsm works
+with your device (thanks!).
+
+Recent versions of C<Device::Gsm> have also an utility called C<autoscan> in
+the C<bin/> folder, that creates a little profile of the devices it runs
+against, that contains information about supported commands and exact output
+of commands to help recognize similar devices.
+
+Be sure to send me your profile by email (if you want to),
+so I can add better support for your device in the future!
+
+=head1 METHODS
+
+The following documents all supported methods with simple examples of usage.
+
+=head2 new()
+
+Inherited from L<Device::Modem>. See L<Device::Modem> documentation
+for more details.
+
+The only mandatory argument is the C<port> you want to use to connect
+to the GSM device:
+
+ my $gsm = Device::Gsm->new(
+ port => '/dev/ttyS0',
+ );
+
+On some phones, you may experience problems in the GSM network registration
+step. For this reasons, you can pass a special C<assume_registered> option
+to have L<Device::Gsm> ignore the registration step and assume the device
+is already registered on the GSM network. Example:
+
+ my $gsm = Device::Gsm->new(
+ port => '/dev/ttyS0',
+ assume_registered => 1,
+ );
+
+If you want to send debugging information to your own log file instead of
+the default setting, you can:
+
+ my $gsm = Device::Gsm->new(
+ port => '/dev/ttyS1',
+ log => 'file,/tmp/myfile.log',
+ loglevel => 'debug', # default is 'warning'
+ );
+
+=head2 connect()
+
+This is the main call that connects to the appropriate device. After the
+connection has been established, you can start issuing commands.
+The list of accepted parameters (to be specified as hash keys and values) is
+the same of C<Device::SerialPort> (or C<Win32::SerialPort> on Windows platform),
+as all parameters are passed to those classes' connect() method.
+
+The default value for C<baudrate> parameter is C<19200>.
+
+Example:
+
+ my $gsm = Device::Gsm->new( port=>'/dev/ttyS0', log=>'syslog' );
+ # ...
+ if( $gsm->connect(baudrate => 19200) ) {
+ print "Connected!";
+ } else {
+ print "Could not connect, sorry!";
+ }
+ # ...
+
+=head2 datetime()
+
+Used to get or set your phone/gsm modem date and time.
+
+If called without parameters, it gets the current phone/gsm date and time in "gsm"
+format "YY/MM/DD,HH:MN:SS". For example C<03/12/15,22:48:59> means December the 15th,
+at 10:48:59 PM. Example:
+
+ $datestr = $gsm->datetime();
+
+If called with parameters, sets the current phone/gsm date and time to that
+of supplied value. Example:
+
+ $newdate = $gsm->datetime( time() );
+
+where C<time()> is the perl's builtin C<time()> function (see C<perldoc -f time> for details).
+Another variant allows to pass a C<localtime> array to set the correspondent datetime. Example:
+
+ $newdate = $gsm->datetime( localtime() );
+
+(Note the list context). Again you can read the details for C<localtime> function
+with C<perldoc -f localtime>.
+
+If your device does not support this command, an B<undefined> value will be returned
+in either case.
+
+
+=head2 delete_sms()
+
+This method deletes a message from your SIM card, given the message index number.
+Example:
+
+ $gsm->delete_sms(3);
+
+An optional second parameter specifies the "storage". It allows to delete messages
+from gsm phone memory or sim card memory. Example:
+
+ # Deletes first message from gsm phone memory
+ $gsm->delete_sms(1, 'ME');
+
+ # Deletes 3rd message from sim card
+ $gsm->delete_sms(3, 'SM');
+
+By default, it uses the currently set storage, via the C<storage()> method.
+
+=head2 forward()
+
+Sets call forwarding. Accepts three arguments: reason, mode and number.
+Reason can be the string C<unconditional>, C<busy>, C<no reply> and C<unreachable>.
+Mode can be the string C<disable>, C<enable>, C<query>, C<register>, C<erase>.
+
+Example:
+
+ # Set unconditional call forwarding to +47 123456789
+ $gsm->forward('unconditional','register','+47123456789');
+
+ # Erase unconditional call forwarding
+ $gsm->forward('unconditional','erase');
+
+
+=head2 hangup()
+
+Hangs up the phone, terminating the active calls, if any.
+This method has been never tested on real "live" conditions, but it needs to be
+specialized for GSM phones, because it relies on C<+HUP> GSM command.
+Example:
+
+ $gsm->hangup();
+
+
+=head2 imei()
+
+Returns the device own IMEI number (International Mobile Equipment Identifier ???).
+This identifier is numeric and should be unique among all GSM mobile devices and phones.
+This is not really true, but ... . Example:
+
+ my $imei = $gsm->imei();
+
+
+=head2 manufacturer()
+
+Returns the device manufacturer, usually only the first word (example: C<Nokia>,
+C<Siemens>, C<Falcom>, ...). Example:
+
+ my $man_name = $gsm->manufacturer();
+ if( $man_name eq 'Nokia' ) {
+ print "We have a nokia phone...";
+ } else {
+ print "We have a $man_name phone...";
+ }
+
+
+=head2 messages()
+
+This method is a somewhat unstable and subject to change, but for now it seems to work.
+It is meant to extract all text SMS messages stored on your SIM card or gsm phone.
+In list context, it returns a list of messages (or undefined value if no message or errors),
+every message being a C<Device::Gsm::Sms> object.
+
+The only parameter specifies the C<storage> where you want to read the messages,
+and can assume some of the following values (but check your phone/modem manual for
+special manufacturer values):
+
+=over 4
+
+=item C<ME>
+
+Means gsm phone B<ME>mory
+
+=item C<MT>
+
+Means gsm phone B<ME>mory on Nokia phones?
+
+=item C<SM>
+
+Means B<S>im card B<M>emory (default value)
+
+=back
+
+Example:
+
+ my $gsm = Device::Gsm->new();
+ $gsm->connect(port=>'/dev/ttyS0') or die "Can't connect!";
+
+ for( $gsm->messages('SM') )
+ {
+ print $_->sender(), ': ', $_->content(), "\n";
+ }
+
+=head2 mode()
+
+Sets the device GSM command mode. Accepts one parameter to set the new mode that can
+be the string C<text> or C<pdu>. Example:
+
+ # Set text mode
+ $gsm->mode('text');
+
+ # Set pdu mode
+ $gsm->mode('pdu');
+
+
+=head2 model()
+
+Returns phone/device model name or number. Example:
+
+ my $model = $gsm->model();
+
+For example, for Siemens C45, C<$model> holds C<C45>; for Nokia 6600, C<$model>
+holds C<6600>.
+
+
+=head2 network()
+
+Returns the current registered or preferred GSM network operator. Example:
+
+ my $net_name = $gsm->network();
+ # Returns 'Wind Telecom Spa'
+
+ my($net_name, $net_code) = $gsm->network();
+ # Returns ('Wind Telecom Spa', '222 88')
+
+This obviously varies depending on country and network operator. For me now,
+it holds "Wind Telecomunicazioni SpA". It is not guaranteed that the mobile
+phone returns the decoded network name. It can also return a gsm network code,
+like C<222 88>. In this case, an attempt to decode the network name is made.
+
+Be sure to call the C<network()> method when already registered to gsm
+network. See C<register()> method.
+
+
+=head2 signal_quality()
+
+Returns the measure of signal quality expressed in dBm units, where near to zero is better.
+An example value is -91 dBm, and reported value is C<-91>. Values should range from
+-113 to -51 dBm, where -113 is the minimum signal quality and -51 is the theorical maximum quality.
+
+ my $level = $gsm->signal_quality();
+
+If signal quality can't be read or your device does not support this command,
+an B<undefined> value will be returned.
+
+=head2 software_version()
+
+Returns the device firmare version, as stored by the manufacturer. Example:
+
+ my $rev = $gsm->software_revision();
+
+For example, for my Siemens C45, C<$rev> holds C<06>.
+
+=head2 storage()
+
+Allows to get/set the current sms storage, that is where the sms messages are saved,
+either the sim card or gsm phone memory. Phones/modems that do not support this feature
+(implemented by C<+CPMS> AT command won't be affected by this method.
+
+ my @msg;
+ my $storage = $gsm->storage();
+ print "Current storage is $storage\n";
+
+ # Read all messages on sim card
+ $gsm->storage('SM');
+ @msg = $gsm->messages();
+
+ # Read messages from gsm phone memory
+ $gsm->storage('ME');
+ push @msg, $gsm->messages();
+
+=head2 test_command()
+
+This method allows to query the device to know if a specific AT GSM command is supported.
+This is used only with GSM commands (those with C<AT+> prefix).
+For example, I want to know if my device supports the C<AT+GXXX> command.
+All we have to do is:
+
+ my $gsm = Device::Gsm->new( port => '/dev/myport' );
+
+ ...
+
+ if( $gsm->test_command('GXXX') ) {
+ # Ok, command is supported
+ } else {
+ # Nope, no GXXX command
+ }
+
+Note that if you omit the starting C<+> character, it is automatically added.
+You can also test commands like C<^SNBR> or the like, without C<+> char being added.
+
+=for html
+<I>Must be explained better, uh?</I>
+
+=for comment
+// must be explainer better, uh? //
+
+=head2 register()
+
+"Registering" on the GSM network is what happens when you turn on your mobile phone or GSM equipment
+and the device tries to reach the GSM operator network. If your device requires a B<PIN> number,
+it is used here (but remember to supply the C<pin> parameter in new() object constructor for this
+to work.
+
+Registration can take some seconds, don't worry for the wait.
+After that, you are ready to send your SMS messages or do some voice calls, ... .
+Normally you don't need to call register() explicitly because it is done automatically for you
+when/if needed.
+
+If return value is true, registration was successful, otherwise there is something wrong;
+probably you supplied the wrong PIN code or network unreachable.
+
+=head2 send_sms()
+
+Obviously, this sends out SMS text messages. I should warn you that B<you cannot send>
+(for now) MMS, ringtone, smart, ota messages of any kind with this method.
+
+Send out an SMS message quickly:
+
+ my $sent = $gsm->send_sms(
+ content => 'Hello, world!', # SMS text
+ recipient => '+99000123456', # recipient phone number
+ );
+
+ if( $sent ) {
+ print "OK!";
+ } else {
+ print "Troubles...";
+ }
+
+The allowed parameters to send_sms() are:
+
+=over -
+
+=item C<class>
+
+Class parameter can assume two values: C<normal> and C<flash>. Flash (or class zero) messages are
+particular because they are immediately displayed (without user confirm) and never stored
+on phone memory, while C<normal> is the default.
+
+=item C<content>
+
+This is the text you want to send, consisting of max 160 chars if you use B<PDU> mode
+and 140 (?) if in B<text> mode (more on this later).
+
+=item C<mode>
+
+Can assume two values (case insensitive): C<pdu> and C<text>.
+C<PDU> means B<Protocol Data Unit> and it is a sort of B<binary> encoding of commands,
+to save time/space, while C<text> is the normal GSM commands text mode.
+
+Recent mobile phones and GSM equipments surely have support for C<PDU> mode.
+Older OEM modules (like Falcom Swing, for example) don't have PDU mode, but only text mode.
+It is just a matter of trying.
+
+=item C<recipient>
+
+Phone number of message recipient
+
+=item C<status_report>
+
+If present with a true value, it enables sending of SMS messages (only for PDU mode,
+text mode SMS won't be influenced by this parameter) with the status report,
+also known as delivery report, that is a short message that reports the status
+of your sent message.
+Usually this is only available if your mobile company supports this feature,
+and probably you will be charged a small amount for this service.
+
+More information on this would be welcome.
+
+=back
+
+=head2 service_center()
+
+If called without parameters, returns the actual SMS Service Center phone number. This is
+the number your phone automatically calls when receiving and sending SMS text messages, and
+your network operator should tell you what this number is.
+
+Example:
+
+ my $gsm = Device::Gsm->new( port => 'COM1' );
+ $gsm->connect() or die "Can't connect";
+ $srv_cnt = $gsm->service_center();
+ print "My service center number is: $srv_cnt\n";
+
+If you want to set or change this number (if used improperly this can disable
+sending of SMS messages, so be warned!), you can try something like:
+
+ my $ok = $gsm->service_center('+99001234567');
+ print "Service center changed!\n" if $ok;
+
+=head1 REQUIRES
+
+=over 4
+
+=item *
+
+Device::Modem, which in turn requires
+
+=item *
+
+Device::SerialPort (or Win32::SerialPort on Windows machines)
+
+=back
+
+=head1 EXPORT
+
+None
+
+=head1 TROUBLESHOOTING
+
+If you experience problems, please double check:
+
+=over 4
+
+=item Device permissions
+
+Maybe you don't have necessary permissions to access your serial,
+irda or bluetooth port device. Try executing your script as root, or
+try, if you don't mind, C<chmod a+rw /dev/ttyS1> (or whatever device
+you use instead of C</dev/ttyS1>).
+
+=item Connection speed
+
+Try switching C<baudrate> parameter from 19200 (the default value)
+to 9600 or viceversa. This one is the responsible of 80% of the problems,
+because there is no baudrate auto-detection.
+
+=item Device autoscan
+
+If all else fails, please use the B<autoscan> utility in the C<bin/> folder
+of the C<Device::Gsm> distribution. Try running this autoscan utility and
+examine the log file produced in the current directory.
+
+If you lose any hope, send me this log file so I can eventually
+have any clue about the problem / failure.
+
+Also this is a profiling tool, to know which commands are supported
+by your device, so please send me profiles of your devices, so
+I can add better support for all devices in the future!
+
+=back
+
+=head1 TO-DO
+
+=over 4
+
+=item Spooler
+
+Build a simple spooler program that sends all SMS stored in a special
+queue (that could be a simple filesystem folder).
+
+=item Validity Period
+
+Support C<validity> period option on SMS sending. Tells how much time the SMS
+Service Center must hold the SMS for delivery when not received.
+
+=item Profiles
+
+Build a profile of the GSM device used, so that we don't have to C<always>
+test each command to know whether it is supported or not, because this takes
+too time to be done every time.
+
+=back
+
+
+=head1 AUTHOR
+
+Cosimo Streppone, cosimo@cpan.org
+
+=head1 SEE ALSO
+
+L<Device::Modem>, L<Device::SerialPort>, L<Win32::SerialPort>, perl(1)
+
+=cut
+
+
@@ -1,6 +1,5 @@
bin/autoscan
Changes
-docs/gsm0338.txt
examples/delete_message.pl
examples/get_time.pl
examples/network.pl
@@ -9,8 +8,8 @@ examples/report_signal.pl
examples/send_sms.pl
examples/send_to_cosimo.pl
examples/sync_time.pl
+Gsm.pm
INSTALL
-lib/Device/Gsm.pm
lib/Device/Gsm/Charset.pm
lib/Device/Gsm/Networks.pm
lib/Device/Gsm/Pdu.pm
@@ -19,29 +18,23 @@ lib/Device/Gsm/Sms/Structure.pm
lib/Device/Gsm/Sms/Token.pm
lib/Device/Gsm/Sms/Token/DA.pm
lib/Device/Gsm/Sms/Token/DCS.pm
-lib/Device/Gsm/Sms/Token/DT.pm
lib/Device/Gsm/Sms/Token/MR.pm
lib/Device/Gsm/Sms/Token/OA.pm
lib/Device/Gsm/Sms/Token/PDUTYPE.pm
lib/Device/Gsm/Sms/Token/PID.pm
lib/Device/Gsm/Sms/Token/SCA.pm
lib/Device/Gsm/Sms/Token/SCTS.pm
-lib/Device/Gsm/Sms/Token/ST.pm
lib/Device/Gsm/Sms/Token/UD.pm
-lib/Device/Gsm/Sms/Token/UDH.pm
lib/Device/Gsm/Sms/Token/VP.pm
Makefile.PL
MANIFEST
MANIFEST.SKIP
META.yml Module meta-data (added by MakeMaker)
-perltidyrc
README
t/01basic.t
t/02info.t
-t/05messages.t
t/06msgcodec.t
t/07tokens.t
-t/08storage.t
t/20pdu.t
t/21pdu_latin1.t
t/30gsmascii.t
@@ -1,8 +1,5 @@
^\.
^CVS
-^\.svn
-^\.git
^pod2
^makedoc\.sh
^contrib
-blib
@@ -1,9 +1,9 @@
--- #YAML:1.0
name: Device-Gsm
-version: 1.60
+version: 1.58
abstract: Perl extension to interface GSM phones / modems
author:
- - Cosimo Streppone <cosimo@cpan.org>,Grzegorz Woźniak <wozniakg@gmail.com>
+ - Cosimo Streppone <cosimo@cpan.org>
license: unknown
distribution_type: module
configure_requires:
@@ -1,10 +1,10 @@
use 5.008;
use ExtUtils::MakeMaker;
WriteMakefile(
- 'ABSTRACT_FROM' => 'lib/Device/Gsm.pm',
- 'AUTHOR' => 'Cosimo Streppone <cosimo@cpan.org>,Grzegorz Woźniak <wozniakg@gmail.com>',
+ 'ABSTRACT_FROM' => 'Gsm.pm',
+ 'AUTHOR' => 'Cosimo Streppone <cosimo@cpan.org>',
'NAME' => 'Device::Gsm',
- 'VERSION_FROM' => 'lib/Device/Gsm.pm', # finds $VERSION
+ 'VERSION_FROM' => 'Gsm.pm', # finds $VERSION
'PREREQ_PM' => {
'Test::More' => 0,
'Device::Modem' => 1.47,
@@ -1,239 +0,0 @@
-#
-# Name: GSM 03.38 to Unicode
-# Unicode version: 3.0
-# Table version: 1.1
-# Table format: Format A
-# Date: 2000 May 30
-# Authors: Ken Whistler <kenw@sybase.com>,
-# Kent Karlsson <keka@im.se>,
-# Markus Kuhn <mkuhn@acm.org>
-#
-# Copyright (c) 2000 Unicode, Inc. All Rights reserved.
-#
-# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
-# No claims are made as to fitness for any particular purpose. No
-# warranties of any kind are expressed or implied. The recipient
-# agrees to determine applicability of information provided. If this
-# file has been provided on optical media by Unicode, Inc., the sole
-# remedy for any claim will be exchange of defective media within 90
-# days of receipt.
-#
-# Unicode, Inc. hereby grants the right to freely use the information
-# supplied in this file in the creation of products supporting the
-# Unicode Standard, and to make copies of this file in any form for
-# internal or external distribution as long as this notice remains
-# attached.
-#
-# General notes:
-#
-# This table contains the data the Unicode Consortium has on how
-# ETSI GSM 03.38 7-bit default alphabet characters map into Unicode.
-# This mapping is based on ETSI TS 100 900 V7.2.0 (1999-07), with
-# a correction of 0x09 to *small* c-cedilla, instead of *capital*
-# C-cedilla.
-#
-# Format: Three tab-separated columns
-# Column #1 is the ETSI GSM 03.38 7-bit default alphabet
-# code (in hex as 0xXX, or 0xXXXX for double-byte
-# sequences)
-# Column #2 is the Unicode scalar value (in hex as 0xXXXX)
-# Column #3 the Unicode name (follows a comment sign, '#')
-#
-# The entries are in ETSI GSM 03.38 7-bit default alphabet code order.
-#
-# Note that ETSI GSM 03.38 also allows for the use of UCS-2 (UTF-16
-# restricted to the BMP) in GSM/SMS messages.
-#
-# Note also that there are commented Greek mappings for some
-# capital Latin characters. This follows from the clear intent
-# of the ETSI GSM 03.38 to have glyph coverage for the uppercase
-# Greek alphabet by reusing Latin letters that have the same
-# form as an uppercase Greek letter. Conversion implementations
-# should be aware of this fact.
-#
-# The ETSI GSM 03.38 specification shows an uppercase C-cedilla
-# glyph at 0x09. This may be the result of limited display
-# capabilities for handling characters with descenders. However, the
-# language coverage intent is clearly for the lowercase c-cedilla, as shown
-# in the mapping below. The mapping for uppercase C-cedilla is shown
-# in a commented line in the mapping table.
-#
-# The ESC character 0x1B is
-# mapped to the no-break space character, unless it is part of a
-# valid ESC sequence, to facilitate round-trip compatibility in
-# the presence of unknown ESC sequences.
-#
-# 0x00 is NULL (when followed only by 0x00 up to the
-# end of (fixed byte length) message, possibly also up to
-# FORM FEED. But 0x00 is also the code for COMMERCIAL AT
-# when some other character (CARRIAGE RETURN if nothing else)
-# comes after the 0x00.
-#
-# Version history
-# 1.0 version: first creation
-# 1.1 version: fixed problem with the wrong line being a comment,
-# added text regarding 0x00's interpretation,
-# added second mapping for C-cedilla,
-# added mapping of 0x1B escape to NBSP for display.
-#
-# Updated versions of this file may be found in:
-# <ftp://ftp.unicode.org/Public/MAPPINGS/>
-#
-# Any comments or problems, contact <errata@unicode.org>
-# Please note that <errata@unicode.org> is an archival address;
-# notices will be checked, but do not expect an immediate response.
-#
-0x00 0x0040 # COMMERCIAL AT
-#0x00 0x0000 # NULL (see note above)
-0x01 0x00A3 # POUND SIGN
-0x02 0x0024 # DOLLAR SIGN
-0x03 0x00A5 # YEN SIGN
-0x04 0x00E8 # LATIN SMALL LETTER E WITH GRAVE
-0x05 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
-0x06 0x00F9 # LATIN SMALL LETTER U WITH GRAVE
-0x07 0x00EC # LATIN SMALL LETTER I WITH GRAVE
-0x08 0x00F2 # LATIN SMALL LETTER O WITH GRAVE
-0x09 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA
-#0x09 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA (see note above)
-0x0A 0x000A # LINE FEED
-0x0B 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
-0x0C 0x00F8 # LATIN SMALL LETTER O WITH STROKE
-0x0D 0x000D # CARRIAGE RETURN
-0x0E 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
-0x0F 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
-0x10 0x0394 # GREEK CAPITAL LETTER DELTA
-0x11 0x005F # LOW LINE
-0x12 0x03A6 # GREEK CAPITAL LETTER PHI
-0x13 0x0393 # GREEK CAPITAL LETTER GAMMA
-0x14 0x039B # GREEK CAPITAL LETTER LAMDA
-0x15 0x03A9 # GREEK CAPITAL LETTER OMEGA
-0x16 0x03A0 # GREEK CAPITAL LETTER PI
-0x17 0x03A8 # GREEK CAPITAL LETTER PSI
-0x18 0x03A3 # GREEK CAPITAL LETTER SIGMA
-0x19 0x0398 # GREEK CAPITAL LETTER THETA
-0x1A 0x039E # GREEK CAPITAL LETTER XI
-0x1B 0x00A0 # ESCAPE TO EXTENSION TABLE (or displayed as NBSP, see note above)
-0x1B0A 0x000C # FORM FEED
-0x1B14 0x005E # CIRCUMFLEX ACCENT
-0x1B28 0x007B # LEFT CURLY BRACKET
-0x1B29 0x007D # RIGHT CURLY BRACKET
-0x1B2F 0x005C # REVERSE SOLIDUS
-0x1B3C 0x005B # LEFT SQUARE BRACKET
-0x1B3D 0x007E # TILDE
-0x1B3E 0x005D # RIGHT SQUARE BRACKET
-0x1B40 0x007C # VERTICAL LINE
-0x1B65 0x20AC # EURO SIGN
-0x1C 0x00C6 # LATIN CAPITAL LETTER AE
-0x1D 0x00E6 # LATIN SMALL LETTER AE
-0x1E 0x00DF # LATIN SMALL LETTER SHARP S (German)
-0x1F 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
-0x20 0x0020 # SPACE
-0x21 0x0021 # EXCLAMATION MARK
-0x22 0x0022 # QUOTATION MARK
-0x23 0x0023 # NUMBER SIGN
-0x24 0x00A4 # CURRENCY SIGN
-0x25 0x0025 # PERCENT SIGN
-0x26 0x0026 # AMPERSAND
-0x27 0x0027 # APOSTROPHE
-0x28 0x0028 # LEFT PARENTHESIS
-0x29 0x0029 # RIGHT PARENTHESIS
-0x2A 0x002A # ASTERISK
-0x2B 0x002B # PLUS SIGN
-0x2C 0x002C # COMMA
-0x2D 0x002D # HYPHEN-MINUS
-0x2E 0x002E # FULL STOP
-0x2F 0x002F # SOLIDUS
-0x30 0x0030 # DIGIT ZERO
-0x31 0x0031 # DIGIT ONE
-0x32 0x0032 # DIGIT TWO
-0x33 0x0033 # DIGIT THREE
-0x34 0x0034 # DIGIT FOUR
-0x35 0x0035 # DIGIT FIVE
-0x36 0x0036 # DIGIT SIX
-0x37 0x0037 # DIGIT SEVEN
-0x38 0x0038 # DIGIT EIGHT
-0x39 0x0039 # DIGIT NINE
-0x3A 0x003A # COLON
-0x3B 0x003B # SEMICOLON
-0x3C 0x003C # LESS-THAN SIGN
-0x3D 0x003D # EQUALS SIGN
-0x3E 0x003E # GREATER-THAN SIGN
-0x3F 0x003F # QUESTION MARK
-0x40 0x00A1 # INVERTED EXCLAMATION MARK
-0x41 0x0041 # LATIN CAPITAL LETTER A
-#0x41 0x0391 # GREEK CAPITAL LETTER ALPHA
-0x42 0x0042 # LATIN CAPITAL LETTER B
-#0x42 0x0392 # GREEK CAPITAL LETTER BETA
-0x43 0x0043 # LATIN CAPITAL LETTER C
-0x44 0x0044 # LATIN CAPITAL LETTER D
-0x45 0x0045 # LATIN CAPITAL LETTER E
-#0x45 0x0395 # GREEK CAPITAL LETTER EPSILON
-0x46 0x0046 # LATIN CAPITAL LETTER F
-0x47 0x0047 # LATIN CAPITAL LETTER G
-0x48 0x0048 # LATIN CAPITAL LETTER H
-#0x48 0x0397 # GREEK CAPITAL LETTER ETA
-0x49 0x0049 # LATIN CAPITAL LETTER I
-#0x49 0x0399 # GREEK CAPITAL LETTER IOTA
-0x4A 0x004A # LATIN CAPITAL LETTER J
-0x4B 0x004B # LATIN CAPITAL LETTER K
-#0x4B 0x039A # GREEK CAPITAL LETTER KAPPA
-0x4C 0x004C # LATIN CAPITAL LETTER L
-0x4D 0x004D # LATIN CAPITAL LETTER M
-#0x4D 0x039C # GREEK CAPITAL LETTER MU
-0x4E 0x004E # LATIN CAPITAL LETTER N
-#0x4E 0x039D # GREEK CAPITAL LETTER NU
-0x4F 0x004F # LATIN CAPITAL LETTER O
-#0x4F 0x039F # GREEK CAPITAL LETTER OMICRON
-0x50 0x0050 # LATIN CAPITAL LETTER P
-#0x50 0x03A1 # GREEK CAPITAL LETTER RHO
-0x51 0x0051 # LATIN CAPITAL LETTER Q
-0x52 0x0052 # LATIN CAPITAL LETTER R
-0x53 0x0053 # LATIN CAPITAL LETTER S
-0x54 0x0054 # LATIN CAPITAL LETTER T
-#0x54 0x03A4 # GREEK CAPITAL LETTER TAU
-0x55 0x0055 # LATIN CAPITAL LETTER U
-#0x55 0x03A5 # GREEK CAPITAL LETTER UPSILON
-0x56 0x0056 # LATIN CAPITAL LETTER V
-0x57 0x0057 # LATIN CAPITAL LETTER W
-0x58 0x0058 # LATIN CAPITAL LETTER X
-#0x58 0x03A7 # GREEK CAPITAL LETTER CHI
-0x59 0x0059 # LATIN CAPITAL LETTER Y
-0x5A 0x005A # LATIN CAPITAL LETTER Z
-#0x5A 0x0396 # GREEK CAPITAL LETTER ZETA
-0x5B 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
-0x5C 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
-0x5D 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE
-0x5E 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
-0x5F 0x00A7 # SECTION SIGN
-0x60 0x00BF # INVERTED QUESTION MARK
-0x61 0x0061 # LATIN SMALL LETTER A
-0x62 0x0062 # LATIN SMALL LETTER B
-0x63 0x0063 # LATIN SMALL LETTER C
-0x64 0x0064 # LATIN SMALL LETTER D
-0x65 0x0065 # LATIN SMALL LETTER E
-0x66 0x0066 # LATIN SMALL LETTER F
-0x67 0x0067 # LATIN SMALL LETTER G
-0x68 0x0068 # LATIN SMALL LETTER H
-0x69 0x0069 # LATIN SMALL LETTER I
-0x6A 0x006A # LATIN SMALL LETTER J
-0x6B 0x006B # LATIN SMALL LETTER K
-0x6C 0x006C # LATIN SMALL LETTER L
-0x6D 0x006D # LATIN SMALL LETTER M
-0x6E 0x006E # LATIN SMALL LETTER N
-0x6F 0x006F # LATIN SMALL LETTER O
-0x70 0x0070 # LATIN SMALL LETTER P
-0x71 0x0071 # LATIN SMALL LETTER Q
-0x72 0x0072 # LATIN SMALL LETTER R
-0x73 0x0073 # LATIN SMALL LETTER S
-0x74 0x0074 # LATIN SMALL LETTER T
-0x75 0x0075 # LATIN SMALL LETTER U
-0x76 0x0076 # LATIN SMALL LETTER V
-0x77 0x0077 # LATIN SMALL LETTER W
-0x78 0x0078 # LATIN SMALL LETTER X
-0x79 0x0079 # LATIN SMALL LETTER Y
-0x7A 0x007A # LATIN SMALL LETTER Z
-0x7B 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
-0x7C 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
-0x7D 0x00F1 # LATIN SMALL LETTER N WITH TILDE
-0x7E 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
-0x7F 0x00E0 # LATIN SMALL LETTER A WITH GRAVE
@@ -42,548 +42,499 @@ use constant ESCAPE => 0x1B;
#
@Device::Gsm::Charset::GSM0338_TO_ISO8859 = (
- 64, # 0 @ COMMERCIAL AT */
- 163, # 1 £ POUND SIGN */
- 36, # 2 $ DOLLAR SIGN */
- 165, # 3 ¥ YEN SIGN */
- 232, # 4 è LATIN SMALL LETTER E WITH GRAVE */
- 233, # 5 é LATIN SMALL LETTER E WITH ACUTE */
- 249, # 6 ù LATIN SMALL LETTER U WITH GRAVE */
- 236, # 7 ì LATIN SMALL LETTER I WITH GRAVE */
- 242, # 8 ò LATIN SMALL LETTER O WITH GRAVE */
- 199, # 9 Ç LATIN CAPITAL LETTER C WITH CEDILLA */
- 10, # 10 LINE FEED */
- 216, # 11 Ø LATIN CAPITAL LETTER O WITH STROKE */
- 248, # 12 ø LATIN SMALL LETTER O WITH STROKE */
- 13, # 13 CARRIAGE RETURN */
- 197, # 14 Å LATIN CAPITAL LETTER A WITH RING ABOVE */
- 229, # 15 å LATIN SMALL LETTER A WITH RING ABOVE */
- NPC8, # 16 GREEK CAPITAL LETTER DELTA */
- 95, # 17 _ LOW LINE */
- NPC8, # 18 GREEK CAPITAL LETTER PHI */
- NPC8, # 19 GREEK CAPITAL LETTER GAMMA */
- NPC8, # 20 GREEK CAPITAL LETTER LAMBDA */
- NPC8, # 21 GREEK CAPITAL LETTER OMEGA */
- NPC8, # 22 GREEK CAPITAL LETTER PI */
- NPC8, # 23 GREEK CAPITAL LETTER PSI */
- NPC8, # 24 GREEK CAPITAL LETTER SIGMA */
- NPC8, # 25 GREEK CAPITAL LETTER THETA */
- NPC8, # 26 GREEK CAPITAL LETTER XI */
- 27, # 27 ESCAPE TO EXTENSION TABLE */
- 198, # 28 Æ LATIN CAPITAL LETTER AE */
- 230, # 29 æ LATIN SMALL LETTER AE */
- 223, # 30 ß LATIN SMALL LETTER SHARP S (German) */
- 201, # 31 É LATIN CAPITAL LETTER E WITH ACUTE */
- 32, # 32 SPACE */
- 33, # 33 ! EXCLAMATION MARK */
- 34, # 34 " QUOTATION MARK */
- 35, # 35 # NUMBER SIGN */
- 164, # 36 ¤ CURRENCY SIGN */
- 37, # 37 % PERCENT SIGN */
- 38, # 38 & AMPERSAND */
- 39, # 39 ' APOSTROPHE */
- 40, # 40 ( LEFT PARENTHESIS */
- 41, # 41 ) RIGHT PARENTHESIS */
- 42, # 42 * ASTERISK */
- 43, # 43 + PLUS SIGN */
- 44, # 44 , COMMA */
- 45, # 45 - HYPHEN-MINUS */
- 46, # 46 . FULL STOP */
- 47, # 47 / SOLIDUS (SLASH) */
- 48, # 48 0 DIGIT ZERO */
- 49, # 49 1 DIGIT ONE */
- 50, # 50 2 DIGIT TWO */
- 51, # 51 3 DIGIT THREE */
- 52, # 52 4 DIGIT FOUR */
- 53, # 53 5 DIGIT FIVE */
- 54, # 54 6 DIGIT SIX */
- 55, # 55 7 DIGIT SEVEN */
- 56, # 56 8 DIGIT EIGHT */
- 57, # 57 9 DIGIT NINE */
- 58, # 58 : COLON */
- 59, # 59 ; SEMICOLON */
- 60, # 60 < LESS-THAN SIGN */
- 61, # 61 = EQUALS SIGN */
- 62, # 62 > GREATER-THAN SIGN */
- 63, # 63 ? QUESTION MARK */
- 161, # 64 ¡ INVERTED EXCLAMATION MARK */
- 65, # 65 A LATIN CAPITAL LETTER A */
- 66, # 66 B LATIN CAPITAL LETTER B */
- 67, # 67 C LATIN CAPITAL LETTER C */
- 68, # 68 D LATIN CAPITAL LETTER D */
- 69, # 69 E LATIN CAPITAL LETTER E */
- 70, # 70 F LATIN CAPITAL LETTER F */
- 71, # 71 G LATIN CAPITAL LETTER G */
- 72, # 72 H LATIN CAPITAL LETTER H */
- 73, # 73 I LATIN CAPITAL LETTER I */
- 74, # 74 J LATIN CAPITAL LETTER J */
- 75, # 75 K LATIN CAPITAL LETTER K */
- 76, # 76 L LATIN CAPITAL LETTER L */
- 77, # 77 M LATIN CAPITAL LETTER M */
- 78, # 78 N LATIN CAPITAL LETTER N */
- 79, # 79 O LATIN CAPITAL LETTER O */
- 80, # 80 P LATIN CAPITAL LETTER P */
- 81, # 81 Q LATIN CAPITAL LETTER Q */
- 82, # 82 R LATIN CAPITAL LETTER R */
- 83, # 83 S LATIN CAPITAL LETTER S */
- 84, # 84 T LATIN CAPITAL LETTER T */
- 85, # 85 U LATIN CAPITAL LETTER U */
- 86, # 86 V LATIN CAPITAL LETTER V */
- 87, # 87 W LATIN CAPITAL LETTER W */
- 88, # 88 X LATIN CAPITAL LETTER X */
- 89, # 89 Y LATIN CAPITAL LETTER Y */
- 90, # 90 Z LATIN CAPITAL LETTER Z */
- 196, # 91 Ä LATIN CAPITAL LETTER A WITH DIAERESIS */
- 214, # 92 Ö LATIN CAPITAL LETTER O WITH DIAERESIS */
- 209, # 93 Ñ LATIN CAPITAL LETTER N WITH TILDE */
- 220, # 94 Ü LATIN CAPITAL LETTER U WITH DIAERESIS */
- 167, # 95 § SECTION SIGN */
- 191, # 96 ¿ INVERTED QUESTION MARK */
- 97, # 97 a LATIN SMALL LETTER A */
- 98, # 98 b LATIN SMALL LETTER B */
- 99, # 99 c LATIN SMALL LETTER C */
- 100, # 100 d LATIN SMALL LETTER D */
- 101, # 101 e LATIN SMALL LETTER E */
- 102, # 102 f LATIN SMALL LETTER F */
- 103, # 103 g LATIN SMALL LETTER G */
- 104, # 104 h LATIN SMALL LETTER H */
- 105, # 105 i LATIN SMALL LETTER I */
- 106, # 106 j LATIN SMALL LETTER J */
- 107, # 107 k LATIN SMALL LETTER K */
- 108, # 108 l LATIN SMALL LETTER L */
- 109, # 109 m LATIN SMALL LETTER M */
- 110, # 110 n LATIN SMALL LETTER N */
- 111, # 111 o LATIN SMALL LETTER O */
- 112, # 112 p LATIN SMALL LETTER P */
- 113, # 113 q LATIN SMALL LETTER Q */
- 114, # 114 r LATIN SMALL LETTER R */
- 115, # 115 s LATIN SMALL LETTER S */
- 116, # 116 t LATIN SMALL LETTER T */
- 117, # 117 u LATIN SMALL LETTER U */
- 118, # 118 v LATIN SMALL LETTER V */
- 119, # 119 w LATIN SMALL LETTER W */
- 120, # 120 x LATIN SMALL LETTER X */
- 121, # 121 y LATIN SMALL LETTER Y */
- 122, # 122 z LATIN SMALL LETTER Z */
- 228, # 123 ä LATIN SMALL LETTER A WITH DIAERESIS */
- 246, # 124 ö LATIN SMALL LETTER O WITH DIAERESIS */
- 241, # 125 ñ LATIN SMALL LETTER N WITH TILDE */
- 252, # 126 ü LATIN SMALL LETTER U WITH DIAERESIS */
- 224, # 127 à LATIN SMALL LETTER A WITH GRAVE */
-
- # 12 27 10 FORM FEED
- # 94 27 20 ^ CIRCUMFLEX ACCENT
- # 123 27 40 { LEFT CURLY BRACKET
- # 125 27 41 } RIGHT CURLY BRACKET
- # 92 27 47 \ REVERSE SOLIDUS (BACKSLASH)
- # 91 27 60 [ LEFT SQUARE BRACKET
- # 126 27 61 ~ TILDE
- # 93 27 62 ] RIGHT SQUARE BRACKET
- # 124 27 64 | VERTICAL BAR */
+ 64, # 0 @ COMMERCIAL AT */
+ 163, # 1 £ POUND SIGN */
+ 36, # 2 $ DOLLAR SIGN */
+ 165, # 3 ¥ YEN SIGN */
+ 232, # 4 è LATIN SMALL LETTER E WITH GRAVE */
+ 233, # 5 é LATIN SMALL LETTER E WITH ACUTE */
+ 249, # 6 ù LATIN SMALL LETTER U WITH GRAVE */
+ 236, # 7 ì LATIN SMALL LETTER I WITH GRAVE */
+ 242, # 8 ò LATIN SMALL LETTER O WITH GRAVE */
+ 199, # 9 Ç LATIN CAPITAL LETTER C WITH CEDILLA */
+ 10, # 10 LINE FEED */
+ 216, # 11 Ø LATIN CAPITAL LETTER O WITH STROKE */
+ 248, # 12 ø LATIN SMALL LETTER O WITH STROKE */
+ 13, # 13 CARRIAGE RETURN */
+ 197, # 14 Å LATIN CAPITAL LETTER A WITH RING ABOVE */
+ 229, # 15 å LATIN SMALL LETTER A WITH RING ABOVE */
+ NPC8, # 16 GREEK CAPITAL LETTER DELTA */
+ 95, # 17 _ LOW LINE */
+ NPC8, # 18 GREEK CAPITAL LETTER PHI */
+ NPC8, # 19 GREEK CAPITAL LETTER GAMMA */
+ NPC8, # 20 GREEK CAPITAL LETTER LAMBDA */
+ NPC8, # 21 GREEK CAPITAL LETTER OMEGA */
+ NPC8, # 22 GREEK CAPITAL LETTER PI */
+ NPC8, # 23 GREEK CAPITAL LETTER PSI */
+ NPC8, # 24 GREEK CAPITAL LETTER SIGMA */
+ NPC8, # 25 GREEK CAPITAL LETTER THETA */
+ NPC8, # 26 GREEK CAPITAL LETTER XI */
+ 27, # 27 ESCAPE TO EXTENSION TABLE */
+ 198, # 28 Æ LATIN CAPITAL LETTER AE */
+ 230, # 29 æ LATIN SMALL LETTER AE */
+ 223, # 30 ß LATIN SMALL LETTER SHARP S (German) */
+ 201, # 31 É LATIN CAPITAL LETTER E WITH ACUTE */
+ 32, # 32 SPACE */
+ 33, # 33 ! EXCLAMATION MARK */
+ 34, # 34 " QUOTATION MARK */
+ 35, # 35 # NUMBER SIGN */
+ 164, # 36 ¤ CURRENCY SIGN */
+ 37, # 37 % PERCENT SIGN */
+ 38, # 38 & AMPERSAND */
+ 39, # 39 ' APOSTROPHE */
+ 40, # 40 ( LEFT PARENTHESIS */
+ 41, # 41 ) RIGHT PARENTHESIS */
+ 42, # 42 * ASTERISK */
+ 43, # 43 + PLUS SIGN */
+ 44, # 44 , COMMA */
+ 45, # 45 - HYPHEN-MINUS */
+ 46, # 46 . FULL STOP */
+ 47, # 47 / SOLIDUS (SLASH) */
+ 48, # 48 0 DIGIT ZERO */
+ 49, # 49 1 DIGIT ONE */
+ 50, # 50 2 DIGIT TWO */
+ 51, # 51 3 DIGIT THREE */
+ 52, # 52 4 DIGIT FOUR */
+ 53, # 53 5 DIGIT FIVE */
+ 54, # 54 6 DIGIT SIX */
+ 55, # 55 7 DIGIT SEVEN */
+ 56, # 56 8 DIGIT EIGHT */
+ 57, # 57 9 DIGIT NINE */
+ 58, # 58 : COLON */
+ 59, # 59 ; SEMICOLON */
+ 60, # 60 < LESS-THAN SIGN */
+ 61, # 61 = EQUALS SIGN */
+ 62, # 62 > GREATER-THAN SIGN */
+ 63, # 63 ? QUESTION MARK */
+ 161, # 64 ¡ INVERTED EXCLAMATION MARK */
+ 65, # 65 A LATIN CAPITAL LETTER A */
+ 66, # 66 B LATIN CAPITAL LETTER B */
+ 67, # 67 C LATIN CAPITAL LETTER C */
+ 68, # 68 D LATIN CAPITAL LETTER D */
+ 69, # 69 E LATIN CAPITAL LETTER E */
+ 70, # 70 F LATIN CAPITAL LETTER F */
+ 71, # 71 G LATIN CAPITAL LETTER G */
+ 72, # 72 H LATIN CAPITAL LETTER H */
+ 73, # 73 I LATIN CAPITAL LETTER I */
+ 74, # 74 J LATIN CAPITAL LETTER J */
+ 75, # 75 K LATIN CAPITAL LETTER K */
+ 76, # 76 L LATIN CAPITAL LETTER L */
+ 77, # 77 M LATIN CAPITAL LETTER M */
+ 78, # 78 N LATIN CAPITAL LETTER N */
+ 79, # 79 O LATIN CAPITAL LETTER O */
+ 80, # 80 P LATIN CAPITAL LETTER P */
+ 81, # 81 Q LATIN CAPITAL LETTER Q */
+ 82, # 82 R LATIN CAPITAL LETTER R */
+ 83, # 83 S LATIN CAPITAL LETTER S */
+ 84, # 84 T LATIN CAPITAL LETTER T */
+ 85, # 85 U LATIN CAPITAL LETTER U */
+ 86, # 86 V LATIN CAPITAL LETTER V */
+ 87, # 87 W LATIN CAPITAL LETTER W */
+ 88, # 88 X LATIN CAPITAL LETTER X */
+ 89, # 89 Y LATIN CAPITAL LETTER Y */
+ 90, # 90 Z LATIN CAPITAL LETTER Z */
+ 196, # 91 Ä LATIN CAPITAL LETTER A WITH DIAERESIS */
+ 214, # 92 Ö LATIN CAPITAL LETTER O WITH DIAERESIS */
+ 209, # 93 Ñ LATIN CAPITAL LETTER N WITH TILDE */
+ 220, # 94 Ü LATIN CAPITAL LETTER U WITH DIAERESIS */
+ 167, # 95 § SECTION SIGN */
+ 191, # 96 ¿ INVERTED QUESTION MARK */
+ 97, # 97 a LATIN SMALL LETTER A */
+ 98, # 98 b LATIN SMALL LETTER B */
+ 99, # 99 c LATIN SMALL LETTER C */
+ 100, # 100 d LATIN SMALL LETTER D */
+ 101, # 101 e LATIN SMALL LETTER E */
+ 102, # 102 f LATIN SMALL LETTER F */
+ 103, # 103 g LATIN SMALL LETTER G */
+ 104, # 104 h LATIN SMALL LETTER H */
+ 105, # 105 i LATIN SMALL LETTER I */
+ 106, # 106 j LATIN SMALL LETTER J */
+ 107, # 107 k LATIN SMALL LETTER K */
+ 108, # 108 l LATIN SMALL LETTER L */
+ 109, # 109 m LATIN SMALL LETTER M */
+ 110, # 110 n LATIN SMALL LETTER N */
+ 111, # 111 o LATIN SMALL LETTER O */
+ 112, # 112 p LATIN SMALL LETTER P */
+ 113, # 113 q LATIN SMALL LETTER Q */
+ 114, # 114 r LATIN SMALL LETTER R */
+ 115, # 115 s LATIN SMALL LETTER S */
+ 116, # 116 t LATIN SMALL LETTER T */
+ 117, # 117 u LATIN SMALL LETTER U */
+ 118, # 118 v LATIN SMALL LETTER V */
+ 119, # 119 w LATIN SMALL LETTER W */
+ 120, # 120 x LATIN SMALL LETTER X */
+ 121, # 121 y LATIN SMALL LETTER Y */
+ 122, # 122 z LATIN SMALL LETTER Z */
+ 228, # 123 ä LATIN SMALL LETTER A WITH DIAERESIS */
+ 246, # 124 ö LATIN SMALL LETTER O WITH DIAERESIS */
+ 241, # 125 ñ LATIN SMALL LETTER N WITH TILDE */
+ 252, # 126 ü LATIN SMALL LETTER U WITH DIAERESIS */
+ 224, # 127 à LATIN SMALL LETTER A WITH GRAVE */
+# 12 27 10 FORM FEED
+# 94 27 20 ^ CIRCUMFLEX ACCENT
+# 123 27 40 { LEFT CURLY BRACKET
+# 125 27 41 } RIGHT CURLY BRACKET
+# 92 27 47 \ REVERSE SOLIDUS (BACKSLASH)
+# 91 27 60 [ LEFT SQUARE BRACKET
+# 126 27 61 ~ TILDE
+# 93 27 62 ] RIGHT SQUARE BRACKET
+# 124 27 64 | VERTICAL BAR */
);
#my $gsm_charset = join '' => map chr => @GSM0338_TO_ISO8859;
@Device::Gsm::Charset::ISO8859_TO_GSM0338 = (
- NPC7, # 0 null [NUL] */
- NPC7, # 1 start of heading [SOH] */
- NPC7, # 2 start of text [STX] */
- NPC7, # 3 end of text [ETX] */
- NPC7, # 4 end of transmission [EOT] */
- NPC7, # 5 enquiry [ENQ] */
- NPC7, # 6 acknowledge [ACK] */
- NPC7, # 7 bell [BEL] */
- NPC7, # 8 backspace [BS] */
- NPC7, # 9 horizontal tab [HT] */
- 10, # 10 line feed [LF] */
- NPC7, # 11 vertical tab [VT] */
- 10 + 256, # 12 form feed [FF] */
- 13, # 13 carriage return [CR] */
- NPC7, # 14 shift out [SO] */
- NPC7, # 15 shift in [SI] */
- NPC7, # 16 data link escape [DLE] */
- NPC7, # 17 device control 1 [DC1] */
- NPC7, # 18 device control 2 [DC2] */
- NPC7, # 19 device control 3 [DC3] */
- NPC7, # 20 device control 4 [DC4] */
- NPC7, # 21 negative acknowledge [NAK] */
- NPC7, # 22 synchronous idle [SYN] */
- NPC7, # 23 end of trans. block [ETB] */
- NPC7, # 24 cancel [CAN] */
- NPC7, # 25 end of medium [EM] */
- NPC7, # 26 substitute [SUB] */
- NPC7, # 27 escape [ESC] */
- NPC7, # 28 file separator [FS] */
- NPC7, # 29 group separator [GS] */
- NPC7, # 30 record separator [RS] */
- NPC7, # 31 unit separator [US] */
- 32, # 32 space */
- 33, # 33 ! exclamation mark */
- 34, # 34 " double quotation mark */
- 35, # 35 # number sign */
- 2, # 36 $ dollar sign */
- 37, # 37 % percent sign */
- 38, # 38 & ampersand */
- 39, # 39 ' apostrophe */
- 40, # 40 ( left parenthesis */
- 41, # 41 ) right parenthesis */
- 42, # 42 * asterisk */
- 43, # 43 + plus sign */
- 44, # 44 , comma */
- 45, # 45 - hyphen */
- 46, # 46 . period */
- 47, # 47 / slash, */
- 48, # 48 0 digit 0 */
- 49, # 49 1 digit 1 */
- 50, # 50 2 digit 2 */
- 51, # 51 3 digit 3 */
- 52, # 52 4 digit 4 */
- 53, # 53 5 digit 5 */
- 54, # 54 6 digit 6 */
- 55, # 55 7 digit 7 */
- 56, # 56 8 digit 8 */
- 57, # 57 9 digit 9 */
- 58, # 58 : colon */
- 59, # 59 ; semicolon */
- 60, # 60 < less-than sign */
- 61, # 61 = equal sign */
- 62, # 62 > greater-than sign */
- 63, # 63 ? question mark */
- 0, # 64 @ commercial at sign */
- 65, # 65 A uppercase A */
- 66, # 66 B uppercase B */
- 67, # 67 C uppercase C */
- 68, # 68 D uppercase D */
- 69, # 69 E uppercase E */
- 70, # 70 F uppercase F */
- 71, # 71 G uppercase G */
- 72, # 72 H uppercase H */
- 73, # 73 I uppercase I */
- 74, # 74 J uppercase J */
- 75, # 75 K uppercase K */
- 76, # 76 L uppercase L */
- 77, # 77 M uppercase M */
- 78, # 78 N uppercase N */
- 79, # 79 O uppercase O */
- 80, # 80 P uppercase P */
- 81, # 81 Q uppercase Q */
- 82, # 82 R uppercase R */
- 83, # 83 S uppercase S */
- 84, # 84 T uppercase T */
- 85, # 85 U uppercase U */
- 86, # 86 V uppercase V */
- 87, # 87 W uppercase W */
- 88, # 88 X uppercase X */
- 89, # 89 Y uppercase Y */
- 90, # 90 Z uppercase Z */
- 60 + 256, # 91 [ left square bracket */
- 47 + 256, # 92 \ backslash */
- 62 + 256, # 93 ] right square bracket */
- 20 + 256, # 94 ^ circumflex accent */
- 17, # 95 _ underscore */
- -39, # 96 ` back apostrophe */
- 97, # 97 a lowercase a */
- 98, # 98 b lowercase b */
- 99, # 99 c lowercase c */
- 100, # 100 d lowercase d */
- 101, # 101 e lowercase e */
- 102, # 102 f lowercase f */
- 103, # 103 g lowercase g */
- 104, # 104 h lowercase h */
- 105, # 105 i lowercase i */
- 106, # 106 j lowercase j */
- 107, # 107 k lowercase k */
- 108, # 108 l lowercase l */
- 109, # 109 m lowercase m */
- 110, # 110 n lowercase n */
- 111, # 111 o lowercase o */
- 112, # 112 p lowercase p */
- 113, # 113 q lowercase q */
- 114, # 114 r lowercase r */
- 115, # 115 s lowercase s */
- 116, # 116 t lowercase t */
- 117, # 117 u lowercase u */
- 118, # 118 v lowercase v */
- 119, # 119 w lowercase w */
- 120, # 120 x lowercase x */
- 121, # 121 y lowercase y */
- 122, # 122 z lowercase z */
- 40 + 256, # 123 { left brace */
- 64 + 256, # 124 | vertical bar */
- 41 + 256, # 125 } right brace */
- 61 + 256, # 126 ~ tilde accent */
- NPC7, # 127 delete [DEL] */
- NPC7, # 128 */
- NPC7, # 129 */
- -39, # 130 low left rising single quote */
- -102, # 131 lowercase italic f */
- -34, # 132 low left rising double quote */
- NPC7, # 133 low horizontal ellipsis */
- NPC7, # 134 dagger mark */
- NPC7, # 135 double dagger mark */
- NPC7, # 136 letter modifying circumflex */
- NPC7, # 137 per thousand (mille) sign */
- -83, # 138 uppercase S caron or hacek */
- -39, # 139 left single angle quote mark */
- -214, # 140 uppercase OE ligature */
- NPC7, # 141 */
- NPC7, # 142 */
- NPC7, # 143 */
- NPC7, # 144 */
- -39, # 145 left single quotation mark */
- -39, # 146 right single quote mark */
- -34, # 147 left double quotation mark */
- -34, # 148 right double quote mark */
- -42, # 149 round filled bullet */
- -45, # 150 en dash */
- -45, # 151 em dash */
- -39, # 152 small spacing tilde accent */
- NPC7, # 153 trademark sign */
- -115, # 154 lowercase s caron or hacek */
- -39, # 155 right single angle quote mark */
- -111, # 156 lowercase oe ligature */
- NPC7, # 157 */
- NPC7, # 158 */
- -89, # 159 uppercase Y dieresis or umlaut */
- -32, # 160 non-breaking space */
- 64, # 161 ¡ inverted exclamation mark */
- -99, # 162 ¢ cent sign */
- 1, # 163 £ pound sterling sign */
- 36, # 164 ¤ general currency sign */
- 3, # 165 ¥ yen sign */
- -33, # 166 ¦ broken vertical bar */
- 95, # 167 § section sign */
- -34, # 168 ¨ spacing dieresis or umlaut */
- NPC7, # 169 © copyright sign */
- NPC7, # 170 ª feminine ordinal indicator */
- -60, # 171 « left (double) angle quote */
- NPC7, # 172 ¬ logical not sign */
- -45, # 173 soft hyphen */
- NPC7, # 174 ® registered trademark sign */
- NPC7, # 175 ¯ spacing macron (long) accent */
- NPC7, # 176 ° degree sign */
- NPC7, # 177 ± plus-or-minus sign */
- -50, # 178 ² superscript 2 */
- -51, # 179 ³ superscript 3 */
- -39, # 180 ´ spacing acute accent */
- -117, # 181 µ micro sign */
- NPC7, # 182 ¶ paragraph sign, pilcrow sign */
- NPC7, # 183 · middle dot, centered dot */
- NPC7, # 184 ¸ spacing cedilla */
- -49, # 185 ¹ superscript 1 */
- NPC7, # 186 º masculine ordinal indicator */
- -62, # 187 » right (double) angle quote (guillemet) */
- NPC7, # 188 ¼ fraction 1/4 */
- NPC7, # 189 ½ fraction 1/2 */
- NPC7, # 190 ¾ fraction 3/4 */
- 96, # 191 ¿ inverted question mark */
- -65, # 192 À uppercase A grave */
- -65, # 193 Á uppercase A acute */
- -65, # 194 Â uppercase A circumflex */
- -65, # 195 Ã uppercase A tilde */
- 91, # 196 Ä uppercase A dieresis or umlaut */
- 14, # 197 Å uppercase A ring */
- 28, # 198 Æ uppercase AE ligature */
- 9, # 199 Ç uppercase C cedilla */
- -31, # 200 È uppercase E grave */
- 31, # 201 É uppercase E acute */
- -31, # 202 Ê uppercase E circumflex */
- -31, # 203 Ë uppercase E dieresis or umlaut */
- -73, # 204 Ì uppercase I grave */
- -73, # 205 Í uppercase I acute */
- -73, # 206 Î uppercase I circumflex */
- -73, # 207 Ï uppercase I dieresis or umlaut */
- -68, # 208 Ð uppercase ETH */
- 93, # 209 Ñ uppercase N tilde */
- -79, # 210 Ò uppercase O grave */
- -79, # 211 Ó uppercase O acute */
- -79, # 212 Ô uppercase O circumflex */
- -79, # 213 Õ uppercase O tilde */
- 92, # 214 Ö uppercase O dieresis or umlaut */
- -42, # 215 × multiplication sign */
- 11, # 216 Ø uppercase O slash */
- -85, # 217 Ù uppercase U grave */
- -85, # 218 Ú uppercase U acute */
- -85, # 219 Û uppercase U circumflex */
- 94, # 220 Ü uppercase U dieresis or umlaut */
- -89, # 221 Ý uppercase Y acute */
- NPC7, # 222 Þ uppercase THORN */
- 30, # 223 ß lowercase sharp s, sz ligature */
- 127, # 224 à lowercase a grave */
- -97, # 225 á lowercase a acute */
- -97, # 226 â lowercase a circumflex */
- -97, # 227 ã lowercase a tilde */
- 123, # 228 ä lowercase a dieresis or umlaut */
- 15, # 229 å lowercase a ring */
- 29, # 230 æ lowercase ae ligature */
- -9, # 231 ç lowercase c cedilla */
- 4, # 232 è lowercase e grave */
- 5, # 233 é lowercase e acute */
- -101, # 234 ê lowercase e circumflex */
- -101, # 235 ë lowercase e dieresis or umlaut */
- 7, # 236 ì lowercase i grave */
- -7, # 237 í lowercase i acute */
- -105, # 238 î lowercase i circumflex */
- -105, # 239 ï lowercase i dieresis or umlaut */
- NPC7, # 240 ð lowercase eth */
- 125, # 241 ñ lowercase n tilde */
- 8, # 242 ò lowercase o grave */
- -111, # 243 ó lowercase o acute */
- -111, # 244 ô lowercase o circumflex */
- -111, # 245 õ lowercase o tilde */
- 124, # 246 ö lowercase o dieresis or umlaut */
- -47, # 247 ÷ division sign */
- 12, # 248 ø lowercase o slash */
- 6, # 249 ù lowercase u grave */
- -117, # 250 ú lowercase u acute */
- -117, # 251 û lowercase u circumflex */
- 126, # 252 ü lowercase u dieresis or umlaut */
- -121, # 253 ý lowercase y acute */
- NPC7, # 254 þ lowercase thorn */
- -121 # 255 ÿ lowercase y dieresis or umlaut */
+ NPC7, # 0 null [NUL] */
+ NPC7, # 1 start of heading [SOH] */
+ NPC7, # 2 start of text [STX] */
+ NPC7, # 3 end of text [ETX] */
+ NPC7, # 4 end of transmission [EOT] */
+ NPC7, # 5 enquiry [ENQ] */
+ NPC7, # 6 acknowledge [ACK] */
+ NPC7, # 7 bell [BEL] */
+ NPC7, # 8 backspace [BS] */
+ NPC7, # 9 horizontal tab [HT] */
+ 10, # 10 line feed [LF] */
+ NPC7, # 11 vertical tab [VT] */
+ 10+256, # 12 form feed [FF] */
+ 13, # 13 carriage return [CR] */
+ NPC7, # 14 shift out [SO] */
+ NPC7, # 15 shift in [SI] */
+ NPC7, # 16 data link escape [DLE] */
+ NPC7, # 17 device control 1 [DC1] */
+ NPC7, # 18 device control 2 [DC2] */
+ NPC7, # 19 device control 3 [DC3] */
+ NPC7, # 20 device control 4 [DC4] */
+ NPC7, # 21 negative acknowledge [NAK] */
+ NPC7, # 22 synchronous idle [SYN] */
+ NPC7, # 23 end of trans. block [ETB] */
+ NPC7, # 24 cancel [CAN] */
+ NPC7, # 25 end of medium [EM] */
+ NPC7, # 26 substitute [SUB] */
+ NPC7, # 27 escape [ESC] */
+ NPC7, # 28 file separator [FS] */
+ NPC7, # 29 group separator [GS] */
+ NPC7, # 30 record separator [RS] */
+ NPC7, # 31 unit separator [US] */
+ 32, # 32 space */
+ 33, # 33 ! exclamation mark */
+ 34, # 34 " double quotation mark */
+ 35, # 35 # number sign */
+ 2, # 36 $ dollar sign */
+ 37, # 37 % percent sign */
+ 38, # 38 & ampersand */
+ 39, # 39 ' apostrophe */
+ 40, # 40 ( left parenthesis */
+ 41, # 41 ) right parenthesis */
+ 42, # 42 * asterisk */
+ 43, # 43 + plus sign */
+ 44, # 44 , comma */
+ 45, # 45 - hyphen */
+ 46, # 46 . period */
+ 47, # 47 / slash, */
+ 48, # 48 0 digit 0 */
+ 49, # 49 1 digit 1 */
+ 50, # 50 2 digit 2 */
+ 51, # 51 3 digit 3 */
+ 52, # 52 4 digit 4 */
+ 53, # 53 5 digit 5 */
+ 54, # 54 6 digit 6 */
+ 55, # 55 7 digit 7 */
+ 56, # 56 8 digit 8 */
+ 57, # 57 9 digit 9 */
+ 58, # 58 : colon */
+ 59, # 59 ; semicolon */
+ 60, # 60 < less-than sign */
+ 61, # 61 = equal sign */
+ 62, # 62 > greater-than sign */
+ 63, # 63 ? question mark */
+ 0, # 64 @ commercial at sign */
+ 65, # 65 A uppercase A */
+ 66, # 66 B uppercase B */
+ 67, # 67 C uppercase C */
+ 68, # 68 D uppercase D */
+ 69, # 69 E uppercase E */
+ 70, # 70 F uppercase F */
+ 71, # 71 G uppercase G */
+ 72, # 72 H uppercase H */
+ 73, # 73 I uppercase I */
+ 74, # 74 J uppercase J */
+ 75, # 75 K uppercase K */
+ 76, # 76 L uppercase L */
+ 77, # 77 M uppercase M */
+ 78, # 78 N uppercase N */
+ 79, # 79 O uppercase O */
+ 80, # 80 P uppercase P */
+ 81, # 81 Q uppercase Q */
+ 82, # 82 R uppercase R */
+ 83, # 83 S uppercase S */
+ 84, # 84 T uppercase T */
+ 85, # 85 U uppercase U */
+ 86, # 86 V uppercase V */
+ 87, # 87 W uppercase W */
+ 88, # 88 X uppercase X */
+ 89, # 89 Y uppercase Y */
+ 90, # 90 Z uppercase Z */
+ 60+256, # 91 [ left square bracket */
+ 47+256, # 92 \ backslash */
+ 62+256, # 93 ] right square bracket */
+ 20+256, # 94 ^ circumflex accent */
+ 17, # 95 _ underscore */
+ -39, # 96 ` back apostrophe */
+ 97, # 97 a lowercase a */
+ 98, # 98 b lowercase b */
+ 99, # 99 c lowercase c */
+ 100, # 100 d lowercase d */
+ 101, # 101 e lowercase e */
+ 102, # 102 f lowercase f */
+ 103, # 103 g lowercase g */
+ 104, # 104 h lowercase h */
+ 105, # 105 i lowercase i */
+ 106, # 106 j lowercase j */
+ 107, # 107 k lowercase k */
+ 108, # 108 l lowercase l */
+ 109, # 109 m lowercase m */
+ 110, # 110 n lowercase n */
+ 111, # 111 o lowercase o */
+ 112, # 112 p lowercase p */
+ 113, # 113 q lowercase q */
+ 114, # 114 r lowercase r */
+ 115, # 115 s lowercase s */
+ 116, # 116 t lowercase t */
+ 117, # 117 u lowercase u */
+ 118, # 118 v lowercase v */
+ 119, # 119 w lowercase w */
+ 120, # 120 x lowercase x */
+ 121, # 121 y lowercase y */
+ 122, # 122 z lowercase z */
+ 40+256, # 123 { left brace */
+ 64+256, # 124 | vertical bar */
+ 41+256, # 125 } right brace */
+ 61+256, # 126 ~ tilde accent */
+ NPC7, # 127 delete [DEL] */
+ NPC7, # 128 */
+ NPC7, # 129 */
+ -39, # 130 low left rising single quote */
+ -102, # 131 lowercase italic f */
+ -34, # 132 low left rising double quote */
+ NPC7, # 133 low horizontal ellipsis */
+ NPC7, # 134 dagger mark */
+ NPC7, # 135 double dagger mark */
+ NPC7, # 136 letter modifying circumflex */
+ NPC7, # 137 per thousand (mille) sign */
+ -83, # 138 uppercase S caron or hacek */
+ -39, # 139 left single angle quote mark */
+ -214, # 140 uppercase OE ligature */
+ NPC7, # 141 */
+ NPC7, # 142 */
+ NPC7, # 143 */
+ NPC7, # 144 */
+ -39, # 145 left single quotation mark */
+ -39, # 146 right single quote mark */
+ -34, # 147 left double quotation mark */
+ -34, # 148 right double quote mark */
+ -42, # 149 round filled bullet */
+ -45, # 150 en dash */
+ -45, # 151 em dash */
+ -39, # 152 small spacing tilde accent */
+ NPC7, # 153 trademark sign */
+ -115, # 154 lowercase s caron or hacek */
+ -39, # 155 right single angle quote mark */
+ -111, # 156 lowercase oe ligature */
+ NPC7, # 157 */
+ NPC7, # 158 */
+ -89, # 159 uppercase Y dieresis or umlaut */
+ -32, # 160 non-breaking space */
+ 64, # 161 ¡ inverted exclamation mark */
+ -99, # 162 ¢ cent sign */
+ 1, # 163 £ pound sterling sign */
+ 36, # 164 ¤ general currency sign */
+ 3, # 165 ¥ yen sign */
+ -33, # 166 ¦ broken vertical bar */
+ 95, # 167 § section sign */
+ -34, # 168 ¨ spacing dieresis or umlaut */
+ NPC7, # 169 © copyright sign */
+ NPC7, # 170 ª feminine ordinal indicator */
+ -60, # 171 « left (double) angle quote */
+ NPC7, # 172 ¬ logical not sign */
+ -45, # 173 soft hyphen */
+ NPC7, # 174 ® registered trademark sign */
+ NPC7, # 175 ¯ spacing macron (long) accent */
+ NPC7, # 176 ° degree sign */
+ NPC7, # 177 ± plus-or-minus sign */
+ -50, # 178 ² superscript 2 */
+ -51, # 179 ³ superscript 3 */
+ -39, # 180 ´ spacing acute accent */
+ -117, # 181 µ micro sign */
+ NPC7, # 182 ¶ paragraph sign, pilcrow sign */
+ NPC7, # 183 · middle dot, centered dot */
+ NPC7, # 184 ¸ spacing cedilla */
+ -49, # 185 ¹ superscript 1 */
+ NPC7, # 186 º masculine ordinal indicator */
+ -62, # 187 » right (double) angle quote (guillemet) */
+ NPC7, # 188 ¼ fraction 1/4 */
+ NPC7, # 189 ½ fraction 1/2 */
+ NPC7, # 190 ¾ fraction 3/4 */
+ 96, # 191 ¿ inverted question mark */
+ -65, # 192 À uppercase A grave */
+ -65, # 193 Á uppercase A acute */
+ -65, # 194 Â uppercase A circumflex */
+ -65, # 195 Ã uppercase A tilde */
+ 91, # 196 Ä uppercase A dieresis or umlaut */
+ 14, # 197 Å uppercase A ring */
+ 28, # 198 Æ uppercase AE ligature */
+ 9, # 199 Ç uppercase C cedilla */
+ -31, # 200 È uppercase E grave */
+ 31, # 201 É uppercase E acute */
+ -31, # 202 Ê uppercase E circumflex */
+ -31, # 203 Ë uppercase E dieresis or umlaut */
+ -73, # 204 Ì uppercase I grave */
+ -73, # 205 Í uppercase I acute */
+ -73, # 206 Î uppercase I circumflex */
+ -73, # 207 Ï uppercase I dieresis or umlaut */
+ -68, # 208 Ð uppercase ETH */
+ 93, # 209 Ñ uppercase N tilde */
+ -79, # 210 Ò uppercase O grave */
+ -79, # 211 Ó uppercase O acute */
+ -79, # 212 Ô uppercase O circumflex */
+ -79, # 213 Õ uppercase O tilde */
+ 92, # 214 Ö uppercase O dieresis or umlaut */
+ -42, # 215 × multiplication sign */
+ 11, # 216 Ø uppercase O slash */
+ -85, # 217 Ù uppercase U grave */
+ -85, # 218 Ú uppercase U acute */
+ -85, # 219 Û uppercase U circumflex */
+ 94, # 220 Ü uppercase U dieresis or umlaut */
+ -89, # 221 Ý uppercase Y acute */
+ NPC7, # 222 Þ uppercase THORN */
+ 30, # 223 ß lowercase sharp s, sz ligature */
+ 127, # 224 à lowercase a grave */
+ -97, # 225 á lowercase a acute */
+ -97, # 226 â lowercase a circumflex */
+ -97, # 227 ã lowercase a tilde */
+ 123, # 228 ä lowercase a dieresis or umlaut */
+ 15, # 229 å lowercase a ring */
+ 29, # 230 æ lowercase ae ligature */
+ -9, # 231 ç lowercase c cedilla */
+ 4, # 232 è lowercase e grave */
+ 5, # 233 é lowercase e acute */
+ -101, # 234 ê lowercase e circumflex */
+ -101, # 235 ë lowercase e dieresis or umlaut */
+ 7, # 236 ì lowercase i grave */
+ -7, # 237 í lowercase i acute */
+ -105, # 238 î lowercase i circumflex */
+ -105, # 239 ï lowercase i dieresis or umlaut */
+ NPC7, # 240 ð lowercase eth */
+ 125, # 241 ñ lowercase n tilde */
+ 8, # 242 ò lowercase o grave */
+ -111, # 243 ó lowercase o acute */
+ -111, # 244 ô lowercase o circumflex */
+ -111, # 245 õ lowercase o tilde */
+ 124, # 246 ö lowercase o dieresis or umlaut */
+ -47, # 247 ÷ division sign */
+ 12, # 248 ø lowercase o slash */
+ 6, # 249 ù lowercase u grave */
+ -117, # 250 ú lowercase u acute */
+ -117, # 251 û lowercase u circumflex */
+ 126, # 252 ü lowercase u dieresis or umlaut */
+ -121, # 253 ý lowercase y acute */
+ NPC7, # 254 þ lowercase thorn */
+ -121 # 255 ÿ lowercase y dieresis or umlaut */
);
sub iso8859_to_gsm0338 {
- my $ascii = shift;
- return '' if !defined $ascii || $ascii eq '';
+ my $ascii = shift;
+ return '' if ! defined $ascii || $ascii eq '';
- my $gsm = '';
- my $n = 0;
- for (; $n < length($ascii); $n++) {
+ my $gsm = '';
+ my $n = 0;
+ for( ; $n < length($ascii) ; $n++ ) {
my $ch_ascii = ord(substr($ascii, $n, 1));
- my $ch_gsm = $Device::Gsm::Charset::ISO8859_TO_GSM0338[$ch_ascii];
+ my $ch_gsm = $Device::Gsm::Charset::ISO8859_TO_GSM0338[$ch_ascii];
# Is this a "replaced" char?
- if ($ch_gsm <= 0xFF) {
+ if( $ch_gsm <= 0xFF ) {
$ch_gsm = abs($ch_gsm);
}
- else {
-
+ else
+ {
# Prepend an escape char for extended char
$gsm .= chr(ESCAPE);
-
# Encode extended char
$ch_gsm -= 256;
}
-
#warn('char ['.$ch_ascii.'] => ['.$ch_gsm.']');
- $gsm .= chr($ch_gsm);
- }
- return $gsm;
+ $gsm .= chr($ch_gsm);
+ }
+ return $gsm;
}
sub gsm0338_to_iso8859 {
- my $gsm = shift;
- return '' if !defined $gsm || $gsm eq '';
+ my $gsm = shift;
+ return '' if ! defined $gsm || $gsm eq '';
- my $ascii = '';
- my $n = 0;
+ my $ascii = '';
+ my $n = 0;
- for (; $n < length($gsm); $n++) {
+ for( ; $n < length($gsm) ; $n++ ) {
- my $c = ord(substr($gsm, $n, 1));
+ my $c = ord(substr($gsm, $n, 1));
- # Extended charset ?
- if ($c == ESCAPE) { # "escape extended mode"
- $n++;
- $c = ord(substr($gsm, $n, 1));
- if ($c == 0x0A) {
+ # Extended charset ?
+ if( $c == ESCAPE ) { # "escape extended mode"
+ $n++;
+ $c = ord(substr($gsm, $n, 1));
+ if( $c == 0x0A ) {
$ascii .= chr(12);
}
- elsif ($c == 0x14) {
- $ascii .= '^';
- }
- elsif ($c == 0x28) {
+ elsif( $c == 0x14 ) {
+ $ascii .= '^';
+ }
+ elsif( $c == 0x28 ) {
$ascii .= '{';
}
- elsif ($c == 0x29) {
+ elsif( $c == 0x29 ) {
$ascii .= '}';
}
- elsif ($c == 0x2F) {
- $ascii .= '\\';
- }
- elsif ($c == 0x3C) {
- $ascii .= '[';
- }
- elsif ($c == 0x3D) {
+ elsif( $c == 0x2F ) {
+ $ascii .= '\\';
+ }
+ elsif( $c == 0x3C ) {
+ $ascii .= '[';
+ }
+ elsif( $c == 0x3D ) {
$ascii .= '~';
}
- elsif ($c == 0x3E) {
- $ascii .= ']';
- }
- elsif ($c == 0x40) {
+ elsif( $c == 0x3E ) {
+ $ascii .= ']';
+ }
+ elsif( $c == 0x40 ) {
$ascii .= '|';
}
- elsif ($c == 0x65) { # 'e'
- $ascii .= chr(164)
- ; # iso_8859_15 EURO SIGN or iso_8859_1 CURRENCY_SIGN
- }
+ elsif( $c == 0x65 ) { # 'e'
+ $ascii .= chr(164); # iso_8859_15 EURO SIGN or iso_8859_1 CURRENCY_SIGN
+ }
else {
- $ascii .= chr(NPC8); # Non printable
- }
-
- }
- else {
+ $ascii .= chr(NPC8); # Non printable
+ }
- # Standard GSM 3.38 encoding
- $ascii .= chr($Device::Gsm::Charset::GSM0338_TO_ISO8859[$c]);
- }
+ } else {
+ # Standard GSM 3.38 encoding
+ my $latin1 = $Device::Gsm::Charset::GSM0338_TO_ISO8859[$c];
+ if (defined $latin1) {
+ $ascii .= chr($latin1);
+ }
+ else {
+ $ascii .= chr($c);
+ }
+ }
#warn('gsm char ['.$c.'] converted to ascii ['.ord(substr($ascii,-1)).']');
- }
-
- return $ascii;
-}
+ }
-sub gsm0338_length {
- my $ascii = shift;
- my $gsm0338_length = 0;
- my $n = 0;
- for (; $n < length($ascii); $n++) {
- my $ch_ascii = ord(substr($ascii, $n, 1));
- my $ch_gsm = $Device::Gsm::Charset::ISO8859_TO_GSM0338[$ch_ascii];
-
- # Is this a "replaced" char?
- if ($ch_gsm <= 0xFF) {
- $gsm0338_length++;
- }
- else {
- $gsm0338_length += 2;
- }
- }
- return $gsm0338_length;
+ return $ascii;
}
-sub gsm0338_split {
- my $ascii = shift;
- return '' if !defined $ascii || $ascii eq '';
- my @parts;
- my $part;
- my $chars_count = 0;
- my $ascii_length = length($ascii);
- while ($ascii_length) {
- my $ch_ascii = substr($ascii, 0, 1);
- my $ch_gsm
- = $Device::Gsm::Charset::ISO8859_TO_GSM0338[ ord($ch_ascii) ];
- if ($chars_count < 153 and $ch_gsm <= 0xFF) {
- $part .= $ch_ascii;
- $chars_count++;
- $ascii = substr($ascii, 1, $ascii_length--);
- }
- elsif ($chars_count < 152 and $ch_gsm > 0xFF) {
- $part .= $ch_ascii;
- $chars_count += 2;
- $ascii = substr($ascii, 1, $ascii_length--);
- }
- else {
- push(@parts, $part);
- $part = '';
- $chars_count = 0;
- }
- }
- push(@parts, $part);
- return (@parts);
-}
1;
__END__
@@ -4,388 +4,389 @@ package Device::Gsm::Networks;
# Gsm networks data stolen from Gnokii
#
our %COUNTRIES = (
- '202' => 'Greece',
- '204' => 'Netherlands',
- '206' => 'Belgium',
- '208' => 'France',
- '213' => 'Andorra',
- '214' => 'Spain',
- '216' => 'Hungary',
- '218' => 'Bosnia Herzegovina',
- '219' => 'Croatia',
- '220' => 'Yugoslavia',
- '222' => 'Italy',
- '226' => 'Romania',
- '228' => 'Switzerland',
- '230' => 'Czech Republic',
- '231' => 'Slovak Republic',
- '232' => 'Austria',
- '234' => 'United Kingdom',
- '238' => 'Denmark',
- '240' => 'Sweden',
- '242' => 'Norway',
- '244' => 'Finland',
- '246' => 'Lithuania',
- '247' => 'Latvia',
- '248' => 'Estonia',
- '250' => 'Russia',
- '255' => 'Ukraine',
- '259' => 'Moldova',
- '260' => 'Poland',
- '262' => 'Germany',
- '266' => 'Gibraltar',
- '268' => 'Portugal',
- '270' => 'Luxembourg',
- '272' => 'Ireland',
- '274' => 'Iceland',
- '276' => 'Albania',
- '278' => 'Malta',
- '280' => 'Cyprus',
- '282' => 'Georgia',
- '283' => 'Armenia',
- '284' => 'Bulgaria',
- '286' => 'Turkey',
- '290' => 'Greenland',
- '293' => 'Slovenia',
- '294' => 'Macedonia',
- '302' => 'Canada',
- '310' => 'U.S.A.',
- '340' => 'French West Indies',
- '400' => 'Azerbaijan',
- '404' => 'India',
- '410' => 'Pakistan',
- '413' => 'Sri Lanka',
- '415' => 'Lebanon',
- '416' => 'Jordan',
- '417' => 'Syria',
- '418' => 'Iraq',
- '419' => 'Kuwait',
- '420' => 'Saudi Arabia',
- '422' => 'Oman',
- '424' => 'United Arab Emirates',
- '425' => 'Israel',
- '426' => 'Bahrain',
- '427' => 'Qatar',
- '432' => 'Iran',
- '434' => 'Uzbekistan',
- '437' => 'Kyrgyz Republic',
- '452' => 'Vietnam',
- '454' => 'Hong Kong',
- '455' => 'Macau',
- '456' => 'Cambodia',
- '457' => 'Lao',
- '460' => 'China',
- '466' => 'Taiwan',
- '470' => 'Bangladesh',
- '502' => 'Malaysia',
- '505' => 'Australia',
- '510' => 'Indonesia',
- '515' => 'Philippines',
- '520' => 'Thailand',
- '525' => 'Singapore',
- '528' => 'Brunei Darussalam',
- '530' => 'New Zealand',
- '542' => 'Fiji',
- '546' => 'New Caledonia',
- '547' => 'French Polynesia',
- '602' => 'Egypt',
- '603' => 'Algeria',
- '604' => 'Morocco',
- '605' => 'Tunisia',
- '608' => 'Senegal',
- '611' => 'Guinea',
- '612' => 'Cote d\'Ivoire',
- '615' => 'Togo',
- '617' => 'Mauritius',
- '618' => 'Liberia',
- '620' => 'Ghana',
- '624' => 'Cameroon',
- '625' => 'Cape Verde',
- '633' => 'Seychelles',
- '634' => 'Mozambique',
- '634' => 'Sudan',
- '635' => 'Rwanda',
- '636' => 'Ethiopia',
- '640' => 'Tanzania',
- '641' => 'Uganda',
- '645' => 'Zambia',
- '646' => 'Madagascar',
- '647' => 'Reunion',
- '648' => 'Zimbabwe',
- '649' => 'Namibia',
- '650' => 'Malawi',
- '651' => 'Lesotho',
- '652' => 'Botswana',
- '655' => 'South Africa',
- '730' => 'Chile',
- '734' => 'Venezuela',
- undef => 'unknown',
+ '202'=> 'Greece',
+ '204'=> 'Netherlands',
+ '206'=> 'Belgium',
+ '208'=> 'France',
+ '213'=> 'Andorra',
+ '214'=> 'Spain',
+ '216'=> 'Hungary',
+ '218'=> 'Bosnia Herzegovina',
+ '219'=> 'Croatia',
+ '220'=> 'Yugoslavia',
+ '222'=> 'Italy',
+ '226'=> 'Romania',
+ '228'=> 'Switzerland',
+ '230'=> 'Czech Republic',
+ '231'=> 'Slovak Republic',
+ '232'=> 'Austria',
+ '234'=> 'United Kingdom',
+ '238'=> 'Denmark',
+ '240'=> 'Sweden',
+ '242'=> 'Norway',
+ '244'=> 'Finland',
+ '246'=> 'Lithuania',
+ '247'=> 'Latvia',
+ '248'=> 'Estonia',
+ '250'=> 'Russia',
+ '255'=> 'Ukraine',
+ '259'=> 'Moldova',
+ '260'=> 'Poland',
+ '262'=> 'Germany',
+ '266'=> 'Gibraltar',
+ '268'=> 'Portugal',
+ '270'=> 'Luxembourg',
+ '272'=> 'Ireland',
+ '274'=> 'Iceland',
+ '276'=> 'Albania',
+ '278'=> 'Malta',
+ '280'=> 'Cyprus',
+ '282'=> 'Georgia',
+ '283'=> 'Armenia',
+ '284'=> 'Bulgaria',
+ '286'=> 'Turkey',
+ '290'=> 'Greenland',
+ '293'=> 'Slovenia',
+ '294'=> 'Macedonia',
+ '302'=> 'Canada',
+ '310'=> 'U.S.A.',
+ '340'=> 'French West Indies',
+ '400'=> 'Azerbaijan',
+ '404'=> 'India',
+ '410'=> 'Pakistan',
+ '413'=> 'Sri Lanka',
+ '415'=> 'Lebanon',
+ '416'=> 'Jordan',
+ '417'=> 'Syria',
+ '418'=> 'Iraq',
+ '419'=> 'Kuwait',
+ '420'=> 'Saudi Arabia',
+ '422'=> 'Oman',
+ '424'=> 'United Arab Emirates',
+ '425'=> 'Israel',
+ '426'=> 'Bahrain',
+ '427'=> 'Qatar',
+ '432'=> 'Iran',
+ '434'=> 'Uzbekistan',
+ '437'=> 'Kyrgyz Republic',
+ '452'=> 'Vietnam',
+ '454'=> 'Hong Kong',
+ '455'=> 'Macau',
+ '456'=> 'Cambodia',
+ '457'=> 'Lao',
+ '460'=> 'China',
+ '466'=> 'Taiwan',
+ '470'=> 'Bangladesh',
+ '502'=> 'Malaysia',
+ '505'=> 'Australia',
+ '510'=> 'Indonesia',
+ '515'=> 'Philippines',
+ '520'=> 'Thailand',
+ '525'=> 'Singapore',
+ '528'=> 'Brunei Darussalam',
+ '530'=> 'New Zealand',
+ '542'=> 'Fiji',
+ '546'=> 'New Caledonia',
+ '547'=> 'French Polynesia',
+ '602'=> 'Egypt',
+ '603'=> 'Algeria',
+ '604'=> 'Morocco',
+ '605'=> 'Tunisia',
+ '608'=> 'Senegal',
+ '611'=> 'Guinea',
+ '612'=> 'Cote d\'Ivoire',
+ '615'=> 'Togo',
+ '617'=> 'Mauritius',
+ '618'=> 'Liberia',
+ '620'=> 'Ghana',
+ '624'=> 'Cameroon',
+ '625'=> 'Cape Verde',
+ '633'=> 'Seychelles',
+ '634'=> 'Mozambique',
+ '634'=> 'Sudan',
+ '635'=> 'Rwanda',
+ '636'=> 'Ethiopia',
+ '640'=> 'Tanzania',
+ '641'=> 'Uganda',
+ '645'=> 'Zambia',
+ '646'=> 'Madagascar',
+ '647'=> 'Reunion',
+ '648'=> 'Zimbabwe',
+ '649'=> 'Namibia',
+ '650'=> 'Malawi',
+ '651'=> 'Lesotho',
+ '652'=> 'Botswana',
+ '655'=> 'South Africa',
+ '730'=> 'Chile',
+ '734'=> 'Venezuela',
+ undef=> 'unknown',
);
our %NETWORKS = (
- "20201" => "Cosmote",
- "20205" => "PANAFON",
- "20210" => "TELESTET",
- "20404" => "LIBERTEL",
- "20408" => "KPN Telecom",
- "20412" => "O2",
- "20416" => "BEN",
- "20420" => "Dutchtone NV",
- "20601" => "PROXIMUS",
- "20610" => "Mobistar",
- "20620" => "Base",
- "20801" => "ITINERIS",
- "20810" => "SFR",
- "20820" => "Bouygues Telecom",
- "21303" => "MOBILAND",
- "21401" => "Airtel GSM 900-Spain",
- "21403" => "Retevision Movil",
- "21407" => "MOVISTAR",
- "21601" => "Pannon GSM",
- "21670" => "Vodafone",
- "21630" => "Westel 900",
- "21890" => "GSMBIH",
- "21901" => "CRONET",
- "21910" => "VIP",
- "22001" => "MOBTEL",
- "22002" => "ProMonte GSM",
- "22003" => "Telekom Srbije",
- "22201" => "Telecom Italia Mobile",
- "22210" => "OMNITEL",
- "22288" => "Wind Telecomunicazioni SpA",
- "22601" => "CONNEX GSM",
- "22610" => "DIALOG",
- "22801" => "NATEL International",
- "22802" => "diAx Mobile AG",
- "23001" => "T-Mobile CZ",
- "23002" => "EuroTel",
- "23003" => "Oskar",
- "23101" => "Orange",
- "23102" => "EuroTel GSM",
- "23201" => "A1",
- "23203" => "T-Mobile AT",
- "23205" => "ONE",
- "23207" => "tele.ring",
- "23410" => "Cellnet",
- "23415" => "Vodafone",
- "23430" => "T-Mobile UK",
- "23433" => "ORANGE",
- "23450" => "Jersey Telecoms GSM",
- "23455" => "Guernsey Telecoms GSM",
- "23458" => "PRONTO GSM",
- "23801" => "TDK-MOBIL",
- "23802" => "SONOFON",
- "23820" => "TELIA DK",
- "23830" => "Mobilix",
- "24001" => "Telia AB",
- "24007" => "COMVIQ",
- "24008" => "EUROPOLITAN",
- "24201" => "Telenor Mobil",
- "24202" => "NetCom GSM",
- "24403" => "Telia City (Finland)",
- "24405" => "Radiolinja",
- "24409" => "Finnet",
- "24491" => "Sonera",
- "24601" => "OMNITEL",
- "24602" => "Bite GSM",
- "24701" => "LMT LV",
- "24702" => "BALTCOM GSM",
- "24801" => "EMT GSM",
- "24802" => "Radiolinja Eesti AS",
- "24803" => "Q GSM",
- "25001" => "Mobile Telesystems",
- "25002" => "North-West GSM",
- "25005" => "Siberian Cellular Systems 900",
- "25007" => "BM Telecom",
- "25010" => "Don Telecom",
- "25012" => "FECS-900",
- "25013" => "Kuban GSM",
- "25039" => "Uraltel",
- "25044" => "North Caucasian GSM",
- "25099" => "BeeLine",
- "25501" => "UMC",
- "25502" => "WellCOM",
- "25503" => "Kyivstar",
- "25505" => "Golden Telecom",
- "25901" => "VOXTEL",
- "26001" => "PLUS GSM",
- "26002" => "ERA GSM",
- "26003" => "IDEA Centertel",
- "26201" => "T-Mobile D",
- "26202" => "D2 PRIVAT",
- "26203" => "E-Plus",
- "26207" => "Interkom",
- "26601" => "Gibtel GSM",
- "26801" => "TELECEL",
- "26803" => "OPTIMUS",
- "26806" => "TMN",
- "27001" => "LUXGSM",
- "27077" => "TANGO",
- "27201" => "EIRCELL-GSM",
- "27202" => "Digifone",
- "27401" => "Landssiminn GSM 900",
- "27402" => "TAL hf",
- "27601" => "AMC",
- "27801" => "Vodafone Malta Limited",
- "28001" => "CYTAGSM",
- "28201" => "Geocell Limited",
- "28202" => "Magti GSM",
- "28301" => "ArmGSM",
- "28401" => "M-TEL GSM BG",
- "28601" => "Turkcell",
- "28602" => "TELSIM GSM",
- "28801" => "Faroese Telecom",
- "29001" => "Tele Greenland",
- "29340" => "SI.MOBIL d. d.",
- "29341" => "MOBITEL",
- "29370" => "SI VEGA 070",
- "29401" => "MobiMak",
- "30237" => "Microcell Connexions Inc",
- "30272" => "Rogers AT&T",
- "31001" => "Cellnet",
- "31002" => "Sprint Spectrum",
- "31011" => "Wireless 2000 Telephone Co.",
- "31015" => "BellSouth Mobility DCS",
- "31016" => "T-Mobile",
- "31017" => "Pac Bell",
- "31020" => "T-Mobile",
- "31021" => "T-Mobile",
- "31022" => "T-Mobile",
- "31023" => "T-Mobile",
- "31024" => "T-Mobile",
- "31025" => "T-Mobile",
- "31026" => "T-Mobile",
- "31027" => "T-Mobile",
- "31031" => "T-Mobile",
- "31038" => "AT&T Wireless",
- "31058" => "T-Mobile",
- "31066" => "T-Mobile",
- "31077" => "Iowa Wireless Services LP",
- "31080" => "T-Mobile",
- "34001" => "AMERIS",
- "40001" => "AZERCELL GSM",
- "40002" => "Bakcell GSM 2000",
- "40407" => "TATA Cellular",
- "40410" => "AirTel",
- "40411" => "Essar Cellphone",
- "40412" => "Escotel",
- "40414" => "Modicom",
- "40415" => "Essar Cellphone",
- "40420" => "Max Touch",
- "40421" => "BPL - Mobile",
- "40427" => "BPL USWEST Cellular",
- "40430" => "Command",
- "40440" => "SkyCell",
- "40441" => "RPG Cellular",
- "40442" => "AIRCEL",
- "41001" => "Mobilink",
- "41302" => "DIALOG GSM",
- "41501" => "CELLIS",
- "41503" => "LIBANCELL",
- "41601" => "Fastlink",
- "41709" => "MOBILE SYRIA",
- "41902" => "MTCNet",
- "42001" => "Al Jawwal",
- "42007" => "E.A.E",
- "42202" => "GTO",
- "42402" => "UAE-ETISALAT",
- "42501" => "Partner Communications Company Ltd",
- "42601" => "BHR MOBILE PLUS",
- "42701" => "QATARNET",
- "43211" => "TCI",
- "43404" => "Daewoo Unitel",
- "43405" => "Coscom",
- "43701" => "Bitel",
- "45400" => "TCSL GSM",
- "45404" => "HKGHT",
- "45406" => "SMARTONE GSM",
- "45410" => "New World PCS",
- "45412" => "PEOPLES",
- "45416" => "SUNDAY",
- "45501" => "TELEMOVEL+ GSM900-Macau",
- "45601" => "MobiTel",
- "45602" => "SAMART-GSM",
- "45701" => "Lao Shinawatra Telecom",
- "46000" => "China Telecom GSM",
- "46001" => "CU-GSM",
- "46601" => "Far EasTone Telecoms 900",
- "46606" => "TUNTEX GSM 1800",
- "46688" => "KG Telecom",
- "46692" => "Chunghwa GSM",
- "46693" => "MobiTai",
- "46697" => "TWNGSM",
- "46699" => "TransAsia",
- "47001" => "GrameenPhone Ltd",
- "47019" => "Mobile 2000",
- "50212" => "Maxis Mobile",
- "50213" => "TM Touch",
- "50216" => "DiGi 1800",
- "50217" => "ADAM",
- "50219" => "CELCOM",
- "50501" => "MobileNet",
- "50502" => "OPTUS",
- "50503" => "VODAFONE",
- "50508" => "One.Tel",
- "51001" => "SATELINDO",
- "51008" => "LIPPO TELECOM",
- "51010" => "TELKOMSEL",
- "51011" => "Excelcom",
- "51021" => "INDOSAT",
- "51501" => "ISLACOM",
- "51502" => "Globe Telecom",
- "52001" => "AIS GSM",
- "52010" => "WCS",
- "52018" => "Worldphone 1800",
- "52023" => "HELLO",
- "52501" => "SingTel Mobile",
- "52502" => "ST-PCN",
- "52503" => "MOBILEONE",
- "52811" => "DSTCom",
- "53001" => "Vodafone New Zealand Limited",
- "54201" => "Vodafone",
- "54601" => "Mobilis",
- "54720" => "VINI",
- "60201" => "MobiNil",
- "60202" => "Tunicell",
- "60301" => "ALGERIAN MOBILE NETWORK",
- "60401" => "I A M",
- "60801" => "ALIZE",
- "61102" => "Lagui",
- "61203" => "IVOIRIS",
- "61205" => "Telecel",
- "61501" => "TOGO CELL",
- "61701" => "Cellplus Mobile Comms",
- "61801" => "Omega",
- "62001" => "SPACEFON",
- "62501" => "CVMOVEL",
- "63301" => "Seychelles Cellular Services",
- "63310" => "AIRTEL",
- "63401" => "MobiTel",
- "63510" => "Rwandacell",
- "63601" => "ETMTN",
- "64001" => "TRITEL",
- "64110" => "MTN-Uganda",
- "64202" => "ANTARIS",
- "64301" => "T.D.M GSM 900",
- "64501" => "ZAMCELL",
- "64601" => "Madacom",
- "64603" => "Sacel Madagascar S.A.",
- "64710" => "SRR",
- "64801" => "NET*ONE",
- "64803" => "Telecel",
- "64901" => "MTC",
- "65001" => "Callpoint 900",
- "65101" => "Vodacom Lesotho (Pty) Ltd",
- "65501" => "Vodacom",
- "65510" => "MTN",
- "68038" => "NPI Wireless",
- "73001" => "Entel Telefonia Movi",
- "73010" => "Entel PCS",
- "73401" => "Infonet",
- undef => 'unknown',
+ "20201"=> "Cosmote",
+ "20205"=> "PANAFON",
+ "20210"=> "TELESTET",
+ "20404"=> "LIBERTEL",
+ "20408"=> "KPN Telecom",
+ "20412"=> "O2",
+ "20416"=> "BEN",
+ "20420"=> "Dutchtone NV",
+ "20601"=> "PROXIMUS",
+ "20610"=> "Mobistar",
+ "20620"=> "Base",
+ "20801"=> "ITINERIS",
+ "20810"=> "SFR",
+ "20820"=> "Bouygues Telecom",
+ "21303"=> "MOBILAND",
+ "21401"=> "Airtel GSM 900-Spain",
+ "21403"=> "Retevision Movil",
+ "21407"=> "MOVISTAR",
+ "21601"=> "Pannon GSM",
+ "21670"=> "Vodafone",
+ "21630"=> "Westel 900",
+ "21890"=> "GSMBIH",
+ "21901"=> "CRONET",
+ "21910"=> "VIP",
+ "22001"=> "MOBTEL",
+ "22002"=> "ProMonte GSM",
+ "22003"=> "Telekom Srbije",
+ "22201"=> "Telecom Italia Mobile",
+ "22210"=> "OMNITEL",
+ "22288"=> "Wind Telecomunicazioni SpA",
+ "22601"=> "CONNEX GSM",
+ "22610"=> "DIALOG",
+ "22801"=> "NATEL International",
+ "22802"=> "diAx Mobile AG",
+ "23001"=> "T-Mobile CZ",
+ "23002"=> "EuroTel",
+ "23003"=> "Oskar",
+ "23101"=> "Orange",
+ "23102"=> "EuroTel GSM",
+ "23201"=> "A1",
+ "23203"=> "T-Mobile AT",
+ "23205"=> "ONE",
+ "23207"=> "tele.ring",
+ "23410"=> "Cellnet",
+ "23415"=> "Vodafone",
+ "23430"=> "T-Mobile UK",
+ "23433"=> "ORANGE",
+ "23450"=> "Jersey Telecoms GSM",
+ "23455"=> "Guernsey Telecoms GSM",
+ "23458"=> "PRONTO GSM",
+ "23801"=> "TDK-MOBIL",
+ "23802"=> "SONOFON",
+ "23820"=> "TELIA DK",
+ "23830"=> "Mobilix",
+ "24001"=> "Telia AB",
+ "24007"=> "COMVIQ",
+ "24008"=> "EUROPOLITAN",
+ "24201"=> "Telenor Mobil",
+ "24202"=> "NetCom GSM",
+ "24403"=> "Telia City (Finland)",
+ "24405"=> "Radiolinja",
+ "24409"=> "Finnet",
+ "24491"=> "Sonera",
+ "24601"=> "OMNITEL",
+ "24602"=> "Bite GSM",
+ "24701"=> "LMT LV",
+ "24702"=> "BALTCOM GSM",
+ "24801"=> "EMT GSM",
+ "24802"=> "Radiolinja Eesti AS",
+ "24803"=> "Q GSM",
+ "25001"=> "Mobile Telesystems",
+ "25002"=> "North-West GSM",
+ "25005"=> "Siberian Cellular Systems 900",
+ "25007"=> "BM Telecom",
+ "25010"=> "Don Telecom",
+ "25012"=> "FECS-900",
+ "25013"=> "Kuban GSM",
+ "25039"=> "Uraltel",
+ "25044"=> "North Caucasian GSM",
+ "25099"=> "BeeLine",
+ "25501"=> "UMC",
+ "25502"=> "WellCOM",
+ "25503"=> "Kyivstar",
+ "25505"=> "Golden Telecom",
+ "25901"=> "VOXTEL",
+ "26001"=> "PLUS GSM",
+ "26002"=> "ERA GSM",
+ "26003"=> "IDEA Centertel",
+ "26201"=> "T-Mobile D",
+ "26202"=> "D2 PRIVAT",
+ "26203"=> "E-Plus",
+ "26207"=> "Interkom",
+ "26601"=> "Gibtel GSM",
+ "26801"=> "TELECEL",
+ "26803"=> "OPTIMUS",
+ "26806"=> "TMN",
+ "27001"=> "LUXGSM",
+ "27077"=> "TANGO",
+ "27201"=> "EIRCELL-GSM",
+ "27202"=> "Digifone",
+ "27401"=> "Landssiminn GSM 900",
+ "27402"=> "TAL hf",
+ "27601"=> "AMC",
+ "27801"=> "Vodafone Malta Limited",
+ "28001"=> "CYTAGSM",
+ "28201"=> "Geocell Limited",
+ "28202"=> "Magti GSM",
+ "28301"=> "ArmGSM",
+ "28401"=> "M-TEL GSM BG",
+ "28601"=> "Turkcell",
+ "28602"=> "TELSIM GSM",
+ "28801"=> "Faroese Telecom",
+ "29001"=> "Tele Greenland",
+ "29340"=> "SI.MOBIL d. d.",
+ "29341"=> "MOBITEL",
+ "29370"=> "SI VEGA 070",
+ "29401"=> "MobiMak",
+ "30237"=> "Microcell Connexions Inc",
+ "30272"=> "Rogers AT&T",
+ "31001"=> "Cellnet",
+ "31002"=> "Sprint Spectrum",
+ "31011"=> "Wireless 2000 Telephone Co.",
+ "31015"=> "BellSouth Mobility DCS",
+ "31016"=> "T-Mobile",
+ "31017"=> "Pac Bell",
+ "31020"=> "T-Mobile",
+ "31021"=> "T-Mobile",
+ "31022"=> "T-Mobile",
+ "31023"=> "T-Mobile",
+ "31024"=> "T-Mobile",
+ "31025"=> "T-Mobile",
+ "31026"=> "T-Mobile",
+ "31027"=> "T-Mobile",
+ "31031"=> "T-Mobile",
+ "31038"=> "AT&T Wireless",
+ "31058"=> "T-Mobile",
+ "31066"=> "T-Mobile",
+ "31077"=> "Iowa Wireless Services LP",
+ "31080"=> "T-Mobile",
+ "34001"=> "AMERIS",
+ "40001"=> "AZERCELL GSM",
+ "40002"=> "Bakcell GSM 2000",
+ "40407"=> "TATA Cellular",
+ "40410"=> "AirTel",
+ "40411"=> "Essar Cellphone",
+ "40412"=> "Escotel",
+ "40414"=> "Modicom",
+ "40415"=> "Essar Cellphone",
+ "40420"=> "Max Touch",
+ "40421"=> "BPL - Mobile",
+ "40427"=> "BPL USWEST Cellular",
+ "40430"=> "Command",
+ "40440"=> "SkyCell",
+ "40441"=> "RPG Cellular",
+ "40442"=> "AIRCEL",
+ "41001"=> "Mobilink",
+ "41302"=> "DIALOG GSM",
+ "41501"=> "CELLIS",
+ "41503"=> "LIBANCELL",
+ "41601"=> "Fastlink",
+ "41709"=> "MOBILE SYRIA",
+ "41902"=> "MTCNet",
+ "42001"=> "Al Jawwal",
+ "42007"=> "E.A.E",
+ "42202"=> "GTO",
+ "42402"=> "UAE-ETISALAT",
+ "42501"=> "Partner Communications Company Ltd",
+ "42601"=> "BHR MOBILE PLUS",
+ "42701"=> "QATARNET",
+ "43211"=> "TCI",
+ "43404"=> "Daewoo Unitel",
+ "43405"=> "Coscom",
+ "43701"=> "Bitel",
+ "45400"=> "TCSL GSM",
+ "45404"=> "HKGHT",
+ "45406"=> "SMARTONE GSM",
+ "45410"=> "New World PCS",
+ "45412"=> "PEOPLES",
+ "45416"=> "SUNDAY",
+ "45501"=> "TELEMOVEL+ GSM900-Macau",
+ "45601"=> "MobiTel",
+ "45602"=> "SAMART-GSM",
+ "45701"=> "Lao Shinawatra Telecom",
+ "46000"=> "China Telecom GSM",
+ "46001"=> "CU-GSM",
+ "46601"=> "Far EasTone Telecoms 900",
+ "46606"=> "TUNTEX GSM 1800",
+ "46688"=> "KG Telecom",
+ "46692"=> "Chunghwa GSM",
+ "46693"=> "MobiTai",
+ "46697"=> "TWNGSM",
+ "46699"=> "TransAsia",
+ "47001"=> "GrameenPhone Ltd",
+ "47019"=> "Mobile 2000",
+ "50212"=> "Maxis Mobile",
+ "50213"=> "TM Touch",
+ "50216"=> "DiGi 1800",
+ "50217"=> "ADAM",
+ "50219"=> "CELCOM",
+ "50501"=> "MobileNet",
+ "50502"=> "OPTUS",
+ "50503"=> "VODAFONE",
+ "50508"=> "One.Tel",
+ "51001"=> "SATELINDO",
+ "51008"=> "LIPPO TELECOM",
+ "51010"=> "TELKOMSEL",
+ "51011"=> "Excelcom",
+ "51021"=> "INDOSAT",
+ "51501"=> "ISLACOM",
+ "51502"=> "Globe Telecom",
+ "52001"=> "AIS GSM",
+ "52010"=> "WCS",
+ "52018"=> "Worldphone 1800",
+ "52023"=> "HELLO",
+ "52501"=> "SingTel Mobile",
+ "52502"=> "ST-PCN",
+ "52503"=> "MOBILEONE",
+ "52811"=> "DSTCom",
+ "53001"=> "Vodafone New Zealand Limited",
+ "54201"=> "Vodafone",
+ "54601"=> "Mobilis",
+ "54720"=> "VINI",
+ "60201"=> "MobiNil",
+ "60202"=> "Tunicell",
+ "60301"=> "ALGERIAN MOBILE NETWORK",
+ "60401"=> "I A M",
+ "60801"=> "ALIZE",
+ "61102"=> "Lagui",
+ "61203"=> "IVOIRIS",
+ "61205"=> "Telecel",
+ "61501"=> "TOGO CELL",
+ "61701"=> "Cellplus Mobile Comms",
+ "61801"=> "Omega",
+ "62001"=> "SPACEFON",
+ "62501"=> "CVMOVEL",
+ "63301"=> "Seychelles Cellular Services",
+ "63310"=> "AIRTEL",
+ "63401"=> "MobiTel",
+ "63510"=> "Rwandacell",
+ "63601"=> "ETMTN",
+ "64001"=> "TRITEL",
+ "64110"=> "MTN-Uganda",
+ "64202"=> "ANTARIS",
+ "64301"=> "T.D.M GSM 900",
+ "64501"=> "ZAMCELL",
+ "64601"=> "Madacom",
+ "64603"=> "Sacel Madagascar S.A.",
+ "64710"=> "SRR",
+ "64801"=> "NET*ONE",
+ "64803"=> "Telecel",
+ "64901"=> "MTC",
+ "65001"=> "Callpoint 900",
+ "65101"=> "Vodacom Lesotho (Pty) Ltd",
+ "65501"=> "Vodacom",
+ "65510"=> "MTN",
+ "68038"=> "NPI Wireless",
+ "73001"=> "Entel Telefonia Movi",
+ "73010"=> "Entel PCS",
+ "73401"=> "Infonet",
+ undef => 'unknown',
);
-sub name {
+sub name
+{
my $number = $_[0];
$number =~ s/\D//;
return exists $NETWORKS{$number}
@@ -393,7 +394,8 @@ sub name {
: 'unknown';
}
-sub country {
+sub country
+{
my $number = $_[0];
$number =~ s/\D//;
return exists $COUNTRIES{$number}
@@ -1,6 +1,5 @@
-# Device::Gsm::Pdu - PDU encoding/decoding functions for Device::Gsm class
+# Device::Gsm::Pdu - PDU encoding/decoding functions for Device::Gsm class
# Copyright (C) 2002-2011 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
#
# This program is free software; you can redistribute it and/or modify
# it only under the terms of Perl itself.
@@ -21,14 +20,13 @@ package Device::Gsm::Pdu;
use strict;
use Device::Gsm::Charset;
-use Device::Gsm::Sms::Token::UDH;
-# decode a pdu encoded phone number into human readable format
+# decode a pdu encoded phone number into human readable format
sub decode_address {
my $address = shift or return;
my $number;
- my ($length, $type, $bcd_digits) = unpack('A2 A2 A*', $address);
+ my($length, $type, $bcd_digits) = unpack('A2 A2 A*', $address);
# XXX DEBUG
#print STDERR "len=$length type=$type bcd=$bcd_digits\n";
@@ -37,14 +35,15 @@ sub decode_address {
# Alphabetical addresses begin with 'D0'.
# Check also http://smslink.sourceforge.net/pdu.html
#
- if ($type eq 'D0') {
+ if( $type eq 'D0' )
+ {
$number = decode_text7($length . $bcd_digits);
return $number;
}
# Reverse each pair of bcd digits
- while ($bcd_digits) {
- $number .= reverse substr($bcd_digits, 0, 2);
+ while( $bcd_digits ) {
+ $number .= reverse substr( $bcd_digits, 0, 2 );
$bcd_digits = substr $bcd_digits, 2;
}
@@ -59,7 +58,8 @@ sub decode_address {
$number =~ s/B/#/;
# If number is international, put a '+' sign before
- if ($type == 91 && $number !~ /^\s*\+/) {
+ if( $type == 91 && $number !~ /^\s*\+/ )
+ {
$number = '+' . $number;
}
@@ -68,39 +68,10 @@ sub decode_address {
sub decode_text7 {
pack '(b*)*',
- unpack 'C/(a7)',
- pack 'C a*',
- unpack 'C b*',
- pack 'H*', $_[0];
-}
-
-#remains for comatibility reasons with my production scripts :)
-sub decode_text7_udh1 {
- my $unpacked = join '',
- unpack 'C/(a7)',
- pack 'C a*',
- unpack 'C b*',
- pack 'H*', $_[0];
-
- #remove bit of padding from message
- $unpacked = substr($unpacked, 1, length($unpacked));
- pack '(b*)*', ($unpacked =~ m/([01]{1,7})/gs);
-}
-
-#decode text with padding
-sub decode_text7_udh {
- my ($encoded, $padding) = @_;
- $padding = 0 unless ($padding);
- my $unpacked = join '',
- unpack 'C/(a7)',
- pack 'C a*',
- unpack 'C b*',
- pack 'H*', $encoded;
-
- #remove bits of padding from message
- $unpacked = substr($unpacked, $padding, length($unpacked));
- pack '(b*)*', ($unpacked =~ m/([01]{7})/gs);
-
+ unpack 'C/(a7)',
+ pack 'C a*',
+ unpack 'C b*',
+ pack 'H*', $_[0]
}
# decode 8-bit encoded text
@@ -110,12 +81,11 @@ sub decode_text8($) {
return unless $text8;
my $str;
- while ($text8) {
- $str .= chr(hex(substr $text8, 0, 2));
- if (length($text8) > 2) {
+ while( $text8 ) {
+ $str .= chr( hex(substr $text8, 0, 2) );
+ if( length($text8) > 2 ) {
$text8 = substr($text8, 2);
- }
- else {
+ } else {
$text8 = '';
}
}
@@ -123,9 +93,9 @@ sub decode_text8($) {
}
sub encode_address {
- my $num = shift;
- my $type = '';
- my $len = 0;
+ my $num = shift;
+ my $type = '';
+ my $len = 0;
my $encoded = '';
$num =~ s/\s+//g;
@@ -133,26 +103,27 @@ sub encode_address {
#warn('encode_address('.$num.')');
# Check for alphabetical addresses (TS 03.38)
- if ($num =~ /[A-Z][a-z]/) {
-
+ if( $num =~ /[A-Z][a-z]/ )
+ {
# Encode clear text in gsm0338 7-bit
- $type = 'D0';
+ $type = 'D0';
$encoded = encode_text7($num);
- $len = unpack 'H2' => chr(length $encoded);
+ $len = unpack 'H2' => chr( length $encoded );
}
- else {
- $type = index($num, '+') == 0 ? 91 : 81;
+ else
+ {
+ $type = index($num,'+') == 0 ? 91 : 81;
# Remove all non-numbers. Beware to GPRS dialing chars.
$num =~ s/[^\d\*#]//g;
- $num =~ s/\*/A/g; # "*" maps to A
- $num =~ s/#/B/g; # "#" maps to B
+ $num =~ s/\*/A/g; # "*" maps to A
+ $num =~ s/#/B/g; # "#" maps to B
- $len = unpack 'H2' => chr(length $num);
+ $len = unpack 'H2' => chr( length $num );
$num .= 'F';
my @digit = split // => $num;
- while (@digit > 1) {
+ while( @digit > 1 ) {
$encoded .= join '', reverse splice @digit, 0, 2;
}
}
@@ -163,108 +134,53 @@ sub encode_address {
}
sub decode_text_UCS2 {
- my $encoded = shift;
+ my $encoded= shift;
return undef unless $encoded;
-
- my $len = hex substr($encoded, 0, 2);
+
+ my $len = hex substr( $encoded, 0, 2 );
$encoded = substr $encoded, 2;
-
+
my $decoded = "";
while ($encoded) {
- $decoded .= pack("C0U", hex(substr($encoded, 0, 4)));
- $encoded = substr($encoded, 4);
+ $decoded .= pack("C0U",hex(substr($encoded,0,4)));
+ $encoded = substr($encoded, 4);
}
return $decoded;
}
sub encode_text7 {
uc
- unpack 'H*',
- pack 'C b*',
- length $_[0],
- join '',
- unpack '(b7)*', $_[0];
-}
-
-#
-#return complete ud with udh
-#remains for comatibility reasons with my production scripts :)
-#
-sub encode_text7_udh1 {
- my $decoded = shift;
- my $udh1 = shift;
- my $decoded_length = length($decoded);
- $decoded = Device::Gsm::Charset::iso8859_to_gsm0338($decoded);
- my $pdu_msg = uc
- unpack 'H*',
- pack 'b*',
-
- #add one bit of padding to align septet boundary
- '0' . join '', unpack '(b7)*', $decoded;
-
- #below add 7 septets length for udh1
- return
- sprintf("%02X", $decoded_length + Sms::Token::UDH::UDH1_LENGTH)
- . $udh1
- . $pdu_msg;
-}
-
-#
-#encode text with padding
-#
-sub encode_text7_udh {
- my $decoded = shift;
- my $padding = shift;
- $padding = 0 unless ($padding);
- my $decoded_length = length($decoded);
- $decoded = Device::Gsm::Charset::iso8859_to_gsm0338($decoded);
- my $pdu_msg = uc
- unpack 'H*',
- pack 'b*',
-
- #add bits of padding to align septet boundary
- '0' x $padding . join '', unpack '(b7)*', $decoded;
-
- #below add septets length of text
- my $len_hex = sprintf("%02X", $decoded_length);
- return
- wantarray
- ? ($len_hex, $pdu_msg, $len_hex . $pdu_msg)
- : $len_hex . $pdu_msg;
+ unpack 'H*',
+ pack 'C b*',
+ length $_[0],
+ join '',
+ unpack '(b7)*', $_[0];
}
sub pdu_to_latin1 {
-
- # Reattach a length octet.
- my $s = shift;
- my $len = length $s;
-
- #arn "len=$len, len/2=", $len/2, "\n";
- my $l = uc unpack("H*", pack("C", int(length($s) / 2 * 8 / 7)));
- if (length($l) % 2 == 1) { $l = '0' . $l }
- my $pdu = $l . $s;
-
- #arn "l=$l, pdu=$pdu\n";
- my $decoded = Device::Gsm::Pdu::decode_text7($pdu);
-
- #arn "decoded_text7=$decoded\n";
- my $latin1 = Device::Gsm::Charset::gsm0338_to_iso8859($decoded);
-
- #arn "latin1=$latin1\n";
- return $latin1;
+ # Reattach a length octet.
+ my $s = shift;
+ my $len = length $s;
+ #arn "len=$len, len/2=", $len/2, "\n";
+ my $l = uc unpack("H*", pack("C", int(length($s)/2*8/7)));
+ if (length($l) % 2 == 1) { $l = '0'.$l }
+ my $pdu = $l . $s;
+ #arn "l=$l, pdu=$pdu\n";
+ my $decoded = Device::Gsm::Pdu::decode_text7($pdu);
+ #arn "decoded_text7=$decoded\n";
+ my $latin1 = Device::Gsm::Charset::gsm0338_to_iso8859($decoded);
+ #arn "latin1=$latin1\n";
+ return $latin1;
}
sub latin1_to_pdu {
- my $latin1_text = $_[0];
-
- #arn "latin1=$latin1_text\n";
- my $gsm0338 = Device::Gsm::Charset::iso8859_to_gsm0338($latin1_text);
-
- #arn "gsm0338=$gsm0338\n";
- my $fullpdu = Device::Gsm::Pdu::encode_text7($gsm0338);
-
- #arn "pdu=$fullpdu\n";
- return substr($fullpdu, 2); # strip off the length octet
+ my $latin1_text = $_[0];
+ #arn "latin1=$latin1_text\n";
+ my $gsm0338 = Device::Gsm::Charset::iso8859_to_gsm0338($latin1_text);
+ #arn "gsm0338=$gsm0338\n";
+ my $fullpdu = Device::Gsm::Pdu::encode_text7($gsm0338);
+ #arn "pdu=$fullpdu\n";
+ return substr($fullpdu, 2); # strip off the length octet
}
1;
@@ -1,6 +1,5 @@
# Device::Gsm::Sms::Structure - SMS messages structure class
# Copyright (C) 2002 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
#
# This program is free software; you can redistribute it and/or modify
# it only under the terms of Perl itself.
@@ -22,32 +21,24 @@ use Device::Gsm::Sms::Token;
use Device::Gsm::Sms::Token::SCA;
use Device::Gsm::Sms::Token::PDUTYPE;
-use Data::Dumper;
#
# Inspect structure of SMS
# This varies with sms type (deliver or submit)
#
sub structure {
- my $self = shift;
- my @struct;
- if ($self->type() == SMS_DELIVER) {
- if ($self->{'tokens'}->{'PDUTYPE'}->{'_UDHI'}) {
- @struct = qw/SCA PDUTYPE OA PID DCS SCTS UDH UD/;
- }
- else {
-
- # UD takes UDL + UD automatically
- @struct = qw/SCA PDUTYPE OA PID DCS SCTS UD/;
- }
- }
- elsif ($self->type() == SMS_SUBMIT) {
- @struct = qw/SCA PDUTYPE MR DA PID DCS VP UD/;
- }
- elsif ($self->type() == SMS_STATUS) {
- @struct = qw/SCA PDUTYPE MR DA SCTS DT ST/;
- }
- return @struct;
+ my $self = shift;
+ my @struct;
+
+ if( $self->type() == SMS_DELIVER ) {
+ # UD takes UDL + UD automatically
+ @struct = qw/SCA PDUTYPE OA PID DCS SCTS UD/;
+ } elsif( $self->type() == SMS_SUBMIT ) {
+ @struct = qw/SCA PDUTYPE MR DA PID DCS VP UD/;
+ }
+
+ return @struct;
}
+
1;
@@ -22,16 +22,16 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes token from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
- $self->data(hex substr($$rMessage, 0, 2));
- $self->state(Sms::Token::DECODED);
+ $self->data( hex substr($$rMessage, 0, 2) );
+ $self->state( Sms::Token::DECODED );
- # Remove DCS from message
- $$rMessage = substr($$rMessage, 2);
+ # Remove DCS from message
+ $$rMessage = substr( $$rMessage, 2 );
- return 1;
+ return 1;
}
#
@@ -41,16 +41,16 @@ sub decode {
# or undef value in case of errors
#
sub encode {
- my $self = shift;
+ my $self = shift;
- # Take supplied data (optional) or object internal data
- my $data = shift;
- if (!defined $data || $data eq '') {
- $data = $self->data();
- $data ||= '00';
- }
+ # Take supplied data (optional) or object internal data
+ my $data = shift;
+ if( ! defined $data || $data eq '' ) {
+ $data = $self->data();
+ $data ||= '00';
+ }
- return $data;
+ return $data;
}
1;
@@ -1,73 +0,0 @@
-# Sms::Token::DT - SMS TP-DT token (Discharge-Time of <TP-ST>,
-# given in semioctet representation, and represents
-# the local time as described in GSM03.40)
-# Copyright (C) 2002-2006 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
-#
-# This program is free software; you can redistribute it and/or modify
-# it only under the terms of Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# Perl licensing terms for details.
-#
-# $Id$
-
-package Sms::Token::DT;
-use integer;
-use strict;
-use Device::Gsm::Sms::Token;
-
-@Sms::Token::DT::ISA = ('Sms::Token');
-
-# takes (scalar message (string) reference)
-# returns success/failure of decoding
-# if all ok, removes DT from message
-sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
-
- my @ts = split //, substr($$rMessage, 0, 14);
-
- $self->set(year => $ts[1] . $ts[0]);
- $self->set(month => $ts[3] . $ts[2]);
- $self->set(day => $ts[5] . $ts[4]);
- $self->set(hour => $ts[7] . $ts[6]);
- $self->set(minute => $ts[9] . $ts[8]);
- $self->set(second => $ts[11] . $ts[10]);
- $self->set(timezone => $ts[13] . $ts[12]);
-
- # Store also timestamp as convenient format
- $self->set('date' => $self->get('day') . '/'
- . $self->get('month') . '/'
- . $self->get('year'));
- $self->set('time' => $self->get('hour') . ':'
- . $self->get('minute') . ':'
- . $self->get('second'));
-
- # TODO: add timezone decoding ...
- $self->data($self->get('date') . ' '
- . $self->get('time') . ' '
- . $self->get('timezone'));
-
- # Signal token as correctly decoded (?)
- $self->state(Sms::Token::DECODED);
-
- # Remove DT info from message
- $$rMessage = substr($$rMessage, 14);
-
- return 1;
-}
-
-#
-# [token]->encode( [$data] )
-#
-# takes internal token data and encodes it, returning the result
-# or undef value in case of errors
-#
-sub encode {
- return '99211332959500';
-}
-
-1;
@@ -22,16 +22,16 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes token from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
- $self->data(hex substr($$rMessage, 0, 2));
- $self->state(Sms::Token::DECODED);
+ $self->data( hex substr($$rMessage, 0, 2) );
+ $self->state( Sms::Token::DECODED );
- # Remove MR from message
- $$rMessage = substr($$rMessage, 2);
+ # Remove MR from message
+ $$rMessage = substr( $$rMessage, 2 );
- return 1;
+ return 1;
}
#
@@ -41,16 +41,16 @@ sub decode {
# or undef value in case of errors
#
sub encode {
- my $self = shift;
+ my $self = shift;
- # Take supplied data (optional) or object internal data
- my $data = shift;
- if (!defined $data || $data eq '') {
- $data = $self->data();
- $data ||= '00';
- }
+ # Take supplied data (optional) or object internal data
+ my $data = shift;
+ if( ! defined $data || $data eq '' ) {
+ $data = $self->data();
+ $data ||= '00';
+ }
- return $data;
+ return $data;
}
1;
@@ -22,32 +22,33 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes OA from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
- # Detect originating address length
- my $oa_len = hex(substr $$rMessage, 0, 2);
+ # Detect originating address length
+ my $oa_len = hex( substr $$rMessage, 0, 2 );
- # Get number type (0x91=international, 0x81=local)
- my $oa_type = substr($$rMessage, 2, 2);
+ # Get number type (0x91=international, 0x81=local)
+ my $oa_type = substr( $$rMessage, 2, 2 );
# Number of octets to remove from message
- my $oa_octets = (($oa_len + 1) >> 1) << 1;
+ my $oa_octets = (($oa_len + 1) >> 1) << 1;
- # Get address
+ # Get address
my $addr = Device::Gsm::Pdu::decode_address(
- substr($$rMessage, 0, 4 + $oa_octets));
+ substr($$rMessage, 0, 4 + $oa_octets)
+ );
- $self->set('length' => $oa_len);
- $self->set('type' => $oa_type);
- $self->set('address' => $addr);
- $self->data($oa_len, $oa_type, $addr);
- $self->state(Sms::Token::DECODED);
+ $self->set('length' => $oa_len);
+ $self->set('type' => $oa_type);
+ $self->set('address' => $addr);
+ $self->data( $oa_len, $oa_type, $addr );
+ $self->state( Sms::Token::DECODED );
- # Remove OA from message
- $$rMessage = substr($$rMessage, 4 + $oa_octets);
+ # Remove OA from message
+ $$rMessage = substr( $$rMessage, 4 + $oa_octets );
- return 1;
+ return 1;
}
#
@@ -56,23 +57,23 @@ sub decode {
# encodes originating address (OA)
#
sub encode {
- my $self = shift;
- my $oa_len = $self->get('length');
+ my $self = shift;
+ my $oa_len = $self->get('length');
- # XXX TO BE COMPLETED...
- return $oa_len;
+ # XXX TO BE COMPLETED...
+ return $oa_len;
}
sub toString {
- my $self = shift;
- my $str = $self->get('address');
-
+ my $self = shift;
+ my $str = $self->get('address');
# Prepend + to number if international
- if ($str !~ /^\s*\+/ && $self->get('type') eq '91') {
+ if( $str !~ /^\s*\+/ && $self->get('type') eq '91' )
+ {
$str = '+' . $str;
}
- return $str;
+ return $str;
}
1;
@@ -22,26 +22,26 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes PDUTYPE from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
-
- $self->data(substr($$rMessage, 0, 2));
-
- # Update PDU type flags into token object
- $self->set('pdutype', hex(substr($$rMessage, 0, 2)));
- $self->set('MTI', $self->MTI());
- $self->set('MMS', $self->MMS());
- $self->set('RD', $self->RD());
- $self->set('VPF', $self->VPF());
- $self->set('SRR', $self->SRR());
- $self->set('SRI', $self->SRI());
- $self->set('UDHI', $self->UDHI());
- $self->set('RP', $self->RP());
-
- # Remove PDU TYPE from message
- $$rMessage = substr($$rMessage, 2);
-
- return 1;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
+
+ $self->data( substr($$rMessage, 0, 2) );
+
+ # Update PDU type flags into token object
+ $self->set( 'pdutype', hex(substr($$rMessage,0,2)) );
+ $self->set( 'MTI', $self->MTI() );
+ $self->set( 'MMS', $self->MMS() );
+ $self->set( 'RD', $self->RD() );
+ $self->set( 'VPF', $self->VPF() );
+ $self->set( 'SRR', $self->SRR() );
+ $self->set( 'SRI', $self->SRI() );
+ $self->set( 'UDHI',$self->UDHI());
+ $self->set( 'RP', $self->RP() );
+
+ # Remove PDU TYPE from message
+ $$rMessage = substr($$rMessage, 2);
+
+ return 1;
}
#
@@ -51,60 +51,58 @@ sub decode {
# or undef value in case of errors
#
sub encode {
- my $self = shift;
+ my $self = shift;
- # Take supplied data (optional) or object internal data
- my $data = shift;
- if (!defined $data || $data eq '') {
- $data = $self->data();
- }
+ # Take supplied data (optional) or object internal data
+ my $data = shift;
+ if( ! defined $data || $data eq '' ) {
+ $data = $self->data();
+ }
- return $data;
+ return $data;
}
#--------------------------------------------
# Bit component flags
-sub RP { # REPLY PATH PARAMETER SET
- my $self = shift;
- ($self->get('pdutype') & 0x80) >> 7;
+sub RP { # REPLY PATH PARAMETER SET
+ my $self = shift;
+ ( $self->get('pdutype') & 0x80 ) >> 7;
}
-sub UDHI { # USER DATA HEADER PRESENT
- my $self = shift;
- ($self->get('pdutype') & 0x40) >> 6;
+sub UDHI { # USER DATA HEADER PRESENT
+ my $self = shift;
+ ( $self->get('pdutype') & 0x40 ) >> 6;
}
-sub SRR { # STATUS REPORT REQUESTED
- my $self = shift;
- ($self->get('pdutype') & 0x20) >> 5;
+sub SRR { # STATUS REPORT REQUESTED
+ my $self = shift;
+ ( $self->get('pdutype') & 0x20 ) >> 5;
}
-sub SRI { # STATUS REPORT WILL BE RETURNED
- my $self = shift;
- ($self->get('pdutype') & 0x20) >> 5;
+sub SRI { # STATUS REPORT WILL BE RETURNED
+ my $self = shift;
+ ( $self->get('pdutype') & 0x20 ) >> 5;
}
-sub VPF
-{ # VALIDITY PERIOD FLAG 0=not present, 1=reserved, 2=integer, 3=semioctet
- my $self = shift;
- ($self->get('pdutype') & 0x18) >> 3;
+sub VPF { # VALIDITY PERIOD FLAG 0=not present, 1=reserved, 2=integer, 3=semioctet
+ my $self = shift;
+ ( $self->get('pdutype') & 0x18 ) >> 3;
}
-sub MMS { # MORE MESSAGES WAITING AT SMS-C
- my $self = shift;
- ($self->get('pdutype') & 0x04) >> 2;
+sub MMS { # MORE MESSAGES WAITING AT SMS-C
+ my $self = shift;
+ ( $self->get('pdutype') & 0x04 ) >> 2;
}
-sub RD { # ... allow repeated sending (REJECT DUPLICATES)
- my $self = shift;
- ($self->get('pdutype') & 0x04) >> 2;
+sub RD { # ... allow repeated sending (REJECT DUPLICATES)
+ my $self = shift;
+ ( $self->get('pdutype') & 0x04 ) >> 2;
}
-sub MTI
-{ # TYPE OF SMS (0x00=SMS-DELIVER, 0x01=SMS-SUBMIT, 0x10=SMS-STATUS/COMMAND, 0x11=RESERVED
- my $self = shift;
- $self->get('pdutype') & 0x03;
+sub MTI { # TYPE OF SMS (0x00=SMS-DELIVER, 0x01=SMS-SUBMIT, 0x10=SMS-STATUS/COMMAND, 0x11=RESERVED
+ my $self = shift;
+ $self->get('pdutype') & 0x03;
}
1;
@@ -22,16 +22,16 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes PDUTYPE from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
- $self->data(substr $$rMessage, 0, 2);
- $self->state(Sms::Token::DECODED);
+ $self->data( substr $$rMessage, 0, 2 );
+ $self->state( Sms::Token::DECODED );
- # Remove PID from message
- $$rMessage = substr($$rMessage, 2);
+ # Remove PID from message
+ $$rMessage = substr( $$rMessage, 2 );
- return 1;
+ return 1;
}
#
@@ -41,16 +41,16 @@ sub decode {
# or undef value in case of errors
#
sub encode {
- my $self = shift;
+ my $self = shift;
- # Take supplied data (optional) or object internal data
- my $data = shift;
- if (!defined $data || $data eq '') {
- $data = $self->data();
- $data ||= '00';
- }
+ # Take supplied data (optional) or object internal data
+ my $data = shift;
+ if( ! defined $data || $data eq '' ) {
+ $data = $self->data();
+ $data ||= '00';
+ }
- return $data;
+ return $data;
}
1;
@@ -22,74 +22,73 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes SCA from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
- my ($length, $type, $address);
- my $msg = $$rMessage;
- my $msg_copy = $msg;
-
- # .------------.----------.---------------------------------.
- # | LENGTH (1) | TYPE (1) | ADDRESS BCD DIGITS (0-8 octets) |
- # `------------'----------'---------------------------------'
- $length = substr $msg, 0, 2;
-
- # If length is `00', SCA = default end decoding ends
- if ($length eq '00') {
- $self->data('');
- $self->state(Sms::Token::DECODED);
-
- # Remove length-octet read from message
- $$rMessage = substr($$rMessage, 2);
- return 1;
- }
-
- # Begin decoding (length is number of octets for the SCA + 1 (length) )
- $length = hex $length;
-
- # Length > 9 is impossible; max is 8 + 1 (length)
- if ($length > 9) {
- $self->data(undef);
- $self->state(Sms::Token::ERROR);
- return 0;
- }
-
- $self->set('length' => $length);
-
- # Get type of message (81 = national, 91 = international)
- $type = substr $msg, 2, 2;
- if ($type ne '81' and $type ne '91') {
- $self->data(undef);
- $self->state(Sms::Token::ERROR);
- return 0;
- }
-
- $self->set(type => $type);
-
- # Get rest of address
- $address = substr $msg, 4, (($length - 1) << 1);
-
- # Reverse each pair of bcd digits
- my $sca;
- while ($address) {
- $sca .= reverse substr($address, 0, 2);
- $address = substr $address, 2;
- }
-
- # Truncate last `F' if found (XXX)
- chop $sca if substr($sca, -1) eq 'F';
-
- # If sca is international, put a '+' sign before
- $sca = '+' . $sca if $type eq '91';
-
- $self->data($sca);
- $self->set(type => $type);
- $self->set('length' => $length);
- $self->state(Sms::Token::DECODED);
-
- # Remove SCA info from message
- $$rMessage = substr($msg, ($length + 1) << 1);
-
- return 1;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
+ my($length, $type, $address);
+ my $msg = $$rMessage;
+ my $msg_copy = $msg;
+
+ # .------------.----------.---------------------------------.
+ # | LENGTH (1) | TYPE (1) | ADDRESS BCD DIGITS (0-8 octets) |
+ # `------------'----------'---------------------------------'
+ $length = substr $msg, 0, 2;
+
+ # If length is `00', SCA = default end decoding ends
+ if( $length eq '00' ) {
+ $self->data( '' );
+ $self->state( Sms::Token::DECODED );
+ # Remove length-octet read from message
+ $$rMessage = substr( $$rMessage, 2 );
+ return 1;
+ }
+
+ # Begin decoding (length is number of octets for the SCA + 1 (length) )
+ $length = hex $length;
+
+ # Length > 9 is impossible; max is 8 + 1 (length)
+ if( $length > 9 ) {
+ $self->data( undef );
+ $self->state( Sms::Token::ERROR );
+ return 0;
+ }
+
+ $self->set( 'length' => $length );
+
+ # Get type of message (81 = national, 91 = international)
+ $type = substr $msg, 2, 2;
+ if( $type ne '81' and $type ne '91' ) {
+ $self->data( undef );
+ $self->state( Sms::Token::ERROR );
+ return 0;
+ }
+
+ $self->set( type => $type );
+
+ # Get rest of address
+ $address = substr $msg, 4, ( ($length - 1) << 1 );
+
+ # Reverse each pair of bcd digits
+ my $sca;
+ while( $address ) {
+ $sca .= reverse substr( $address, 0, 2 );
+ $address = substr $address, 2;
+ }
+
+ # Truncate last `F' if found (XXX)
+ chop $sca if substr($sca, -1) eq 'F';
+
+ # If sca is international, put a '+' sign before
+ $sca = '+'.$sca if $type eq '91';
+
+ $self->data( $sca );
+ $self->set( type => $type );
+ $self->set( 'length' => $length );
+ $self->state( Sms::Token::DECODED );
+
+ # Remove SCA info from message
+ $$rMessage = substr( $msg, ($length + 1) << 1 );
+
+ return 1;
}
#
@@ -99,40 +98,40 @@ sub decode {
# or undef value in case of errors
#
sub encode {
- my $self = shift;
+ my $self = shift;
- # Take supplied data (optional) or object internal data
- my $data = shift;
- if (!defined $data || $data eq '') {
- $data = $self->data();
- }
+ # Take supplied data (optional) or object internal data
+ my $data = shift;
+ if( ! defined $data || $data eq '' ) {
+ $data = $self->data();
+ }
- # Begin encoding as SCA
- $data =~ s/\s+//g;
+ # Begin encoding as SCA
+ $data =~ s/\s+//g;
- my $type = index($data, '+') == 0 ? 91 : 81;
+ my $type = index($data,'+') == 0 ? 91 : 81;
- # Remove all non-numbers
- $data =~ s/\D//g;
+ # Remove all non-numbers
+ $data =~ s/\D//g;
- my $len = unpack 'H2' => chr(length $data);
+ my $len = unpack 'H2' => chr( length $data );
- $data .= 'F';
- my @digit = split // => $data;
- my $encoded;
+ $data .= 'F';
+ my @digit = split // => $data;
+ my $encoded;
- while (@digit > 1) {
- $encoded .= join '', reverse splice @digit, 0, 2;
- }
+ while( @digit > 1 ) {
+ $encoded .= join '', reverse splice @digit, 0, 2;
+ }
- $data = uc $len . $type . $encoded;
+ $data = uc $len . $type . $encoded;
- $self->data($data);
- $self->set('length' => $len);
- $self->set('type' => $type);
- $self->state(Sms::Token::ENCODED);
+ $self->data( $data );
+ $self->set( 'length' => $len );
+ $self->set( 'type' => $type );
+ $self->state( Sms::Token::ENCODED );
- return $data;
+ return $data;
}
@@ -22,39 +22,33 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes SCTS from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
- my @ts = split //, substr($$rMessage, 0, 14);
+ my @ts = split //, substr( $$rMessage, 0, 14 );
- $self->set(year => $ts[1] . $ts[0]);
- $self->set(month => $ts[3] . $ts[2]);
- $self->set(day => $ts[5] . $ts[4]);
- $self->set(hour => $ts[7] . $ts[6]);
- $self->set(minute => $ts[9] . $ts[8]);
- $self->set(second => $ts[11] . $ts[10]);
- $self->set(timezone => $ts[13] . $ts[12]);
+ $self->set( year => $ts [1] . $ts [0] );
+ $self->set( month => $ts [3] . $ts [2] );
+ $self->set( day => $ts [5] . $ts [4] );
+ $self->set( hour => $ts [7] . $ts [6] );
+ $self->set( minute => $ts [9] . $ts [8] );
+ $self->set( second => $ts[11] . $ts[10] );
+ $self->set( timezone => $ts[13] . $ts[12] );
- # Store also timestamp as convenient format
- $self->set('date' => $self->get('day') . '/'
- . $self->get('month') . '/'
- . $self->get('year'));
- $self->set('time' => $self->get('hour') . ':'
- . $self->get('minute') . ':'
- . $self->get('second'));
+ # Store also timestamp as convenient format
+ $self->set( 'date' => $self->get('day').'/'.$self->get('month').'/'.$self->get('year') );
+ $self->set( 'time' => $self->get('hour').':'.$self->get('minute').':'.$self->get('second') );
- # TODO: add timezone decoding ...
- $self->data($self->get('date') . ' '
- . $self->get('time') . ' '
- . $self->get('timezone'));
+ # TODO: add timezone decoding ...
+ $self->data( $self->get('date').' '.$self->get('time').' '.$self->get('timezone') );
- # Signal token as correctly decoded (?)
- $self->state(Sms::Token::DECODED);
+ # Signal token as correctly decoded (?)
+ $self->state( Sms::Token::DECODED );
- # Remove SCTS info from message
- $$rMessage = substr($$rMessage, 14);
+ # Remove SCTS info from message
+ $$rMessage = substr( $$rMessage, 14 );
- return 1;
+ return 1;
}
#
@@ -64,7 +58,7 @@ sub decode {
# or undef value in case of errors
#
sub encode {
- return '99211332959500';
+ return '99211332959500';
}
1;
@@ -1,131 +0,0 @@
-# Sms::Token::ST - SMS TP-ST token (Status of the MO message)
-#
-#/* TP-Status from 3GPP TS 23.040 section 9.2.3.15 */
-#/* sms received sucessfully */
-#TP_STATUS_RECEIVED_OK = 0x00,
-#TP_STATUS_UNABLE_TO_CONFIRM_DELIVERY = 0x01,
-#TP_STATUS_REPLACED = 0x02,
-#/* Reserved: 0x03 - 0x0f */
-#/* Values specific to each SC: 0x10 - 0x1f */
-#/* Temporary error, SC still trying to transfer SM: */
-#TP_STATUS_TRY_CONGESTION = 0x20,
-#TP_STATUS_TRY_SME_BUSY = 0x21,
-#TP_STATUS_TRY_NO_RESPONSE_FROM_SME = 0x22,
-#TP_STATUS_TRY_SERVICE_REJECTED = 0x23,
-#TP_STATUS_TRY_QOS_NOT_AVAILABLE = 0x24,
-#TP_STATUS_TRY_SME_ERROR = 0x25,
-#/* Reserved: 0x26 - 0x2f */
-#/* Values specific to each SC: 0x30 - 0x3f */
-#/* Permanent error, SC is not making any more transfer attempts: */
-#TP_STATUS_PERM_REMOTE_PROCEDURE_ERROR = 0x40,
-#TP_STATUS_PERM_INCOMPATIBLE_DEST = 0x41,
-#TP_STATUS_PERM_REJECTED_BY_SME = 0x42,
-#TP_STATUS_PERM_NOT_OBTAINABLE = 0x43,
-#TP_STATUS_PERM_QOS_NOT_AVAILABLE = 0x44,
-#TP_STATUS_PERM_NO_INTERWORKING = 0x45,
-#TP_STATUS_PERM_VALID_PER_EXPIRED = 0x46,
-#TP_STATUS_PERM_DELETED_BY_ORIG_SME = 0x47,
-#TP_STATUS_PERM_DELETED_BY_SC_ADMIN = 0x48,
-#TP_STATUS_PERM_SM_NO_EXIST = 0x49,
-#/* Reserved: 0x4a - 0x4f */
-#/* Values specific to each SC: 0x50 - 0x5f */
-#/* Temporary error, SC is not making any more transfer attempts: */
-#TP_STATUS_TMP_CONGESTION = 0x60,
-#TP_STATUS_TMP_SME_BUSY = 0x61,
-#TP_STATUS_TMP_NO_RESPONSE_FROM_SME = 0x62,
-#TP_STATUS_TMP_SERVICE_REJECTED = 0x63,
-#TP_STATUS_TMP_QOS_NOT_AVAILABLE = 0x64,
-#TP_STATUS_TMP_SME_ERROR = 0x65,
-#/* Reserved: 0x66 - 0x6f */
-#/* Values specific to each SC: 0x70 - 0x7f */
-#/* Reserved: 0x80 - 0xff */
-#TP_STATUS_NONE = 0xFF
-#
-# Copyright (C) 2002-2006 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
-#
-# This program is free software; you can redistribute it and/or modify
-# it only under the terms of Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# Perl licensing terms for details.
-#
-# $Id$
-
-package Sms::Token::ST;
-use integer;
-use strict;
-use Device::Gsm::Sms::Token;
-
-@Sms::Token::ST::ISA = ('Sms::Token');
-%Sms::Token::ST::STATUS_CODES = (
- 0x00 => 'TP_STATUS_RECEIVED_OK',
- 0x01 => 'TP_STATUS_UNABLE_TO_CONFIRM_DELIVERY',
- 0x02 => 'TP_STATUS_REPLACED',
-############
- 0x20 => 'TP_STATUS_TRY_CONGESTION',
- 0x21 => 'TP_STATUS_TRY_SME_BUSY',
- 0x22 => 'TP_STATUS_TRY_NO_RESPONSE_FROM_SME',
- 0x23 => 'TP_STATUS_TRY_SERVICE_REJECTED',
- 0x24 => 'TP_STATUS_TRY_QOS_NOT_AVAILABLE',
- 0x25 => 'TP_STATUS_TRY_SME_ERROR',
-############
- 0x40 => 'TP_STATUS_PERM_REMOTE_PROCEDURE_ERROR',
- 0x41 => 'TP_STATUS_PERM_INCOMPATIBLE_DEST',
- 0x42 => 'TP_STATUS_PERM_REJECTED_BY_SME',
- 0x43 => 'TP_STATUS_PERM_NOT_OBTAINABLE',
- 0x44 => 'TP_STATUS_PERM_QOS_NOT_AVAILABLE',
- 0x45 => 'TP_STATUS_PERM_NO_INTERWORKING',
- 0x46 => 'TP_STATUS_PERM_VALID_PER_EXPIRED',
- 0x47 => 'TP_STATUS_PERM_DELETED_BY_ORIG_SME',
- 0x48 => 'TP_STATUS_PERM_DELETED_BY_SC_ADMIN',
- 0x49 => 'TP_STATUS_PERM_SM_NO_EXIST',
-############
- 0x60 => 'TP_STATUS_TMP_CONGESTION',
- 0x61 => 'TP_STATUS_TMP_SME_BUSY',
- 0x62 => 'TP_STATUS_TMP_NO_RESPONSE_FROM_SME',
- 0x63 => 'TP_STATUS_TMP_SERVICE_REJECTED',
- 0x64 => 'TP_STATUS_TMP_QOS_NOT_AVAILABLE',
- 0x65 => 'TP_STATUS_TMP_SME_ERROR',
-############
- 0xFF => 'TP_STATUS_NONE'
-);
-
-# takes (scalar message (string) reference)
-# returns success/failure of decoding
-# if all ok, removes token from message
-sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
-
- $self->data(substr($$rMessage, 0, 2));
- $self->state(Sms::Token::DECODED);
-
- # Remove ST from message
- $$rMessage = substr($$rMessage, 2);
-
- return 1;
-}
-
-#
-# [token]->encode( [$data] )
-#
-# takes internal token data and encodes it, returning the result
-# or undef value in case of errors
-#
-sub encode {
- my $self = shift;
-
- # Take supplied data (optional) or object internal data
- my $data = shift;
- if (!defined $data || $data eq '') {
- $data = $self->data();
- $data ||= '00';
- }
-
- return $data;
-}
-
-1;
@@ -1,6 +1,5 @@
# Sms::Token::UD - SMS UD (user data length + user data) token
# Copyright (C) 2002-2006 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
#
# This program is free software; you can redistribute it and/or modify
# it only under the terms of Perl itself.
@@ -15,57 +14,45 @@
package Sms::Token::UD;
use integer;
use strict;
-
use Device::Gsm::Charset;
use Device::Gsm::Pdu;
use Device::Gsm::Sms::Token;
-#my $udh1_length=UDH1_LENGTH;
-#my $udh2_length=UDH2_LENGTH;
-
@Sms::Token::UD::ISA = ('Sms::Token');
# takes (scalar message (string) reference)
# returns success/failure of decoding
# if all ok, removes user data from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
- my $padding = 0;
-
- # Get length of message
- my $ud_len = hex substr($$rMessage, 0, 2);
-
- # Finally get text of message
- my $dcs = $self->get('_messageTokens')->{'DCS'}->get('_data')->[0];
- my $is_csms = $self->get('_messageTokens')->{'UDH'}->{'_IS_CSMS'};
- $is_csms
- and my $udhl = $self->get('_messageTokens')->{'UDH'}->{'_length'};
- my $text;
-
- if ($dcs == 8) {
- $text = Device::Gsm::Pdu::decode_text_UCS2($$rMessage);
- }
- else {
- if ($is_csms) {
- $padding = Sms::Token::UDH::calculate_padding($udhl);
- $text = Device::Gsm::Pdu::decode_text7_udh($$rMessage, $padding);
- }
- else {
- $text = Device::Gsm::Pdu::decode_text7($$rMessage);
- }
- $text = Device::Gsm::Charset::gsm0338_to_iso8859($text);
- }
- $self->set('padding' => $padding);
- $self->set('length' => $ud_len);
- $self->set('text' => $text);
- $self->data($text);
- $self->state(Sms::Token::DECODED);
-
- # Empty message
- $$rMessage = '';
-
- return 1;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
+
+ # Get length of message
+ my $ud_len = hex substr($$rMessage, 0, 2);
+
+ # Finally get text of message
+ my $dcs= $self->get('_messageTokens')->{'DCS'}->get('_data')->[0];
+ my $text;
+ if ($dcs == 8) {
+ $text = Device::Gsm::Pdu::decode_text_UCS2($$rMessage);
+ } else {
+ # XXX Here assume that DCS == 0x00 (7 bit coding)
+ $text = Device::Gsm::Pdu::decode_text7($$rMessage);
+
+ # Convert text from GSM 03.38 to Latin 1
+ $text = Device::Gsm::Charset::gsm0338_to_iso8859($text);
+ }
+
+ $self->set( 'length' => $ud_len );
+ $self->set( 'text' => $text );
+
+ $self->data( $text );
+ $self->state( Sms::Token::DECODED );
+
+ # Empty message
+ $$rMessage = '';
+
+ return 1;
}
#
@@ -74,13 +61,12 @@ sub decode {
# takes internal token data and encodes it, returning the result or undef value in case of errors
#
sub encode {
- my $self = shift;
- my $padding = shift;
+ my $self = shift;
- #my $ud_len = $self->get('length');
- my $text = $self->get('text');
+ #my $ud_len = $self->get('length');
+ my $text = $self->get('text');
- return Device::Gsm::Pdu::encode_text7($text);
+ return Device::Gsm::Pdu::encode_text7($text);
}
@@ -1,148 +0,0 @@
-# Sms::Token::UDH - SMS UDH token (User Data Header stores non text data inluding CSMS ref,parts,part number)
-# Copyright (C) 2002-2006 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
-#
-# This program is free software; you can redistribute it and/or modify
-# it only under the terms of Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# Perl licensing terms for details.
-#
-# $Id$
-
-package Sms::Token::UDH;
-use strict;
-
-use Device::Gsm::Pdu;
-use Device::Gsm::Sms::Token;
-
-#IEI types corresponding CSMS
-use constant IEI_T_8 => 0x00;
-use constant IEI_T_16 => 0x08;
-use constant IEI_T_8_L => 5;
-use constant IEI_T_16_L => 6;
-
-#constants for compatibility with older versions
-##user data headers in CSMS more here : http://mobiletidings.com/2009/02/18/combining-sms-messages/
-use constant UDH1 => '050003';
-use constant UDH2 => '060804';
-
-#lenght in septets
-use constant UDH1_LENGTH => 7;
-use constant UDH2_LENGTH => 8;
-
-@Sms::Token::UDH::ISA = ('Sms::Token');
-
-# takes (scalar message (string) reference)
-# returns success/failure of decoding
-# if all ok, removes user data header from message
-sub decode {
- my ($self, $rMessage) = @_;
-
- # Get length of message
- my $ud_len = hex substr($$rMessage, 0, 2);
-
- #get UDH length
- my $udhl = hex substr($$rMessage, 2, 2);
-
- #get UDH raw data
- my $udh = substr($$rMessage, 4, 2 * $udhl);
-
- #cut udh from message
- $$rMessage = substr($$rMessage, 4 + 2 * $udhl);
- my $udhCp = $udh;
- my %udh_data_hash;
- while (length($udh)) {
-
- #Information-Element-Identifier type octet
- my $IEI_t = hex(substr($udh, 0, 2));
-
- #Information-Element-Identifier data length
- my $IEI_l = hex(substr($udh, 2, 2));
-
- #Information-Element-Identifier data
- my $IEI_d = substr($udh, 4, 2 * $IEI_l);
-
- #cut element form data
- $udh = substr($udh, 4 + 2 * $IEI_l);
-
- #store data in hash
- $udh_data_hash{$IEI_t} = $IEI_d;
- }
- my $csms_ref_hex;
- my $csms_ref_num;
- my $csms_parts;
- my $csms_part_num;
- if (defined($udh_data_hash{ +IEI_T_8 })) {
- ($csms_ref_hex, $csms_parts, $csms_part_num)
- = ($udh_data_hash{ +IEI_T_8 }
- =~ /^([A-F0-9]{2})([A-F0-9]{2})([A-F0-9]{2})/);
- $csms_parts = hex($csms_parts);
- $csms_part_num = hex($csms_part_num);
- $csms_ref_num = hex($csms_ref_hex);
-
- }
- elsif (defined($udh_data_hash{ +IEI_T_16 })) {
- ($csms_ref_hex, $csms_parts, $csms_part_num)
- = ($udh_data_hash{ +IEI_T_16 }
- =~ /^([A-F0-9]{4})([A-F0-9]{2})([A-F0-9]{2})/);
- $csms_parts = hex($csms_parts);
- $csms_part_num = hex($csms_part_num);
- $csms_ref_num = hex($csms_ref_hex);
- }
- if (defined($csms_ref_hex)) {
- $self->set('IS_CSMS' => 1);
- $self->set('REF_NUM' => $csms_ref_num);
- $self->set('REF_HEX' => $csms_ref_hex);
- $self->set('PARTS' => $csms_parts);
- $self->set('PART_NUM' => $csms_part_num);
- }
- else {
- $self->set('IS_CSMS' => 0);
- }
- $self->set('UDHI' => 1);
- $self->set('length' => $udhl);
- $self->set('raw_data' => $udhCp);
- $self->data(\%udh_data_hash);
- $self->state(Sms::Token::DECODED);
-
- #restore ud_len
- $$rMessage = sprintf("%02X", $ud_len - ($udhl + 1)) . $$rMessage;
-
- return 1;
-}
-
-#
-# [token]->encode($IEI_t1=>$IEI_d1,$IEI_t2=>$IEI_d2,... )
-# takes %opts like above, returns complete UDH string
-# eg. my $udh=new Sms::Token("UDH");print $udh->encode(0x00=>"050401") gives 050003050401
-#
-sub encode {
- my $self = shift;
- my %udh_data_hash = @_;
- my $udh;
- foreach (keys %udh_data_hash) {
- my $IEI_t = sprintf("%02X", $_);
- my $IEI_l = sprintf("%02X", length($udh_data_hash{$_}) / 2);
- $udh .= $IEI_t . $IEI_l . $udh_data_hash{$_};
- }
- $udh = sprintf("%02X", length($udh) / 2) . $udh;
- return $udh;
-}
-
-#
-#return padding for given user data header lenght
-#
-
-sub calculate_padding {
-
- #my $self=shift;
- my $udhl = shift;
- return 0 unless ($udhl);
- return 7 - ((($udhl + 1) * 8) % 7);
-}
-
-1;
-
@@ -22,40 +22,37 @@ use Device::Gsm::Sms::Token;
# returns success/failure of decoding
# if all ok, removes token from message
sub decode {
- my ($self, $rMessage) = @_;
- my $ok = 0;
+ my($self, $rMessage) = @_;
+ my $ok = 0;
- my $vpf = $self->messageTokens('PDUTYPE')->VPF();
+ my $vpf = $self->messageTokens('PDUTYPE')->VPF();
- # Check if VP flag is present
- if ($vpf & 0x02) {
+ # Check if VP flag is present
+ if( $vpf & 0x02 ) {
- my $vp = hex substr($$rMessage, 0, 2);
+ my $vp = hex substr($$rMessage, 0, 2);
- # Decode value of VP field
- if ($vp <= 0x8F) {
- $vp = (($vp + 1) * 5) . ' minutes';
- }
- elsif ($vp <= 0xA7) {
- $vp = ((24 + ($vp - 143)) * 30) . ' minutes';
- }
- elsif ($vp <= 0xC4) {
- $vp = ($vp - 166) . ' days';
- }
- else {
- $vp = ($vp - 192) . ' weeks';
- }
+ # Decode value of VP field
+ if( $vp <= 0x8F ) {
+ $vp = (($vp + 1) * 5).' minutes';
+ } elsif( $vp <= 0xA7 ) {
+ $vp = (( 24 + ($vp - 143) ) * 30 ) . ' minutes';
+ } elsif( $vp <= 0xC4 ) {
+ $vp = ($vp - 166) . ' days';
+ } else {
+ $vp = ($vp - 192) . ' weeks';
+ }
- $self->set('validity_period' => $vp);
- $self->data($vp);
+ $self->set( 'validity_period' => $vp );
+ $self->data( $vp );
- # Remove VP from message
- $$rMessage = substr($$rMessage, 2);
- }
+ # Remove VP from message
+ $$rMessage = substr( $$rMessage, 2 );
+ }
- $self->state(Sms::Token::DECODED);
+ $self->state( Sms::Token::DECODED );
- return 1;
+ return 1;
}
#
@@ -65,16 +62,16 @@ sub decode {
# or undef value in case of errors
#
sub encode {
- my $self = shift;
+ my $self = shift;
- # Take supplied data (optional) or object internal data
- my $data = shift;
- if (!defined $data || $data eq '') {
- $data = $self->data();
- $data ||= '00';
- }
+ # Take supplied data (optional) or object internal data
+ my $data = shift;
+ if( ! defined $data || $data eq '' ) {
+ $data = $self->data();
+ $data ||= '00';
+ }
- return $data;
+ return $data;
}
1;
@@ -29,79 +29,70 @@ use constant DECODED => 2;
# new token ( @data )
#
sub new {
- my ($proto, $name, $options) = @_;
-
- # my $class = ref $proto || $proto;
- $options->{'data'} ||= [];
-
- # Cannot load a token without its name
- if (!defined $name || $name eq '') {
- return undef;
- }
-
- # Create basic structure for a token
- my %token = (
-
- # Name of token, see ->name()
- __name => $name,
-
- # Data that token contains
- __data => $options->{'data'},
-
- # Decoded? or error?
- __state => '',
-
- # This is used to access other tokens in the "message"
- __messageTokens => $options->{'messageTokens'}
- );
-
- # Dynamically load required token module
- eval { require "Device/Gsm/Sms/Token/$name.pm" };
- if ($@) {
- warn( 'cannot load Device::Gsm::Sms::Token::'
- . $name
- . ' plug-in for decoding. Error: '
- . $@);
- return undef;
- }
-
- # Try "static blessing" =:-o and see if it works
- bless \%token, 'Sms::Token::' . $name;
+ my($proto, $name, $options ) = @_;
+# my $class = ref $proto || $proto;
+ $options->{'data'} ||= [];
+
+ # Cannot load a token without its name
+ if( ! defined $name || $name eq '' ) {
+ return undef;
+ }
+
+ # Create basic structure for a token
+ my %token = (
+ # Name of token, see ->name()
+ __name => $name,
+ # Data that token contains
+ __data => $options->{'data'},
+ # Decoded? or error?
+ __state => '',
+ # This is used to access other tokens in the "message"
+ __messageTokens => $options->{'messageTokens'}
+ );
+
+ # Dynamically load required token module
+ eval { require "Device/Gsm/Sms/Token/$name.pm" };
+ if( $@ ) {
+ warn('cannot load Device::Gsm::Sms::Token::'.$name.' plug-in for decoding. Error: '.$@);
+ return undef;
+ }
+
+ # Try "static blessing" =:-o and see if it works
+ bless \%token, 'Sms::Token::'.$name;
}
#
# Get/set internal token data
#
sub data {
- my $self = shift;
- if (@_) {
- if (!defined $_[0]) {
- $self->{'__data'} = [];
- }
- else {
- $self->{'__data'} = [@_];
- }
- }
- $self->{'__data'};
+ my $self = shift;
+ if( @_ ) {
+ if( ! defined $_[0] ) {
+ $self->{'__data'} = [];
+ } else {
+ $self->{'__data'} = [ @_ ];
+ }
+ }
+ $self->{'__data'};
}
# Must be implemented in real token
sub decode {
- croak('decode() not implemented in token base class');
- return 0;
+ croak( 'decode() not implemented in token base class');
+ return 0;
}
# Must be implemented in real token
sub encode {
- croak('encode() not implemented in token base class');
- return 0;
+ croak( 'encode() not implemented in token base class');
+ return 0;
}
sub get {
- my ($self, $info) = @_;
- return undef unless $info;
+ my($self, $info) = @_;
+ return undef unless $info;
- return $self->{"_$info"};
+ return $self->{"_$info"};
}
# XXX This must be filled by the higher level object that
@@ -110,45 +101,43 @@ sub get {
# [token]->messageTokens( [name] )
#
sub messageTokens {
-
- # Usually this is a hash of token objects, accessible by key (token name)
- my $self = shift;
- my $name;
- if (@_) {
- $name = shift;
- }
- if (defined $name) {
- return $self->{'__messageTokens'}->{$name};
- }
- else {
- return $self->{'__messageTokens'};
- }
+ # Usually this is a hash of token objects, accessible by key (token name)
+ my $self = shift;
+ my $name;
+ if( @_ ) {
+ $name = shift;
+ }
+ if( defined $name ) {
+ return $self->{'__messageTokens'}->{$name};
+ } else {
+ return $self->{'__messageTokens'};
+ }
}
sub name {
- my $self = shift;
- return $self->{'__name'};
+ my $self = shift;
+ return $self->{'__name'};
}
sub set {
- my ($self, $info, $newval) = @_;
- return undef unless $info;
- $newval = undef unless defined $newval;
- $self->{"_$info"} = $newval;
+ my($self, $info, $newval) = @_;
+ return undef unless $info;
+ $newval = undef unless defined $newval;
+ $self->{"_$info"} = $newval;
}
sub state {
- my $self = shift;
- return $self->{'__state'};
+ my $self = shift;
+ return $self->{'__state'};
}
sub toString {
- my $self = shift;
- my $string;
- if (ref $self->{'__data'} eq 'ARRAY') {
- $string = join '', @{ $self->{'__data'} };
- }
- return $string;
+ my $self = shift;
+ my $string;
+ if( ref $self->{'__data'} eq 'ARRAY' ) {
+ $string = join '', @{$self->{'__data'}};
+ }
+ return $string;
}
1;
@@ -1,6 +1,5 @@
# Device::Gsm::Sms - SMS message simple class that represents a text SMS message
# Copyright (C) 2002-2009 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
#
# This program is free software; you can redistribute it and/or modify
# it only under the terms of Perl itself.
@@ -28,7 +27,7 @@ use Device::Gsm::Pdu;
use Device::Gsm::Sms::Structure;
use Device::Gsm::Sms::Token;
-sub _log { print @_, "\n"; }
+sub _log { print @_, "\n"; }
sub _parent { $_[0]->{_parent} }
#
@@ -40,116 +39,84 @@ sub _parent { $_[0]->{_parent} }
# creates message object
#
sub new {
- my ($proto, %opt) = @_;
- my $class = ref $proto || $proto;
+ my($proto, %opt) = @_;
+ my $class = ref $proto || $proto;
- # Create new message object
- my $self = {};
+ # Create new message object
+ my $self = {};
# Store gsm parent object reference
- if (exists $opt{'parent'}) {
+ if( exists $opt{'parent'} ) {
$self->{'_parent'} = $opt{'parent'};
-
# Assume default storage for sms message
$opt{'storage'} ||= $self->{'_parent'}->storage();
}
# Store options into main object
- $self->{'options'} = \%opt;
-
- # Hash to contain token objects after decoding (must be accessible by name)
- $self->{'tokens'} = {};
+ $self->{'options'} = \%opt;
- return undef unless (exists $opt{'header'} && exists $opt{'pdu'});
+ # Hash to contain token objects after decoding (must be accessible by name)
+ $self->{'tokens'} = {};
- #_log("NEW SMS OBJECT");
- #_log("Header [$opt{header}]");
- #_log("PDU [$opt{pdu}]");
+ return undef unless( exists $opt{'header'} && exists $opt{'pdu'} );
- # Check for valid msg header (thanks to Pierre Hilson for his patch
- # to make this regex work also for Alcatel gsm software)
- if ($opt{'header'} =~ /\+CMGL:\s*(\d+),\s*(\d+),\s*(\w*),\s*(\d+)/o) {
+#_log("NEW SMS OBJECT");
+#_log("Header [$opt{header}]");
+#_log("PDU [$opt{pdu}]");
- $self->{'index'} = $1; # Position of message in SIM card
- $self->{'status'}
- = $2; # Status of message (REC READ/UNREAD, STO, ...);
- $self->{'alpha'} = $3; # Alphanumeric representation of sender
- $self->{'length'} = $4; # Final length of message
- $self->{'pdu'} = $opt{'pdu'}; # PDU content
- $self->{'storage'} = $opt{'storage'}; # Storage (SM or ME)
+ # Check for valid msg header (thanks to Pierre Hilson for his patch
+ # to make this regex work also for Alcatel gsm software)
+ if( $opt{'header'} =~ /\+CMGL:\s*(\d+),\s*(\d+),\s*(\w*),\s*(\d+)/o )
+ {
- bless $self, $class;
+ $self->{'index'} = $1; # Position of message in SIM card
+ $self->{'status'} = $2; # Status of message (REC READ/UNREAD, STO, ...);
+ $self->{'alpha'} = $3; # Alphanumeric representation of sender
+ $self->{'length'} = $4; # Final length of message
+ $self->{'pdu'} = $opt{'pdu'}; # PDU content
+ $self->{'storage'}= $opt{'storage'}; # Storage (SM or ME)
- if ($self->decode(Device::Gsm::Sms::SMS_DELIVER)) {
+ bless $self, $class;
- # _log('OK, message decoded correctly!');
- }
- elsif ($self->decode(Device::Gsm::Sms::SMS_STATUS)) {
+ if( $self->decode( Device::Gsm::Sms::SMS_DELIVER ) ) {
+# _log('OK, message decoded correctly!');
+ } else {
+# _log('CASINO!');
+ undef $self;
+ }
- }
- else {
+ } else {
- # _log('CASINO!');
- undef $self;
- }
-
- }
- else {
+ # Warning: could not parse message header
+ undef $self;
- # Warning: could not parse message header
- undef $self;
-
- }
+ }
- return $self;
+ return $self;
}
#
# time(): returns message time in ascii format
#
sub time {
- my $self = shift;
- if (my $t = $self->token('SCTS')) {
- return $t->toString();
- }
- return '';
-}
-
-#
-# time_dt (): returns status message discharge time in ascii format
-#
-sub time_dt {
- my $self = shift;
- if (my $t = $self->token('DT')) {
- return $t->toString();
- }
- return '';
-}
-
-#
-# message_ref(): returns message reference of status message
-#
-sub message_ref {
- my $self = shift;
- if (my $t = $self->token('MR')) {
- return $t->toString();
- }
- return '';
+ my $self = shift;
+ if( my $t = $self->token('SCTS') ) {
+ return $t->toString();
+ }
+ return '';
}
#
# type(): returns message type in ascii readable format
#
{
+ # List of allowed status strings
+ my @status = ( 'UNKNOWN', 'REC UNREAD', 'REC READ', 'SENT UNREAD', 'SENT READ' );
- # List of allowed status strings
- my @status
- = ('UNKNOWN', 'REC UNREAD', 'REC READ', 'SENT UNREAD', 'SENT READ');
-
- sub status () {
- my $self = shift;
- return $status[ defined $self->{'status'} ? $self->{'status'} : 0 ];
- }
+ sub status () {
+ my $self = shift;
+ return $status[ defined $self->{'status'} ? $self->{'status'} : 0 ];
+ }
}
@@ -163,136 +130,127 @@ sub message_ref {
#
#
sub _old_decode {
- my ($header, $pdu) = @_;
- my %msg = ();
- my $errors = 0;
-
- # Copy original header/pdu strings
- $msg{'_HEADER'} = $header;
- $msg{'_PDU'} = $pdu;
-
- #
- # Decode header string
- #
- if ($header =~ /\+CMGL:\s*(\d+),(\d+),(\d*),(\d+)/) {
- $msg{'index'} = $1;
- $msg{'type'} = $2;
- $msg{'xxx'} = $3; # XXX
- $msg{'length'} = $4;
- }
-
- #
- # Decode all parts of PDU message
- #
-
- # ----------------------------------- SCA (service center address)
- my $sca_length = hex(substr $pdu, 0, 2);
- if ($sca_length == 0) {
-
- # No SCA provided, take default
- $msg{'SCA'} = undef;
- }
- else {
-
- # Parse SCA address
- #print STDERR "SCA length = ", $sca_length, "; ";
- #print STDERR "Parsing address ", substr( $pdu, 0, ($sca_length+1) << 1 );
- $msg{'SCA'} = Device::Gsm::Pdu::decode_address(
- substr($pdu, 0, ($sca_length + 1) << 1));
+ my($header, $pdu) = @_;
+ my %msg = ();
+ my $errors = 0;
+
+ # Copy original header/pdu strings
+ $msg{'_HEADER'} = $header;
+ $msg{'_PDU'} = $pdu;
+
+ #
+ # Decode header string
+ #
+ if( $header =~ /\+CMGL:\s*(\d+),(\d+),(\d*),(\d+)/ ) {
+ $msg{'index'} = $1;
+ $msg{'type'} = $2;
+ $msg{'xxx'} = $3; # XXX
+ $msg{'length'} = $4;
+ }
- #print STDERR ' = `', $msg{'SCA'}, "'\n";
- }
+ #
+ # Decode all parts of PDU message
+ #
+
+ # ----------------------------------- SCA (service center address)
+ my $sca_length = hex( substr $pdu, 0, 2 );
+ if( $sca_length == 0 ) {
+ # No SCA provided, take default
+ $msg{'SCA'} = undef;
+ } else {
+ # Parse SCA address
+ #print STDERR "SCA length = ", $sca_length, "; ";
+ #print STDERR "Parsing address ", substr( $pdu, 0, ($sca_length+1) << 1 );
+ $msg{'SCA'} = Device::Gsm::Pdu::decode_address( substr($pdu, 0, ($sca_length+1) << 1 ) );
+ #print STDERR ' = `', $msg{'SCA'}, "'\n";
+ }
- # ----------------------------------- PDU type
- $pdu = substr $pdu => (($sca_length + 1) << 1);
- $msg{'PDU_TYPE'} = substr $pdu, 0, 2;
- undef $sca_length;
-
- # ----------------------------------- OA (originating address)
- $pdu = substr $pdu => 2;
- my $oa_length = hex(substr $pdu, 0, 2);
-
- $msg{'OA'} = Device::Gsm::Pdu::decode_address(
- substr($pdu, 0, ($oa_length + 1) << 1));
- undef $oa_length;
-
- # PID (protocol identifier)
- # DCS (data coding scheme)
- # SCTS (service center time stamp)
- # UDL + UD (user data)
- @msg{qw/PID DCS SCTS UDL UD/} = unpack 'A2 A2 A14 A2 A*', $pdu;
-
- #map { $msg{$_} = hex $msg{$_} } qw/PID DCS UDL/;
- #
- # Decode USER DATA in 7/8 bit encoding
- #
- if ($msg{'DCS'} eq '00') { # DCS_7BIT
- Device::Gsm::Pdu::decode_text7($msg{'UD'});
- }
- elsif ($msg{'DCS'} eq 'F6') { # DCS_8BIT
- Device::Gsm::Pdu::decode_text8($msg{'UD'});
- }
+ # ----------------------------------- PDU type
+ $pdu = substr $pdu => (($sca_length+1) << 1);
+ $msg{'PDU_TYPE'} = substr $pdu, 0, 2;
+ undef $sca_length;
+
+ # ----------------------------------- OA (originating address)
+ $pdu = substr $pdu => 2;
+ my $oa_length = hex( substr $pdu, 0, 2 );
+
+ $msg{'OA'} = Device::Gsm::Pdu::decode_address( substr($pdu, 0, ($oa_length+1) << 1 ) );
+ undef $oa_length;
+
+ # PID (protocol identifier)
+ # DCS (data coding scheme)
+ # SCTS (service center time stamp)
+ # UDL + UD (user data)
+ @msg{ qw/PID DCS SCTS UDL UD/ } = unpack 'A2 A2 A14 A2 A*', $pdu;
+
+ #map { $msg{$_} = hex $msg{$_} } qw/PID DCS UDL/;
+ #
+ # Decode USER DATA in 7/8 bit encoding
+ #
+ if( $msg{'DCS'} eq '00' ) { # DCS_7BIT
+ Device::Gsm::Pdu::decode_text7( $msg{'UD'} );
+ } elsif( $msg{'DCS'} eq 'F6' ) { # DCS_8BIT
+ Device::Gsm::Pdu::decode_text8( $msg{'UD'} );
+ }
- # XXX DEBUG
- #foreach( sort keys %msg ) {
- # print STDERR 'MSG[', $_, '] = `'.$msg{$_}.'\'', "\n";
- #}
+ # XXX DEBUG
+ #foreach( sort keys %msg ) {
+ # print STDERR 'MSG[', $_, '] = `'.$msg{$_}.'\'', "\n";
+ #}
- bless \%msg, 'Device::Gsm::Sms';
+ bless \%msg, 'Device::Gsm::Sms';
}
+
sub decode {
- my ($self, $type) = @_;
- $self->{'type'} = $type;
+ my( $self, $type ) = @_;
+ $self->{'type'} = $type;
- # Get list of tokens for this message (from ::Sms::Structure)
- my $cPdu = $self->{'pdu'};
+ # Get list of tokens for this message (from ::Sms::Structure)
+ my $cPdu = $self->{'pdu'};
- # Check that PDU is not empty
- return 0 unless $cPdu;
+ # Check that PDU is not empty
+ return 0 unless $cPdu;
- # Backup copy for "backtracking"
- my $cPduCopy = $cPdu;
+ # Backup copy for "backtracking"
+ my $cPduCopy = $cPdu;
- my @token_names = $self->structure();
- my $decoded = 1;
+ my @token_names = $self->structure();
+ my $decoded = 1;
- #is udh in pdu?
- my $udh_parsed = 0;
- while (@token_names) {
+ while( @token_names ) {
- # Create new token object
- my $token = new Sms::Token(shift @token_names,
- { messageTokens => $self->{'tokens'} });
- if (!defined $token) {
- $decoded = 0;
- last;
- }
+ # Create new token object
+ my $token = new Sms::Token( shift @token_names, {messageTokens => $self->{'tokens'}} );
+ if( ! defined $token ) {
+ $decoded = 0;
+ last;
+ }
- # If decoding is completed successfully, add token object to message
- #_log('PDU BEFORE ['.$cPdu.']', length($cPdu) );
+ # If decoding is completed successfully, add token object to message
+#_log('PDU BEFORE ['.$cPdu.']', length($cPdu) );
- if ($token->decode(\$cPdu)) {
+ if( $token->decode(\$cPdu) ) {
- # Store token object into SMS message
- $self->{'tokens'}->{ $token->name() } = $token;
+ # Store token object into SMS message
+ $self->{'tokens'}->{ $token->name() } = $token;
- # Catch message type indicator (MTI) and re-load structure
+ # Catch message type indicator (MTI) and re-load structure
# We must also skip message types 0x02 and 0x03 because we don't handle them currently
- if ($token->name() eq 'PDUTYPE') {
-
- my $mti = $token->MTI();
- my $udhi = $token->UDHI();
-
- # # If MTI has bit 1 on, this could be a SMS-STATUS message (0x02), or (0x03???)
- # if( $mti >= SMS_STATUS ) {
- # _log('skipping unhandled message type ['.$mti.']');
- # return undef;
- # }
+ if( $token->name() eq 'PDUTYPE' ) {
+
+ my $mti = $token->MTI();
- if ($mti != $type) {
+=cut
+ # If MTI has bit 1 on, this could be a SMS-STATUS message (0x02), or (0x03???)
+ if( $mti >= SMS_STATUS ) {
+ _log('skipping unhandled message type ['.$mti.']');
+ return undef;
+ }
+=cut
- #_log('token PDUTYPE, data='.$token->data().' MTI='.$token->get('MTI').' ->MTI()='.$token->MTI());
+ if( $mti != $type ) {
+#_log('token PDUTYPE, data='.$token->data().' MTI='.$token->get('MTI').' ->MTI()='.$token->MTI());
#
# This is a SMS-SUBMIT message, so:
#
@@ -301,35 +259,28 @@ sub decode {
# 3) reload token structure
# 4) restart decoding
#
- $self->type($type = $mti);
+ $self->type( $type = $mti );
- $cPdu = $cPduCopy;
+ $cPdu = $cPduCopy;
@token_names = $self->structure();
- #_log('RESTARTING DECODING AFTER MTI DETECTION'); #<STDIN>;
- redo;
- }
-
- if ($udh_parsed == 0 and $udhi == 1) {
- $cPdu = $cPduCopy;
- @token_names = $self->structure();
- $udh_parsed = 1;
- redo;
- }
+#_log('RESTARTING DECODING AFTER MTI DETECTION'); #<STDIN>;
+ redo;
+ }
- #_log(' ', $token->name(), ' DATA = ', $token->toString() );
+#_log(' ', $token->name(), ' DATA = ', $token->toString() );
}
- }
+ }
- #_log('PDU AFTER ['.$cPdu.']', length($cPdu) );
+#_log('PDU AFTER ['.$cPdu.']', length($cPdu) );
- }
+ }
- #_log("\n", 'PRESS ENTER TO CONTINUE'); <STDIN>;
+#_log("\n", 'PRESS ENTER TO CONTINUE'); <STDIN>;
- return $decoded;
+ return $decoded;
}
@@ -343,25 +294,14 @@ sub delete {
# Try to delete message
my $msg_index = $self->index();
- my $storage = $self->storage();
+ my $storage = $self->storage();
# Issue delete command
- if (ref $gsm && $storage && $msg_index >= 0) {
+ if( ref $gsm && $storage && $msg_index >= 0 ) {
$ok = $gsm->delete_sms($msg_index, $storage);
- $gsm->log->write('info',
- 'Delete sms n.'
- . $msg_index
- . ' in storage '
- . $storage . ' => '
- . ($ok ? 'OK' : '*ERROR'));
- }
- else {
- $gsm->log->write('warn',
- 'Could not delete sms n.'
- . $msg_index
- . ' in storage '
- . $storage
- . '. Internal error.');
+ $gsm->log->write('info', 'Delete sms n.'.$msg_index.' in storage '.$storage.' => '.($ok?'OK':'*ERROR'));
+ } else {
+ $gsm->log->write('warn', 'Could not delete sms n.'.$msg_index.' in storage '.$storage.'. Internal error.');
$ok = undef;
}
@@ -369,7 +309,7 @@ sub delete {
}
#
-# Returns message own index number (position)
+# Returns message own index number (position)
#
sub index {
my $self = $_[0];
@@ -385,134 +325,63 @@ sub storage {
}
#
-# Only valid for SMS_SUBMIT and SMS_STATUS messages
+# Only valid for SMS_SUBMIT messages (?)
#
sub recipient {
- my $self = shift;
- if ($self->type() == SMS_SUBMIT or $self->type() == SMS_STATUS) {
- my $t = $self->token('DA');
- return $t->toString() if $t;
- }
-}
-
-#
-#Only valid for SMS_STATUS messages returns status code(in hex) extracted from status message
-#Codes are explained in ST.pm
-#
-sub delivery_status {
- my $self = shift;
- if ($self->type() == SMS_STATUS) {
- my $t = $self->token('ST');
- return $t->toString() if $t;
- }
+ my $self = shift;
+ if( $self->type() == SMS_SUBMIT ) {
+ my $t = $self->token('DA');
+ return $t->toString() if $t;
+ }
}
#
# Only valid for SMS_DELIVER messages (?)
#
sub sender {
- my $self = shift;
- if ($self->type() == SMS_DELIVER) {
- my $t = $self->token('OA');
- return $t->toString() if $t;
- }
+ my $self = shift;
+ if( $self->type() == SMS_DELIVER ) {
+ my $t = $self->token('OA');
+ return $t->toString() if $t;
+ }
}
# Alias for text()
sub content {
- return $_[0]->text();
+ return $_[0]->text();
}
sub text {
- my $self = shift;
- my $t = $self->token('UD');
- return $t->toString() if $t;
-}
-
-#
-#only valid for SMS_DELIVER messages, retuns presence of UDH
-#
-sub is_udh {
- my $self = shift;
- if ($self->type() == SMS_DELIVER) {
- return $self->{'tokens'}->{'PDUTYPE'}->{'_UDHI'};
- }
-}
-
-#
-#only valid for SMS_DELIVER messages with UDH, returns if sms is csms
-#
-sub is_csms {
- my $self = shift;
- if ($self->is_udh()) {
- return $self->{'tokens'}->{'UDH'}->{'_IS_CSMS'};
- }
-}
-
-#
-#only valid for SMS_DELIVER messages with UDH, retuns CSM reference number
-#
-sub csms_ref_num {
- my $self = shift;
- if ($self->is_csms()) {
- return $self->{'tokens'}->{'UDH'}->{'_REF_NUM'};
- }
-}
-
-#
-#only valid for SMS_DELIVER messages with UDH, retuns CSM reference number
-#
-sub csms_ref_hex {
- my $self = shift;
- if ($self->is_csms()) {
- return $self->{'tokens'}->{'UDH'}->{'_REF_HEX'};
- }
-}
-
-#
-#only valid for SMS_DELIVER messages with UDH, retuns CSM parts count
-#
-sub csms_parts {
- my $self = shift;
- if ($self->is_csms()) {
- return $self->{'tokens'}->{'UDH'}->{'_PARTS'};
- }
-}
-
-#
-#only valid for SMS_DELIVER messages with UDH, retuns CSM current part number
-#
-sub csms_part_num {
- my $self = shift;
- if ($self->is_csms()) {
- return $self->{'tokens'}->{'UDH'}->{'_PART_NUM'};
- }
+ my $self = shift;
+ my $t = $self->token('UD');
+ return $t->toString() if $t;
}
sub token ($) {
- my ($self, $token_name) = @_;
- return undef unless $token_name;
-
- if (exists $self->{'tokens'}->{$token_name}) {
- return $self->{'tokens'}->{$token_name};
- }
- else {
- warn('undefined token ' . $token_name . ' for this sms');
- return undef;
- }
+ my($self, $token_name) = @_;
+ return undef unless $token_name;
+
+ if( exists $self->{'tokens'}->{$token_name} ) {
+ return $self->{'tokens'}->{$token_name};
+ } else {
+ warn('undefined token '.$token_name.' for this sms');
+ return undef;
+ }
}
#
# Returns type of sms (SMS_DELIVER || SMS_SUBMIT)
#
sub type {
- my $self = shift;
- if (@_) {
- $self->{'type'} = shift;
- }
- $self->{'type'};
+ my $self = shift;
+ if( @_ ) {
+ $self->{'type'} = shift;
+ }
+ $self->{'type'};
}
+
+
=pod
=head1 NAME
@@ -1,1974 +0,0 @@
-# Device::Gsm - a Perl class to interface GSM devices as AT modems
-# Copyright (C) 2002-2012 Cosimo Streppone, cosimo@cpan.org
-# Copyright (C) 2006-2011 Grzegorz Wozniak, wozniakg@gmail.com
-#
-# This program is free software; you can redistribute it and/or modify
-# it only under the terms of Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# Perl licensing terms for more details.
-
-package Device::Gsm;
-
-$Device::Gsm::VERSION = '1.60';
-
-use strict;
-use Device::Modem 1.47;
-use Device::Gsm::Sms;
-use Device::Gsm::Pdu;
-use Device::Gsm::Charset;
-use Device::Gsm::Sms::Token;
-use Time::HiRes qw(sleep);
-use constant USSD_DCS => 15;
-
-@Device::Gsm::ISA = ('Device::Modem');
-
-%Device::Gsm::USSD_RESPONSE_CODES = (
- 0 =>
- 'No further user action required (network initiated USSD-Notify, or no further information needed after mobile Initiated operation)',
- 1 =>
- 'Further user action required (network initiated USSD-Request, or further information needed after mobile initiated operation)',
- 2 =>
- 'USSD terminated by network. the reason for the termination is indicated by the index stored in %Device::Gsm::USSD_TERMINATION_CODES',
- 3 => 'Other local client has responded',
- 4 => 'Operation not supported',
- 5 => 'Network time out'
-);
-%Device::Gsm::USSD_TERMINATION_CODES = (
- 0 => 'NO_CAUSE',
- 1 => 'CC_BUSY',
- 2 => 'PARAMETER_ERROR',
- 3 => 'INVALID_NUMBER',
- 4 => 'OUTGOING_CALL_BARRED',
- 5 => 'TOO_MANY_CALLS_ON_HOLD',
- 6 => 'NORMAL',
- 10 => 'DROPPED',
- 12 => 'NETWORK',
- 13 => 'INVALID_CALL_ID',
- 14 => 'NORMAL_CLEARING',
- 16 => 'TOO_MANY_ACTIVE_CALLS',
- 17 => 'UNASSIGNED_NUMBER',
- 18 => 'NO_ROUTE_TO_DEST',
- 19 => 'RESOURCE_UNAVAILABLE',
- 20 => 'CALL_BARRED',
- 21 => 'USER_BUSY',
- 22 => 'NO_ANSWER',
- 23 => 'CALL_REJECTED',
- 24 => 'NUMBER_CHANGED',
- 25 => 'DEST_OUT_OF_ORDER',
- 26 => 'SIGNALING_ERROR',
- 27 => 'NETWORK_ERROR',
- 28 => 'NETWORK_BUSY',
- 29 => 'NOT_SUBSCRIBED',
- 31 => 'SERVICE_UNAVAILABLE',
- 32 => 'SERVICE_NOT_SUPPORTED',
- 33 => 'PREPAY_LIMIT_REACHED',
- 35 => 'INCOMPATIBLE_DEST',
- 43 => 'ACCESS_DENIED',
- 45 => 'FEATURE_NOT_AVAILABLE',
- 46 => 'WRONG_CALL_STATE',
- 47 => 'SIGNALING_TIMEOUT',
- 48 => 'MAX_MPTY_PARTICIPANTS_EXCEEDED',
- 49 => 'SYSTEM_FAILURE',
- 50 => 'DATA_MISSING',
- 51 => 'BASIC_SERVICE_NOT_PROVISIONED',
- 52 => 'ILLEGAL_SS_OPERATION',
- 53 => 'SS_INCOMPATIBILITY',
- 54 => 'SS_NOT_AVAILABLE',
- 55 => 'SS_SUBSCRIPTION_VIOLATION',
- 56 => 'INCORRECT_PASSWORD',
- 57 => 'TOO_MANY_PASSWORD_ATTEMPTS',
- 58 => 'PASSWORD_REGISTRATION_FAILURE',
- 59 => 'ILLEGAL_EQUIPMENT',
- 60 => 'UNKNOWN_SUBSCRIBER',
- 61 => 'ILLEGAL_SUBSCRIBER',
- 62 => 'ABSENT_SUBSCRIBER',
- 63 => 'USSD_BUSY',
- 65 => 'CANNOT_TRANSFER_MPTY_CALL',
- 66 => 'BUSY_WITH_UNANSWERED_CALL',
- 68 => 'UNANSWERED_CALL_PENDING',
- 69 => 'USSD_CANCELED',
- 70 => 'PRE_EMPTION',
- 71 => 'OPERATION_NOT_ALLOWED',
- 72 => 'NO_FREE_BEARER_AVAILABLE',
- 73 => 'NBR_SN_EXCEEDED',
- 74 => 'NBR_USER_EXCEEDED',
- 75 => 'NOT_ALLOWED_BY_CC',
- 76 => 'MODIFIED_TO_SS_BY_CC',
- 77 => 'MODIFIED_TO_CALL_BY_CC',
- 78 => 'CALL_MODIFIED_BY_CC',
- 90 => 'FDN_FAILURE'
-);
-
-# Connection defaults to 19200 baud. This seems to be the optimal
-# rate for serial links to new gsm phones.
-$Device::Gsm::BAUDRATE = 19200;
-
-# Time to wait after network register command (secs)
-$Device::Gsm::REGISTER_DELAY = 2;
-
-# Connect on serial port to gsm device
-# see parameters on Device::Modem::connect()
-sub connect {
- my $me = shift;
- my %aOpt;
- %aOpt = @_ if (@_);
-
- #
- # If you have problems with bad characters being trasmitted across serial link,
- # try different baud rates, as below...
- #
- # .---------------------------------.
- # | Model (phone/modem) | Baudrate |
- # |---------------------+-----------|
- # | Falcom Swing (A2D) | 9600 |
- # | Siemens C35/C45 | 19200 |
- # | Nokia phones | 19200 |
- # | Nokia Communicator | 9600 |
- # | Digicom | 9600 |
- # `---------------------------------'
- #
- # GSM class defaults to 19200 baud
- #
- $aOpt{'baudrate'} ||= $Device::Gsm::BAUDRATE;
-
- $me->SUPER::connect(%aOpt);
-}
-
-sub disconnect {
- my $me = shift;
- $me->SUPER::disconnect();
- sleep 0.05;
-}
-
-#
-# Get/set phone date and time
-#
-sub datetime {
- my $self = shift;
- my $ok = undef; # ok/err flag
- my $datetime = undef; # datetime string
- my @time = (); # array in "localtime" format
-
- # Test support for clock function
- if ($self->test_command('+CCLK')) {
-
- if (@_) {
-
- # If called with "$self->datetime(time())" format
- if (@_ == 1) {
-
- # $_[0] must be result of `time()' func
- @time = localtime($_[0]);
- }
- else {
-
- # If called with "$self->datetime(localtime())" format
- # @_ here is the result of `localtime()' func
- @time = @_;
- }
-
- $datetime = sprintf(
- '%02d/%02d/%02d,%02d:%02d:%02d',
- $time[5] - 100, # year
- 1 + $time[4], # month
- $time[3], # day
- @time[ 2, 1, 0 ], # hr,min,secs
- );
-
- # Set time of phone
- $self->atsend(qq{AT+CCLK="$datetime"} . Device::Modem::CR);
- $ok = $self->parse_answer($Device::Modem::STD_RESPONSE);
-
- $self->log->write(
- 'info',
- "write datetime ($datetime) to phone => ("
- . ($ok ? 'OK' : 'FAILED') . ")"
- );
-
- }
- else {
-
- $self->atsend('AT+CCLK?' . Device::Modem::CR);
- ($ok, $datetime)
- = $self->parse_answer($Device::Modem::STD_RESPONSE);
-
- #warn('datetime='.$datetime);
- if ( $ok
- && $datetime
- =~ m|\+CCLK:\s*"?(\d\d)/(\d\d)/(\d\d)\,(\d\d):(\d\d):(\d\d)"?|
- )
- {
- $datetime = "$1/$2/$3 $4:$5:$6";
- $self->log->write(
- 'info',
- "read datetime from phone ($datetime)"
- );
- }
- else {
- $self->log->write(
- 'warn',
- "datetime format ($datetime) not recognized"
- );
- $datetime = undef;
- }
-
- }
-
- }
-
- return $datetime;
-
-}
-
-#
-# Delete a message from sim card
-#
-sub delete_sms {
- my $self = shift;
- my $msg_index = shift;
- my $storage = shift;
- my $ok;
-
- if (!defined $msg_index || $msg_index eq '') {
- $self->log->write(
- 'warn',
- 'undefined message number. cannot delete sms message'
- );
- return 0;
- }
-
- # Set default SMS storage if supported
- $self->storage($storage);
-
- $self->atsend(qq{AT+CMGD=$msg_index} . Device::Modem::CR);
-
- my $ans = $self->parse_answer($Device::Modem::STD_RESPONSE);
- if (index($ans, 'OK') > -1 || $ans =~ /\+CMGD/) {
- $ok = 1;
- }
-
- $self->log->write(
- 'info',
- "deleting sms n.$msg_index from storage "
- . ($storage || "default")
- . " (result: `$ans') => "
- . ($ok ? 'ok' : '*FAILED*')
- );
-
- return $ok;
-}
-
-#
-# Call forwarding
-#
-sub forward {
- my ($self, $reason, $mode, $number) = @_;
-
- $reason = lc $reason || 'unconditional';
- $mode = lc $mode || 'register';
- $number ||= '';
-
- my %reasons = (
- 'unconditional' => 0,
- 'busy' => 1,
- 'no reply' => 2,
- 'unreachable' => 3
- );
-
- my %modes = (
- 'disable' => 0,
- 'enable' => 1,
- 'query' => 2,
- 'register' => 3,
- 'erase' => 4
- );
-
- my $reasoncode = $reasons{$reason};
- my $modecode = $modes{$mode};
-
- $self->log->write(
- 'info',
- qq{setting $reason call forwarding to [$number]}
- );
- $self->atsend(
- qq{AT+CCFC=$reasoncode,$modecode,"$number"} . Device::Modem::CR);
-
- return $self->parse_answer($Device::Modem::STD_RESPONSE, 15000);
-}
-
-#
-# Hangup and terminate active call(s)
-# this overrides the `Device::Modem::hangup()' method
-#
-sub hangup {
- my $self = shift;
- $self->log->write('info', 'hanging up...');
- $self->attention();
- $self->atsend('AT+CHUP' . Device::Modem::CR);
- $self->flag('OFFHOOK', 0);
- $self->answer(undef, 5000);
-}
-
-#
-# Who is the manufacturer of this device?
-#
-sub manufacturer {
- my $self = shift;
- my ($ok, $man);
-
- # We can't test for command support, because some phones, mainly Motorola
- # will spit out an error, instead of telling if CGMI is supported.
- $self->atsend('AT+CGMI' . Device::Modem::CR);
- ($ok, $man) = $self->parse_answer($Device::Modem::STD_RESPONSE);
-
- if ($ok ne 'OK') {
- $self->log->write(
- 'warn',
- 'manufacturer command ended with error [' . $ok . $man . ']'
- );
- return undef;
- }
-
- # Again, seems that Motorola phones will re-echo
- # the CGMI command header, instead of giving us the
- # manufacturer info we want. Thanks to Niolay Shaplov
- # for reporting (RT #31540)
- if ($man =~ /\+CGMI:\ \"(.*)\"/s) {
- $man = $1;
- }
-
- $self->log->write(
- 'info',
- 'manufacturer of this device appears to be [' . $man . ']'
- );
-
- return $man || $ok;
-}
-
-#
-# Set text or pdu mode for gsm devices. If no parameter passed, returns current mode
-#
-sub mode {
- my $self = shift;
-
- if (@_) {
- my $mode = lc $_[0];
- if ($mode eq 'text') {
- $mode = 1;
- }
- else {
- $mode = 0;
- }
- $self->{'_mode'} = $mode ? 'text' : 'pdu';
- $self->log->write(
- 'info',
- 'setting mode to [' . $self->{'_mode'} . ']'
- );
- $self->atsend(qq{AT+CMGF=$mode} . Device::Modem::CR);
-
- return $self->parse_answer($Device::Modem::STD_RESPONSE);
- }
-
- return ($self->{'_mode'} || '');
-
-}
-
-#
-# What is the model of this device?
-#
-sub model {
- my $self = shift;
- my ($code, $model);
-
- # Test if manufacturer code command is supported
- if ($self->test_command('+CGMM')) {
-
- $self->atsend('AT+CGMM' . Device::Modem::CR);
- ($code, $model) = $self->parse_answer($Device::Modem::STD_RESPONSE);
-
- $self->log->write(
- 'info',
- 'model of this device is [' . ($model || '') . ']'
- );
-
- }
-
- return $model || $code;
-}
-
-#
-# Get handphone serial number (IMEI number)
-#
-sub imei {
- my $self = shift;
- my ($code, $imei);
-
- # Test if manufacturer code command is supported
- if ($self->test_command('+CGSN')) {
-
- $self->atsend('AT+CGSN' . Device::Modem::CR);
- ($code, $imei) = $self->parse_answer($Device::Modem::STD_RESPONSE);
-
- $self->log->write('info', 'IMEI code is [' . $imei . ']');
-
- }
- return $imei || $code;
-}
-
-# Alias for `imei()' is `serial_number()'
-*serial_number = *imei;
-
-#
-# Get mobile phone signal quality (expressed in dBm)
-#
-sub signal_quality {
- my $self = shift;
-
- # Error code, dBm (signal power), bit error rate
- my ($code, @dBm, $dBm, $ber);
-
- # Test if signal quality command is implemented
- if ($self->test_command('+CSQ')) {
-
- $self->atsend('AT+CSQ' . Device::Modem::CR);
- ($code, @dBm)
- = $self->parse_answer($Device::Modem::STD_RESPONSE, 15000);
-
- # Vodafone data cards send out response to commands with
- # many empty lines in between, so +CSQ response is not the very
- # first line of answer.
- for (@dBm) {
- if (/\+CSQ:/) {
- $dBm = $_;
- last;
- }
- }
-
- # Some gsm software send CSQ command result as "+CSQ: xx,yy"
- if ($dBm =~ /\+CSQ:\s*(\d+),(\d+)/) {
-
- ($dBm, $ber) = ($1, $2);
-
- # Further process dBm number to obtain real dB power
- if ($dBm > 30) {
- $dBm = -51;
- }
- else {
- $dBm = -113 + ($dBm << 1);
- }
-
- $self->log->write(
- 'info',
- 'signal dBm power is ['
- . $dBm
- . '], bit error rate ['
- . $ber . ']'
- );
-
- # Other versions put out "+CSQ: xx" only...
- }
- elsif ($dBm =~ /\+CSQ:\s*(\d+)/) {
-
- $dBm = $1;
-
- $self->log->write('info', 'signal is [' . $dBm . '] "bars"');
-
- }
- else {
-
- $self->log->write('warn', 'cannot obtain signal dBm power');
-
- }
-
- }
- else {
-
- $self->log->write('warn', 'signal quality command not supported!');
-
- }
-
- return $dBm;
-
-}
-
-#
-# Get the GSM software version on this device
-#
-sub software_version {
- my $self = shift;
- my ($code, $ver);
-
- # Test if manufacturer code command is supported
- if ($self->test_command('+CGMR')) {
-
- $self->atsend('AT+CGMR' . Device::Modem::CR);
- ($code, $ver) = $self->parse_answer($Device::Modem::STD_RESPONSE);
-
- $self->log->write('info', 'GSM version is [' . $ver . ']');
-
- }
-
- return $ver || $code;
-}
-
-#
-# Test support for a specific command
-#
-sub test_command {
- my ($self, $command) = @_;
-
- # Support old code adding a `+' if not specified
- # TODO to be removed in 1.30 ?
- if ($command =~ /^[a-zA-Z]/) {
- $command = '+' . $command;
- }
-
- # Standard test procedure for every command
- $self->log->write(
- 'info',
- 'testing support for command [' . $command . ']'
- );
- $self->atsend("AT$command=?" . Device::Modem::CR);
-
- # If answer is ok, command is supported
- my $ok = ($self->answer($Device::Modem::STD_RESPONSE) || '') =~ /OK/o;
- $self->log->write(
- 'info',
- 'command [' . $command . '] is ' . ($ok ? '' : 'not ') . 'supported'
- );
-
- $ok;
-}
-
-#
-# Read all messages on SIM card (XXX must be registered on network)
-#
-sub messages {
- my ($self, $storage) = @_;
- my @messages;
-
- # By default (old behaviour) messages are read from sim card
- $storage ||= 'SM';
-
- $self->log->write('info', 'Reading messages on '
- . ($storage eq 'SM' ? 'Sim card' : 'phone memory'));
-
- # Register on network (give your PIN number for this!)
- #return undef unless $self->register();
- $self->register();
-
- #
- # Read messages (TODO need to check if device supports CMGL with `stat'=4)
- #
- if ($self->mode() eq 'text') {
- warn 'Read messages in text mode is not implemented yet.';
-
- #@messages = $self->_read_messages_text();
- }
- else {
-
- # Set default storage if supported
- $self->storage($storage);
-
- push @messages, $self->_read_messages_pdu();
- }
-
- return @messages;
-}
-
-sub storage {
- my $self = shift;
- my $ok = 0;
-
- # Set default SMS storage if supported by phone
- if (@_ && (my $storage = uc $_[0])) {
- return unless $self->test_command('+CPMS');
- $self->atsend(qq{AT+CPMS="$storage"} . Device::Modem::CR);
-
- # Read and discard the answer
- $self->answer($Device::Modem::STD_RESPONSE, 5000);
- $self->{_storage} = $storage;
- }
-
- return $self->{_storage};
-}
-
-#
-# Register to GSM service provider network
-#
-sub register {
- my $me = shift;
- my $lOk = 0;
-
- # Check for connection
- if (!$me->{'CONNECTED'}) {
- $me->log->write('info', 'Not yet connected. Doing it now...');
- if (!$me->connect()) {
- $me->log->write('warning', 'No connection!');
- return $lOk;
- }
- }
-
- # On some phones, registration doesn't work, so you can skip it entirely
- # by passing 'assume_registered => 1' to the new() constructor
- if (exists $me->{'assume_registered'} && $me->{'assume_registered'}) {
- return $me->{'REGISTERED'} = 1;
- }
-
- # Send PIN status query
- $me->log->write('info', 'PIN status query');
- $me->atsend('AT+CPIN?' . Device::Modem::CR);
-
- # Get answer
- my $cReply = $me->answer($Device::Modem::STD_RESPONSE, 10000);
-
- if (!defined $cReply || $cReply eq "") {
- $me->log->write('warn',
- 'Could not get a reply for the AT+CPIN command');
- return;
- }
-
- if ($cReply =~ /(READY|SIM PIN2)/) {
-
- # Iridium satellite phones rest saying "SIM PIN2" when they are registered...
-
- $me->log->write(
- 'info',
- 'Already registered on network. Ready to send.'
- );
- $lOk = 1;
-
- }
- elsif ($cReply =~ /SIM PIN/) {
-
- # Pin request, sending PIN code
- $me->log->write('info', 'PIN requested: sending...');
- $me->atsend(qq[AT+CPIN="$$me{'pin'}"] . Device::Modem::CR);
-
- # Get reply
- $cReply = $me->answer($Device::Modem::STD_RESPONSE, 10000);
-
- # Test reply
- if ($cReply !~ /ERROR/) {
- $me->log->write('info', 'PIN accepted. Ready to send.');
- $lOk = 1;
- }
- else {
- $me->log->write('warning', 'PIN rejected');
- $lOk = 0;
- }
-
- }
-
- # Store status in object and return
- $me->{'REGISTERED'} = $lOk;
-
- return $lOk;
-}
-
-# send_sms( %options )
-#
-# recipient => '+39338101010'
-# class => 'flash' | 'normal'
-# validity => [ default = 24 hours ]
-# content => 'text-only for now'
-# mode => 'text' | 'pdu' (default = 'pdu')
-#
-sub send_sms {
-
- my ($me, %opt) = @_;
-
- my $lOk = 0;
- my $mr;
- return unless $opt{'recipient'} and $opt{'content'};
-
- # Check if registered to network
- if (!$me->{'REGISTERED'}) {
- $me->log->write('info', 'Not yet registered, doing now...');
- $me->register();
-
- # Wait some time to allow SIM registering to network
- $me->wait($Device::Gsm::REGISTER_DELAY << 10);
- }
-
- # Again check if now registered
- if (!$me->{'REGISTERED'}) {
-
- $me->log->write('warning', 'ERROR in registering to network');
- return $lOk;
-
- }
-
- # Ok, registered. Select mode to send SMS
- $opt{'mode'} ||= 'PDU';
- if (uc $opt{'mode'} ne 'TEXT') {
-
- ($lOk, $mr) = $me->_send_sms_pdu(%opt);
-
- }
- else {
-
- ($lOk, $mr) = $me->_send_sms_text(%opt);
- }
-
- # Return result of sending
- return wantarray ? ($lOk, $mr) : $lOk;
-}
-
-# send_csms( %options )
-#
-# recipient => '+39338101010'
-# class => 'flash' | 'normal'
-# validity => [ default = 24 hours ]
-# content => 'text-only above 160 chars'
-#
-sub send_csms {
-
- my ($me, %opt) = @_;
-
- my $lOk = 0;
- my @mrs;
- return unless $opt{'recipient'} and $opt{'content'};
-
- # Check if registered to network
- if (!$me->{'REGISTERED'}) {
- $me->log->write('info', 'Not yet registered, doing now...');
- $me->register();
-
- # Wait some time to allow SIM registering to network
- $me->wait($Device::Gsm::REGISTER_DELAY << 10);
- }
-
- # Again check if now registered
- if (!$me->{'REGISTERED'}) {
-
- $me->log->write('warning', 'ERROR in registering to network');
- return 0;
-
- }
-
- # Ok, registered. Select mode to send SMS
- $opt{'mode'} ||= 'PDU';
-
- if (uc $opt{'mode'} eq 'TEXT') {
- $me->log->write('warning', 'CSMS only in PDU mode, switching');
- until (uc($me->{'_mode'}) ne 'PDU') {
- $me->mode('pdu') or sleep 0.05;
- }
- }
- my @text_parts;
-
- #ensure we have to send CSMS
- if (Device::Gsm::Charset::gsm0338_length($opt{'content'}) <= 160) {
- my @send_return = $me->_send_sms_pdu(%opt);
- if ($send_return[0]) {
- $lOk++;
- push(@mrs, $send_return[1]);
- }
- else {
- $lOk = 0;
- $#mrs = -1;
- }
- }
- else {
- my $udh = new Sms::Token("UDH");
- my $ref_num = sprintf("%02X", (int(rand(255))));
- my @text_parts = Device::Gsm::Charset::gsm0338_split($opt{'content'});
- my $parts = scalar(@text_parts);
- $parts = sprintf("%02X", $parts);
- my $padding
- = Sms::Token::UDH::calculate_padding(Sms::Token::UDH::IEI_T_8_L);
- my $part_count = 1;
- foreach my $text_part (@text_parts) {
- my $part = sprintf("%02X", $part_count);
- my ($len_hex, $encoded_text)
- = Device::Gsm::Pdu::encode_text7_udh($text_part, $padding);
- $part_count++;
- $opt{'content'} = $text_part;
- $opt{'pdu_msg'}
- = sprintf("%02X",
- hex($len_hex) + Sms::Token::UDH::IEI_T_8_L + 2)
- . $udh->encode(
- Sms::Token::UDH::IEI_T_8 => $ref_num . $parts . $part)
- . $encoded_text;
- my @send_return = $me->send_sms_pdu_long(%opt);
- if ($send_return[0]) {
- $lOk++;
- push(@mrs, $send_return[1]);
-
- }
- else {
- $lOk = 0;
- $#mrs = -1;
- last;
- }
- sleep 0.05;
- }
- }
-
- # Return result of sending
- return wantarray ? ($lOk, @mrs) : $lOk;
-}
-
-#
-#
-# read messages in pdu mode
-#
-#
-sub _read_messages_pdu {
- my $self = shift;
-
- $self->mode('pdu');
-
- $self->atsend(q{AT+CMGL=4} . Device::Modem::CR);
- my ($messages) = $self->answer($Device::Modem::STD_RESPONSE, 5000);
-
- # Catch the case that the msgs are returned with gaps between them
- while (my $more = $self->answer($Device::Modem::STD_RESPONSE, 200)) {
-
- #-- $self->answer will chomp trailing newline, add it back
- $messages .= "\n";
- $messages .= $more;
- }
-
- # Ok, messages read, now convert from PDU and store in object
- $self->log->write('debug', 'Messages=' . $messages);
-
- my @data = split /[\r\n]+/m, $messages;
-
- # Check for errors on SMS reading
- my $code;
- if (($code = pop @data) =~ /ERROR/) {
- $self->log->write(
- 'error',
- 'cannot read SMS messages on SIM: [' . $code . ']'
- );
- return ();
- }
-
- my @message = ();
- my $current;
-
- # Current sms storage memory (ME or SM)
- my $storage = $self->storage();
-
- #
- # Parse received data (result of +CMGL command)
- #
- while (@data) {
-
- $self->log->write('debug', 'data[] = ', $data[0]);
- my $header = shift @data;
- my $pdu = shift @data;
-
- # Instance new message object
- my $msg = new Device::Gsm::Sms(
- header => $header,
- pdu => $pdu,
-
- # XXX mode => $self->mode(),
- storage => $storage,
- parent => $self # Ref to parent Device::Gsm class
- );
-
- # Check if message has been instanced correctly
- if (ref $msg) {
- push @message, $msg;
- }
- else {
- $self->log->write(
- 'info',
- "could not instance message $header $pdu!"
- );
- }
-
- }
-
- $self->log->write(
- 'info',
- 'found ' . (scalar @message) . ' messages on SIM. Reading.'
- );
-
- return @message;
-
-}
-
-#
-# _send_sms_text( %options ) : sends message in text mode
-#
-sub _send_sms_text {
- my ($me, %opt) = @_;
-
- my $num = $opt{'recipient'};
- my $text = $opt{'content'};
-
- return 0 unless $num and $text;
-
- my $lOk = 0;
- my $mr;
- my $cReply;
-
- # Select text format for messages
- $me->mode('text');
- $me->log->write('info', 'Selected text format for message sending');
-
- # Send sms in text mode
- $me->atsend(qq[AT+CMGS="$num"] . Device::Modem::CR);
-
- # Wait a bit before sending the text. Some GSM software needs it.
- $me->wait($Device::Modem::WAITCMD);
-
- # Complete message sending
- $text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
- $me->atsend($text . Device::Modem::CTRL_Z);
-
- # Get reply and check for errors
- $cReply = $me->answer('+CMGS', 2000);
- if ($cReply =~ /OK$/i) {
- $cReply =~ /\+CMGS:\s*(\d+)/i;
- $me->log->write('info', "Sent SMS (text mode) to $num!");
- $lOk = 1;
- $mr = $1;
- }
- else {
- $me->log->write('warning', "ERROR in sending SMS");
- }
-
- return wantarray ? ($lOk, $mr) : $lOk;
-}
-
-#
-# _send_sms_pdu( %options ) : sends message in PDU mode
-#
-sub _send_sms_pdu {
- my ($me, %opt, $is_gsm0338) = @_;
-
- # Get options
- my $num = $opt{'recipient'};
- my $text = $opt{'content'};
-
- return 0 unless $num and $text;
-
- $me->atsend(q[ATE1] . Device::Modem::CR);
- $me->answer($Device::Modem::STD_RESPONSE);
-
- # Select class of sms (normal or *flash sms*)
- my $class = $opt{'class'} || 'normal';
- $class = $class eq 'normal' ? '00' : 'F0';
-
- #Validity period value
- #0 to 143 (TP-VP + 1) * 5 minutes (i.e. 5 minutes intervals up to 12 hours)
- #144 to 167 12 hours + ((TP-VP - 143) * 30 minutes)
- #168 to 196 (TP-VP - 166) * 1 day
- #197 to 255 (TP-VP - 192) * 1 week
- #default 24h
- my $vp = 'A7';
- if (defined $opt{'validity_period'}) {
- $vp = sprintf("%02X", $opt{'validity_period'});
- }
-
- # Status report requested?
- my $status_report = 0;
- if (exists $opt{'status_report'} && $opt{'status_report'}) {
- $status_report = 1;
- }
-
- my $lOk = 0;
- my $mr = undef;
- my $cReply;
-
- # Send sms in PDU mode
-
- #
- # Example of sms send in PDU mode
- #
- #AT+CMGS=22
- #> 0011000A8123988277190000AA0AE8329BFD4697D9EC37
- #+CMGS: 111
- #
- #OK
-
- # Encode DA
- my $enc_da = Device::Gsm::Pdu::encode_address($num);
- $me->log->write('info', 'encoded dest. address is [' . $enc_da . ']');
-
- # Encode text
- $is_gsm0338 or $text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
- my $enc_msg = Device::Gsm::Pdu::encode_text7($text);
- $me->log->write(
- 'info',
- 'encoded 7bit text (w/length) is [' . $enc_msg . ']'
- );
-
- # Build PDU data
- my $pdu = uc join(
- '',
- '00',
- ($status_report ? '31' : '11'),
- '00',
- $enc_da,
- '00',
- $class,
- $vp,
- $enc_msg
- );
-
- $me->log->write('info', 'due to send PDU [' . $pdu . ']');
-
- # Sending main SMS command ( with length )
- my $len = ((length $pdu) >> 1) - 1;
-
- #$me->log->write('info', 'AT+CMGS='.$len.' string sent');
-
- # Select PDU format for messages
- $me->atsend(q[AT+CMGF=0] . Device::Modem::CR);
- $me->answer($Device::Modem::STD_RESPONSE);
- $me->log->write('info', 'Selected PDU format for msg sending');
-
- # Send SMS length
- $me->atsend(qq[AT+CMGS=$len] . Device::Modem::CR);
- $me->answer($Device::Modem::STD_RESPONSE);
-
- # Sending SMS content encoded as PDU
- $me->log->write('info', 'PDU sent [' . $pdu . ' + CTRLZ]');
- $me->atsend($pdu . Device::Modem::CTRL_Z);
-
- # Get reply and check for errors
- $cReply = $me->answer($Device::Modem::STD_RESPONSE, 30000);
- $me->log->write('debug', "SMS reply: $cReply\r\n");
-
- if ($cReply =~ /OK$/i) {
- $cReply =~ /\+CMGS:\s*(\d+)/i;
- $me->log->write('info', "Sent SMS (pdu mode) to $num!");
- $lOk = 1;
- $mr = $1;
-
- }
- else {
- $cReply =~ /(\+CMGS:.*)/;
- $me->log->write('warning', "ERROR in sending SMS: $1");
- }
-
- return wantarray ? ($lOk, $mr) : $lOk;
-}
-
-sub send_sms_pdu_long {
- my ($me, %opt) = @_;
-
- # Get options
- my $num = $opt{'recipient'};
- my $text = $opt{'content'};
- my $pdu_msg = $opt{'pdu_msg'};
-
- return 0 unless $num and $text and $pdu_msg;
-
- $me->atsend(q[ATE1] . Device::Modem::CR);
- $me->answer($Device::Modem::STD_RESPONSE);
-
- # Select class of sms (normal or *flash sms*)
- my $class = $opt{'class'} || 'normal';
- $class = $class eq 'normal' ? '00' : 'F0';
-
- #Validity period value
- #0 to 143 (TP-VP + 1) * 5 minutes (i.e. 5 minutes intervals up to 12 hours)
- #144 to 167 12 hours + ((TP-VP - 143) * 30 minutes)
- #168 to 196 (TP-VP - 166) * 1 day
- #197 to 255 (TP-VP - 192) * 1 week
- #default 24h
- my $vp = 'A7';
- if (defined $opt{'validity_period'}) {
- $vp = sprintf("%02X", $opt{'validity_period'});
- }
-
- # Status report requested?
- my $status_report = 0;
- if (exists $opt{'status_report'} && $opt{'status_report'}) {
- $status_report = 1;
- }
-
- my $lOk = 0;
- my $mr = undef;
- my $cReply;
-
- # Send sms in PDU mode
-
- #
- # Example of sms send in PDU mode
- #
- #AT+CMGS=22
- #> 0011000A8123988277190000AA0AE8329BFD4697D9EC37
- #+CMGS: 111
- #
- #OK
-
- # Encode DA
- my $enc_da = Device::Gsm::Pdu::encode_address($num);
- $me->log->write('info', 'encoded dest. address is [' . $enc_da . ']');
-
- # Encode text
- #$text = Device::Gsm::Charset::iso8859_to_gsm0338($text);
- #my $enc_msg = Device::Gsm::Pdu::encode_text7($text);
- $me->log->write(
- 'info',
- 'encoded 7bit text (w/length) is [' . $pdu_msg . ']'
- );
-
- # Build PDU data
- my $pdu = uc join(
- '',
-
- #we use default SMSC address(don supply one)
- '00',
-
- #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)
- ($status_report ? '71' : '51'),
-
- #message reference, my G24 returns own MR after successful sending, setting this value did nothing in that case, but other modems may behave differently
- '00',
- $enc_da,
-
- #protocol identifier (0x00 use default)
- '00',
-
- #data coding scheme (flash sms or normal, coding etc. more about:http://www.dreamfabric.com/sms/dcs.html)
- $class,
- $vp,
- $pdu_msg
- );
-
- $me->log->write('info', 'due to send PDU [' . $pdu . ']');
-
- # Sending main SMS command ( with length )
- my $len = ((length $pdu) >> 1) - 1;
-
- #$me->log->write('info', 'AT+CMGS='.$len.' string sent');
-
- # Select PDU format for messages
- $me->atsend(q[AT+CMGF=0] . Device::Modem::CR);
- $me->answer($Device::Modem::STD_RESPONSE);
- $me->log->write('info', 'Selected PDU format for msg sending');
-
- # Send SMS length
- $me->atsend(qq[AT+CMGS=$len] . Device::Modem::CR);
- $me->answer($Device::Modem::STD_RESPONSE);
-
- # Sending SMS content encoded as PDU
- $me->log->write('info', 'PDU sent [' . $pdu . ' + CTRLZ]');
- $me->atsend($pdu . Device::Modem::CTRL_Z);
-
- # Get reply and check for errors
- $cReply = $me->answer($Device::Modem::STD_RESPONSE, 30000);
- $me->log->write('debug', "SMS reply: $cReply\r\n");
-
- if ($cReply =~ /OK$/i) {
- $cReply =~ /\+CMGS:\s*(\d+)/i;
- $me->log->write('info', "Sent SMS (pdu mode) to $num!");
- $lOk = 1;
- $mr = $1;
- }
- else {
- $cReply =~ /(\+CMGS:.*)/;
- $me->log->write('warning', "ERROR in sending SMS: $1");
- }
-
- return wantarray ? ($lOk, $mr) : $lOk;
-}
-
-#
-# Set or request service center number
-#
-sub service_center {
-
- my $self = shift;
- my $nCenter;
- my $lOk = 1;
- my $code;
-
- # If additional parameter is supplied, store new message center number
- if (@_) {
- $nCenter = shift();
-
- # Remove all non numbers or `+' sign
- $nCenter =~ s/[^0-9+]//g;
-
- # Send AT command
- $self->atsend(qq[AT+CSCA="$nCenter"] . Device::Modem::CR);
-
- # Check for modem answer
- $lOk = ($self->answer($Device::Modem::STD_RESPONSE) =~ /OK/);
-
- if ($lOk) {
- $self->log->write(
- 'info',
- 'service center number [' . $nCenter . '] stored'
- );
- }
- else {
- $self->log->write(
- 'warning',
- 'unexpected response for "service_center" command'
- );
- }
-
- }
- else {
-
- $self->log->write('info', 'requesting service center number');
- $self->atsend('AT+CSCA?' . Device::Modem::CR);
-
- # Get answer and check for errors
- ($code, $nCenter) = $self->parse_answer($Device::Modem::STD_RESPONSE);
-
- if ($code =~ /ERROR/) {
- $self->log->write(
- 'warning',
- 'error status for "service_center" command'
- );
- $lOk = 0;
- }
- else {
-
- # $nCenter =~ tr/\r\nA-Z//s;
- $self->log->write(
- 'info',
- 'service center number is [' . $nCenter . ']'
- );
-
- # Return service center number
- $lOk = $nCenter;
- }
-
- }
-
- # Status flag or service center number
- return $lOk;
-
-}
-
-sub network {
- my $self = $_[0];
- my $network;
-
- #if( ! $self->test_command('COPS') )
- #{
- # print 'NO COMMAND';
- # return undef;
- #}
-
- $self->atsend('AT+COPS?' . Device::Modem::CR);
-
- # Parse COPS answer, the 3rd string is the network name
- my $ans = $self->answer();
- if ($ans =~ /"([^"]*)"/) {
- $network = $1;
- $self->log->write('info', 'Received network name [' . $network . ']');
- }
- else {
- $self->log->write('info', 'Received no network name');
- }
-
- # Try to decode the network name
- require Device::Gsm::Networks;
- my $netname = Device::Gsm::Networks::name($network);
- if (!defined $netname || $netname eq 'unknown') {
- $netname = undef;
- }
- return wantarray
- ? ($netname, $network)
- : $netname;
-
-}
-
-#
-#returns simcard MSISDN
-#
-sub selfnum {
- my $self = shift;
- my @selfnum;
- my $selfnum;
- if ($self->test_command('CNUM')) {
- $self->atsend('AT+CNUM' . Device::Modem::CR);
- my $ans = $self->answer($Device::Modem::STD_RESPONSE);
- my @answer = split /[\r\n]+/m, $ans;
- foreach (@answer) {
- if ($_ =~ /^\+CNUM: /) {
- my @temp = split /,/, $';
- $temp[1] =~ s/"//g;
- if ($temp[1] =~ /\d{9,}/) {
- !$selfnum and $selfnum = $temp[1];
- push(@selfnum, $temp[1]);
- }
- }
- }
- if ($selfnum) {
- $self->log->write('info', 'Received number [' . "@selfnum" . ']');
- return wantarray
- ? @selfnum
- : $selfnum;
- }
- else {
- $self->log->write('info', 'Received no numbers');
- return "";
- }
-
- }
-
- #
- #On my motorola G24 for messages with alphanumeric sender sender() returns malformed characters
- #on globetrotter option 505 everything is all right. I wrote this at beggining of playng with you module,
- #and almost forgot about it. I'll investigate this bug in future.
- #
-}
-
-sub get_literal_header {
- my ($self, $index) = @_;
- my $header = '';
-
- #set text mode
- $self->atsend('AT+CMGF=1' . Device::Modem::CR);
- sleep 0.05;
- if ($self->answer($Device::Modem::STD_RESPONSE) =~ /OK/) {
- $self->log->write('warning', 'Text mode set');
- }
- else {
- $self->log->write('warning', 'Text mode not set');
- $self->log->write('warning', 'Trying restore PDU mode');
- $self->atsend('AT+CMGF=0' . Device::Modem::CR);
- sleep 0.05;
- $self->answer($Device::Modem::STD_RESPONSE) =~ /OK/
- and $self->log->write('warning', 'PDU mode restored');
- return;
- }
- $self->atsend('AT+MMGR=' . $index . Device::Modem::CR);
- my $ans = $self->answer();
- if ($ans =~ /\+MMGR:/) {
- my @temp = split(/,/, $');
- $header = $temp[1];
- $header =~ s/\"|\'//g;
- }
- $self->atsend('AT+CMGF=0' . Device::Modem::CR);
- sleep 0.05;
- $self->answer($Device::Modem::STD_RESPONSE) =~ /OK/
- and $self->log->write('warning', 'PDU mode Set')
- or return;
- return $header;
-}
-
-sub send_ussd {
- my ($self, $message) = @_;
- my $answer = '';
- my $encoded = Device::Gsm::Pdu::encode_text7_ussd($message);
- if ($self->test_command("CUSD")) {
- my $at_command
- = 'AT+CUSD=1,"' . $encoded . '",' . USSD_DCS . Device::Modem::CR;
- $self->atsend($at_command);
- my $expect = qr/ERROR|OK|\+CUSD:/;
- my $cReadChars = $Device::Modem::READCHARS;
- $Device::Modem::READCHARS = 300;
- my $response = '';
- $response = $self->answer($expect, 1000);
-
- # Catch the case that the msgs are returned with gaps between them
- $response =~ m/OK/
- and $response .= "\n" . $self->answer($expect, 15000);
- $Device::Modem::READCHARS = $cReadChars;
- if ($response =~ m/OK/) {
- $self->log->write('warning',
- 'send_ussd command: "'
- . $message
- . '" OK, AT: '
- . $at_command . " "
- . 'response: '
- . $response);
- if ($response =~ m/\+CUSD:\s*(\d+)\s*,/) {
- my $response_code = $1;
- $self->log->write('warning',
- "Have a ussd_response code: $response_code=>"
- . $Device::Gsm::USSD_RESPONSE_CODES{$1});
- $response = $';
- if ($response_code < 2) {
- if ($response =~ m/\s*\"?([0-9A-F]+)\"?\s*,\s*(\d*)\s*/) {
- my $ussd_response = $1;
- my $ussd_dcs = length($2) ? $2 : USSD_DCS;
- $self->log->write('warning',
- "Have a ussd_response message: $ussd_response, dcs: $ussd_dcs"
- );
- ($ussd_dcs == 15 or $ussd_dcs == 0)
- and $answer
- = Device::Gsm::Pdu::decode_text7_ussd(
- $ussd_response)
- and $ussd_dcs = -1;
- $ussd_dcs == 72
- and $answer
- = Device::Gsm::Pdu::decode_text_UCS2(
- $ussd_response)
- and $ussd_dcs = -1;
- $ussd_dcs == 68
- and $answer
- = Device::Gsm::Pdu::decode_text8($ussd_response)
- and $ussd_dcs = -1;
- $ussd_dcs != -1
- and $self->log->write('warning',
- "Cant decode ussd_response message with dcs: $ussd_dcs"
- );
-
- }
-
- }
- elsif ($response_code == 2) {
- $response =~ m/\s*(\d+)\s*/
- and $self->log->write('warning',
- "Have a ussd_termintion code: $1=>"
- . $Device::Gsm::USSD_TERMINATION_CODES{$1});
- }
- }
- }
- else {
- $self->log->write('warning',
- 'Error send_ussd command: '
- . $at_command
- . ", returned: "
- . $response);
- return '';
-
- }
- }
- else {
- $self->log->write('warning',
- 'Error send_ussd AT+CUSD command not supported');
- return '';
- }
- return $answer;
-}
-1;
-
-__END__
-
-=head1 NAME
-
-Device::Gsm - Perl extension to interface GSM phones / modems
-
-=head1 SYNOPSIS
-
- use Device::Gsm;
-
- my $gsm = new Device::Gsm( port => '/dev/ttyS1', pin => 'xxxx' );
-
- if( $gsm->connect() ) {
- print "connected!\n";
- } else {
- print "sorry, no connection with gsm phone on serial port!\n";
- }
-
- # Register to GSM network (you must supply PIN number in above new() call)
- # See 'assume_registered' in the new() method documentation
- $gsm->register();
-
- # Send quickly a short text message
- $gsm->send_sms(
- recipient => '+3934910203040',
- content => 'Hello world! from Device::Gsm'
- );
-
- # Get list of Device::Gsm::Sms message objects
- # see `examples/read_messages.pl' for all the details
- my @messages = $gsm->messages();
-
-=head1 DESCRIPTION
-
-C<Device::Gsm> class implements basic GSM functions, network registration and SMS sending.
-
-This class supports also C<PDU> mode to send C<SMS> messages, and should be
-fairly usable. In the past, I have developed and tested it under Linux RedHat 7.1
-with a 16550 serial port and Siemens C35i/C45 GSM phones attached with
-a Siemens-compatible serial cable. Currently, I'm developing and testing this stuff
-with Linux Slackware 10.2 and a B<Cambridge Silicon Radio> (CSR) USB
-bluetooth dongle, connecting to a Nokia 6600 phone.
-
-Please be kind to the universe and contact me if you have troubles or you are
-interested in this.
-
-Please be monstruosly kind to the universe and (if you don't mind spending an SMS)
-use the C<examples/send_to_cosimo.pl> script to make me know that Device::Gsm works
-with your device (thanks!).
-
-Recent versions of C<Device::Gsm> have also an utility called C<autoscan> in
-the C<bin/> folder, that creates a little profile of the devices it runs
-against, that contains information about supported commands and exact output
-of commands to help recognize similar devices.
-
-Be sure to send me your profile by email (if you want to),
-so I can add better support for your device in the future!
-
-=head1 METHODS
-
-The following documents all supported methods with simple examples of usage.
-
-=head2 new()
-
-Inherited from L<Device::Modem>. See L<Device::Modem> documentation
-for more details.
-
-The only mandatory argument is the C<port> you want to use to connect
-to the GSM device:
-
- my $gsm = Device::Gsm->new(
- port => '/dev/ttyS0',
- );
-
-On some phones, you may experience problems in the GSM network registration
-step. For this reasons, you can pass a special C<assume_registered> option
-to have L<Device::Gsm> ignore the registration step and assume the device
-is already registered on the GSM network. Example:
-
- my $gsm = Device::Gsm->new(
- port => '/dev/ttyS0',
- assume_registered => 1,
- );
-
-If you want to send debugging information to your own log file instead of
-the default setting, you can:
-
- my $gsm = Device::Gsm->new(
- port => '/dev/ttyS1',
- log => 'file,/tmp/myfile.log',
- loglevel => 'debug', # default is 'warning'
- );
-
-=head2 connect()
-
-This is the main call that connects to the appropriate device. After the
-connection has been established, you can start issuing commands.
-The list of accepted parameters (to be specified as hash keys and values) is
-the same of C<Device::SerialPort> (or C<Win32::SerialPort> on Windows platform),
-as all parameters are passed to those classes' connect() method.
-
-The default value for C<baudrate> parameter is C<19200>.
-
-Example:
-
- my $gsm = Device::Gsm->new( port=>'/dev/ttyS0', log=>'syslog' );
- # ...
- if( $gsm->connect(baudrate => 19200) ) {
- print "Connected!";
- } else {
- print "Could not connect, sorry!";
- }
- # ...
-
-=head2 datetime()
-
-Used to get or set your phone/gsm modem date and time.
-
-If called without parameters, it gets the current phone/gsm date and time in "gsm"
-format "YY/MM/DD,HH:MN:SS". For example C<03/12/15,22:48:59> means December the 15th,
-at 10:48:59 PM. Example:
-
- $datestr = $gsm->datetime();
-
-If called with parameters, sets the current phone/gsm date and time to that
-of supplied value. Example:
-
- $newdate = $gsm->datetime( time() );
-
-where C<time()> is the perl's builtin C<time()> function (see C<perldoc -f time> for details).
-Another variant allows to pass a C<localtime> array to set the correspondent datetime. Example:
-
- $newdate = $gsm->datetime( localtime() );
-
-(Note the list context). Again you can read the details for C<localtime> function
-with C<perldoc -f localtime>.
-
-If your device does not support this command, an B<undefined> value will be returned
-in either case.
-
-
-=head2 delete_sms()
-
-This method deletes a message from your SIM card, given the message index number.
-Example:
-
- $gsm->delete_sms(3);
-
-An optional second parameter specifies the "storage". It allows to delete messages
-from gsm phone memory or sim card memory. Example:
-
- # Deletes first message from gsm phone memory
- $gsm->delete_sms(1, 'ME');
-
- # Deletes 3rd message from sim card
- $gsm->delete_sms(3, 'SM');
-
-By default, it uses the currently set storage, via the C<storage()> method.
-
-=head2 forward()
-
-Sets call forwarding. Accepts three arguments: reason, mode and number.
-Reason can be the string C<unconditional>, C<busy>, C<no reply> and C<unreachable>.
-Mode can be the string C<disable>, C<enable>, C<query>, C<register>, C<erase>.
-
-Example:
-
- # Set unconditional call forwarding to +47 123456789
- $gsm->forward('unconditional','register','+47123456789');
-
- # Erase unconditional call forwarding
- $gsm->forward('unconditional','erase');
-
-
-=head2 hangup()
-
-Hangs up the phone, terminating the active calls, if any.
-This method has been never tested on real "live" conditions, but it needs to be
-specialized for GSM phones, because it relies on C<+HUP> GSM command.
-Example:
-
- $gsm->hangup();
-
-
-=head2 imei()
-
-Returns the device own IMEI number (International Mobile Equipment Identifier ???).
-This identifier is numeric and should be unique among all GSM mobile devices and phones.
-This is not really true, but ... . Example:
-
- my $imei = $gsm->imei();
-
-
-=head2 manufacturer()
-
-Returns the device manufacturer, usually only the first word (example: C<Nokia>,
-C<Siemens>, C<Falcom>, ...). Example:
-
- my $man_name = $gsm->manufacturer();
- if( $man_name eq 'Nokia' ) {
- print "We have a nokia phone...";
- } else {
- print "We have a $man_name phone...";
- }
-
-
-=head2 messages()
-
-This method is a somewhat unstable and subject to change, but for now it seems to work.
-It is meant to extract all text SMS messages stored on your SIM card or gsm phone.
-In list context, it returns a list of messages (or undefined value if no message or errors),
-every message being a C<Device::Gsm::Sms> object.
-
-The only parameter specifies the C<storage> where you want to read the messages,
-and can assume some of the following values (but check your phone/modem manual for
-special manufacturer values):
-
-=over 4
-
-=item C<ME>
-
-Means gsm phone B<ME>mory
-
-=item C<MT>
-
-Means gsm phone B<ME>mory on Nokia phones?
-
-=item C<SM>
-
-Means B<S>im card B<M>emory (default value)
-
-=back
-
-Example:
-
- my $gsm = Device::Gsm->new();
- $gsm->connect(port=>'/dev/ttyS0') or die "Can't connect!";
-
- for( $gsm->messages('SM') )
- {
- print $_->sender(), ': ', $_->content(), "\n";
- }
-
-=head2 mode()
-
-Sets the device GSM command mode. Accepts one parameter to set the new mode that can
-be the string C<text> or C<pdu>. Example:
-
- # Set text mode
- $gsm->mode('text');
-
- # Set pdu mode
- $gsm->mode('pdu');
-
-
-=head2 model()
-
-Returns phone/device model name or number. Example:
-
- my $model = $gsm->model();
-
-For example, for Siemens C45, C<$model> holds C<C45>; for Nokia 6600, C<$model>
-holds C<6600>.
-
-
-=head2 network()
-
-Returns the current registered or preferred GSM network operator. Example:
-
- my $net_name = $gsm->network();
- # Returns 'Wind Telecom Spa'
-
- my($net_name, $net_code) = $gsm->network();
- # Returns ('Wind Telecom Spa', '222 88')
-
-This obviously varies depending on country and network operator. For me now,
-it holds "Wind Telecomunicazioni SpA". It is not guaranteed that the mobile
-phone returns the decoded network name. It can also return a gsm network code,
-like C<222 88>. In this case, an attempt to decode the network name is made.
-
-Be sure to call the C<network()> method when already registered to gsm
-network. See C<register()> method.
-
-
-=head2 signal_quality()
-
-Returns the measure of signal quality expressed in dBm units, where near to zero is better.
-An example value is -91 dBm, and reported value is C<-91>. Values should range from
--113 to -51 dBm, where -113 is the minimum signal quality and -51 is the theorical maximum quality.
-
- my $level = $gsm->signal_quality();
-
-If signal quality can't be read or your device does not support this command,
-an B<undefined> value will be returned.
-
-=head2 software_version()
-
-Returns the device firmare version, as stored by the manufacturer. Example:
-
- my $rev = $gsm->software_revision();
-
-For example, for my Siemens C45, C<$rev> holds C<06>.
-
-=head2 storage()
-
-Allows to get/set the current sms storage, that is where the sms messages are saved,
-either the sim card or gsm phone memory. Phones/modems that do not support this feature
-(implemented by C<+CPMS> AT command won't be affected by this method.
-
- my @msg;
- my $storage = $gsm->storage();
- print "Current storage is $storage\n";
-
- # Read all messages on sim card
- $gsm->storage('SM');
- @msg = $gsm->messages();
-
- # Read messages from gsm phone memory
- $gsm->storage('ME');
- push @msg, $gsm->messages();
-
-=head2 test_command()
-
-This method allows to query the device to know if a specific AT GSM command is supported.
-This is used only with GSM commands (those with C<AT+> prefix).
-For example, I want to know if my device supports the C<AT+GXXX> command.
-All we have to do is:
-
- my $gsm = Device::Gsm->new( port => '/dev/myport' );
-
- ...
-
- if( $gsm->test_command('GXXX') ) {
- # Ok, command is supported
- } else {
- # Nope, no GXXX command
- }
-
-Note that if you omit the starting C<+> character, it is automatically added.
-You can also test commands like C<^SNBR> or the like, without C<+> char being added.
-
-=for html
-<I>Must be explained better, uh?</I>
-
-=for comment
-// must be explainer better, uh? //
-
-=head2 register()
-
-"Registering" on the GSM network is what happens when you turn on your mobile phone or GSM equipment
-and the device tries to reach the GSM operator network. If your device requires a B<PIN> number,
-it is used here (but remember to supply the C<pin> parameter in new() object constructor for this
-to work.
-
-Registration can take some seconds, don't worry for the wait.
-After that, you are ready to send your SMS messages or do some voice calls, ... .
-Normally you don't need to call register() explicitly because it is done automatically for you
-when/if needed.
-
-If return value is true, registration was successful, otherwise there is something wrong;
-probably you supplied the wrong PIN code or network unreachable.
-
-=head2 send_sms()
-
-Obviously, this sends out SMS text messages. I should warn you that B<you cannot send>
-(for now) MMS, ringtone, smart, ota messages of any kind with this method.
-
-Send out an SMS message quickly:
-
- my $sent = $gsm->send_sms(
- content => 'Hello, world!', # SMS text
- recipient => '+99000123456', # recipient phone number
- );
-
- if( $sent ) {
- print "OK!";
- } else {
- print "Troubles...";
- }
-
-The allowed parameters to send_sms() are:
-
-=over
-
-=item C<class>
-
-Class parameter can assume two values: C<normal> and C<flash>. Flash (or class zero) messages are
-particular because they are immediately displayed (without user confirm) and never stored
-on phone memory, while C<normal> is the default.
-
-=item C<content>
-
-This is the text you want to send, consisting of max 160 chars if you use B<PDU> mode
-and 140 (?) if in B<text> mode (more on this later).
-
-=item C<mode>
-
-Can assume two values (case insensitive): C<pdu> and C<text>.
-C<PDU> means B<Protocol Data Unit> and it is a sort of B<binary> encoding of commands,
-to save time/space, while C<text> is the normal GSM commands text mode.
-
-Recent mobile phones and GSM equipments surely have support for C<PDU> mode.
-Older OEM modules (like Falcom Swing, for example) don't have PDU mode, but only text mode.
-It is just a matter of trying.
-
-=item C<recipient>
-
-Phone number of message recipient
-
-=item C<status_report>
-
-If present with a true value, it enables sending of SMS messages (only for PDU mode,
-text mode SMS won't be influenced by this parameter) with the status report,
-also known as delivery report, that is a short message that reports the status
-of your sent message.
-Usually this is only available if your mobile company supports this feature,
-and probably you will be charged a small amount for this service.
-
-More information on this would be welcome.
-
-=back
-
-=head2 service_center()
-
-If called without parameters, returns the actual SMS Service Center phone number. This is
-the number your phone automatically calls when receiving and sending SMS text messages, and
-your network operator should tell you what this number is.
-
-Example:
-
- my $gsm = Device::Gsm->new( port => 'COM1' );
- $gsm->connect() or die "Can't connect";
- $srv_cnt = $gsm->service_center();
- print "My service center number is: $srv_cnt\n";
-
-If you want to set or change this number (if used improperly this can disable
-sending of SMS messages, so be warned!), you can try something like:
-
- my $ok = $gsm->service_center('+99001234567');
- print "Service center changed!\n" if $ok;
-
-=head1 REQUIRES
-
-=over 4
-
-=item *
-
-Device::Modem, which in turn requires
-
-=item *
-
-Device::SerialPort (or Win32::SerialPort on Windows machines)
-
-=back
-
-=head1 EXPORT
-
-None
-
-=head1 TROUBLESHOOTING
-
-If you experience problems, please double check:
-
-=over 4
-
-=item Device permissions
-
-Maybe you don't have necessary permissions to access your serial,
-irda or bluetooth port device. Try executing your script as root, or
-try, if you don't mind, C<chmod a+rw /dev/ttyS1> (or whatever device
-you use instead of C</dev/ttyS1>).
-
-=item Connection speed
-
-Try switching C<baudrate> parameter from 19200 (the default value)
-to 9600 or viceversa. This one is the responsible of 80% of the problems,
-because there is no baudrate auto-detection.
-
-=item Device autoscan
-
-If all else fails, please use the B<autoscan> utility in the C<bin/> folder
-of the C<Device::Gsm> distribution. Try running this autoscan utility and
-examine the log file produced in the current directory.
-
-If you lose any hope, send me this log file so I can eventually
-have any clue about the problem / failure.
-
-Also this is a profiling tool, to know which commands are supported
-by your device, so please send me profiles of your devices, so
-I can add better support for all devices in the future!
-
-=back
-
-=head1 TO-DO
-
-=over 4
-
-=item Spooler
-
-Build a simple spooler program that sends all SMS stored in a special
-queue (that could be a simple filesystem folder).
-
-=item Validity Period
-
-Support C<validity> period option on SMS sending. Tells how much time the SMS
-Service Center must hold the SMS for delivery when not received.
-
-=item Profiles
-
-Build a profile of the GSM device used, so that we don't have to C<always>
-test each command to know whether it is supported or not, because this takes
-too time to be done every time.
-
-=back
-
-
-=head1 AUTHOR
-
-Cosimo Streppone, cosimo@cpan.org
-
-=head1 SEE ALSO
-
-L<Device::Modem>, L<Device::SerialPort>, L<Win32::SerialPort>, perl(1)
-
-=cut
-
-
@@ -1,32 +0,0 @@
-# Perl Best Practices (plus errata) .perltidyrc file
-
--l=98 # Max line width is 98 cols
--i=4 # Indent level is 4 cols
--ci=4 # Continuation indent is 4 cols
--st # Output to STDOUT
--se # Errors to STDERR
--vt=2 # Maximal vertical tightness
--cti=0 # No extra indentation for closing brackets
--pt=1 # Medium parenthesis tightness
--bt=1 # Medium brace tightness
--sbt=1 # Medium square bracket tightness
--bbt=1 # Medium block brace tightness
--nsfs # No space before semicolons
--nolq # Don't outdent long quoted strings
--wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
- # Break before all operators
-
-# extras/overrides/deviations from PBP
-
-#--maximum-line-length=100 # be slightly more generous
---warning-output # Show warnings
---maximum-consecutive-blank-lines=2 # default is 1
---nohanging-side-comments # troublesome for commented out code
-
--isbc # block comments may only be indented if they have some space characters before the #
-
-# for the up-tight folk :)
--pt=2 # High parenthesis tightness
--bt=2 # High brace tightness
--sbt=2 # High square bracket tightness
-
@@ -1,79 +0,0 @@
-# $Id: 05messages.t,v 1.2 2004-05-25 21:01:32 cosimix Exp $
-#
-# test sim card message reading functions
-#
-use Test::More;
-BEGIN { plan tests => 3 };
-use Device::Gsm;
-ok(1);
-
-# Configure some useful parameters via environment
-my $port = $ENV{'DEV_GSM_PORT'} || '';
-my $baud = $ENV{'DEV_GSM_BAUD'} || 9600;
-my $pin = $ENV{'DEV_GSM_PIN'} || '';
-
-SKIP: {
-
-if( $port eq '' ) {
-
- print STDERR <<NOTICE;
-
- No serial port set up, so *NO* tests will be executed...
- To enable full testing, you can set these environment vars:
-
- DEV_GSM_PORT=[your serial port] (Ex.: 'COM1', '/dev/ttyS1', ...)
- DEV_GSM_BAUD=[serial link speed] (default is `9600')
- DEV_GSM_PIN=[nnnn] (your SIM PIN code, *only* if needs it)
-
- On most unix environments, this can be done running:
-
- export DEV_GSM_PORT=/dev/modem
- export DEV_GSM_BAUD=9600
- export DEV_GSM_PIN=1234
- make test
-
- On Win32 systems, you can do:
-
- set DEV_GSM_PORT=COM1
- set DEV_GSM_BAUD=9600
- set DEV_GSM_PIN=1234
- nmake test (or make test)
-
-NOTICE
-
- skip( 'Serial port not set up!', 2 );
-# print "skip $_\n" for (2..3);
-
- exit;
-
-}
-
-
-my $gsm = new Device::Gsm( port => $port );
-
-# Object instance is ok?
-ok( $gsm );
-
-exit unless $gsm;
-
-#
-# Serial port connection ok?
-#
-my %options = ( baudrate => $baud );
-$options{'pin'} = $pin if defined($pin) && $pin ne '';
-ok( $gsm->connect(%options) );
-
-
-my @msg = $gsm->messages();
-foreach my $msg ( @msg ) {
- print 'MSG ', $msg->{'index'}, "\n";
- print ' ty', $msg->type(), "\n";
- print 'PDU(', $msg->{'pdu'}, ")\n";
- print 'DEC(', ($msg->{'decoded'}||''), ")\n";
- print "-" x 72, "\n";
-}
-
-$gsm->disconnect();
-
-}
-
@@ -1,94 +0,0 @@
-# $Id: 08storage.t,v 1.1 2006-07-23 15:47:58 cosimo Exp $
-#
-# test new token engine for decoding/encoding sms messages
-#
-use Test::More;
-BEGIN { plan tests => 8 };
-use lib '../lib';
-use_ok('Device::Gsm');
-use_ok('Device::Gsm::Sms');
-
-# Configure some useful parameters via environment
-my $port = $ENV{'DEV_GSM_PORT'} || '';
-my $baud = $ENV{'DEV_GSM_BAUD'} || 9600;
-my $pin = $ENV{'DEV_GSM_PIN'} || '';
-
-SKIP: {
-
-if( $port eq '' ) {
-
- print STDERR <<NOTICE;
-
- No serial port set up, so *NO* tests will be executed...
- To enable full testing, you can set these environment vars:
-
- DEV_GSM_PORT=[your serial port] (Ex.: 'COM1', '/dev/ttyS1', ...)
- DEV_GSM_BAUD=[serial link speed] (default is `9600')
- DEV_GSM_PIN=[nnnn] (your SIM PIN code, *only* if needs it)
-
- On most unix environments, this can be done running:
-
- export DEV_GSM_PORT=/dev/modem
- export DEV_GSM_BAUD=9600
- export DEV_GSM_PIN=1234
- make test
-
- On Win32 systems, you can do:
-
- set DEV_GSM_PORT=COM1
- set DEV_GSM_BAUD=9600
- set DEV_GSM_PIN=1234
- nmake test (or make test)
-
-NOTICE
-
- skip( 'Serial port not set up!', 6 );
-
-}
-
-}
-
-# Uh...
-exit if $port eq '';
-
-my $gsm = new Device::Gsm(port=>$port, log=>'file,storage.log', loglevel=>'debug');
-
-# Object instance is ok?
-ok( $gsm );
-
-exit unless $gsm;
-
-#
-# Serial port connection ok?
-#
-my %options = ( baudrate => $baud );
-$options{'pin'} = $pin if defined($pin) && $pin ne '';
-ok( $gsm->connect(%options) );
-
-my $storage = $gsm->storage();
-is(undef, $storage, 'storage when starting is undefined');
-
-my $has_cpms = $gsm->test_command('+CPMS');
-
-$gsm->storage('SM');
-
-if($has_cpms)
-{
- is($storage, 'SM', 'storage changed to SM');
-}
-else
-{
- is($storage, undef, 'storage not changed because phone does not support it');
-}
-
-$gsm->storage('ME');
-
-if($has_cpms)
-{
- is($storage, 'ME', 'storage changed to ME');
-}
-else
-{
- is($storage, undef, 'storage not changed because phone does not support it');
-}
-