The main annoyance I faced was the lack of a proper error reporting mechanism. When you have an error on your controller, the script that starts the server simply refuse to start you can see the following VERY helpful error message in the console.

Unknown error
Compilation failed in require at /usr/share/perl5/Catalyst/Utils.pm line 270.
Compilation failed in require at ./script/stocktrader_server.pl line 55.

You cannot find out where the error occured. Only conclusion that you can make out of this is that there is an error in one of your controllers. Errors in models are shown correctly as they should. Template errors can easily be fixed. If you haven’t been doing incremental development, meaning you add a little bit of code then start the server and see whether everything has worked ok up to now, you’ll be in serious trouble. If you have the habit of writing large amounts of code without testing and keep testing for the last minute, Catalyst will torture you and put you through hellish debugging sessions for hours. I spent an inordinate amount of time trying to figure out the error and finally spotted that I’ve forgotten to make a single variable lexically scoped with my.

I also configured Log4perl to log all the errors to a log file and enabled the option to log warnings. Sadly I could not see any more log messages than I see in the console.

That aside, Catalyst is a fantastic framework to write web applications if you know Perl. As a big fan of frameworks it’s so exciting to see high quality open source MVC frameworks being developed that drastically reduce the effort of building web applications. Whatever the language you’re comfortable in programming, you can easily find a decent MVC framework for it these days. Well .. almost.

Catalyst is a MVC framework written in Perl. If you’ve written any applications with Ruby on Rails or Django, the first thing you’ll notice is, like anything written in Perl, speed. Also, another difference that I see with Catalyst is the unprecedented flexibility it gives to the hands of the application developer. For a framework providing this level of flexibility, Catalyst is surprisingly easy to program with. Will write more about my Catalyst chronicles in another post.

#!/usr/bin/env perl

sub getRandomNumber {
    return 4;
}

I’m going to assuming you have configured your web server to execute Perl scripts ending with .pl via ModPerl for a directory called perl. You copy the file and it’s accessible from http://localhost/perl/random.pl. And it’s a web service now. So you can send an XML payload like,

And get back something like,

4

Since I’m using WSF/C as the underlying Web service engine and it provides various other facilities like WS-Security, WS-ReliableMessaging etc… at blazing speed, I wanna use it.

Here’s a simplified graphical version of the story,

1. Request comes to rand.pl via ModPerl and it gets executed.
2. rand.pl then calls some methods in Service.pm module which in turn calls to some C functions.
3. From one of those C functions we need to call a Perl function residing in the script the request came into.

If you’re wondering how the graphic relates to the story of copying your Perl script and making it a service (‘cos there’s a Service.pm in the picture), please note that I’ve not yet figured out every detail in the system

Perl is segfaulting at all the bizzare places when this is executed. When things get this bad it’s time to write a very simple application that does the same thing without any WSF/C code. Here’s how I did it.

I started by creating a new Perl extension in C.

$ h2xs -A -n ICanHaz

This’ll create the skeleton and all I have to do is edit the .xs file and put my code there. Here’s my ICanHaz.xs file,

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include 

#include "ppport.h"

static	PerlInterpreter *my_perl;

void cheeseburger( void )
{
    char *embedding[] = {"/usr/local/apache2/perl/exec-this.pl"};

    my_perl = perl_alloc();
    perl_construct(my_perl);
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
    perl_parse(my_perl, NULL, 1, embedding, NULL);
    perl_run(my_perl);
    perl_destruct(my_perl);
    perl_free(my_perl);
    PERL_SYS_TERM();
}

MODULE = ICanHaz		PACKAGE = ICanHaz		

void
cheeseburger()

Now you have to edit Makefile.PL and give the output of, perl -MExtUtils::Embed -e ccopts -e ldopts to the compiler flags. After that you can compile and install the module. Here’s what’s inside exec-this.pl,

sub keele_teh_urth {
    print "oh noez. i iz gud kitteh";
}

Just a simple function. Then I wrote another Perl script to invoke the method in my C extension. Here’s the program,

#!/usr/local/bin/perl

use ICanHaz;

ICanHaz::cheeseburger();

print "Content-type: text/html\n\n";
print "dis segfaults, srsly.\n";

