File Coverage

blib/lib/Mobile/Messaging/ParlayX.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             # Mobile::Messaging::ParlayX.pm version 0.0.3
2             #
3             # Copyright (c) 2006 Thanos Chatziathanassioy . All rights reserved.
4             # This program is free software; you can redistribute it and/or
5             # modify it under the same terms as Perl itself.
6              
7             package Mobile::Messaging::ParlayX;
8             local $^W;
9             require 'Exporter.pm';
10 1     1   29632 use vars qw(@ISA @EXPORT @EXPORT_OK);
  1         3  
  1         111  
11             @ISA = (Exporter);
12             @EXPORT = qw(); #&new);
13             @EXPORT_OK = qw(@error_str);
14              
15             $Mobile::Messaging::ParlayX::VERSION='0.0.3';
16             $Mobile::Messaging::ParlayX::ver=$Mobile::Messaging::ParlayX::VERSION;
17              
18 1     1   6 use strict 'vars';
  1         2  
  1         37  
19 1     1   5 use Carp();
  1         5  
  1         22  
20 1     1   1115 use LWP::UserAgent();
  1         50047  
  1         33  
21 1     1   13 use HTTP::Request();
  1         1  
  1         15  
22 1     1   512 use XML::LibXML();
  0            
  0            
23              
24             @Mobile::Messaging::ParlayX::Errors = (
25            
26             );
27              
28             =head1 NAME
29              
30             Mobile::Messaging::ParlayX - Interface to ParlayX OSA.
31              
32             Version 0.0.3
33              
34             =head1 SYNOPSIS
35              
36             use Mobile::Messaging::ParlayX;
37              
38             =head1 DESCRIPTION
39              
40             C is an interface to ParlayX web service by Sony Ericsson for SMS and MMS messaging,
41             among other things.
42             This being a Web Service L would probably be better suited to the task, but I decided to stick
43             with C, C and C until things in C stabilize (it is currently
44             under rewrite as far as I know) and I have more time (not that this will happen anytime soon).
45             Besides, I cannot fully grasp ParlayX just yet, thanks to inadequate documentation and JAVA only code
46             samples for it.
47             Anyway, you need L , L and L for this module to work.
48             Most are in the standard distribution already, but any of them are available at your local CPAN mirror.
49              
50             I tried not to stray too far off the ``native'' JAVA names of method and properties, but chances are some
51             differences exist.
52              
53             =head1 new Mobile::Messaging::ParlayX
54              
55             new Mobile::Messaging::ParlayX
56              
57             =head2 Parameters/Properties
58              
59             =over 4
60              
61             =item username
62              
63             C<>=> Your mobile operator should provide you with this, along with
64              
65             =item password
66              
67             C<>=> for your authentication against his gateway.
68              
69             =item nonce
70              
71             C<>=> This is also supposed to be part of the authentication process, though I`m not quite sure what it does...
72             Note that both password and nonce seem to be some kind of Base64 encoded digests, though I`m not quite sure what they are.
73             If you figure it out, I`ll be happy to include them here.
74              
75             =item host
76              
77             C<>=> Your operators` mobile gateway; the one your SOAP request will end up in.
78              
79             =item senderName
80              
81             C<>=> Technically, the originator of the SMS. Specs say it can be alphanumeric up to 11 chars in length,
82             though your operator may or may not allow you to set it.
83              
84             =item receiptRequest
85              
86             C<>=> You can ask for a delivery report for each SMS message, though the details of this are unclear to me,
87             since my operator does not (for the time being) support this. ``receiptRequest'' should be a hash reference
88             with ``endpoint'', ``correlator'' and ``interfaceName'' as the keys.
89             In theory, endpoint should be a URI of your own, where the operator will POST a SOAP of the results of the
90             SMS. Correlator is supposed to be a unique ID for this message, and your guess is as good as mine what
91             ``interfaceName'' stands for.
92             How this works and how bad, I do not know, since if I put receiptRequest in my SOAP request, my operator
93             will drop the message altogether.
94             You can still try and send me a patch/recommendation though.
95              
96             =item ChargingInformation
97              
98             C<>=> This is supposed to carry MT (Mobile Terminated) charging info in it and seems to work better than
99             receiptRequest above, but I cannot confirm this yet.
100             It is also a hash reference with ``description'' (probably will appear on the users` bill as such),
101             ``currency'' and ``amount'' (which are fairly self-explanatory, although amount should be decimal ie not a
102             float) and ``code'' (which I haven`t the faintest idea what it does).
103             if you provide at least the first 3, the module will put the relavant item in the SOAP request, though
104             again I cannot guarantee that it`ll work as expected.
105             UPDATE: Either amount and currency or just plain code will work. Code is supposed to contain what TIM
106             refers to as VASID and VASPID, which in itself is enough for an MT message.
107              
108             =back
109              
110             =cut
111              
112             sub new {
113             my $this = shift;
114             my $class = ref($this) || $this;
115             my $self = {};
116             bless $self, $class;
117             return $self->initialize(@_);
118             }
119              
120             sub initialize {
121             my $self = shift;
122            
123             if (@_ != 0) {
124             if (ref $_[0] eq 'HASH') {
125             my $hash=$_[0];
126             foreach (keys %$hash) {
127             $self->{lc $_}=$hash->{$_};
128             }
129             }
130             }
131            
132             $self->{'die_on_error'} ||= 0;
133             $self->{'DEBUG'} ||= 0;
134            
135             $self->{'ua'} = new LWP::UserAgent;
136             $self->{'ua'}->agent("Mobile::Messaging::ParlayX/0.0.3");
137            
138             $self->{'parser'} = XML::LibXML->new();
139            
140             return $self;
141             }
142              
143             =pod
144              
145             =head2 Methods
146              
147             =over 4
148              
149             =item sendSMS
150              
151             C<>=> Pretty much finished. It would be highly unusable without named arguments, so call it like so:
152              
153             $self->sendSMS( {
154             username => 'Your ParlayX Username',
155             host => 'ParlayX SMS Gateway',
156             password => 'Password',
157             nonce => 'No Idea What This Does',
158             senderName => 'Where The SMS will Seem to Come From',
159             message => 'The actual sms message',
160             addresses => 'Recipient(s)',
161             receiptRequest => {
162             endpoint => 'URI where the reciept will be sent',
163             interfaceName => 'Never used that one and dont quite know what it is',
164             correlator => 'Unique ID of the receiver'
165             }
166             ChargingInformation => {
167             description => 'Arbitrary string describing the reason for the MT charge',
168             currency => 'Should be self-explanatory, but my operator does not use it',
169             amount => 'Ditto, because these are inside argument code',
170             code => 'Instead of amount and currency, you have these pre-packaged in code'
171             }
172             } );
173              
174             Obviously username, host, message and addresses are mandatory for anything to work at all, the rest
175             can be filled in according to your requirements. Your operator should give you a pretty good idea
176             what`s neccessary and what is not.
177             Returns two scalars, the first indicating success (1) or not (0) while the second will give you the
178             unique id of the message (for future delivery report queries) in case of success. In case of failure
179             it will hopefully contain the error string returned by ParlayX Gateway.
180             The module will happily croak() if LWP::UserAgent cannot establish communication with ParlayX Gateway.
181             Ah, message and addresses can be array references, to send different messages to different recipients
182             or the same message to multiple recipients, or even different messages to the same recipient. Mix
183             those as you see fit.
184              
185             =back
186              
187             =cut
188              
189             sub sendSMS {
190             my $self = shift;
191            
192             $self->{'DEBUG'} and warn "Entering sendSMS\n";
193            
194             my ($username, $password, $nonce, $host, $senderName, $message, $receiptRequest, $ChargingInformation, $addresses);
195             if (ref $_[0] eq 'HASH') {
196             $username = $_[0]->{'username'} || $self->{'username'} || Carp::croak("Cant sendSMS without username\n");
197             $host = $_[0]->{'host'} || $self->{'host'} || Carp::croak("Cant sendSMS without ParlayX host definition\n");
198             $password = $_[0]->{'password'} || $self->{'password'} || '';
199             $nonce = $_[0]->{'nonce'} || $self->{'nonce'} || '';
200             $senderName = $_[0]->{'senderName'} || $self->{'senderName'} || '';
201             $message = $_[0]->{'message'} || $self->{'message'} || '';
202             $addresses = $_[0]->{'addresses'} || $self->{'addresses'} || '';
203            
204             #special handling of $receiptRequest & $ChargingInformation
205             $receiptRequest = $_[0]->{'receiptRequest'} || $self->{'receiptRequest'} || '';
206             $ChargingInformation = $_[0]->{'ChargingInformation'} || $self->{'ChargingInformation'} || '';
207            
208             if ($receiptRequest && ref($receiptRequest) ne 'HASH') {
209             Carp::croak("\$receiptRequest is not a hash reference\n");
210             }
211            
212             if ($ChargingInformation && ref($ChargingInformation) ne 'HASH') {
213             Carp::croak("\$ChargingInformation is not a hash reference\n");
214             }
215            
216             if (!$addresses) {
217             Carp::croak("No recipients for SMS!\n");
218             }
219             }
220            
221             $self->{'DEBUG'} and warn "Constructing SOAP request..\n";
222            
223             #construct the SOAP request..header first.
224             my $soap = $self->soap_send_body($username,$password,$nonce,$addresses,$senderName,$message,$receiptRequest,$ChargingInformation);
225            
226             $self->parse_xml(\$soap);
227            
228             $self->{'DEBUG'} and warn "SOAP request passed XML validation, sending HTTP Request\n";
229            
230             my ($soapaction,$lookfor) = ('http://www.csapi.org/wsdl/parlayx/sms/send/v2_1/local','result');
231             return $self->doHTTP($host,\$soap,$soapaction,$lookfor);
232             }
233              
234             =pod
235              
236             =over 4
237              
238             =item getSmsDeliveryStatus
239              
240             C<>=> Pretty much finished too. It would be highly unusable without named arguments, so call it like so:
241              
242             $self->getSmsDeliveryStatus( {
243             username => 'Your ParlayX Username',
244             host => 'ParlayX SMS Gateway',
245             password => 'Password',
246             nonce => 'No Idea What This Does',
247             messageid => 'A message unique ID, obtained from sendSMS() above',
248             } );
249              
250             Needs username, host and messageid for anything to work at all, the rest
251             can be filled in according to your requirements. Your operator should give you a pretty good idea
252             what`s neccessary and what is not.
253             Returns a scalar indicating success (1) or not (0) and a hash reference (if you only asked
254             for a single message ID) containing deliveryStatus and recipients` address (addresses).
255             if you used an array reference to ask for multiple message IDs, the 2nd returning value will be
256             an array reference with hashes like the one above inside it (should work, but could not be tested
257             in time).
258              
259             =back
260              
261             =cut
262              
263             sub getSmsDeliveryStatus {
264             my $self = shift;
265            
266             $self->{'DEBUG'} and warn "Entering getSmsDeliveryStatus()\n";
267            
268             my ($username, $password, $nonce, $host, $messageid, $addresses);
269             if (ref $_[0] eq 'HASH') {
270             $username = $_[0]->{'username'} || $self->{'username'} || Carp::croak("Cant getSmsDeliveryStatus without username\n");
271             $host = $_[0]->{'host'} || $self->{'host'} || Carp::croak("Cant getSmsDeliveryStatus without ParlayX host definition\n");
272             $password = $_[0]->{'password'} || $self->{'password'} || '';
273             $nonce = $_[0]->{'nonce'} || $self->{'nonce'} || '';
274             $messageid = $_[0]->{'messageid'} || $self->{'messageid'} || '';
275             $addresses = $_[0]->{'addresses'} || $self->{'addresses'} || '';
276            
277             if (!$messageid) {
278             Carp::croak("Need messageid for delivery status!\n");
279             }
280             }
281            
282             $self->{'DEBUG'} and warn "Constructing SOAP request..\n";
283            
284             my $soap = $self->soap_deliv_body($username,$password,$nonce,$messageid);
285            
286             $self->parse_xml(\$soap);
287            
288             $self->{'DEBUG'} and warn "SOAP request passed XML validation, sending HTTP Request\n";
289            
290             my ($soapaction,$lookfor) = (
291             '',{ deliveryStatus => '',
292             address => '' }
293             );
294             my ($success,$result) = $self->doHTTP($host,\$soap,$soapaction,$lookfor);
295            
296             return ($success,$result);
297             }
298              
299             =pod
300              
301             =over 4
302              
303             =item ReceiveSms
304              
305             C<>=> Works quite well for me YMMV.
306              
307             $self->ReceiveSms( {
308             username => 'Your ParlayX Username',
309             host => 'ParlayX SMS Gateway',
310             password => 'Password',
311             nonce => 'No Idea What This Does',
312             registrationIdentifier => 'Never seen this used, so dont know what it does - username should be enough to identify you',
313             } );
314              
315             This is the polling interface for receiving SMS from ParlayX. Using it will result in ParlayX
316             ``de-spooling'' awaiting SMSs for you.
317             Obviously needs a username to work and may need registrationIdentifier, the rest
318             can be filled in according to your requirements. Your operator should give you a pretty good idea
319             what`s neccessary and what is not.
320             Returns a scalar indicating success (1) or not (0) and a hash reference (if only a single SMS was waiting
321             in line) containing message, senderAddress and the number the SMS was sent to (smsServiceActivationNumber).
322             if multiple messages are waiting, the 2nd returning value will be
323             an array reference with hashes like the one above inside it.
324              
325             =back
326              
327             =cut
328              
329             sub ReceiveSms {
330             my $self = shift;
331            
332             $self->{'DEBUG'} and warn "Entering ReceiveSms()\n";
333            
334             my ($username, $password, $nonce, $host, $registrationIdentifier);
335             if (ref $_[0] eq 'HASH') {
336             $username = $_[0]->{'username'} || $self->{'username'} || Carp::croak("Cant getSmsDeliveryStatus without username\n");
337             $host = $_[0]->{'host'} || $self->{'host'} || Carp::croak("Cant getSmsDeliveryStatus without ParlayX host definition\n");
338             $password = $_[0]->{'password'} || $self->{'password'} || '';
339             $nonce = $_[0]->{'nonce'} || $self->{'nonce'} || '';
340            
341             $registrationIdentifier = $_[0]->{'registrationIdentifier'} || $self->{'registrationIdentifier'} || '';
342             }
343            
344             $self->{'DEBUG'} and warn "Constructing SOAP request..\n";
345            
346             my $soap = $self->soap_receivesms_body($username,$password,$nonce,$registrationIdentifier);
347            
348             $self->parse_xml(\$soap);
349            
350             $self->{'DEBUG'} and warn "SOAP request passed XML validation, sending HTTP Request\n";
351            
352             my ($soapaction,$lookfor) = (
353             '', {
354             message => '',
355             senderAddress => '',
356             smsServiceActivationNumber => ''
357             }
358             );
359             my ($success,$result) = $self->doHTTP($host,\$soap,$soapaction,$lookfor);
360            
361             return ($success,$result);
362             }
363              
364             =pod
365              
366             =over 4
367              
368             =item ReceiveAutoSms
369              
370             C<>=>
371             $self->ReceiveAutoSms($incoming_soap_post);
372              
373             This is the other (lets call on-demand) interface for receiving SMS from ParlayX.
374             You need to register yourself with the gateway (see C and C below)
375             and then, whenever you have an incoming SMS, the gateway will POST any SMS to the URI you specified there.
376             Returns a hash reference containing message, senderAddress and the number the SMS was sent to (smsServiceActivationNumber).
377             An example, written in mod_perl/Apache::ASP, script accepting SMS follows.
378              
379             <%
380             use strict;
381             use Mobile::Messaging::ParlayX;
382             my $incoming = $Request->BinaryRead();
383             $incoming =~ s|||s;
384             $incoming =~ s|(smsServiceActivationNumber>.*?)|$1|s;
385             my $ret = $sms->ReceiveAutoSms(\$incoming);
386             %>>
387              
388             In the example above, now $ret->{'message'} contains the SMS, $ret->{'smsServiceActivationNumber'} contains the number
389             the SMS was sent to (but prefixed with ``tel:'' so you might want to remove this before replying) and $ret->{'senderAddress'}
390             contains the number of the person who sent the SMS (which can be used as is in the reply).
391             Due to (our operator`s only ?) ParlayX being slightly liberal (for lack of a better word) it uses , while it
392             meant . The regex is there to make the message compatible with ReceiveSms() parsing above.
393             Also note the use of ``\$incoming'': In general, I try to avoid copying large strings back and forth and most of the module
394             will happily accept a scalar or a reference when either would apply. So you could use
395             ``my $ret = $sms->ReceiveAutoSms($incoming);'' instead if you feel more comfortable with it.
396             Personally, I designed it so I could use ``my $ret = $sms->ReceiveAutoSms(\$Request->BinaryRead());'' and I would too,
397             if it were not for the funky instead of stuff.
398              
399             =back
400              
401             =cut
402              
403             sub ReceiveAutoSms {
404             my $self = shift;
405            
406             my $soap = shift;
407            
408             if (ref($soap)) {
409             return $self->parse_xml($soap, {
410             message => '',
411             senderAddress => '',
412             smsServiceActivationNumber => ''
413             }
414             );
415             }
416             else {
417             return $self->parse_xml(\$soap, {
418             message => '',
419             senderAddress => '',
420             smsServiceActivationNumber => ''
421             }
422             );
423             }
424             }
425            
426             =pod
427              
428             =over 4
429              
430             =item stopSmsNotification
431              
432             C<>=>
433              
434             $self->stopSmsNotification( {
435             username => 'Your ParlayX Username',
436             host => 'ParlayX SMS Gateway',
437             password => 'Password',
438             nonce => 'No Idea What This Does',
439             correlator => 'Unique Identifier for you (assigned when you did startSmsNotification()'
440             } );
441              
442             if you previously registered yourself with ParlayX with C and you do not want to automatically
443             recieve SMS from now on, use this. It tells ParlayX to stop sending you SMS to the URI you specified.
444             You`ll probably never have to use this, but it is included for the sake of completeness.
445             I have no idea if it works without a correlator (mine doesn`t), but if you implementation is different, feel free to
446             fix this.
447              
448             =back
449              
450             =cut
451            
452             sub stopSmsNotification {
453             my $self = shift;
454            
455             $self->{'DEBUG'} and warn "Entering stopSmsNotification()\n";
456            
457             my ($username, $password, $nonce, $host, $correlator);
458             if (ref $_[0] eq 'HASH') {
459             $username = $_[0]->{'username'} || $self->{'username'} || Carp::croak("Cant getSmsDeliveryStatus without username\n");
460             $host = $_[0]->{'host'} || $self->{'host'} || Carp::croak("Cant getSmsDeliveryStatus without ParlayX host definition\n");
461             $password = $_[0]->{'password'} || $self->{'password'} || '';
462             $nonce = $_[0]->{'nonce'} || $self->{'nonce'} || '';
463            
464             $correlator = $_[0]->{'correlator'} || $self->{'correlator'} || '';
465            
466             if (!$correlator) {
467             Carp::croak("Need correlator for stopSmsNotification!\n");
468             }
469             }
470            
471             $self->{'DEBUG'} and warn "Constructing SOAP request..\n";
472            
473             my $soap = $self->soap_stopsms_body($username,$password,$nonce,$correlator);
474            
475             $self->parse_xml(\$soap);
476            
477             $self->{'DEBUG'} and warn "SOAP request passed XML validation, sending HTTP Request\n";
478            
479             my ($soapaction,$lookfor) = ('', 'Body');
480             my ($success,$result) = $self->doHTTP($host,\$soap,$soapaction,$lookfor);
481            
482             return ($success,$result);
483             }
484              
485             =pod
486              
487             =over 4
488              
489             =item startSmsNotification
490              
491             C<>=>
492              
493             $self->startSmsNotification( {
494             username => 'Your ParlayX Username',
495             host => 'ParlayX SMS Gateway',
496             password => 'Password',
497             nonce => 'No Idea What This Does',
498             endpoint => 'YOUR URI that ParlayX will send SMS to',
499             correlator => 'A unique ID for you (more on this later)',
500             interfaceName => 'No idea..always empty as far as I know'
501             } );
502              
503             To register yourself with ParlayX you need to use this. After you do, all SMS to your number will be sent to the
504             URI you specify in ``endpoint''.
505             if you do not specify a correlator, L will be used.
506             Returns 3 scalars, the first indicating success (1) or failure (0), the second your designated correlator (keep this
507             somewhere safe) and the third will normall be empty, except for error cases, where it will contain extended error
508             information.
509             Probably one-off use for it...
510              
511             =back
512              
513             =cut
514              
515             sub startSmsNotification {
516             my $self = shift;
517            
518             $self->{'DEBUG'} and warn "Entering startSmsNotification()\n";
519            
520             my ($username, $password, $nonce, $host, $endpoint, $correlator, $interfaceName, $smsServiceActivationNumber, $criteria);
521             if (ref $_[0] eq 'HASH') {
522             $username = $_[0]->{'username'} || $self->{'username'} || Carp::croak("Cant getSmsDeliveryStatus without username\n");
523             $host = $_[0]->{'host'} || $self->{'host'} || Carp::croak("Cant getSmsDeliveryStatus without ParlayX host definition\n");
524             $password = $_[0]->{'password'} || $self->{'password'} || '';
525             $nonce = $_[0]->{'nonce'} || $self->{'nonce'} || '';
526            
527             $endpoint = $_[0]->{'endpoint'} || $self->{'endpoint'} || '';
528             $correlator = $_[0]->{'correlator'} || $self->{'correlator'} || '';
529             $interfaceName = $_[0]->{'interfaceName'} || $self->{'interfaceName'} || '';
530            
531             $smsServiceActivationNumber = $_[0]->{'smsServiceActivationNumber'} || $self->{'smsServiceActivationNumber'} || '';
532             $criteria = $_[0]->{'criteria'} || $self->{'criteria'} || '';
533            
534             if (!$endpoint) {
535             Carp::croak("Need endpoint for startSmsNotification!\n");
536             }
537             elsif (!$smsServiceActivationNumber) {
538             Carp::croak("Need smsServiceActivationNumber for startSmsNotification!\n");
539             }
540            
541             if (!$correlator) {
542             $correlator = time();
543             }
544             }
545            
546             $self->{'DEBUG'} and warn "Constructing SOAP request..\n";
547            
548             my $soap = $self->soap_startsms_body($username,$password,$nonce,$endpoint,$correlator,$interfaceName,$smsServiceActivationNumber,$criteria);
549            
550             $self->parse_xml(\$soap);
551            
552             $self->{'DEBUG'} and warn "SOAP request passed XML validation, sending HTTP Request\n";
553            
554             my ($soapaction,$lookfor) = ('', 'Body');
555             my ($success,$result) = $self->doHTTP($host,\$soap,$soapaction,$lookfor);
556            
557             return ($success,$correlator,$result);
558             }
559              
560             =pod
561              
562             =head2 Esoterics
563              
564             =over 4
565              
566             =item Before we do this, know that all this is subject (rather mandatory I think) to change.
567              
568             =item soap_header
569              
570             =item soap_footer
571              
572             =item parse_xml
573              
574             =item doHTTP
575              
576             =item soap_startsms_body
577              
578             =item soap_stopsms_body
579              
580             =item soap_deliv_body
581              
582             =item soap_send_body
583              
584             =item soap_receivesms_body
585              
586             =item receipt_request
587              
588             =item charging_info
589              
590             C<>=> In very particular order, the top 4 things are not very likely to change anytime soon,
591             unless L transforms into something usable by a poor smuck like me soon.
592             About the rest, I do not know, especially charging_info and receipt_request are only written
593             based on (shoddy) documentation and have never been used in real life.
594              
595             =back
596              
597             =cut
598              
599             sub soap_startsms_body {
600             my $self = shift;
601            
602             my ($username,$password,$nonce,$endpoint,$correlator,$interfaceName,$smsServiceActivationNumber,$criteria) = @_;
603            
604             my $soap = $self->soap_header($username,$password,$nonce);
605            
606             $soap .= qq[
607            
608             $endpoint
609             $interfaceName
610             $correlator
611            
612             $smsServiceActivationNumber
613             $criteria
614             ];
615            
616             $soap .= $self->soap_footer();
617            
618             return $soap;
619             }
620              
621             sub soap_stopsms_body {
622             my $self = shift;
623            
624             my ($username,$password,$nonce,$correlator) = @_;
625            
626             my $soap = $self->soap_header($username,$password,$nonce);
627            
628             $soap .= qq[
629             $correlator
630             ];
631            
632             $soap .= $self->soap_footer();
633            
634             return $soap;
635             }
636              
637             sub soap_deliv_body {
638             my $self = shift;
639            
640             my ($username,$password,$nonce,$messageid) = @_;
641            
642             my $soap = $self->soap_header($username,$password,$nonce);
643            
644             if (ref($messageid) eq 'ARRAY') {
645             foreach (@{$messageid}) {
646             $soap .= qq[
647             $_
648             ];
649             }
650             }
651             elsif ($messageid) {
652             $soap .= qq[
653             $messageid
654             ];
655             }
656            
657             $soap .= $self->soap_footer();
658            
659             return $soap;
660             }
661              
662             sub soap_send_body {
663             my $self = shift;
664             my ($username,$password,$nonce,$addresses,$senderName,$message,$receiptRequest,$ChargingInformation) = @_;
665            
666             my $soap = $self->soap_header($username,$password,$nonce);
667            
668             if (ref($message) eq 'ARRAY') {
669             #different messages for (possibly) different recipients
670             for (my $i=0; $i < scalar(@{$message}); $i++) {
671            
672             $soap .= qq[];
673            
674             if (ref($addresses) eq 'ARRAY' && $addresses->[$i]) {
675             $soap .= qq[$addresses->[$i]];
676             }
677             else {
678             $soap .= qq[$addresses];
679             }
680            
681             if (ref($senderName) eq 'ARRAY' && $senderName->[$i]) {
682             $soap .= qq[$senderName->[$i]];
683             }
684             else {
685             $soap .= qq[$senderName];
686             }
687            
688             $soap .= qq[$message->[$i]];
689            
690             if (ref($receiptRequest) eq 'ARRAY' && ref($receiptRequest->[$i]) eq 'HASH') {
691             $soap .= $self->receipt_request($receiptRequest->[$i]);
692             }
693             elsif ($receiptRequest) {
694             $soap .= $self->receipt_request($receiptRequest);
695             }
696            
697             if (ref($ChargingInformation) eq 'ARRAY' && ref($ChargingInformation->[$i]) eq 'HASH') {
698             $soap .= $self->charging_info($ChargingInformation->[$i]);
699             }
700             elsif ($ChargingInformation) {
701             $soap .= $self->charging_info($ChargingInformation);
702             }
703            
704             $soap .= qq[];
705             }
706             }
707             elsif (ref($addresses) eq 'ARRAY') {
708             #same message to different recipients
709             foreach (@{$addresses}) {
710             $soap .= qq[
711             $_
712             $message];
713            
714             if ($senderName) {
715             $soap .= qq[$senderName];
716             }
717            
718             if ($receiptRequest) {
719             $soap .= $self->receipt_request($receiptRequest);
720             }
721            
722             if ($ChargingInformation) {
723             $soap .= $self->charging_info($ChargingInformation);
724             }
725            
726             $soap .= qq[];
727             }
728             }
729             else {
730             #one message, one recipient
731             $soap .= qq[
732             $addresses
733             $message];
734            
735             if ($senderName) {
736             $soap .= qq[$senderName];
737             }
738            
739             if ($receiptRequest) {
740             $soap .= $self->receipt_request($receiptRequest);
741             }
742            
743             if ($ChargingInformation) {
744             $soap .= $self->charging_info($ChargingInformation);
745             }
746            
747             $soap .= qq[];
748             }
749            
750             $soap .= $self->soap_footer();
751            
752             return $soap;
753             }
754              
755             sub soap_header {
756             my $self = shift;
757             my $username = shift || $self->{'username'};
758             my $password = shift || $self->{'password'} || '';
759             my $nonce = shift || $self->{'nonce'} || '';
760            
761             if ($password) {
762             $password = q[].$password.q[];
763            
764             #only if password, can nonce make sense or not ?
765             if ($nonce) {
766             $nonce = q[].$nonce.q[];
767             }
768             }
769            
770             return qq[
771            
772            
773            
774            
775             ]
776             .$username
777             .qq[]
778             .$password
779             .$nonce
780             .qq[
781            
782            
783            
784             ];
785             }
786              
787             sub soap_footer {
788             my $self = shift;
789            
790             return qq[
791             ];
792             }
793              
794             sub receipt_request {
795             my $self = shift;
796            
797             my $rr = shift;
798            
799             if (ref($rr) ne 'HASH') {
800             Carp::croak("Cant do receipt request without endpoint, interfaceName or correlator (receiptRequest is not a HASH reference\n");
801             }
802            
803             if ($rr->{'endpoint'}) {
804             $rr->{'endpoint'} = qq[$rr->{'endpoint'}];
805             }
806             if ($rr->{'correlator'}) {
807             $rr->{'correlator'} = qq[$rr->{'correlator'}];
808             }
809             if ($rr->{'interfaceName'}) {
810             $rr->{'interfaceName'} = qq[$rr->{'interfaceName'}];
811             }
812            
813             if ($rr->{'interfaceName'} || $rr->{'correlator'} || $rr->{'endpoint'}) {
814             return qq[ $rr->{'endpoint'} $rr->{'interfaceName'} $rr->{'correlator'} ];
815             }
816             else {
817             return '';
818             }
819             }
820              
821             sub soap_receivesms_body {
822             my $self = shift;
823             my ($username,$password,$nonce,$registrationIdentifier) = @_;
824            
825             my $soap = $self->soap_header($username,$password,$nonce);
826            
827             $soap .= qq[];
828            
829             if ($registrationIdentifier) {
830             $soap .= qq[$registrationIdentifier];
831             }
832            
833             $soap .= qq[];
834            
835             $soap .= $self->soap_footer();
836             }
837              
838             sub charging_info {
839             my $self = shift;
840            
841             my $ci = shift;
842            
843             if (ref($ci) ne 'HASH') {
844             Carp::croak("Cant do charging information without description, currency, amount or code (ChargingInformation is not a HASH reference\n");
845             }
846            
847             if ($ci->{'description'}) {
848             $ci->{'description'} = qq[$ci->{'description'}];
849             }
850             if ($ci->{'currency'}) {
851             $ci->{'currency'} = qq[$ci->{'currency'}];
852             }
853             if ($ci->{'amount'}) {
854             $ci->{'amount'} = qq[$ci->{'amount'}];
855             }
856             if ($ci->{'code'}) {
857             $ci->{'code'} = qq[$ci->{'code'}];
858             }
859            
860             if ( ($ci->{'currency'} && $ci->{'amount'}) || $ci->{'code'} ) {
861             return qq[ $ci->{'currency'} $ci->{'amount'} $ci->{'description'} $ci->{'code'} ];
862             }
863             else {
864             return '';
865             }
866             }
867              
868             sub parse_xml {
869             my $self = shift;
870            
871             my $soap = shift;
872            
873             my $returns = shift || '';
874            
875             my $doc;
876            
877             eval {
878             if (ref($soap)) {
879             $self->{'DEBUG'} and warn "SOAP document:\n". ("-" x 80) . "\n" . $$soap . "\n" .("-" x 80) ."\n";
880             #might be a reference
881             $doc = $self->{'parser'}->parse_string($$soap);
882             }
883             else {
884             $self->{'DEBUG'} and warn "SOAP document:\n". ("-" x 80) . "\n$soap" . "\n" . ("-" x 80) ."\n";
885             $doc = $self->{'parser'}->parse_string($soap);
886             }
887             };
888            
889             if ($@) {
890             if (ref($soap)) {
891             Carp::croak("SOAP document:\n\n$$soap\n\n is not valid XML\n");
892             }
893             else {
894             Carp::croak("SOAP document:\n\n$soap\n\n is not valid XML\n");
895             }
896             }
897            
898             if (!$returns) {
899             return 1;
900             }
901             else {
902             my $ret = '';
903            
904             if (ref($returns) eq 'HASH') {
905             my $count = 0; #one or more ``results'' ?
906             #$ret will be an array of hashes if more than one
907             $ret = [];
908             foreach my $res ($doc->getElementsByTagName('result')) {
909             if ($count) {
910             push @{$ret},$returns;
911             }
912             foreach (keys(%{$returns})) {
913             $returns->{$_} = $res->findvalue($_);
914             }
915             $count++;
916             }
917            
918             if ($count > 1) {
919             #had more than 1 sections
920             push @{$ret},$returns;
921             }
922             else {
923             $ret = $returns;
924             }
925             }
926             else {
927             foreach my $res ($doc->getElementsByTagName($returns)) {
928             $ret = $res->to_literal;
929             }
930             }
931            
932             if (!$ret) {
933             $ret = $doc->findvalue('/');
934             }
935             return $ret;
936             }
937             }
938            
939             sub doHTTP {
940             my $self = shift;
941            
942             my ($host,$soap,$soapaction,$lookfor) = @_;
943            
944             my $req = HTTP::Request->new(POST => $host);
945             #ref $soap to save string copying back and forth...
946             if (ref($soap)) {
947             $req->content($$soap);
948             }
949             else {
950             $req->content($soap);
951             }
952            
953             $req->header('SOAPAction' => $soapaction);
954            
955             my $res = $self->{'ua'}->request($req);
956              
957             if ($res->is_success()) {
958             $self->{'DEBUG'} and warn "Request successfull (200 OK) parsing response...\n";
959            
960             my $result = $self->parse_xml(\$res->content,$lookfor);
961            
962             return (1,$result);
963             }
964             else {
965             if ($res->content) {
966             $self->{'DEBUG'} and warn "Request unsuccessfull parsing response...\n";
967            
968             my $fault = $self->parse_xml(\$res->content,'Fault');
969             return (0,$fault);
970             }
971             else {
972             Carp::croak("request failed with ".$res->as_string."\n");
973             }
974             }
975             }
976            
977             =head1 Revision History
978              
979             0.0.1
980             Initial Release
981             0.0.2
982             Requisite XML::LibXML 1.62 specified in Makefile.PL
983             Fixed some POD formatting issues
984             Fixed some POD typos
985             0.0.3
986             Corrected tag ``ChargingInformation'' to ``charging'' in sub charging_info, as per documentation
987            
988             =head1 Caveats
989            
990             I really mean to split this to Mobile::Messaging::ParlayX::SMS,
991             Mobile::Messaging::ParlayX::MMS and Mobile::Messaging::ParlayX::TS
992             (Terminal Status), but I really ran out of time. Perhaps in the future (along with
993             better SOAP handling).
994             while on the subject of SOAP handling, I use XML::LibXML to validate all objects
995             before sending, receiving or processing them, but this is obviously one area that
996             needs quite a lot of work.
997             I`ve also done very little in terms of charsets, partly because my operator was in
998             no position to tell me and partly because I was lazy. I have no clue what happens
999             with GSM 03.38, UTF-8 and numeric encoded UTF-8 thrown in the mix. I`ve reached a
1000             point where it works semi-reliably for me and - after I take a break - I`ll look
1001             further into this.
1002              
1003             =head1 BUGS
1004              
1005             Initial release...what did you expect ;) - well, not any more, but 0.0.2 fixes
1006             were purely cosmetic in nature.
1007             Seriously now, most of the stuff is confirmed to work but probably not all angles
1008             are covered (in fact, I suspect very few are).
1009              
1010             =head1 ACKNOWLEDGEMENTS
1011              
1012             Obvious thanks to LWP::UserAgent, HTTP::Request and XML::LibXML authors, for none
1013             of this would be possible without them (although some may argue that this would be
1014             a good thing).
1015             Big thanks should also go to Joshua Chamas for Apache::ASP and the mod_perl gurus.
1016              
1017             =head1 AUTHOR
1018              
1019             Thanos Chatziathanassiou
1020             http://www.arx.net
1021              
1022             =head1 COPYRIGHT
1023              
1024             Copyright (c) 2007 arx.net - Thanos Chatziathanassiou . All rights reserved.
1025              
1026             This program is free software; you can redistribute it and/or
1027             modify it under the same terms as Perl itself.
1028              
1029             =cut
1030              
1031             1;