#!/usr/bin/perl
 
use strict;
use WSO2::WSF;
use WSO2::WSF::WSService;
use Apache2::RequestUtil ();
 
my $payload =<<E;
<ns1:echoString xmlns:ns1="http://perl.axis2.org/samples">
  <text>plurk u can haz</text>
</ns1:echoString>
E
 
sub echoFunction {
    my $arg = $_[0];
    my $message = new WSO2::WSF::WSMessage ({'payload' => $arg});
    return $message;
}
 
my %operations = ( 'echoString' => 'echoFunction');
 
if (defined $ENV{MOD_PERL}) {
  my $r = Apache2::RequestUtil->request();
 
  my $service = new WSO2::WSF::WSService(
    {'operations' => \%operations, 'action' => 'testAction'}
  );
 
  $service->reply( $r );
}

static axiom_node_t *
wsf_xml_msg_recv_invoke_other(axis2_msg_recv_t* msg_recv,
        const axutil_env_t* env,
        wsf_svc_info_t* svc_info,
        axis2_msg_ctx_t* in_msg_ctx,
        axis2_msg_ctx_t* out_msg_ctx,
        axis2_char_t* function_name,
        axis2_char_t* class_name)
{
    AXIS2_PARAM_CHECK(env->error, svc_info, NULL);
    AXIS2_PARAM_CHECK(env->error, in_msg_ctx, NULL);
    AXIS2_PARAM_CHECK(env->error, out_msg_ctx, NULL);
 
    axiom_node_t *node = NULL;
    axiom_node_t *om_node = NULL;
    axiom_soap_envelope_t *envelope = NULL;
    axiom_soap_body_t *body = NULL;
    axis2_char_t *retstr = NULL;
    axiom_node_t *soap_body_node = NULL;
 
    /* extracting payload from the soap message */
    envelope = axis2_msg_ctx_get_soap_envelope(in_msg_ctx, env);
    if (!envelope)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "[wsf-perl-service] soap envelope not found");
        return NULL;
    }
 
    body = axiom_soap_envelope_get_body(envelope, env);
    if (!body)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "[wsf-perl-service] soap body not found");
        return NULL;
    }
 
    soap_body_node = axiom_soap_body_get_base_node(body, env);
    if (!soap_body_node)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "[wsf-perl-service] soap body base node not found");
        return NULL;
    }
 
    om_node = axiom_node_get_first_child(soap_body_node, env);
    if (!om_node)
    {
        return NULL;
    }
 
    axis2_char_t *embedding[] = {"-M'WSO2::WSF::C; WSO2::WSF::Service;'", ""};
    if (!svc_info->script_filename)
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI,
                "perl function invocation failed, script_file name not found for "
                "service %s", svc_info->svc_name);
        return NULL;
    }
    /* passing script real path into perl interpreter. */
    embedding[1] = svc_info->script_filename;
 
    my_perl = perl_alloc();
    PL_perl_destruct_level = 0;
/*    PL_use_safe_putenv = 1; */
    PERL_SET_CONTEXT(my_perl);
    perl_construct(my_perl);
 
    PL_origalen = 1;
    PERL_SET_CONTEXT(my_perl);
    if (perl_parse(my_perl, xs_init, 2, embedding, NULL))
    {
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "perl_parse method failed");
        return NULL;
    }
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
    /* perl_run(my_perl); */
 
    if (SvTRUE(ERRSV))
    {
        AXIS2_LOG_DEBUG(env->log, AXIS2_LOG_SI, "invoke perl function failed");
    }
 
    retstr = invoke_perl_function(env, om_node, function_name, NULL);
 
    if (retstr)
    {
        node = wsf_util_deserialize_buffer(env, retstr);
    }
 
    PERL_SET_CONTEXT(my_perl);
    perl_destruct(my_perl);
    PERL_SET_CONTEXT(my_perl);
    perl_free(my_perl);
    PERL_SYS_TERM();
    AXIS2_LOG_DEBUG(env->log, AXIS2_LOG_SI, axiom_node_to_string(node, env));
    return node;
}
 
static axis2_char_t *
invoke_perl_function(const axutil_env_t *env, axiom_node_t *om_node,
        axis2_char_t *operation, axis2_char_t *class_name)
{
    int count = 0;
    axis2_char_t *inmsg = NULL;
    SV **wsmsg_str = NULL; /* hold the value for the key 'payload' in WSMessage */
    SV *wsmsg_ref = NULL; /* reference to a WSMessage object */
    HV *wsmsg = NULL; /* WSMessage object */
    char *tmp_str = NULL;
    axis2_char_t *res_payload_str = NULL;
 
    if (!operation)
    {
        AXIS2_LOG_DEBUG(env->log, AXIS2_LOG_SI,
                "invoking perl function failed, operation not available");
        return NULL;
    }
 
    if (om_node)
    {
        inmsg = axiom_node_to_string(om_node, env);
    }
 
    /* declare and init a local copy of the Perl stack pointer */
    dSP;
 
    /* mortal SVs for the stack */
    ENTER;
    SAVETMPS;
 
    /* "record" the current stack pointer */
    PUSHMARK(SP);
 
    /* push parameters to the stack */
    XPUSHs(sv_2mortal(newSVpv(inmsg, 0)));
 
    /* make the global copy of the stack pointer same as the local copy */
    PUTBACK;
 
    /* call the Perl function, expecting a scalar to be returned */
    count = call_pv(operation, G_SCALAR);
 
    /* refreshing the local copy of the stack pointer, call_pv might have reallocated it */
    SPAGAIN;
 
    if (count != 1)
    {
        croak("perl function invocation failed") ;
        AXIS2_LOG_ERROR(env->log, AXIS2_LOG_SI, "perl function %s invocation failed", operation);
    }
 
    /* get the scalar reference from the stack */
    wsmsg_ref = (SV *) POPs;
 
    /* getting the object from the reference */
    wsmsg = SvRV(wsmsg_ref);
 
    /* fetching the value of the member variable 'payload' from WSMessage */
    wsmsg_str = hv_fetch(wsmsg, "payload", 7, FALSE);
 
    /* perl scalar to c string */
    tmp_str = SvPVutf8_nolen(*wsmsg_str);
    res_payload_str = (axis2_char_t *) savepvn(tmp_str, strlen(tmp_str));
 
    PUTBACK;
 
    /* cleaning up mortal SVs */
    FREETMPS;
    LEAVE;
 
    return res_payload_str;
}