@ISA
= (
'SAP::Rfc'
);
$VERSION
=
'0.01'
;
use
vars
qw($SOAPLiteMode)
;
$SOAPLiteMode
=
undef
;
$NAMESPACE
=
" xmlns:rfc=\"urn:sap-com:document:sap:rfc:functions\""
;
sub
soapRequest {
my
(
$self
,
$xml
) =
@_
;
my
$soap
=
""
;
if
(
$SAP::SOAP::SOAPLiteMode
){
$soap
=
$xml
;
}
else
{
eval
{
$soap
= SOAP::Deserializer->deserialize(
$xml
);
};
return
$self
->soapFault(
'Server'
,
"XML::Parser of SOAP request failed"
,
"ERROR: $@"
)
if
$@;
};
my
$name
=
$soap
->dataof(
"/Envelope/Body/[1]"
)->name();
print
STDERR
"NAME IS: "
.
$name
.
"\n"
;
my
(
$rfcname
) =
$soap
->dataof(
"/Envelope/Body/[1]"
)->name() =~ /.*\:(.*?)$/;
print
STDERR
"RFCNAME THING: "
.
$soap
->dataof(
"/Envelope/Body/[1]"
)->name().
"\n"
;
print
STDERR
"RFCNAME IS: "
.
$rfcname
.
"\n"
;
my
$iface
=
$self
->{
'INTERFACES'
}->{
$rfcname
} ||
""
;
if
( !
$iface
) {
eval
{
$iface
=
$self
->discover(
$rfcname
||
$name
);
};
return
$self
->soapFault(
'Server'
,
"SAP::Rfc discover of $rfcname failed"
,
"ERROR: $@"
)
if
$@;
};
$iface
->
reset
;
foreach
my
$data
(
$soap
->dataof(
"/Envelope/Body/"
.
$name
.
'/*'
) ){
if
(
$iface
->isTab(
$data
->name) ){
my
$struct
=
$iface
->tab(
$data
->name)->structure;
my
@rows
= ();
foreach
my
$row
(
$soap
->dataof(
"/Envelope/Body/"
.
$name
.
'/'
.
$data
->name.
'/*'
) ){
map
{
eval
{
$struct
->fieldValue(
$_
,
$row
->value->{
$_
}); };
return
$self
->soapFault(
'Server'
,
"Encoded parameter field not found: "
.
$data
->name.
" - $_"
,
"ERROR: $@"
)
if
$@;
} (
$struct
->fields );
push
(
@rows
,
$struct
->value );
};
$iface
->tab(
$data
->name)->rows(\
@rows
);
}
else
{
my
$struct
=
""
;
eval
{
$struct
=
$iface
->parm(
$data
->name)->structure;
};
return
$self
->soapFault(
'Server'
,
"Encoded parameter not found: "
.
$data
->name,
"ERROR: $@"
)
if
$@;
if
(
$struct
){
map
{
eval
{
$struct
->fieldValue(
$_
,
$data
->value->{
$_
}); };
return
$self
->soapFault(
'Server'
,
"Encoded parameter field not found: "
.
$data
->name.
" - $_"
,
"ERROR: $@"
)
if
$@;
} (
$struct
->fields );
$iface
->parm(
$data
->name)->intvalue(
$struct
->value );
}
else
{
eval
{
$iface
->parm(
$data
->name)->value(
$data
->value);
};
return
$self
->soapFault(
'Server'
,
"Encoded parameter not found: "
.
$data
->name,
"ERROR: $@"
)
if
$@;
};
};
}
return
$iface
;
}
sub
soapCall {
my
(
$self
,
$xml
) =
@_
;
my
$iface
=
$self
->soapRequest(
$xml
);
return
(
$iface
, 1)
if
!
ref
(
$iface
);
print
STDERR
"Abount to do the call: "
. Dumper(
$iface
).
"\n"
;
eval
{
$self
->callrfc(
$iface
);
};
print
STDERR
"After the call: "
. Dumper(
$iface
).
"\n"
;
return
$self
->soapFault(
'Server'
,
"SAP::Rfc call of "
.
$iface
->name.
" failed"
,
"ERROR: $@"
)
if
$@;
return
$SAP::SOAP::SOAPLiteMode
?
$iface
:
$self
->soapResponse(
$iface
);
}
sub
soapResponse {
my
(
$self
,
$iface
) =
@_
;
my
$start_content
=
<<ENDOFHDR;
<?xml version="1.0" encoding="ISO-8859-1"?>
<SOAP-ENV:Body>
ENDOFHDR
my
$end_content
=
<<ENDOFTRL;
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
ENDOFTRL
my
$intrfc
=
$iface
->name();
$intrfc
=~ s/\//\_\-/g;
my
$xml_out
=
"<rfc:"
.
$intrfc
.
$NAMESPACE
.
">\n"
;
map
{
my
$p
=
$_
;
$xml_out
.=
" <"
.
$p
->name .
">"
;
if
(
$p
->structure ){
my
$flds
=
$p
->value();
$xml_out
.=
"\n"
;
map
{
$xml_out
.=
" <$_>"
.
$flds
->{
$_
}.
"<\/$_>\n"
;
} (
keys
%{
$flds
} );
}
else
{
$xml_out
.=
$p
->value;
};
$xml_out
.=
" <\/"
.
$p
->name .
">\n"
;
} (
$iface
->parms );
map
{
my
$tab
=
$_
;
$xml_out
.=
" <"
.
$tab
->name .
">\n"
;
foreach
my
$row
(
$tab
->hashRows ){
$xml_out
.=
" <item>\n"
;
map
{
$xml_out
.=
" <$_>$row->{$_}<\/$_>\n"
}
keys
%{
$row
};
$xml_out
.=
" <\/item>\n"
;
};
$xml_out
.=
" <\/"
.
$tab
->name .
">\n"
} (
$iface
->tabs );
$xml_out
.=
"<\/rfc:"
.
$intrfc
.
">\n"
;
$iface
->
reset
;
return
$start_content
.
$xml_out
.
$end_content
;
}
sub
soapFault {
my
(
$self
,
$faultcode
,
$faultstring
,
$result_desc
) =
@_
;
if
(
$SOAPLiteMode
){
die
SOAP::Fault->faultcode(
$faultcode
)
->faultstring(
$faultstring
)
->faultdetail(
bless
{
code
=> 1} =>
$result_desc
)
};
my
$response_content
=
<<EOFFAULT;
<?xml version="1.0" encoding="ISO-8859-1"?>
<SOAP-ENV:Body>
<SOAP-ENV:Fault>
<faultcode>SOAP-ENV:$faultcode</faultcode>
<faultstring>$faultstring</faultstring>
<detail>$result_desc</detail>
</SOAP-ENV:Fault>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
EOFFAULT
my
$response_content_length
=
length
$response_content
;
return
$response_content
;
}
1;