Executing this file via ModPerl results in a segmentation fault. As you can see even the simplest case of embedding will not execute through ModPerl. Switched to CGI and got the same results. Possible alternatives to try is 1) move all the embedding stuff to it’s own executable, when you need to call the Perl function from C do a fork followed by exec, pass the payload as a parameter, store the result in a shared memory and once done read from it (this .. um .. a bit ugly to say the least). Second alternative is to use PPI. I haven’t looked into PPI yet so don’t know for sure whether it’s possible.

We used SWIG to generate some wrapper functions (plus some custom written C code) which belongs to WSF/C and wrote a Perl module encapsulating the lower level stuff. So when you have to write a Web service in Perl all you have to do is use WSO2::WSF::Service; in your script and call a couple of functions. As the deployment scenario we choose Apache with ModPerl. That combination seemd logical and some of the heavy trafficked sites are using that.

It gets interesting when you test the whole thing. Apache is configured to run ModPerl on a folder named /perl so requests matching /perl/something will go through ModPerl. ResponseHandler is ModPerl::Registry and also GlobalRequest has been enabled to get the global request via Apache::RequestUtil->request().

Say, we have a service script named echo_service.pl which simply return back whatever it gets. Here’s the code,

#!/usr/bin/perl

use strict;
use WSO2::WSF;
use WSO2::WSF::WSService;
use Apache2::RequestUtil ();

my $payload =<
  plurk u can haz

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 );
}

When it goes to the reply method it’ll call up some C routines. Inside one of those C functions, after determining the function name to call by looking at the request payload, we need to call it. From a C function. How can you do that? By embedding the Perl interpreter. AFAIK, you cannot call a Perl function from C without embedding the interpreter (please correct me if I’m wrong). In WSF/Ruby server side there was no such issue because the entire Ruby module (WSService class and methods) is written in C.

Let me show you the code that embeds the interpreter and calls the function after looking at the XML payload in the request,

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;
}

Full source is here (note that the actual source might be different from what you see here since it’s being modified at the time of this writing). Also my_perl is declared as a static variable. The problem is when my_perl gets freed it looks like ModPerl is also affected. A valgrind report shows that it tries to read from a pointer after perl_free() gets called. As the following valgrind exerpt shows,

==16101== Invalid read of size 4
==16101==    at 0x62AD118: _wrap_wsf_worker_process_request (wsf_wrap.c:4167)
==16101==    by 0x5476D68: Perl_pp_entersub (pp_hot.c:2847)
==16101==    by 0x5438092: Perl_runops_debug (dump.c:1931)
==16101==    by 0x546FF97: Perl_call_sv (perl.c:2646)
==16101==    by 0x4DC2AF3: modperl_callback (modperl_callback.c:101)
==16101==    by 0x4DC388B: modperl_callback_run_handlers (modperl_callback.c:262)
==16101==    by 0x4DC4289: modperl_callback_per_dir (modperl_callback.c:369)
==16101==    by 0x4DBB53E: modperl_response_handler_run (mod_perl.c:1004)
==16101==    by 0x4DBB704: modperl_response_handler_cgi (mod_perl.c:1099)
==16101==    by 0x25A6C: ap_run_handler (config.c:158)
==16101==    by 0x295BE: ap_invoke_handler (config.c:372)
==16101==    by 0x35D80: ap_process_request (http_request.c:258)
==16101==  Address 0x649051c is 12 bytes inside a block of size 1,692 free'd
==16101==    at 0x480590A: free (vg_replace_malloc.c:323)
==16101==    by 0x546AED4: perl_free (perl.c:1394)
==16101==    by 0x62BD599: wsf_xml_msg_recv_invoke_business_logic_sync (wsf_xml_msg_recv.c:452)
==16101==    by 0x613D503: axis2_msg_recv_invoke_business_logic (msg_recv.c:392)
==16101==    by 0x613DB34: axis2_msg_recv_receive_impl (msg_recv.c:319)
==16101==    by 0x613D583: axis2_msg_recv_receive (msg_recv.c:431)
==16101==    by 0x61327D4: axis2_engine_receive (engine.c:315)
==16101==    by 0x6167177: axis2_http_transport_utils_process_http_post_request (http_transport_utils.c:595)
==16101==    by 0x62BE9B3: wsf_worker_process_request (wsf_worker.c:301)
==16101==    by 0x62AD0F7: _wrap_wsf_worker_process_request (wsf_wrap.c:4166)
==16101==    by 0x5476D68: Perl_pp_entersub (pp_hot.c:2847)
==16101==    by 0x5438092: Perl_runops_debug (dump.c:1931)

