File Coverage

blib/lib/GSM/Nbit.pm
Criterion Covered Total %
statement 75 91 82.4
branch 15 26 57.6
condition 11 14 78.5
subroutine 10 12 83.3
pod 9 9 100.0
total 120 152 78.9


line stmt bran cond sub pod time code
1             package GSM::Nbit;
2              
3 2     2   51716 use warnings;
  2         5  
  2         66  
4 2     2   13 use strict;
  2         3  
  2         77  
5 2     2   11 use Carp qw(cluck);
  2         18  
  2         2111  
6              
7             =head1 NAME
8              
9             GSM::Nbit - GSM 7bit and 8bit data encoder and decoder.
10              
11             =head1 VERSION
12              
13             Version 0.08
14              
15             =cut
16              
17             our $VERSION = '0.08';
18              
19             =head1 SYNOPSIS
20              
21             GSM::Nbit
22              
23             Throughout GSM world "special" encodings called 7bit and 8bit are used.
24             Encoding in 8bit is just plain HEX value and is provided here for completeness
25             and ease of use, 7bit packs 8bit data into 7bit HEX value by limiting it to the
26             lower 127 characters - and hence gaining 1 extra char every 8 characters.
27              
28             That's how you get 160 characters limit on plain text (ASCII + few Greek chars)
29             messages with only 140 bytes for data.
30              
31             Since many modules need such encodings in them, those functions are refactored
32             here. It's released as separate module and not part of some other distribution
33             exactly for that reason.
34              
35             =head1 Code Sample
36              
37             use Encode qw/encode decode/;
38             use GSM::Nbit;
39              
40             my $gsm = GSM::Nbit->new();
41             my $txt = "some text";
42            
43             # We need to encode it first - for details see:
44             # http://www.dreamfabric.com/sms/default_alphabet.html
45             my $txt0338 = encode("gsm0338", $txt);
46             my $txt_7bit = $gsm->encode_7bit_wlen($txt);
47            
48             # ... we submit it to the GSM network
49             # ... latter we receive something from GSM network
50            
51             my $txt_gsm = $gsm->decode_7bit_wlen($txt_7bit);
52            
53             # we need to decode it back to computer/Perl representation
54             my $txt_orig = decode("gsm0338", $txt_gsm);
55              
56             =head1 METHODS
57              
58             =head2 new
59              
60             This is the constructor. Accepts no params.
61              
62             =cut
63              
64             sub new {
65 1     1 1 13 my $class = shift;
66 1         4 my $self = bless {}, $class;
67 1         3 return $self;
68             }
69              
70             =head2 encode_7bit
71              
72             This function encodes the string as 7bit packed data in HEX representation.
73             Please note that you probably need to convert the text into gsm0338 format first -
74             we don't automatically do that.
75              
76             For details see L.
77              
78             You can use Perl's Encode module for that - see:
79             L
80              
81             =cut
82              
83             sub encode_7bit {
84 6     6 1 9077 my($self, $data) = @_;
85 6 50       19 return unless $data;
86            
87 6         11 my($bit_string, $message) = ('','');
88 6         8 my($octet, $rest);
89              
90 6         29 for(split(//,$data)) {
91 50         111 $bit_string.=unpack('b7',$_);
92             }
93              
94 6   66     45 while(defined($bit_string) && (length($bit_string))) {
95 46         72 $rest = $octet = substr($bit_string,0,8);
96 46         127 $message .= unpack("H2",pack("b8",substr($octet.'0'x7,0,8)));
97 46 100       250 $bit_string = (length($bit_string) > 8) ? substr($bit_string,8) : '';
98             }
99            
100 6         22 return uc($message);
101             }
102              
103             =head2 encode_7bit_wlen
104              
105             Beside encoding the string as 7bit packed data in HEX representation, this
106             method also adds the length in front of the encoded string, it's needed in some
107             GSM protocols as a kind of checksum and to help with certain edge cases.
108              
109             =cut
110              
111             sub encode_7bit_wlen {
112 3     3 1 1313 my($self, $data) = @_;
113 3 50       10 return '00' unless $data;
114            
115 3         9 my $text_7bit = $self->encode_7bit($data);
116            
117 3         24 return sprintf("%02X", length($data)).($text_7bit);
118             }
119              
120             =head2 decode_7bit
121              
122             This function decodes the 7bit data in HEX representation back to a "readable"
123             string. Second optional parameter is length - it's used in edge cases when
124             we can't be sure if the last seven 0's in bit representation are meant to
125             be @ sign, or it's a filler and there to just fit the 7bit representation into
126             8bit data computers (and cellphones) use.
127              
128             Edge cases happen when length of original text is 7, 15, 23, 31 ... (+8) chars.
129              
130             =cut
131              
132             sub decode_7bit {
133 4     4 1 486 my $self = shift();
134 4         7 my $data = shift();
135            
136 4 100       13 return unless $data;
137            
138 3   100     13 my $length = shift || undef;
139 3         5 my $message = "";
140 3         6 my $len = length($data);
141            
142 3         3 my $bytes;
143 3         5 my $i = 0;
144            
145 3         10 my $repeat = int(length($data)) / 2;
146            
147 3         13 for($i=0; $i < $repeat; $i++){
148 25         39 my $hex = substr($data, $i * 2, 2);
149 25         67 my $hex_b = unpack('b8',pack('H2', $hex));
150 25         70 $bytes .= $hex_b;
151             }
152            
153 3   66     15 $repeat = $length || int(length($bytes) / 7);
154 3         9 my $last_loop = int(length($bytes) / 7) - 1;
155 3         10 for($i = 0; $i < $repeat; $i++){
156 28         42 my $letter = substr($bytes, ($i * 7), 7);
157 28 50 100     81 if(($i == $last_loop) && ($letter eq '0000000') && (not defined $length)){
      66        
158 0         0 cluck "Possible edge case, can't be sure if last character is " .
159             'really @ or just a filler.'
160             }
161            
162 28         87 $message .= pack('b7', $letter);
163             }
164            
165 3         11 return $message;
166             }
167              
168             =head2 decode_7bit_wlen
169              
170             This function decodes back to a "readable" text string the 7bit data in HEX
171             representation that includes the length as the first value.
172              
173             =cut
174              
175             sub decode_7bit_wlen {
176 6     6 1 2473 my($self, $data) = @_;
177            
178 6 50       19 unless($data){
179 0         0 return;
180             }
181              
182 6 100       19 if(length($data) < 2){
183 1         143 cluck "Invalid data - must be at least 2 characters of HEX representation";
184 1         78 return;
185             }
186            
187 5         17 my $len = hex(substr($data,0,2));
188            
189 5         17 my $real_length = (length($data) / 2 * 8 / 7 ) - 2;
190 5 100       17 if( $len <= $real_length){
191 2         353 cluck "Something is wrong with the data you want me to decode, length " .
192             "indicates $len chars, but there aren't that much chars.";
193 2         159 return;
194             }
195             # but then it shouldn't be too long for provided length either
196 3 50       25 if($len + 1 <= $real_length){
197 0         0 cluck "Provided length is much shorter than the actual length, ".
198             "something is probably wrong - but I'll continue...";
199             }
200 3         8 $data = substr($data, 2, length($data) - 2);
201            
202 3         8 my $message = $self->decode_7bit($data, $len);
203            
204 3         49 return $message;
205             }
206              
207             =head2 encode_8bit
208              
209             This function encodes the string as 8bit HEX representation of the string.
210              
211             =cut
212              
213             sub encode_8bit {
214 1     1 1 546 my ($self, $data) = @_;
215 1 50       5 return unless $data;
216            
217 1         3 my $message = "";
218              
219 1         5 while (length($data)) {
220 10         25 $message .= sprintf("%.2X", ord(substr($data,0,1)));
221 10         26 $data = substr($data,1);
222             }
223            
224 1         5 return $message;
225             }
226              
227             =head2 encode_8bit_wlen
228              
229             This function encodes the string as 8bit HEX representation of the string
230             and also adds the length in front of the encoded string since it's needed in some
231             GSM protocols as a kind of checksum.
232              
233             =cut
234              
235             sub encode_8bit_wlen {
236 0     0 1 0 my($self, $data) = @_;
237 0 0       0 return '00' unless $data;
238            
239 0         0 my $text_8bit = $self->encode_8bit($data);
240            
241 0         0 return sprintf("%02X", length($data)).($text_8bit);
242             }
243              
244             =head2 decode_8bit
245              
246             This function decodes back to a "readable" text string the 8bit HEX representation
247             with length at the start of the string.
248              
249             =cut
250              
251             sub decode_8bit {
252 1     1 1 489 my ($self, $data) = @_;
253 1 50       8 return unless $data;
254            
255 1         2 my $message;
256              
257 1         6 while ( length($data) ) {
258 10         21 $message .= pack('H2',substr($data,0,2));
259 10         31 $data = substr($data,2);
260             }
261            
262 1         4 return $message;
263             }
264              
265             =head2 decode_8bit_wlen
266              
267             This function decodes the 8bit HEX representation of the string back to
268             readable text string.
269              
270             =cut
271              
272             sub decode_8bit_wlen {
273 0     0 1   my ($self, $data) = @_;
274 0 0         return unless $data;
275              
276 0           my $len = hex(substr($data,0,2));
277 0           $data = substr($data, 2, length($data) - 2);
278            
279 0           my $message = "";
280              
281 0           while ( length($data) ) {
282 0           $message .= pack('H2',substr($data,0,2));
283 0           $data = substr($data,2);
284             }
285            
286 0           return $message;
287             }
288              
289             =head1 INCOMPATIBILITIES
290              
291             Note that you might need to update your Encode.pm module beforehand for tests
292             to pass (and to be able to use this in a meaningful way) since older version
293             had a bug for gsm0338 encode/decode of @ char.
294              
295             =head1 AUTHOR
296              
297             Aleksandar Petrovic, C<< >>
298              
299             =head1 BUGS
300              
301             Please report any bugs or feature requests to C,
302             or through the web interface at
303             L.
304             I will be notified, and then you'll automatically be notified of progress on
305             your bug as I make changes.
306              
307              
308             =head1 SUPPORT
309              
310             You can find documentation for this module with the perldoc command.
311              
312             perldoc GSM::Nbit
313              
314              
315             You can also look for information at:
316              
317             =over 4
318              
319             =item * RT: CPAN's request tracker
320              
321             L
322              
323             =item * AnnoCPAN: Annotated CPAN documentation
324              
325             L
326              
327             =item * CPAN Ratings
328              
329             L
330              
331             =item * Search CPAN
332              
333             L
334              
335             =back
336              
337              
338             =head1 ACKNOWLEDGEMENTS
339              
340              
341             =head1 LICENSE AND COPYRIGHT
342              
343             Copyright 2010 Aleksandar Petrovic.
344              
345             This program is free software; you can redistribute it and/or modify it
346             under the terms of either: the GNU General Public License as published
347             by the Free Software Foundation; or the Artistic License.
348              
349             See http://dev.perl.org/licenses/ for more information.
350              
351              
352             =cut
353              
354             1; # End of GSM::Nbit