Device-Gsm-1.60/0000755000175000017500000000000011730620353012727 5ustar cosimocosimoDevice-Gsm-1.60/MANIFEST0000644000175000017500000000211011730620333014050 0ustar cosimocosimobin/autoscan Changes docs/gsm0338.txt examples/delete_message.pl examples/get_time.pl examples/network.pl examples/read_messages.pl examples/report_signal.pl examples/send_sms.pl examples/send_to_cosimo.pl examples/sync_time.pl INSTALL lib/Device/Gsm.pm lib/Device/Gsm/Charset.pm lib/Device/Gsm/Networks.pm lib/Device/Gsm/Pdu.pm lib/Device/Gsm/Sms.pm 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 t/30networks.t t/31_rt_57585.t t/31_rt_58869.t Device-Gsm-1.60/perltidyrc0000644000175000017500000000225711726073152015045 0ustar cosimocosimo# 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 Device-Gsm-1.60/t/0000755000175000017500000000000011730620353013172 5ustar cosimocosimoDevice-Gsm-1.60/t/30networks.t0000644000175000017500000000077511470300370015402 0ustar cosimocosimo# $Id: 30networks.t,v 1.2 2007-02-28 20:54:32 cosimo Exp $ # test pdu encoding/decoding functions for sms use Test::More; plan tests => 4; use_ok('Device::Gsm::Networks'); is( Device::Gsm::Networks::name('22288'), 'Wind Telecomunicazioni SpA', 'network name decoding works' ); is( Device::Gsm::Networks::name('222 88'), 'Wind Telecomunicazioni SpA', 'network name decoding works' ); is( Device::Gsm::Networks::country('222'), 'Italy', 'country name decoding works' ); Device-Gsm-1.60/t/08storage.t0000644000175000017500000000374411470300370015176 0ustar cosimocosimo# $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 <$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'); } Device-Gsm-1.60/t/06msgcodec.t0000644000175000017500000000421711470300370015310 0ustar cosimocosimo# $Id: 06msgcodec.t,v 1.8 2006-08-12 08:57:19 cosimo Exp $ # # test sim card message encoding/decoding functions # use Test::More; use lib '../lib'; BEGIN { plan tests => 9 }; use_ok('Device::Gsm'); use_ok('Device::Gsm::Sms'); use_ok('Device::Gsm::Pdu'); my @messages = ( [ '+CMGL: 3,3,,36' => '079193235058580011A50A8123988277790000AD1AC33468FE76BF41B19A0B068381E065F9FCED2E8342A110', 'Ci sono 15.000 persone !!!' ], [ '+CMGL: 4,1,,140' => '0791932350591900040CD0ECB4B82C7F033900209021319490008AF3F67C14D381C6E9F09B051ABFDB75777A1CD683C8A079596E4FEB8' ], [ '+CMGL: 2,1,,31' => '0791932350593900040C919323988277190000208082319082000DC170382C168BC3E1B0582C06', 'Aaaabbbaaabbb' ], [ '+CMGL: 1,1,,110' => '059172281991040B917228732143F90000202140311040806846F9BB0D2296EF613619444597E56F3708357DD7E96850D02C4F8FC3A99D8258B6A7C7E5D671DE06D963AE988DA548BBE7F4309B5D2683DE6E1008D59C5ED3EE992CC502C1CB7236C85E73C16036182CA668BEC9BA69B2D82C3AA7' ], # [ '+CMGL: 2,2,,22' => '0791932350585800110000810000AD0FA0D8A61C100C4861F158B6FF2700' => '1abc2' ], [ '+CMGL: 0,0,,00' => '07919471016730510410D06B7658DE7E8BD36C39006070228105118094C8309BFD6681C262D0FC6D7ECBE92071DA0D4A8FD1A0BA9B5E9683DCE57A590E92D6CDEE7ABB5D968356B45CAC16ABD972319A8C360395E5F2727A8C1687E52E90355D66974147B9DF530651DFF239BDEC0635FD6C7659EE5296E97A3A68CD0ECBC7613919242ECFE96536BBEC06D5DDF4B21C74BFDF5D6B7658DE7E8BD36C17B90C', "Hallo, ab sofort bin ich unter neuer Rufnummer +4915156914243 erreichbar. Viele Gr\xFC\xDFe Torsten M\xFCller.Jetzt klarcard bestellen unter www.klarmobil.de" ], # Test for outgoing message decoding [ '+CMGL: 5,3,,35' => '0011FF048160110000AD1CD4F29C0E6A97E7F3F0B90C32BFE52062D99E1E9775BAE3BC0D', 'Test message for Device::Gsm'] ); foreach my $m ( @messages ) { #diag('-' x 72, "\n", "Header: $m->[0]\n", "PDU : $m->[1]\n"); my $msg = new Device::Gsm::Sms( header => $m->[0], pdu => $m->[1] ); #diag('Sender `', $msg->sender(), '\''); #diag('Text `', $msg->text(), '\''); if( $m->[2] ) { is( $m->[2], $msg->text(), 'check of decoded message' ); } else { is( $m->[2], $m->[2], 'missing decoded message text' ); } } Device-Gsm-1.60/t/21pdu_latin1.t0000644000175000017500000000145311726073152015571 0ustar cosimocosimo# test pdu encoding/decoding functions, specifically for CUSD responses from german eplus network use encoding 'latin1'; use Test::More; use Device::Gsm::Pdu; BEGIN { plan tests => 2 }; # PDU without length... my $pdu = 'D37419840E8BCB6E10B92CD797D374D0BA9C7697414F383DFD7683CE65717D8CA6BB40DA7A1B544CBBE5E9319A5E7683CA6977590E7AC2E9E9B71B74DFA3D96537689A2E83C4693ABD0C2297DDA066D9ED87D7DD6B3A485C1FA3CB6E17'; my $plain = 'Sie haben derzeit keine Option gebucht. Zum Einrichten einer Option wählen Sie bitte den Menüpunkt buchen.'; # Test en- and decoding of that message. is( Device::Gsm::Pdu::pdu_to_latin1($pdu) => $plain, "Convert PDU '$pdu' to latin1 text" ); is( Device::Gsm::Pdu::latin1_to_pdu($plain) => $pdu, "Convert latin1 text '$plain' to PDU" ); # end of pdu library test Device-Gsm-1.60/t/01basic.t0000644000175000017500000000031011470300370014566 0ustar cosimocosimo# $Id: 01basic.t,v 1.1 2002-04-03 19:13:35 cosimo Exp $ use Test; BEGIN { plan tests => 2 } END { ok(0) unless $loaded } use Device::Gsm; $loaded = 1; ok(1); my $gsm = Device::Gsm->new(); ok($gsm); Device-Gsm-1.60/t/07tokens.t0000644000175000017500000000204311470300370015023 0ustar cosimocosimo# $Id: 07tokens.t,v 1.2 2007-02-28 21:18:14 cosimo Exp $ # # test new token engine for decoding/encoding sms messages # use Test::More; BEGIN { plan tests => 7 }; use lib '../lib'; use_ok('Device::Gsm'); use_ok('Device::Gsm::Sms'); use_ok('Device::Gsm::Sms::Structure'); use_ok('Device::Gsm::Sms::Token'); #my @messages = ( # [ '+CMGL: 3,3,,36' => '079193235058580011A50A8123988277790000AD1AC33468FE76BF41B19A0B068381E065F9FCED2E8342A110' ], # [ '+CMGL: 4,1,,140' => '0791932350591900040CD0ECB4B82C7F033900209021319490008AF3F67C14D381C6E9F09B051ABFDB75777A1CD683C8A079596E4FEB8' ], # [ '+CMGL: 2,1,,31' => '0791932350593900040C919323988277190000208082319082000DC170382C168BC3E1B0582C06' ] #); my $sca = new Sms::Token 'SCA'; my $msg = '0791932350593900'; my $ok = $sca->decode( \$msg ); ok( $ok ); is( $sca->toString(), '+393205959300' ); # # CPAN Bug #24781 regression test # my $oa = new Sms::Token 'OA'; $oa->set('address', '+3289287791'); $oa->set('type', 91); is($oa->toString(), '+3289287791', 'avoid ++ in sender address (CPAN Bug #24781)'); Device-Gsm-1.60/t/31_rt_58869.t0000644000175000017500000000102411470300370015062 0ustar cosimocosimo# Test decode/encode text7 use strict; use warnings; use utf8; use Test::More; plan tests => 6; use Device::Gsm::Pdu; my @case = ( '1234567', join("", "A".."Z"), join("", "a".."z"), join("", 0..9), join("", map { chr } 0..127), reverse join("", map { chr } 0..127), ); for (@case) { my $text = $_; # Roundtrip test is( $text, Device::Gsm::Pdu::decode_text7( Device::Gsm::Pdu::encode_text7($text) ), 'Round trip text7 conversion of "' . $text . '"' ); } Device-Gsm-1.60/t/31_rt_57585.t0000644000175000017500000000131011726073152015063 0ustar cosimocosimo# $Id: 20pdu.t,v 1.8 2007-02-28 21:18:14 cosimo Exp $ # test pdu encoding/decoding functions for sms use Test::More; use Device::Gsm::Pdu; BEGIN { plan tests => 5 }; # Test decoding unicode strings is( Device::Gsm::Pdu::decode_text_UCS2('020041'), "A"); #1 U+0061 a 61 LATIN SMALL LETTER A is( Device::Gsm::Pdu::decode_text_UCS2('020061'), "\x61"); #2 U+00C0 À c3 80 LATIN CAPITAL LETTER A WITH GRAVE is( Device::Gsm::Pdu::decode_text_UCS2('0200C0'), "\xC3\x80"); #3 U+0160 Å  c5 a0 LATIN CAPITAL LETTER S WITH CARON is( Device::Gsm::Pdu::decode_text_UCS2('020160'), "\xC5\xA0"); #4 U+0202 È‚ c8 82 LATIN CAPITAL LETTER A WITH INVERTED BREVE is( Device::Gsm::Pdu::decode_text_UCS2('020202'), "\xC8\x82"); Device-Gsm-1.60/t/30gsmascii.t0000644000175000017500000000172011470300370015314 0ustar cosimocosimo# $Id: 30gsmascii.t,v 1.3 2004-09-15 21:02:40 cosimo Exp $ # test gsm <=> ascii charset conversions use Test::More; use lib '../blib/lib'; use Device::Gsm::Charset; BEGIN { plan tests => 255 }; ok(1, 'loaded'); my @a1 = map {chr} 0 .. 255; foreach my $c (@a1) { # I can't seem to resolve these tests next if $c eq chr(140) || $c eq chr(141); # "Replaced" chars that don't exist in GSM charset must be # passed one-time first before conversion-reconversion phase my $cx = $Device::Gsm::Charset::ISO8859_TO_GSM0338[ord($c)]; if( $cx < 0 || $cx == Device::Gsm::Charset::NPC7 ) { $c = Device::Gsm::Charset::gsm0338_to_iso8859( Device::Gsm::Charset::iso8859_to_gsm0338($c) ); } # Check conversion correctness is( $c, Device::Gsm::Charset::gsm0338_to_iso8859( Device::Gsm::Charset::iso8859_to_gsm0338($c) ), 'conversion of char `'.$c.'\'' ); } # end of test Device-Gsm-1.60/t/05messages.t0000644000175000017500000000323311470300370015327 0ustar cosimocosimo# $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 < $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(); } Device-Gsm-1.60/t/02info.t0000644000175000017500000000421211470300370014446 0ustar cosimocosimo# $Id: 02info.t,v 1.2 2002-09-25 22:08:06 cosimo Exp $ # # test connection with a gsm device on serial port # use Test; BEGIN { plan tests => 10 }; 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'} || ''; if( $port eq '' ) { print STDERR < $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) ); # # Informational messages/commands # my @info = ( $gsm->manufacturer()||'', $gsm->model()||'', $gsm->software_version()||'', $gsm->imei()||'' # no spy-ware installed here :-) ); print 'manufacturer is [', $info[0], ']', "\n"; print 'device model is [', $info[1], ']', "\n"; print 'software ver is [', $info[2], ']', "\n"; print 'imei code is [', $info[3], ']', "\n"; ok( $info[0] ne 'ERROR' ); ok( $info[1] ne 'ERROR' ); ok( $info[2] ne 'ERROR' ); ok( $info[3] ne 'ERROR' ); ok( $info[3] eq $gsm->serial_number ); # # Service-center # ok( $gsm->service_center() ); # # GSM network registration # if( $pin ne '' ) { ok( $gsm->register() ); } else { skip( 'Set your SIM PIN as "DEV_GSM_PIN" environment variable to enable!', 10); } Device-Gsm-1.60/t/20pdu.t0000644000175000017500000000414011726073152014314 0ustar cosimocosimo# $Id: 20pdu.t,v 1.8 2007-02-28 21:18:14 cosimo Exp $ # test pdu encoding/decoding functions for sms use Test::More; use Device::Gsm::Pdu; BEGIN { plan tests => 17 }; # Test encoding mobile numbers is( Device::Gsm::Pdu::encode_address('3289287791'), '0A812398827719' ); #1 is( Device::Gsm::Pdu::encode_address('+393289287791'), '0C91932398827719' ); #2 is( Device::Gsm::Pdu::encode_address('347101010'), '098143171010F0' ); #3 is( Device::Gsm::Pdu::encode_address('+39347101010'), '0B919343171010F0' ); #4 # Address decoding is( Device::Gsm::Pdu::decode_address('0A812398827719'), '3289287791' ); is( Device::Gsm::Pdu::decode_address('0A811234567890'), '2143658709' ); #5 is( Device::Gsm::Pdu::decode_address('0C91731234567890'), '+372143658709' ); #6 is( Device::Gsm::Pdu::decode_address('0D91941234567890F1'), '+4921436587091' ); #7 # Test encoding some text (no test with international chars) is( Device::Gsm::Pdu::encode_text7( 'hellohello' ), '0AE8329BFD4697D9EC37' ); #8 is( Device::Gsm::Pdu::encode_text7( 'The quick fox jumps over the lazy dog' ), '2554741914AFA7C76B90F98D07A9EB6DF81CF4B697E5203ABA0C6287F57910F97D06' ); #9 # Decoding the same text (no test with international chars) is( Device::Gsm::Pdu::decode_text7( '0AE8329BFD4697D9EC37' ), 'hellohello' ); #10 is( Device::Gsm::Pdu::decode_text7( '2554741914AFA7C76B90F98D07A9EB6DF81CF4B697E5203ABA0C6287F57910F97D06'), 'The quick fox jumps over the lazy dog' ); #12 # Self-test on longer strings is( Device::Gsm::Pdu::decode_text7( Device::Gsm::Pdu::encode_text7($_) ), $_ ) for( 'hellohello', 'The quick brown fox jumps over the lazy dog', 'La marianna la va in campagna, quando il sole tramontera\'... chissa\' quando, chissa\' quando ritornera\'' ); # Alphabetical address decoding is( Device::Gsm::Pdu::decode_address('10D06B7658DE7E8BD36C'), "klarmobil\0" ); #7 # CPAN Bug #24781 regression test my $enc = Device::Gsm::Pdu::encode_address('+393289287791'); my $dec = Device::Gsm::Pdu::decode_address($enc); is($dec, '+393289287791', 'intl address without ++ (CPAN Bug #24781)'); # end of pdu library test Device-Gsm-1.60/examples/0000755000175000017500000000000011730620353014545 5ustar cosimocosimoDevice-Gsm-1.60/examples/sync_time.pl0000644000175000017500000000207211470300370017070 0ustar cosimocosimo#!/usr/bin/perl # # Short example of use for Device::Gsm class # Get date and time from phone # # $Id: sync_time.pl,v 1.2 2003-12-15 22:50:12 cosimo Exp $ use strict; use lib 'blib/arch'; use lib 'blib'; use Device::Gsm; print "\nthis is ", '$Id: sync_time.pl,v 1.2 2003-12-15 22:50:12 cosimo Exp $', "\n"; print "This script tries to set phone date/time to that of your PC clock\n"; my $gsm = conn(); print "\nok! connected to gsm phone.\n"; print "Setting phone date/time to [".localtime()."]...\n"; if( my $time = $gsm->datetime(localtime) ) { print "Time of phone set correctly to $time!\n"; } else { print "Failed to set time!\n"; } # End sub conn { my $port = $^O =~ /Win/ ? 'COM2' : '/dev/ttyS1'; my $myport; print "Select your serial port [$port] : "; chomp( $myport = ); $myport ||= $port; my $gsm = new Device::Gsm( port => $myport, log => 'file,sync_time.log', loglevel=>'info' ); die "cannot create Device::Gsm object!" unless $gsm; $gsm->connect( baudrate => 19200 ) or die "cannot connect to GSM device on [$myport]\n"; return $gsm; } Device-Gsm-1.60/examples/get_time.pl0000644000175000017500000000175511470300370016702 0ustar cosimocosimo#!/usr/bin/perl # # Short example of use for Device::Gsm class # Get date and time from phone # # $Id: get_time.pl,v 1.1 2003-12-15 22:49:44 cosimo Exp $ use strict; use lib 'blib/arch'; use lib 'blib'; use Device::Gsm; print "\nthis is ", '$Id: get_time.pl,v 1.1 2003-12-15 22:49:44 cosimo Exp $', "\n"; print "This script tries to get your gsm date/time\n"; my $gsm = conn(); print "\nok! connected to gsm phone.\n"; if( my $time = $gsm->datetime() ) { print "Time of phone should be now $time (yy/mm/dd hh:mn:ss)\n"; } else { print "Failed to get time!\n"; } # End sub conn { my $port = $^O =~ /Win/ ? 'COM2' : '/dev/ttyS1'; my $myport; print "Select your serial port [$port] : "; chomp( $myport = ); $myport ||= $port; my $gsm = new Device::Gsm( port => $myport, log => 'file,get_time.log', loglevel=>'info' ); die "cannot create Device::Gsm object!" unless $gsm; $gsm->connect( baudrate => 19200 ) or die "cannot connect to GSM device on [$myport]\n"; return $gsm; } Device-Gsm-1.60/examples/read_messages.pl0000644000175000017500000000367011470300370017705 0ustar cosimocosimo#!/usr/bin/perl # # Short example of use for Device::Gsm class # Script that reads all SMS stored on SIM # # $Id: read_messages.pl,v 1.5 2006-04-20 20:05:45 cosimo Exp $ use strict; use lib '../lib'; use lib '../'; use Gsm; print "\nthis is ", '$Id: read_messages.pl,v 1.5 2006-04-20 20:05:45 cosimo Exp $', "\n"; print "\nTrying to read all messages you have on your SIM card...\n"; my $port = $ENV{'DEV_GSM_PORT'} || ( $^O =~ /Win/ ? 'COM2' : '/dev/ttyS1' ); my $myport; my $pin = $ENV{'DEV_GSM_PIN'} || '0000'; my $mypin; unless( $port ) { print "Select your serial port [$port] : "; chomp( $myport = ); } $myport ||= $port; unless( $pin ) { print "Insert your PIN number if you need to register to GSM network [$pin] : "; chomp( $mypin = ); $mypin =~ s/\D//g; $mypin = substr( $mypin, 0, 4 ); } $mypin ||= $pin; my $gsm = new Device::Gsm( port => $myport, log => 'file,messages.log', loglevel => 'debug' ); die "cannot create Device::Gsm object!" unless $gsm; my $baud = $ENV{'DEV_GSM_BAUD'} || 9600; print "Connecting on $myport port at $baud baud ..."; $gsm->connect( baudrate => $baud ) or die "cannot connect to GSM device on [$myport]\n"; print " ok\n"; print "Registering on GSM network..."; $gsm->register() or die "cannot register on GSM network: check pin and/or network signal!"; print " ok\n"; print "Connected and registered to network.\n"; my @msg = $gsm->messages(); my $lOk = scalar @msg; if( $lOk ) { print "You have messages!\n" ; my $n = 0; foreach( @msg ) { my $sms = $_; next unless defined $sms; print '-' x 60, "\n", "MESSAGE N. $n\n"; print 'Type ',($sms->type() eq Device::Gsm::Sms::SMS_SUBMIT ? 'SUBMIT' : 'DELIVER'), "\n"; print 'Status ', $sms->status(), "\n"; print 'From ', $sms->sender(), "\n"; print 'To ', $sms->recipient(), "\n"; print 'Text [', $sms->text(), "]\n"; $n++; ; } } else { print "No message on SIM, or error during read!\n"; } Device-Gsm-1.60/examples/send_sms.pl0000644000175000017500000000365011470300370016714 0ustar cosimocosimo#!/usr/bin/perl # # Short example of use for Device::Gsm class # # $Id: send_sms.pl,v 1.2 2002-04-29 17:03:46 cosimo Exp $ use strict; use Device::Gsm; print "\nthis is ", '$Id: send_sms.pl,v 1.2 2002-04-29 17:03:46 cosimo Exp $', "\n"; print "I hope I can send an SMS on your GSM phone attached to...\n"; my $port = $^O =~ /Win/ ? 'COM2' : '/dev/ttyS1'; my $myport; my $pin = '0000'; my $mypin; print "Select your serial port [$port] : "; chomp( $myport = ); $myport ||= $port; print "Insert your PIN number if you need to register to GSM network [$pin] : "; chomp( $mypin = ); $mypin ||= $pin; $mypin =~ s/\D//g; $mypin = substr( $mypin, 0, 4 ); my $gsm = new Device::Gsm( port => $myport, pin => $mypin, log => 'file,send.log' ); die "cannot create Device::Gsm object!" unless $gsm; # # 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 | # | Digicom | 9600 | # | Nokia Communicator | 9600 | # `---------------------------------' # $gsm->connect( baudrate => 9600 ) or die "cannot connect to GSM device on [$myport]\n"; $gsm->register() or die "cannot register on GSM network: check pin and/or network signal!"; print "\nok! connected and registered to network.\n"; my $number; do { print "\nRecipient number (ex.: +490320201020 or 0320201020): "; chomp( $number = ); } until $number; my $content; do { print "\nSMS Text (max 160 chars):\n"; chomp( $content = ); } until $content; $content = substr( $content, 0, 160 ); my $lOk = $gsm->send_sms( content => $content, recipient => $number, class => 'normal' # try `flash' ); if( $lOk ) { print "SMS sent!\n" ; } else { print "Error in sending!\n"; } Device-Gsm-1.60/examples/send_to_cosimo.pl0000644000175000017500000000410111470300370020075 0ustar cosimocosimo#!/usr/bin/perl # # This example sends an SMS to cosimo@cpan.org, the author # of Device::Gsm module. # # This is a funny experiment to know how many people are # using this module out there... :-) # # $Id: send_to_cosimo.pl,v 1.5 2006-05-01 11:56:54 cosimo Exp $ use strict; use Config; use Device::Gsm; print "\nthis is ", '$Id: send_to_cosimo.pl,v 1.5 2006-05-01 11:56:54 cosimo Exp $', "\n\n"; print "\n", '-' x 80, "\n"; print "HEY! I'm sending out an SMS message to the author of Device::Gsm module\n"; print "(Cosimo Streppone ).\n\n"; my $port = $^O =~ /Win/ ? 'COM1' : '/dev/ttyS0'; my $myport; my $pin = '0000'; my $mypin; print "Select your serial port [$port] : "; chomp( $myport = ); $myport ||= $port; print "Insert your PIN number if you need to register to GSM network [$pin] : "; chomp( $mypin = ); $mypin ||= $pin; $mypin =~ s/\D//g; $mypin = substr( $mypin, 0, 4 ); my $gsm = new Device::Gsm( port => $myport, pin => $mypin, log => 'file,send.log' ); die "cannot create Device::Gsm object!" unless $gsm; $gsm->connect( baudrate => 9600 ) or die "cannot connect to GSM device on [$myport]\n"; $gsm->register() or die "cannot register on GSM network: check pin and/or network signal!"; print "\nOk, now ready to send.\n"; print "Your name? "; my $name = ; chomp $name; print "Insert your comment for me...: "; my $comment = ; chomp $comment; # # My GSM phone number # my $number = '+4745016680'; my $content = 'From '.$name.";\n". 'Dev-Gsm v'.$Device::Gsm::VERSION.','."\n". 'Dev-Modem v'.$Device::Modem::VERSION.','."\n". 'on '.$Config{myarchname}.' perl v'.$]."\n". 'Mod:' . ($gsm->manufacturer() || '').'/'.($gsm->model() || ''). ' Ver:'. ($gsm->software_version()||''). "\n" . "-- ".$comment; $content = substr( $content, 0, 160 ); print "Text of the message being sent (max 160 chars)...:\n", $content, "\n"; my $lOk = $gsm->send_sms( content => $content, recipient => $number, class => 'normal' ); if( $lOk ) { print "\nThank you for your kind intentions!\n"; } else { print "\nError in sending!\n"; } Device-Gsm-1.60/examples/network.pl0000644000175000017500000000134411470300370016570 0ustar cosimocosimo#!/usr/bin/perl # # Get GSM network name # # $Id: network.pl,v 1.1 2006-12-19 21:04:52 cosimo Exp $ use strict; use Device::Gsm; my $port = $ENV{DEV_GSM_PORT} or die "Set DEV_GSM_PORT environment variable!"; my $gsm = new Device::Gsm( port => $port, log => 'file,network.log', loglevel => 'info' ); die "cannot create Device::Gsm object!" unless $gsm; $gsm->connect( baudrate => ($ENV{DEV_GSM_BAUD} || 19200) ) or die "cannot connect to GSM device on [$port]\n"; $gsm->register() or die "Can't register to network"; my($network, $code) = $gsm->network(); if($network || $code) { print "Network name the gsm software returns is [$network]\n"; print "Its gsm code is [$code]\n"; } else { print "No network name...\n"; } Device-Gsm-1.60/examples/delete_message.pl0000644000175000017500000000364011470300370020046 0ustar cosimocosimo#!/usr/bin/perl # # Short example of use for Device::Gsm class # Script that deletes permanently one message from sim # # $Id: delete_message.pl,v 1.3 2006-04-20 20:06:15 cosimo Exp $ use strict; use lib '../lib'; use lib '../'; use Gsm; print "\nthis is ", '$Id: delete_message.pl,v 1.3 2006-04-20 20:06:15 cosimo Exp $', "\n"; print "\nDeletes one sms message from your sim card...\n"; my $port = $ENV{'DEV_GSM_PORT'} || ( $^O =~ /Win/ ? 'COM2' : '/dev/ttyS1' ); my $myport; my $pin = $ENV{'DEV_GSM_PIN'} || '0000'; my $mypin; my $baud = $ENV{'DEV_GSM_BAUD'} || 19200; unless( $port ) { print "Select your serial port [$port] : "; chomp( $myport = ); } $myport ||= $port; unless( $pin ) { print "Insert your PIN number if you need to register to GSM network [$pin] : "; chomp( $mypin = ); $mypin =~ s/\D//g; $mypin = substr( $mypin, 0, 4 ); } $mypin ||= $pin; my $gsm = new Device::Gsm( port => $myport, log => 'file,messages.log', loglevel => 'info' ); die "cannot create Device::Gsm object!" unless $gsm; print "Connecting on $myport port..."; $gsm->connect( baudrate => $baud ) or die "cannot connect to GSM device on [$myport]\n"; print " ok\n"; print "Registering on GSM network..."; $gsm->register() or die "cannot register on GSM network: check pin and/or network signal!"; print " ok\n"; print "Connected and registered to network.\n"; my @msg = $gsm->messages(); my $lOk = scalar @msg; if( $lOk ) { print "You have ", $lOk, " messages!\n" ; my $idx = -1; do { print "Insert number to be deleted (1-".(scalar(@msg))."): "; $idx = ; chomp $idx; $idx -= 0; } while ($idx <= 0 || $idx > @msg); print "Ok, going to delete message [$idx]\n"; if( $gsm->delete_sms($idx) ) { print "Deleted!\n"; } else { print "Error in deletion, Sorry\n"; } } else { print "No message on SIM, or error during read!\n"; } Device-Gsm-1.60/examples/report_signal.pl0000644000175000017500000000172211470300370017747 0ustar cosimocosimo#!/usr/bin/perl # # Short example of use for Device::Gsm class # Report signal quality of mobile phone line # # $Id: report_signal.pl,v 1.2 2004-03-15 21:43:22 cosimo Exp $ use strict; use Device::Gsm; print "\nthis is ", '$Id: report_signal.pl,v 1.2 2004-03-15 21:43:22 cosimo Exp $', "\n"; print "\nGetting signal quality of your mobile phone line...\n\n"; my $port = $ENV{DEV_GSM_PORT} || ($^O =~ /Win/ ? 'COM2' : '/dev/ttyS1'); my $myport; print "Select your serial port [$port] : "; chomp( $myport = ); $myport ||= $port; my $gsm = new Device::Gsm( port => $myport, log => 'file,signal.log' ); die "cannot create Device::Gsm object!" unless $gsm; $gsm->connect( baudrate => ($ENV{DEV_GSM_BAUD} || 19200) ) or die "cannot connect to GSM device on [$myport]\n"; print "\nok! connected to gsm phone.\n"; my $dBm = $gsm->signal_quality(); if( $dBm ) { print "Signal quality reading: $dBm dBm\n"; } else { print "Could not read signal quality!\n"; } Device-Gsm-1.60/docs/0000755000175000017500000000000011730620353013657 5ustar cosimocosimoDevice-Gsm-1.60/docs/gsm0338.txt0000644000175000017500000002212611470300370015522 0ustar cosimocosimo# # 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 , # Kent Karlsson , # Markus Kuhn # # 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: # # # Any comments or problems, contact # Please note that 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 Device-Gsm-1.60/MANIFEST.SKIP0000644000175000017500000000007011727632377014641 0ustar cosimocosimo^\. ^CVS ^\.svn ^\.git ^pod2 ^makedoc\.sh ^contrib blib Device-Gsm-1.60/Changes0000644000175000017500000001716311730620230014224 0ustar cosimocosimoRevision 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. 1.57 Mon Mar 7 20:53:03 EST 2011 - Fixed a bug in send_sms() that prevented it from working at all. The bug was introduced with the "assume_registered" option. - Fixed RT #57585. Thanks to Eric Kössldorfer for his patch and test case. - Added PDU<->latin1 conversion functions in Device::Gsm::Pdu - Note to self: first release from Australia! 1.56 Mon Nov 15 21:00:00 CET 2010 - When sending messages in text mode, now we wait a bit between the +CMSG command and the actual text. Fixes RT #61729. Thanks to Boris Ivanov for the report. - Added clear example of logging to a custom file - Added a warning for not implemented _read_messages_text() - Added a "assume_registered" option to skip GSM network registration on buggy/problematic devices. 1.55 Sun Jun 27 18:07:11 CEST 2010 - Fixed RT #58869, incorrect decoding of text7 messages. Thanks to Alexander Onokhov. 1.54 Sun Sep 6 10:44:53 CEST 2009 - Fixed RT #31565, incorrect decoding of outgoing messages due to incorrect removal of zero-length octet in PDU. Thanks to Svami Dhyan Nataraj. 1.53 Fri Aug 14 21:43:37 CEST 2009 - Fixed RT #48700, deleting SMS message with index 0 didn't work. Thanks to Vytas M. for reporting the bug. 1.52 Tue Nov 25 21:24:00 CET 2008 - Added a longer timeout on call forwarding. Thanks to Marek Jaros. 1.51 Wed Oct 29 22:32:00 CET 2008 - Added new method to set/reset call forwarding options (patch contributed by Attila Nagy: thanks!) - Removed the syslog test script (t/04syslog.t). It continuously broke tests on Solaris and basically every other setups where you are not installing as privileged user. 1.50 Tue Sep 30 22:50:00 CEST 2008 - Sometimes send_sms() could report success but no sms has really been sent, and we receive garbage. First attempt at a fix for this. Reported by Marek Jaros. 1.49 Sat Aug 9 15:12:00 CEST 2008 - Modified manufacturer() to work also with some Motorola phones, that report AT+CGMI in a slightly different way. - Changed my phone number :) 1.48 Wed Feb 28 21:55:23 CET 2007 - Fixed CPAN bug #24781, thanks to torsten at archesoft dot de for reporting. 1.47 Tue Feb 13 11:31:24 CET 2007 - Fixed t/30networks.t test script. 1.46 Tue Dec 19 22:05:31 CET 2006 - Fixed CPAN RT wishlist #23575. Again thanks to Troels for his ideas. 1.45 Tue Oct 17 18:01:43 CEST 2006 - Fixed CPAN RT bugs #21991, #21992, #22025. Thanks to Troels Jensen for accurate reporting and patch suggestions. 1.44 Wed Aug 16 08:25:50 CEST 2006 - Fixed decoding of alphabetical sender addresses. - Added correct decoding of UCS languages (Russian for example). Thanks to Nikolay Shaplov for the bug report + patch. 1.43 Sun Jul 23 17:40:15 CEST 2006 - Added ability to decode alphabetical sender addresses. Thanks to Torsten Mueller for report the issue. 1.42 Mon May 8 21:16:40 CEST 2006 - Fixed a bug in Device::Gsm::Sms delete() method that invoked a non-existent Device::Gsm::deleteMessage(). - Implemented read and delete of sms messages from different storages (ME, SM, ...). Only for PDU format. Thanks to Jurij Sikorsky for the patch. 1.41 Thu Apr 20 21:52:19 CEST 2006 - === Now Device::Gsm 1.39+ requires at least Device::Modem v1.47 === Check out on CPAN before upgrading. - Some cool fixes for better support of Iridium Satellite phones, GPRS connections and command/response faster cycle. Many thanks to Ed Wildgoose. 1.37 Sat Aug 27 12:53:00 CEST 2005 - fixed regexp to extract sim card sms messages information (thanks to Pierre Hilson ) 1.36 1.35 Wed Sep 15 23:43:03 CEST 2004 - finally added encoding/decoding of sms text between 8 bit ASCII (ISO-8859) and 7 bit GSM 03.38 (thanks to Stefano Pisani for his feedback) 1.34 Wed Aug 18 09:10:48 CEST 2004 - fixed delete_sms() command syntax and results parsing. Thanks to all users that reported problems. - added an example script on how to delete sms messages. 1.33 Wed May 26 13:52:43 CEST 2004 - added delete_sms() method. For now, works only in PDU mode. - fixed messages() newline regex split pattern - modified send sms in text mode to cope with slower/older devices - modified message read method to set pdu mode before executing 1.28 || 1.25 Fri Jan 23 00:59:16 CET 2004 - further documentation, troubleshooting and autoscan utility sections - added all new pdu sms token-oriented decoding classes (this is an 80% complete implementation, mostly regarding charset conversion issues) - Device::Gsm::Sms public class is now documented properly 1.24 || 1.20 Wed Jan 21 23:32:45 CET 2004 - completed full documentation (to be revised) - documented working irda/bluetooth connections (always through device::serialport :-) 1.19 1.18 Mon Mar 24 23:32:27 CET 2003 - added a complete interface to read messages on SIM card ( $gsm->messages() method and Device::Gsm::Sms objects ) - some minor cleanup 1.17 Thu Sep 12 00:22:06 CEST 2002 - added signal_quality() method to measure gsm signal power (dBm) - added an example script in [examples] folder (`report_signal.pl') 1.15 1.16 Tue Sep 3 23:37:56 CEST 2002 - fixed documentation example (thanks to Domenico Viggiani) - added `examples/send_to_cosimo.pl' script to report successful installations of Device::Gsm module :-) - improved test scripts; now work also with env vars, and without too many `connect()'s 1.14 Mon Apr 29 18:54:36 CEST 2002 - fixed errors in debugging - fixed errors in AT command response handling (still to-do) - included network registration test (must supply PIN in t/30register.t) - added send_sms.pl in examples/ 1.10 Wed Apr 10 00:20:28 CEST 2002 - fixed and renamed Pdu.pm functions - send_sms() new parameters that dispatch calls to _send_sms_pdu() and _send_sms_text() to allow text and PDU modes - send_sms() now works! (with siemens C25/35/45) 1.09 Tue Apr 9 00:19:02 CEST 2002 - Pdu.pm added with functions to treat PDU encoded data - added _send_sms_pdu() internal method 1.08 Sat Apr 6 00:24:29 CEST 2002 - hangup() method - imei() / serial_number() method with test case 1.07 Wed Apr 3 23:38:51 CEST 2002 - removed unnecessary javadoc style tags - made use of new parse_answer() call - now service_center() works - device identification functions now work - improved test suite - fixed logging class mechanism 1.06 Sat Mar 30 16:43:55 CET 2002 - added manufacturer(), model(), software_version() methods to get information about the device - added test_command() to test support for a specific GSM command 1.05 Sat Mar 30 15:12:09 CET 2002 - added service_number() method 1.04 Mon Mar 25 07:34:52 CET 2002 - added pod, html, text docs 0.01 Tue Feb 26 22:15:31 CET 2002 - original version; created by h2xs 1.20 with options -A -X -n Device::Gsm -v 0.01 Device-Gsm-1.60/lib/0000755000175000017500000000000011730620353013475 5ustar cosimocosimoDevice-Gsm-1.60/lib/Device/0000755000175000017500000000000011730620353014674 5ustar cosimocosimoDevice-Gsm-1.60/lib/Device/Gsm/0000755000175000017500000000000011730620353015422 5ustar cosimocosimoDevice-Gsm-1.60/lib/Device/Gsm/Networks.pm0000644000175000017500000002520411726073525017607 0ustar cosimocosimopackage 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', ); 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', ); sub name { my $number = $_[0]; $number =~ s/\D//; return exists $NETWORKS{$number} ? $NETWORKS{$number} : 'unknown'; } sub country { my $number = $_[0]; $number =~ s/\D//; return exists $COUNTRIES{$number} ? $COUNTRIES{$number} : 'unknown'; } 1; # # End of module Device-Gsm-1.60/lib/Device/Gsm/Charset.pm0000644000175000017500000010042411726073535017363 0ustar cosimocosimo# Device::Gsm::Charset - GSM0338 <=> ASCII charset conversion module # Copyright (C) 2004-2009 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 details. # # $Id$ package Device::Gsm::Charset; $VERSION = substr q$Revision$, 0, 10; use strict; use constant NPC7 => 0x3F; use constant NPC8 => 0x3F; use constant ESCAPE => 0x1B; # The following is the GSM 3.38 standard charset, as shown # on some Siemens documentation found on the internet #my $gsm_charset = join('', # '@»$»»»»»»»'."\n".'»»'."\r".'»»»', # 16 # '»»»»»»»»»»»»ß»»', # ' !"# %&‘()*+,-./', # '0123456789:;<=>?', # '-ABCDEFGHIJKLMNO', # 'PQRSTUVWXYZÄֻܻ', # '¨abcdefghijklmno', # 'pqrstuvwxyzäö»ü»' #); # # These conversion tables are taken from pduconv 0.1 library # by Mats Engstrom . See also: # http://freshmeat.net/projects/pduconv # # Un grazie a Stefano! # @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 */ ); #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 */ ); sub iso8859_to_gsm0338 { my $ascii = shift; return '' if !defined $ascii || $ascii eq ''; 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]; # Is this a "replaced" char? if ($ch_gsm <= 0xFF) { $ch_gsm = abs($ch_gsm); } 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; } sub gsm0338_to_iso8859 { my $gsm = shift; return '' if !defined $gsm || $gsm eq ''; my $ascii = ''; my $n = 0; for (; $n < length($gsm); $n++) { 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) { $ascii .= chr(12); } elsif ($c == 0x14) { $ascii .= '^'; } elsif ($c == 0x28) { $ascii .= '{'; } elsif ($c == 0x29) { $ascii .= '}'; } elsif ($c == 0x2F) { $ascii .= '\\'; } elsif ($c == 0x3C) { $ascii .= '['; } elsif ($c == 0x3D) { $ascii .= '~'; } 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 } else { $ascii .= chr(NPC8); # Non printable } } else { # Standard GSM 3.38 encoding $ascii .= chr($Device::Gsm::Charset::GSM0338_TO_ISO8859[$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; } 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__ Device-Gsm-1.60/lib/Device/Gsm/Sms/0000755000175000017500000000000011730620353016164 5ustar cosimocosimoDevice-Gsm-1.60/lib/Device/Gsm/Sms/Token.pm0000644000175000017500000000637611726073605017625 0ustar cosimocosimo# Device::Gsm::Sms::Token - SMS PDU message parser token # Copyright (C) 2002-2006 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 details. # # Commercial support is available. Write me if you are # interested in new features or software support. # # $Id$ package Sms::Token; use strict; use integer; use Carp 'croak'; # Token possible states use constant ERROR => 0; use constant ENCODED => 1; 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; } # # Get/set internal token data # sub 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; } # Must be implemented in real token sub encode { croak('encode() not implemented in token base class'); return 0; } sub get { my ($self, $info) = @_; return undef unless $info; return $self->{"_$info"}; } # XXX This must be filled by the higher level object that # treats the entire message in tokens # # [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'}; } } sub 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; } sub 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; } 1; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/0000755000175000017500000000000011730620353017244 5ustar cosimocosimoDevice-Gsm-1.60/lib/Device/Gsm/Sms/Token/DCS.pm0000644000175000017500000000246511726073656020237 0ustar cosimocosimo# Sms::Token::DCS - SMS DCS (data coding scheme) token # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::DCS; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::DCS::ISA = ('Sms::Token'); # 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(hex substr($$rMessage, 0, 2)); $self->state(Sms::Token::DECODED); # Remove DCS 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/DT.pm0000644000175000017500000000412111726073656020124 0ustar cosimocosimo# Sms::Token::DT - SMS TP-DT token (Discharge-Time of , # 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/UDH.pm0000644000175000017500000001035111726073660020232 0ustar cosimocosimo# 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/SCTS.pm0000644000175000017500000000367411726073660020400 0ustar cosimocosimo# Sms::Token::SCTS - SMS SCTS token (Service Center Time Stamp) # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::SCTS; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::SCTS::ISA = ('Sms::Token'); # takes (scalar message (string) reference) # returns success/failure of decoding # if all ok, removes SCTS 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 SCTS 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/OA.pm0000644000175000017500000000355311726073657020125 0ustar cosimocosimo# Sms::Token::OA - SMS OA (originating address) token # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::OA; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::OA::ISA = ('Sms::Token'); # takes (scalar message (string) reference) # returns success/failure of decoding # if all ok, removes OA from message sub decode { my ($self, $rMessage) = @_; my $ok = 0; # 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); # Number of octets to remove from message my $oa_octets = (($oa_len + 1) >> 1) << 1; # Get address my $addr = Device::Gsm::Pdu::decode_address( 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); # Remove OA from message $$rMessage = substr($$rMessage, 4 + $oa_octets); return 1; } # # [token]->encode( [$data] ) # # encodes originating address (OA) # sub encode { my $self = shift; my $oa_len = $self->get('length'); # XXX TO BE COMPLETED... return $oa_len; } sub toString { my $self = shift; my $str = $self->get('address'); # Prepend + to number if international if ($str !~ /^\s*\+/ && $self->get('type') eq '91') { $str = '+' . $str; } return $str; } 1; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/PID.pm0000644000175000017500000000246311726073657020241 0ustar cosimocosimo# Sms::Token::PID - SMS PID (protocol identifier) token # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::PID; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::PID::ISA = ('Sms::Token'); # takes (scalar message (string) reference) # 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); $self->state(Sms::Token::DECODED); # Remove PID 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/SCA.pm0000644000175000017500000000666211726073657020240 0ustar cosimocosimo# Sms::Token::SCA - SMS SCA token (service center address) # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::SCA; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::SCA::ISA = ('Sms::Token'); # takes (scalar message (string) reference) # 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; } # # [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(); } # Begin encoding as SCA $data =~ s/\s+//g; my $type = index($data, '+') == 0 ? 91 : 81; # Remove all non-numbers $data =~ s/\D//g; my $len = unpack 'H2' => chr(length $data); $data .= 'F'; my @digit = split // => $data; my $encoded; while (@digit > 1) { $encoded .= join '', reverse splice @digit, 0, 2; } $data = uc $len . $type . $encoded; $self->data($data); $self->set('length' => $len); $self->set('type' => $type); $self->state(Sms::Token::ENCODED); return $data; } 1; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/UD.pm0000644000175000017500000000446211726073661020131 0ustar cosimocosimo# 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. # # 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::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; } # # [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; my $padding = shift; #my $ud_len = $self->get('length'); my $text = $self->get('text'); return Device::Gsm::Pdu::encode_text7($text); } 1; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/ST.pm0000644000175000017500000001060411726073660020141 0ustar cosimocosimo# 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/VP.pm0000644000175000017500000000354511726073661020147 0ustar cosimocosimo# Sms::Token::VP - SMS VP (validity period) token # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::VP; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::VP::ISA = ('Sms::Token'); # 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; my $vpf = $self->messageTokens('PDUTYPE')->VPF(); # Check if VP flag is present if ($vpf & 0x02) { 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'; } $self->set('validity_period' => $vp); $self->data($vp); # Remove VP from message $$rMessage = substr($$rMessage, 2); } $self->state(Sms::Token::DECODED); 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/DA.pm0000644000175000017500000000113211726073656020100 0ustar cosimocosimo# Sms::Token::DA - SMS DA (destination address) token # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::DA; use integer; use strict; use Device::Gsm::Sms::Token::OA; @Sms::Token::DA::ISA = ('Sms::Token::OA'); 1; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/MR.pm0000644000175000017500000000246011726073656020137 0ustar cosimocosimo# Sms::Token::MR - SMS MR (data coding scheme) token # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::MR; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::MR::ISA = ('Sms::Token'); # 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(hex substr($$rMessage, 0, 2)); $self->state(Sms::Token::DECODED); # Remove MR 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; Device-Gsm-1.60/lib/Device/Gsm/Sms/Token/PDUTYPE.pm0000644000175000017500000000532111726073657020753 0ustar cosimocosimo# Sms::Token::PDUTYPE - SMS PDU TYPE token (type of message) # Copyright (C) 2002-2006 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 details. # # $Id$ package Sms::Token::PDUTYPE; use integer; use strict; use Device::Gsm::Sms::Token; @Sms::Token::PDUTYPE::ISA = ('Sms::Token'); # takes (scalar message (string) reference) # 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; } # # [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(); } return $data; } #-------------------------------------------- # Bit component flags 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 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 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 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; } 1; Device-Gsm-1.60/lib/Device/Gsm/Sms/Structure.pm0000644000175000017500000000257011726073624020536 0ustar cosimocosimo# 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. # # 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 Device::Gsm::Sms; use strict; use integer; use Device::Gsm::Sms; 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; } 1; Device-Gsm-1.60/lib/Device/Gsm/Sms.pm0000644000175000017500000004200511726073445016534 0ustar cosimocosimo# 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. # # 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. # # Commercial support is available. Write me if you are # interested in new features or software support. # # $Id$ package Device::Gsm::Sms; use strict; use integer; use constant SMS_DELIVER => 0x00; use constant SMS_SUBMIT => 0x01; use constant SMS_STATUS => 0x02; use Device::Gsm::Pdu; use Device::Gsm::Sms::Structure; use Device::Gsm::Sms::Token; sub _log { print @_, "\n"; } sub _parent { $_[0]->{_parent} } # # new( # header => '+CMGL: .....', # pdu => '[encoded pdu string]', # ) # # creates message object # sub new { my ($proto, %opt) = @_; my $class = ref $proto || $proto; # Create new message object my $self = {}; # Store gsm parent object reference 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'} = {}; return undef unless (exists $opt{'header'} && exists $opt{'pdu'}); #_log("NEW SMS OBJECT"); #_log("Header [$opt{header}]"); #_log("PDU [$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) { $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) bless $self, $class; if ($self->decode(Device::Gsm::Sms::SMS_DELIVER)) { # _log('OK, message decoded correctly!'); } elsif ($self->decode(Device::Gsm::Sms::SMS_STATUS)) { } else { # _log('CASINO!'); undef $self; } } else { # Warning: could not parse message header undef $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 ''; } # # type(): returns message type in ascii readable format # { # 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 ]; } } # # decode( CMGL_header, pdu_string ) # # creates a new Device::Gsm::Sms object from # PDU encoded message string returned by +CMGL commands # # If some error occurs, returns undef. # # 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)); #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'}); } # XXX DEBUG #foreach( sort keys %msg ) { # print STDERR 'MSG[', $_, '] = `'.$msg{$_}.'\'', "\n"; #} bless \%msg, 'Device::Gsm::Sms'; } sub decode { my ($self, $type) = @_; $self->{'type'} = $type; # Get list of tokens for this message (from ::Sms::Structure) my $cPdu = $self->{'pdu'}; # Check that PDU is not empty return 0 unless $cPdu; # Backup copy for "backtracking" my $cPduCopy = $cPdu; my @token_names = $self->structure(); my $decoded = 1; #is udh in pdu? my $udh_parsed = 0; while (@token_names) { # 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 ($token->decode(\$cPdu)) { # Store token object into SMS message $self->{'tokens'}->{ $token->name() } = $token; # 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 ($mti != $type) { #_log('token PDUTYPE, data='.$token->data().' MTI='.$token->get('MTI').' ->MTI()='.$token->MTI()); # # This is a SMS-SUBMIT message, so: # # 1) change type # 2) restore original PDU message # 3) reload token structure # 4) restart decoding # $self->type($type = $mti); $cPdu = $cPduCopy; @token_names = $self->structure(); #_log('RESTARTING DECODING AFTER MTI DETECTION'); #; redo; } if ($udh_parsed == 0 and $udhi == 1) { $cPdu = $cPduCopy; @token_names = $self->structure(); $udh_parsed = 1; redo; } #_log(' ', $token->name(), ' DATA = ', $token->toString() ); } } #_log('PDU AFTER ['.$cPdu.']', length($cPdu) ); } #_log("\n", 'PRESS ENTER TO CONTINUE'); ; return $decoded; } # # Delete an sms message # sub delete { my $self = $_[0]; my $gsm = $self->_parent(); my $ok; # Try to delete message my $msg_index = $self->index(); my $storage = $self->storage(); # Issue delete command 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.'); $ok = undef; } return $ok; } # # Returns message own index number (position) # sub index { my $self = $_[0]; return $self->{'index'}; } # # Returns message storage (SM - SIM card or ME - phone memory) # sub storage { my $self = $_[0]; return $self->{'storage'}; } # # Only valid for SMS_SUBMIT and SMS_STATUS 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; } } # # 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; } } # Alias for text() sub content { 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'}; } } 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; } } # # Returns type of sms (SMS_DELIVER || SMS_SUBMIT) # sub type { my $self = shift; if (@_) { $self->{'type'} = shift; } $self->{'type'}; } =pod =head1 NAME Device::Gsm::Sms - SMS message internal class that represents a single text SMS message =head1 SYNOPSIS # A list of Device::Gsm::Sms messages is returned by # Device::Gsm messages() method. use Device::Gsm; ... @sms = $gsm->messages(); if( @sms ) { foreach( @sms ) { print $msg->storage() , "\n"; print $msg->recipient() , "\n"; print $msg->sender() , "\n"; print $msg->content() , "\n"; print $msg->time() , "\n"; print $msg->type() , "\n"; } } # Or you can instance a sms message from raw PDU data my $msg = new Device::Gsm::Sms( header => '+CMGL: ...', pdu => `[encoded pdu data]', storage=> 'ME', # or 'SC' ); if( defined $msg ) { print $msg->recipient() , "\n"; print $msg->sender() , "\n"; print $msg->content() , "\n"; # or $msg->text() print $msg->time() , "\n"; print $msg->type() , "\n"; } $msg->delete(); =head1 DESCRIPTION C class implements very basic SMS message object, that can be used to decode C<+CMGL> GSM command response to build a more friendly high-level object. =head1 METHODS The following is a list of methods applicable to C objects. =head2 content() See text() method. =head2 decode() Starts the decoding process of pdu binary data. If decoding process ends in success, return value is true and sms object is filled with all proper values. If decoding process has errors or pdu data is not provided, return value is 0 (zero). =head2 delete() Delete the current SMS message from sim card. Example: $gsm = Device::Gsm->new(); ... my @msg = $gsm->messages(); $msg[0] && $msg[0]->delete(); =head2 new() Basic constructor. You can build a new C object from the raw B<+CMGL> header and B data. Those data is then decoded and a new sms object is instanced and all information filled, to be available for subsequent method calls. The allowed parameters to new() method are: =over 4 =item header This is the raw B<+CMGL> header string as modem outputs when you issue a B<+CMGL> command =item pdu Binary encoded sms data =item storage Tells which storage to delete the message from. Check the documentation of your phone to know valid storage values. Default values are: =over 4 =item C Deletes messages from gsm phone memory. =item C Deletes messages from sim card. =back =back =head2 index() Returns the sms message index number, that is the position of message in the internal device memory or sim card. This number is used for example to delete the message. my $gsm = Device::Gsm->new(port=>'/dev/ttyS0'); ... my @messages = $gsm->messages(); ... # Delete the first returned message my $msg = shift @messages; $gsm->delete_sms( $msg->index() ); =head2 recipient() Returns the sms recipient number (destination address = DA) as string (ex.: C<+39012345678>). =head2 sender() Returns the sms sender number (originating address = OA) as string. =head2 status() Status of the message can be one value from the following list: =for html
=for pod 'UNKNOWN', 'REC UNREAD', 'REC READ', 'SENT UNREAD', 'SENT READ' =head2 storage() Returns the storage where SMS has been read from. =head2 text() Returns the textual content of sms message. =head2 token() Returns the given PDU token of the decoded message (internal usage). =head2 type() SMS messages can be of two types: SMS_SUBMIT and SMS_DELIVER, that are defined by two constants with those names. type() method returns one of these two values. Example: if( $sms->type() == Device::Gsm::Sms::SMS_DELIVER ) { # ... } elsif( $sms->type() == Device::Gsm::Sms::SMS_SUBMIT ) { # ... } =head1 REQUIRES =over 4 =item * Device::Gsm =back =head1 EXPORTS None =head1 TODO =over 4 =item * Complete and proof-read documentation and examples =back =head1 COPYRIGHT Device::Gsm::Sms - SMS message simple class that represents a text SMS message Copyright (C) 2002-2009 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 details. =head1 AUTHOR Cosimo Streppone, cosimo@cpan.org =head1 SEE ALSO L, perl(1) =cut Device-Gsm-1.60/lib/Device/Gsm/Pdu.pm0000644000175000017500000002236011726073515016522 0ustar cosimocosimo# 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. # # 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. # # Commercial support is available. Write me if you are # interested in new features or software support. # # $Id$ # TODO document decode_text8() 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 sub decode_address { my $address = shift or return; my $number; my ($length, $type, $bcd_digits) = unpack('A2 A2 A*', $address); # XXX DEBUG #print STDERR "len=$length type=$type bcd=$bcd_digits\n"; # Manage alphabetical addresses (as per TS 03.38 specs) # Alphabetical addresses begin with 'D0'. # Check also http://smslink.sourceforge.net/pdu.html # 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); $bcd_digits = substr $bcd_digits, 2; } #print STDERR "num=$number - "; # Truncate last `F' if found (XXX ???) #$number = substr( $number, 0, hex($length) ); chop $number if substr($number, -1) eq 'F'; # Decode special characters for GPRS dialing $number =~ s/A/\*/; $number =~ s/B/#/; # If number is international, put a '+' sign before if ($type == 91 && $number !~ /^\s*\+/) { $number = '+' . $number; } return $number; } 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); } # decode 8-bit encoded text sub decode_text8($) { my $text8 = shift(); return unless $text8; my $str; while ($text8) { $str .= chr(hex(substr $text8, 0, 2)); if (length($text8) > 2) { $text8 = substr($text8, 2); } else { $text8 = ''; } } return $str; } sub encode_address { my $num = shift; my $type = ''; my $len = 0; my $encoded = ''; $num =~ s/\s+//g; #warn('encode_address('.$num.')'); # Check for alphabetical addresses (TS 03.38) if ($num =~ /[A-Z][a-z]/) { # Encode clear text in gsm0338 7-bit $type = 'D0'; $encoded = encode_text7($num); $len = unpack 'H2' => chr(length $encoded); } 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 $len = unpack 'H2' => chr(length $num); $num .= 'F'; my @digit = split // => $num; while (@digit > 1) { $encoded .= join '', reverse splice @digit, 0, 2; } } #warn(' [' . (uc $len . $type . $encoded ) . ']' ); return (uc $len . $type . $encoded); } sub decode_text_UCS2 { my $encoded = shift; return undef unless $encoded; 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); } 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; } 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; } 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 } 1; =head1 NAME Device::Gsm::Pdu - library to manage PDU encoded data for GSM messaging =head1 WARNING This is C software, still needs extensive testing and support for custom GSM commands, so use it at your own risk, and without C warranty! Have fun. =head1 NOTICE This module is meant to be used internally by C class, so you probably do not want to use it directly. =head1 SYNOPSIS use Device::Gsm::Pdu; # DA is destination address $DA = Device::Gsm::Pdu::encode_address('+39347101010'); $number = Device::Gsm::Pdu::decode_address( $DA ); # Encode 7 bit text to send messages $text = Device::Gsm::Pdu::encode_text7('hello'); =head1 DESCRIPTION C module includes a few basic functions to deal with SMS in PDU mode, such as encoding GSM addresses (phone numbers) and, for now only, 7 bit text. =head1 FUNCTIONS =head2 decode_address( pdu_encoded_address ) Takes a PDU encoded address and decodes into human-readable mobile number. If number type is international, result will be prepended with a `+' sign. Clearly, it is intended as an internal function. =head3 Example print Device::Gsm::Pdu::decode_address( '0B919343171010F0' ); # prints `+39347101010'; =head2 encode_address( mobile_number ) Takes a mobile number and encodes it as DA (destination address). If it begins with a `+', as in `+39328101010', it is treated as an international number. =head3 Example print Device::Gsm::Pdu::encode_address( '+39347101010' ); # prints `0B919343171010F0' =head2 encode_text7( text_string ) Encodes some text ASCII string in 7 bits PDU format, including a header byte which tells the length is septets. This is the only 100% supported mode to encode text. =head3 Example print Device::Gsm::Pdu::encode_text7( 'hellohello' ); # prints `0AE832...' =head2 pdu_to_latin1($pdu) Converts a PDU (without the initial length octet) into a latin1 string. =head3 Example my $pdu = 'CAFA9C0E0ABBDF7474590E8296E56C103A3C5E97E5'; print Device::Gsm::Pdu::pdu_to_latin1($pdu); # prints `Just another Perl hacker' =head2 latin1_to_pdu($text) Converts a text string in latin1 encoding (ISO-8859-1) into a PDU string. =head3 Example my $text = "Just another Perl hacker"; print Device::Gsm::Pdu::latin1_to_pdu($text); # prints `CAFA9C0E0ABBDF7474590E8296E56C103A3C5E97E5' =head1 AUTHOR Cosimo Streppone, cosimo@cpan.org =head1 COPYRIGHT This library is free software; you can redistribute it and/or modify it only under the terms of Perl itself. =head1 SEE ALSO Device::Gsm(3), perl(1) Device-Gsm-1.60/lib/Device/Gsm.pm0000644000175000017500000015341611730620165015773 0ustar cosimocosimo# 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 class implements basic GSM functions, network registration and SMS sending. This class supports also C mode to send C 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 (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 script to make me know that Device::Gsm works with your device (thanks!). Recent versions of C have also an utility called C in the C 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. See L documentation for more details. The only mandatory argument is the C 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 option to have L 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 (or C on Windows platform), as all parameters are passed to those classes' connect() method. The default value for C 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 is the perl's builtin C function (see C for details). Another variant allows to pass a C array to set the correspondent datetime. Example: $newdate = $gsm->datetime( localtime() ); (Note the list context). Again you can read the details for C function with C. If your device does not support this command, an B 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 method. =head2 forward() Sets call forwarding. Accepts three arguments: reason, mode and number. Reason can be the string C, C, C and C. Mode can be the string C, C, C, C, C. 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, C, C, ...). 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 object. The only parameter specifies the C 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 Means gsm phone Bmory =item C Means gsm phone Bmory on Nokia phones? =item C Means Bim card Bemory (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 or C. 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; 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 method when already registered to gsm network. See C 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 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 prefix). For example, I want to know if my device supports the C 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 Must be explained better, uh? =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 number, it is used here (but remember to supply the C 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 (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 parameter can assume two values: C and C. Flash (or class zero) messages are particular because they are immediately displayed (without user confirm) and never stored on phone memory, while C is the default. =item C This is the text you want to send, consisting of max 160 chars if you use B mode and 140 (?) if in B mode (more on this later). =item C Can assume two values (case insensitive): C and C. C means B and it is a sort of B encoding of commands, to save time/space, while C is the normal GSM commands text mode. Recent mobile phones and GSM equipments surely have support for C 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 Phone number of message recipient =item C 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 (or whatever device you use instead of C). =item Connection speed Try switching C 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 utility in the C folder of the C 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 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 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, L, L, perl(1) =cut Device-Gsm-1.60/META.yml0000644000175000017500000000151411730620353014201 0ustar cosimocosimo--- #YAML:1.0 name: Device-Gsm version: 1.60 abstract: Perl extension to interface GSM phones / modems author: - Cosimo Streppone ,Grzegorz Woźniak license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Device::Modem: 1.47 Device::SerialPort: 0 Test::More: 0 resources: bugtracker: mailto:bug-device-gsm@rt.cpan.org license: http://dev.perl.org/licenses/ repository: git://github.com/cosimo/perl5-device-gsm.git no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Device-Gsm-1.60/bin/0000755000175000017500000000000011730620353013477 5ustar cosimocosimoDevice-Gsm-1.60/bin/autoscan0000644000175000017500000000422111470300370015231 0ustar cosimocosimo#!/usr/bin/perl # # Autoscan utility, creates a log file with all commands # # Please send the `profile.log' generated file to # cosimo@cpan.org with subject "Device::Gsm profile" # # Usage: autoscan --device=/dev/ttyS0 --baud=19200 --file=my_device.log # # $Id: autoscan,v 1.4 2004-01-10 21:33:46 cosimo Exp $ use Device::Gsm; use Getopt::Long; my $dev = '/dev/nokia6600'; my $baud = 19200; my $file = 'profile.log'; usage() unless @ARGV; GetOptions( 'device:s'=>\$dev, 'baud:i'=>\$baud, 'file:s'=>\$file ); my $gsm = new Device::Gsm( port => $dev, log=>"file,$file", loglevel=>'info' ); $gsm->connect( baudrate => $baud ) or die "could not connect!\n"; print "Auto scan of device on $dev (\@ $baud bps)\n\n"; $gsm->log->write('info', "# Autoscan of device on device $dev (\@ $baud bps)"); $gsm->log->write('info', '# Device::Gsm v'.Device::Gsm->VERSION().', Device::Modem v'.Device::Modem->VERSION().', perl version '.$]); $gsm->log->write('info', '# Started on '.localtime()); my @command = ( '+CCLK', '+CGMI', '+CGMM', '+CGMR', '+CGSN', '+CSCA', '+CSQ', '+CHUP', '+CPIN', '+CMGF', '+CMGL', '+CMGS', '^SBNR', ); $gsm->log->write('info', 'Start of GSM commands support test.'); testcmd($gsm,$_) foreach @command; $gsm->log->write('info', 'End of commands test. Now some methods will be called.'); $gsm->datetime(); $gsm->imei(); $gsm->manufacturer(); $gsm->model(); $gsm->software_version(); $gsm->service_center(); $gsm->signal_quality(); $gsm->messages(); sub testcmd { my $gsm = $_[0]; my $cmd = $_[1]; $gsm->log->write('info', 'testing command ['.$cmd.']'); $gsm->test_command($cmd); } sub usage { print < Device to connect to. Ex.: --device=/dev/ttyS0 for serial ports --device=/dev/rfcomm0 for bluetooth device --baud= Speed of serial communication. Ex.: --baud=19200 or --baud=9600 --file= Name of profile filename to be saved Ex.: --file=my_device.log EOT exit; } Device-Gsm-1.60/Makefile.PL0000644000175000017500000000140411727632377014717 0ustar cosimocosimouse 5.008; use ExtUtils::MakeMaker; WriteMakefile( 'ABSTRACT_FROM' => 'lib/Device/Gsm.pm', 'AUTHOR' => 'Cosimo Streppone ,Grzegorz Woźniak ', 'NAME' => 'Device::Gsm', 'VERSION_FROM' => 'lib/Device/Gsm.pm', # finds $VERSION 'PREREQ_PM' => { 'Test::More' => 0, 'Device::Modem' => 1.47, ( $^O =~ /Win/i ? ( 'Win32::SerialPort' => 0 ) : ( 'Device::SerialPort'=> 0 ) ) }, 'META_MERGE' => { resources => { repository => 'git://github.com/cosimo/perl5-device-gsm.git', bugtracker => 'mailto:bug-device-gsm@rt.cpan.org', license => 'http://dev.perl.org/licenses/', }, }, ); Device-Gsm-1.60/INSTALL0000644000175000017500000000302711470300370013755 0ustar cosimocosimo,=======================================. | Device::Gsm INSTALLATION INSTRUCTIONS | 25/11/2008 `=======================================' Copyright 2002-2008 (C) Cosimo Streppone, This is a perl module extension. If you don't know what it means, please take the time to go to http://www.cpan.org/ or http://www.perl.org ,-------------------------. | PRE-REQUISITES | `-------------------------' - a working perl installation (version 5.005+ recommended, although this module has been reported to work also for 5.004) - Device::Modem perl extension (possibly version >= 1.24) Download this extension from [http://cpan.perl.org/modules/by-module/Device/] - a GSM cellular phone or GSM modem. Various models have been reported to work. Some of these are: Nokia 6600 (19200) Nokia 6310 (19200) Nokia 3310 (19200) Siemens C45 (19200) Siemens S35 (19200) Nokia Communicator (9600) Falcom A2/Swing (9600) Digicom GSM modems (9600) ... If your GSM phone/modem is not reported in this little list, don't despair. Most probably it will work without problems. PLEASE NOTE: without a GSM phone/cellular connected to a serial port at your choice, you will not be able to use this module in ANY useful way. ,-------------------------. | INSTALLATION PROCEDURE | `-------------------------' As with 99,9% of perl extensions, can be installed with: - perl Makefile.PL - make - make test - make install (normally, as super-user) Have fun. Device-Gsm-1.60/README0000644000175000017500000000616011726073152013616 0ustar cosimocosimo,=======================================. | Device::Gsm perl extension | `=======================================' Copyright 2002-2011 (C) Cosimo Streppone, This is a perl module extension. If you don't know what this means, please take the time to go to http://www.cpan.org/ or http://www.perl.org/. ,----------------------------. | WHAT DOES DEVICE::GSM DO ? | `----------------------------' This module works as an interface to GSM phones or GSM modems connected on your local serial ports. It can control your GSM *standard* functions and status. It can send SMS messages in a simple and convenient way. It can read messages stored on your sim card. ,--------------------------------. | WHAT DOES DEVICE::GSM NOT DO ? | `--------------------------------' It does not use free internet web portals to send SMS. If you want to send SMS, you must have your mobile phone or GSM OEM module and a sim card connected to either serial, irda or bluetooth ports. ,-------------------------. | PRE-REQUISITES | `-------------------------' - a working perl installation (version 5.005+ recommended, although this module has been reported to work also for 5.004) - Device::Modem perl extension (possibly version >= 1.30) Download this extension from [http://cpan.perl.org/modules/by-module/Device/] - Device::Modem, in turn, requires Device::SerialPort (for unix-like systems) or Win32::SerialPort (on Win32 systems) to communicate with serial port. Download these extensions from [http://cpan.perl.org/modules/by-module/Device/] or [http://cpan.perl.org/modules/by-module/Win32/] - a GSM cellular phone or GSM modem. Various models have been reported to work. Some of these are: Nokia 6600 (19200 baud) Nokia 6310 (19200 baud) Nokia 3310 (19200 baud) Siemens C45 (19200 baud) Siemens S35 (19200 baud) Iridium Satellite (19200 baud) Nokia Communicator (9600 baud) Falcom A2/Swing (9600 baud) Digicom GSM modems (9600 baud) ... If your GSM phone/modem is not reported in this little list, don't despair. Most probably it will work without problems. PLEASE NOTE: without a GSM phone/cellular connected to a serial port at your choice, you will not be able to use this module in ANY useful way. ,--------------------------------. | PLATFORMS | `--------------------------------' I normally test it with both Linux and Win32 and it works equally well. It is known to work also on Solaris, FreeBSD, NetBSD (packaged with NetBSD perl installation as Feb 2003), OpenBSD and Commodore 64 eventually :-) ,-------------------------. | INSTALLATION PROCEDURE | `-------------------------' As with 99,9% of perl extensions, can be installed with: - perl Makefile.PL - make - make test - make install (normally, as super-user) ,-------------------------. | LICENSING TERMS | `-------------------------' This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Additionally, this is BETA software, so use it at your own risk, and without ANY warranty! Have fun.