File Coverage

blib/lib/SAP/WAS/SOAP.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package SAP::WAS::SOAP;
2              
3              
4 1     1   635 use strict;
  1         2  
  1         29  
5              
6 1     1   607 use SAP::WAS::Iface;
  1         2  
  1         26  
7 1     1   2232 use SOAP::Lite;
  0            
  0            
8              
9              
10             my $sr = "";
11             my $namespace = "rfc:";
12             my $muri = "urn:sap-com:document:sap:rfc:functions";
13             my $s = new SOAP::Lite->uri( $muri );
14             $s->encoding('ISO-8859-1');
15              
16             import SOAP::Data 'name';
17              
18              
19              
20             use Data::Dumper;
21              
22              
23              
24             use vars qw($VERSION $AUTOLOAD);
25              
26             # Global debug flag
27             my $DEBUG = undef;
28              
29             # Valid parameters
30             my $VALID = {
31             URL => 1,
32             USERID => 1,
33             PASSWD => 1
34             };
35              
36             my $_out = "";
37             my $_cell = "";
38             my $_tagre = "";
39              
40             $VERSION = '0.05';
41              
42             # Preloaded methods go here.
43              
44              
45             sub new {
46              
47             my $proto = shift;
48             my $class = ref($proto) || $proto;
49             my $self = {
50             @_
51             };
52              
53             die "SOAP URL not supplied !" if ! exists $self->{URL};
54             die "SAP WAS USERID not supplied !" if ! exists $self->{USERID};
55             die "SAP WAS Password not supplied (PASSWD) !" if ! exists $self->{PASSWD};
56              
57             # Validate parameters
58             map { delete $self->{$_} if ! exists $VALID->{$_} } keys %{$self};
59              
60             # check that the service exists
61             # $self->{WAS} = new SAP::WAS(
62             # server => $self->{SERVER},
63             # user => $self->{USERID},
64             # password => $self->{PASSWD}
65             # );
66              
67             # Fix credentials as supplied by Christian Wippermann
68             eval '
69             sub SOAP::Transport::HTTP::Client::get_basic_credentials {
70             #warn "credentials $self->{USERID} => $self->{PASSWD} \n";
71             return "$self->{USERID}" => "$self->{PASSWD}";
72             }
73             ';
74             # create the object and return it
75             bless ($self, $class);
76             return $self;
77             }
78              
79              
80             # method to return a structure object of SAP::Structure type
81             sub structure {
82              
83             my $self = shift;
84             my $struct = shift;
85             #my $info = $self->sapinfo();
86              
87             my @parms = (name('TABNAME'=> $struct), name('FIELDS'));
88             my $methname = "RFC_GET_STRUCTURE_DEFINITION_P";
89             #my $meth = 'rfc:'.$methname;
90             my $meth = $methname;
91             my $element = $methname.'.Response';
92             #$sr = $s->serializer->autotype(0)->readable(1)->method( $namespace.$methname => @parms );
93             $sr = $s->serializer->autotype(0)->readable(1)->method( $methname => @parms );
94             #print "$methname SOAP: $sr\n";
95             my $som = $s->uri($muri)->proxy($self->{'URL'})->$meth( @parms );
96             my @res = $som->valueof("//Envelope/Body/$element/FIELDS/item");
97              
98              
99             $struct = SAP::WAS::Struc->new( NAME => $struct );
100              
101             foreach my $field ( @res ){
102             $struct->addField( NAME => $field->{'FIELDNAME'},
103             TYPE => 'chars' );
104             }
105              
106             return $struct;
107              
108             }
109              
110              
111             # method to dynamically create functions SAP::WAS::Iface
112             sub Iface{
113              
114             my $self = shift;
115             my $rfcname = shift;
116             die "No RFC name supplied to lookup " if ! $rfcname;
117              
118             my $info = {};
119             my @parms = (name( 'FUNCNAME' => $rfcname), name('PARAMS_P'));
120             my $methname = "RFC_GET_FUNCTION_INTERFACE_P";
121             #my $meth = 'rfc:'.$methname;
122             my $meth = $methname;
123             my $element = $methname.'.Response';
124             #print "$methname SOAP: $sr\n";
125             #$sr = $s->serializer->autotype(0)->readable(1)->method( $namespace.$methname => @parms );
126             $sr = $s->serializer->autotype(0)->readable(1)->method( $methname => @parms );
127             my $som = $s->uri($muri)->proxy($self->{'URL'})->$meth( @parms );
128             my @res = $som->valueof("//Envelope/Body/$element/PARAMS_P/item");
129             # print STDERR "//Envelope/Body/$element/PARAMS_P \n".Dumper(\@res);
130              
131             my $iface = new SAP::WAS::Iface( NAME => $rfcname );
132              
133             foreach my $parm ( @res ){
134             my $type = $parm->{'PARAMCLASS'};
135             my $datatype = $parm->{'EXID'};
136             my $default = $parm->{'DEFAULT'};
137             my $text = $parm->{'PARAMTEXT'};
138             my $name = $parm->{'PARAMETER'};
139             my $tabname = $parm->{'TABNAME'};
140             $tabname =~ s/\s//g;
141             my $field = $parm->{'FIELDNAME'};
142             $field =~ s/\s//g;
143             my $intlen = $parm->{'INTLENGTH'};
144             $intlen = int($intlen);
145             my $decs = $parm->{'DECIMALS'};
146             $decs = int($decs);
147             my $pos = $parm->{'POSITION'};
148             $pos = int($pos);
149             my $off = $parm->{'OFFSET'};
150             $off = int($off);
151             # if the character value default is in quotes - remove quotes
152             if ($defaul't =~ /^\'(.*?)\'\s*$/){
153             $default = $1;
154             # if the value is an SY- field - we have some of them in sapinfo
155             } elsif ($default =~ /^SY\-(\w+)\W*$/) {
156             $default = 'RFC'.$1;
157             if ( exists $info->{$default} ) {
158             $default = $info->{$default};
159             } else {
160             $default = undef;
161             };
162             };
163             my $structure = "";
164             if ($datatype eq "C"){
165             # Character
166             # $datatype = RFCTYPE_CHAR;
167             $default = " " if $default =~ /^SPACE\s*$/;
168             # print STDERR "SET $name TO $default \n";
169             } elsif ($datatype eq "X"){
170             # Integer
171             # $datatype = RFCTYPE_BYTE;
172             $default = pack("H*", $default) if $default;
173             } elsif ($datatype eq "I"){
174             # Integer
175             # $datatype = RFCTYPE_INT;
176             $default = int($default) if $default;
177             } elsif ($datatype eq "s"){
178             # Short Integer
179             # $datatype = RFCTYPE_INT2;
180             $default = int($default) if $default;
181             } elsif ($datatype eq "D"){
182             # Date
183             # $datatype = RFCTYPE_DATE;
184             $default = '00000000';
185             $intlen = 8;
186             } elsif ($datatype eq "T"){
187             # Time
188             # $datatype = RFCTYPE_TIME;
189             $default = '000000';
190             $intlen = 6;
191             } elsif ($datatype eq "P"){
192             # Binary Coded Decimal eg. CURR QUAN etc
193             # $datatype = RFCTYPE_BCD;
194             #$default = 0;
195             } elsif ($datatype eq "N"){
196             # Numchar
197             # $datatype = RFCTYPE_NUM;
198             #$default = 0;
199             $default = sprintf("%0".$intlen."d", $default)
200             if $default == 0 || $default =~ /^[0-9]+$/;
201             } elsif ($datatype eq "F"){
202             # Float
203             # $datatype = RFCTYPE_FLOAT;
204             #$default = 0;
205             # } elsif ( ($datatype eq " " or ! $datatype ) and $type ne "X"){
206             } elsif ( ! $field and $type ne "X"){
207             # do a structure object
208             $structure = structure( $self, $tabname );
209             # $datatype = RFCTYPE_BYTE;
210             } else {
211             # Character
212             # $datatype = RFCTYPE_CHAR;
213             $datatype = "C";
214             $default = " " if $default =~ /^SPACE\s*$/;
215             };
216             # $datatype = RFCTYPE_CHAR if ! $datatype;
217             $datatype = "C" if ! $datatype;
218             if ($type eq "I"){
219             # Export Parameter - Reverse perspective
220             $iface->addParm( NAME => $name,
221             PHASE => 'I',
222             TYPE => 'chars',
223             STRUCTURE => $structure );
224             # $interface->addParm(
225             # TYPE => RFCEXPORT,
226             # INTYPE => $datatype,
227             # NAME => $name,
228             # STRUCTURE => $structure,
229             # DEFAULT => $default,
230             # VALUE => $default,
231             # DECIMALS => $decs,
232             # LEN => $intlen);
233             } elsif ( $type eq "E"){
234             # Import Parameter - Reverse perspective
235             $iface->addParm( NAME => $name,
236             PHASE => 'E',
237             TYPE => 'chars',
238             STRUCTURE => $structure );
239             # $interface->addParm(
240             # TYPE => RFCIMPORT,
241             # INTYPE => $datatype,
242             # NAME => $name,
243             # STRUCTURE => $structure,
244             # VALUE => undef,
245             # DECIMALS => $decs,
246             # LEN => $intlen);
247             } elsif ( $type eq "T"){
248             # Table
249             $iface->addTab( NAME => $name,
250             STRUCTURE => $structure );
251             # $interface->addTab(
252             # # INTYPE => $datatype,
253             # INTYPE => RFCTYPE_BYTE,
254             # NAME => $name,
255             # STRUCTURE => $structure,
256             # LEN => $intlen);
257             } else {
258             # This is an exception definition
259             # $iface->addException( $name );
260             };
261             };
262              
263              
264             # print STDERR "Iface: ".Dumper($iface);
265             return $iface;
266              
267             }
268              
269              
270             # Call The Function module
271             sub soaprfc {
272             my $intrfc = "";
273             my $self = shift;
274             my $iface = shift;
275             my $ref = ref($iface);
276             die "this is not an Interface Object!"
277             unless $ref eq "SAP::WAS::Iface" and $ref;
278              
279              
280             my $methname = $iface->name();
281             #my $meth = 'rfc:'.$methname;
282             my $meth = $methname;
283             my $element = $methname.'.Response';
284              
285             #my @parms = ( name( 'FUNCNAME'=> $rfcname ) );
286             my @parms = ();
287             foreach my $p ( $iface->Parms ){
288             next unless $p->phase() eq 'I';
289             if (my $s = $p->structure ){
290             my @fields = ();
291             foreach my $f ( $s->Fields ){
292             push( @fields, \name( $f => $s->Fieldvalue($f) ) );
293             }
294             push( @parms, name( $p->name() => @fields ) );
295             } else {
296             push( @parms, name( $p->name() => $p->value() ) );
297             }
298             }
299            
300             foreach my $t ( $iface->Tabs ){
301             my @items = ();
302             while ( my $row = $t->nextrow ){
303             my @fields = ();
304             map { push ( @fields, \name( $_ => $row->{$_} ) ) } keys %{$row};
305             push( @items, \name( item => @fields ) );
306             };
307             push( @parms, name( $t->name() => @items ) );
308             }
309              
310             #$sr = $s->serializer->autotype(0)->readable(1)->method( $namespace.$methname => @parms );
311             $sr = $s->serializer->autotype(0)->readable(1)->method( $methname => @parms );
312             #print "$methname SOAP: $sr\n";
313              
314              
315              
316             my $som = $s->uri($muri)->proxy($self->{'URL'})->$meth( @parms );
317              
318              
319              
320             foreach my $p ( $iface->Parms ){
321             next unless $p->phase() ne 'I';
322             if (my $s = $p->structure ){
323             my $res = $som->valueof("//Envelope/Body/$element/".$p->name());
324             # print STDERR "//Envelope/Body/$element/".$p->name()."\n".Dumper($res);
325             foreach my $f ( $s->Fields ){
326             $s->Fieldvalue($f, $res->{$f});
327             }
328             } else {
329             my $res = $som->valueof("//Envelope/Body/$element/".$p->name());
330             # print STDERR "//Envelope/Body/$element/".$p->name()."\n".Dumper($res);
331             $p->value($res);
332             }
333             }
334            
335             foreach my $t ( $iface->Tabs ){
336             my @res = $som->valueof("//Envelope/Body/$element/".$t->name()."/item");
337             $t->empty;
338             $t->rows( \@res );
339             }
340              
341             return $iface;
342              
343             }
344              
345              
346              
347             =head1 NAME
348              
349             SAP::WAS::SOAP - SOAP encoded RFC calls against SAP R/3 / Web Application Server (WAS)
350              
351             =head1 SYNOPSIS
352              
353             # Setup up a service in the SAP WAS server for an RFC-XML based call to RFC_READ_REPORT
354             # called test:ReadReport to make this example work
355              
356             use SAP::WAS::SOAP;
357             use Data::Dumper;
358              
359             my $url = 'http://localhost:8080/sap/bc/soap/rfc';
360             my $rfcname = 'RFC_READ_REPORT';
361              
362             # build the connecting object
363             my $sapsoap = new SAP::WAS::SOAP( URL => $url );
364              
365             # Discover the interface definition for a function module
366             my $i = $sapsoap->Iface( $rfcname );
367              
368             # set a parameter value of the interface
369             $i->Parm('PROGRAM')->value('SAPLGRAP');
370              
371             # call the WAS soap service with an interface object
372             $sapsoap->soaprfc( $i );
373              
374             print "Name:", $i->TRDIR->structure->NAME, "\n";
375              
376             print "Array of Code Lines ( a hash per line including struture fieldnames ):\n";
377             print Dumper ( $i->Tab('QTAB')->rows );
378              
379              
380              
381             =head1 DESCRIPTION
382              
383             Enabler for HTTP based SOAP calls to SAP using the WAS ( Web Application Server ) using the ICMAN interface ( SAP's Internet Connection MANager ).
384             You need to ensure that login to the /sap/bc/soap/rfc service has been configured correctly using SAP transaction SICF, first, or this will not work ( under the version 6.10 WAS that I used the only thing I had to change was the settings for the auto login user ) - this corresponds directly to the URL that is supplied to the SAP::WAS::SOAP constructor.
385              
386              
387             =head1 METHODS:
388              
389             my $rfc = new SAP::WAS::SOAP( URL => );
390              
391             my $i = $rfc->Iface( );
392              
393             < set some parameters in the interface object > .....
394              
395             $rfc->soaprfc( $i ); # execute the rfc call encoded in SOAP via the WAS
396              
397              
398             =head1 AUTHOR
399              
400             Piers Harding, saprfc@kogut.demon.co.uk.
401              
402             But Credit must go to all those that have helped.
403              
404              
405             =head1 SEE ALSO
406              
407             perl(1), SAP::WAS::SOAP(3), SAP::WAS::Iface(3)
408              
409             =cut
410              
411             1;