Still haven’t been able to pin down what exactly happens when perl_free() gets called

This release again has only support only on the client side, if you’re looking forward to write/host services with WSF/Perl you still have to wait a bit more. Dinesh and Danushka has done some excellent progress on that front and will be finishing it soon. If you wanna know how it’s taking shape, then by all means.

The C function reading the image had a char * return type. The code that was generated by SWIG was returning the pointer after running it through the following function,

SWIG_FromCharPtr(const char *cptr)
{
  return SWIG_FromCharPtrAndSize(cptr, (cptr ? strlen(cptr) : 0));
}

The rough English translation of the above is, “you’re screwed”. Why? The strlen doesn’t particularly like to go through binary strings. It’ll choke and die when it see a null byte. So, only the content before the null byte was returned.

The solution was to create a string using the API provided by the particular scripting language. For Perl it’s newSVpv and for Ruby it’s rb_str_new. Wrapped the functions inside an ifdef (thanks to the nice SWIG<lang> defines) and all is set for MTOM!

First, let’s see an example from “Processing XML with Java” (Amazon page) also available online here. I’m using the SOAP header example to show you how to generate the exact thing.

    Elliotte Harold
    VISA
    5125456787651230
    2005-12

Here’s how you can generate the above headers using WSF/Perl,

my $name = new WSO2::WSF::WSHeader(
    {'name' => 'Name', 'data' => 'Elliotte Harold' } );

my $issuer = new WSO2::WSF::WSHeader(
    {'name' => 'Issuer', 'data' => 'VISA' } );

my $number = new WSO2::WSF::WSHeader(
    {'name' => 'Number', 'data' => '5125456787651230' } );

my $expires = new WSO2::WSF::WSHeader(
    {'name' => 'Expires', 'data' => '2005-12' } );

my $payment = new WSO2::WSF::WSHeader(
    {'name' => 'Payment',
      'ns' => 'http://namespaces.cafeconleche.org/xmljava/ch2/',
      'data' => [$name, $issuer, $number, $expires] } );

my $client = new WSO2::WSF::WSClient(
    {...,
     'inputHeaders' => [$payment] } );

In the next example it shows the header with the mustUnderstand attribute set, this is how you set it,

my $client = new WSO2::WSF::WSClient(
    {...,
     'mustUnderstand' => 'true',
     'inputHeaders' => [$payment] } );

Next, I’ll take an example from a developerWorks article that shows you how to manipulate SOAP headers in WebSphere. Consider the following header contents (Listing 4 in the article)

    ServiceRequester1
    1.0
    13:20:00

The main difference in this is that it contains a custom prefix for the element CallingApplication. Here’s the WSF/Perl code to generate this header,

my $name = new WSO2::WSF::WSHeader(
    {'name' => 'name', 'data' => 'ServiceRequester1' } );

my $version = new WSO2::WSF::WSHeader(
    {'name' => 'version', 'data' => '1.0' } );

my $timereq = new WSO2::WSF::WSHeader(
    {'name' => 'timeRequestMade', 'data' => '13:20:00' } );

my $capp = new WSO2::WSF::WSHeader(
    {'name' => 'CallingApplication', 'ns' => 'http://SOAPHeaderDemonstration',
     'nsprefix' => 'MyPrefix',
     'data' => [$name, $version, $timereq] } );

my $client = new WSO2::WSF::WSClient(
    {...,
     'inputHeaders' => [$capp] } );

As you saw in the examples, WSHeader class facilitate creating custom SOAP headers with WSF/Perl.

This was a real issue that we came across developing the Ruby and Perl bindings for the WSF/C framework. Also having the Python binding in sight. We use SWIG to generate language bindings. Having learned the price you have to pay exposing the lowest level functions, I’m gonna look into refactoring the existing code limiting the stuff that’s exposed to the scripting language to a minimum. So, code that goes into the module which need to be written in the respective scripting language is very small.

At the end of the day it’s about making you feel sooo comfortable when you program in your favourite scripting language, exposing your services with the doublew ess death star goodness with a few lines which will call the C library for maximum performance which will then give the result back to your favourite scripting language scripting language. It’s a deadly game out there Yes, you can breathe now.