File Coverage

blib/lib/Device/Gsm/Sms/Token.pm
Criterion Covered Total %
statement 54 63 85.7
branch 10 20 50.0
condition 2 5 40.0
subroutine 14 16 87.5
pod n/a
total 80 104 76.9


line stmt bran cond sub pod time code
1             # Device::Gsm::Sms::Token - SMS PDU message parser token
2             # Copyright (C) 2002-2006 Cosimo Streppone, cosimo@cpan.org
3             #
4             # This program is free software; you can redistribute it and/or modify
5             # it only under the terms of Perl itself.
6             #
7             # This program is distributed in the hope that it will be useful,
8             # but WITHOUT ANY WARRANTY; without even the implied warranty of
9             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10             # Perl licensing terms for details.
11             #
12             # Commercial support is available. Write me if you are
13             # interested in new features or software support.
14             #
15             # $Id$
16              
17             package Sms::Token;
18              
19 10     10   55 use strict;
  10         21  
  10         380  
20 10     10   4084 use integer;
  10         53  
  10         124  
21 10     10   268 use Carp 'croak';
  10         22  
  10         958  
22              
23             # Token possible states
24 10     10   52 use constant ERROR => 0;
  10         26  
  10         597  
25 10     10   47 use constant ENCODED => 1;
  10         17  
  10         466  
26 10     10   50 use constant DECODED => 2;
  10         16  
  10         6478  
27              
28             #
29             # new token ( @data )
30             #
31             sub new {
32 50     50   3218 my ($proto, $name, $options) = @_;
33              
34             # my $class = ref $proto || $proto;
35 50   50     278 $options->{'data'} ||= [];
36              
37             # Cannot load a token without its name
38 50 50 33     229 if (!defined $name || $name eq '') {
39 0         0 return undef;
40             }
41              
42             # Create basic structure for a token
43 50         218 my %token = (
44              
45             # Name of token, see ->name()
46             __name => $name,
47              
48             # Data that token contains
49             __data => $options->{'data'},
50              
51             # Decoded? or error?
52             __state => '',
53              
54             # This is used to access other tokens in the "message"
55             __messageTokens => $options->{'messageTokens'}
56             );
57              
58             # Dynamically load required token module
59 50         114 eval { require "Device/Gsm/Sms/Token/$name.pm" };
  50         6460  
60 50 50       115 if ($@) {
61 0         0 warn( 'cannot load Device::Gsm::Sms::Token::'
62             . $name
63             . ' plug-in for decoding. Error: '
64             . $@);
65 0         0 return undef;
66             }
67              
68             # Try "static blessing" =:-o and see if it works
69 50         254 bless \%token, 'Sms::Token::' . $name;
70             }
71              
72             #
73             # Get/set internal token data
74             #
75             sub data {
76 49     49   69 my $self = shift;
77 49 50       113 if (@_) {
78 49 50       118 if (!defined $_[0]) {
79 0         0 $self->{'__data'} = [];
80             }
81             else {
82 49         191 $self->{'__data'} = [@_];
83             }
84             }
85 49         139 $self->{'__data'};
86             }
87              
88             # Must be implemented in real token
89             sub decode {
90 0     0   0 croak('decode() not implemented in token base class');
91 0         0 return 0;
92             }
93              
94             # Must be implemented in real token
95             sub encode {
96 0     0   0 croak('encode() not implemented in token base class');
97 0         0 return 0;
98             }
99              
100             sub get {
101 137     137   201 my ($self, $info) = @_;
102 137 50       236 return undef unless $info;
103              
104 137         519 return $self->{"_$info"};
105             }
106              
107             # XXX This must be filled by the higher level object that
108             # treats the entire message in tokens
109             #
110             # [token]->messageTokens( [name] )
111             #
112             sub messageTokens {
113              
114             # Usually this is a hash of token objects, accessible by key (token name)
115 2     2   3 my $self = shift;
116 2         4 my $name;
117 2 50       8 if (@_) {
118 2         5 $name = shift;
119             }
120 2 50       8 if (defined $name) {
121 2         19 return $self->{'__messageTokens'}->{$name};
122             }
123             else {
124 0         0 return $self->{'__messageTokens'};
125             }
126             }
127              
128             sub name {
129 96     96   108 my $self = shift;
130 96         405 return $self->{'__name'};
131             }
132              
133             sub set {
134 176     176   291 my ($self, $info, $newval) = @_;
135 176 50       303 return undef unless $info;
136 176 50       277 $newval = undef unless defined $newval;
137 176         1472 $self->{"_$info"} = $newval;
138             }
139              
140             sub state {
141 41     41   59 my $self = shift;
142 41         89 return $self->{'__state'};
143             }
144              
145             sub toString {
146 5     5   616 my $self = shift;
147 5         7 my $string;
148 5 50       27 if (ref $self->{'__data'} eq 'ARRAY') {
149 5         7 $string = join '', @{ $self->{'__data'} };
  5         23  
150             }
151 5         32 return $string;
152             }
153              
154             1;
155