19.3 Examples

Let us now write some code to see this API in action. Suppose you have a Perl script, search.pl , containing subroutine search_files , defined in Example 19.1 .

# search_files - a simple grep. Called as ...
#    search_files ("struct", "*.h")
sub search_files {
    my ($pattern, $filepattern) = @_;
    local (@ARGV) = glob($filepattern);
    return unless (@ARGV);
    while (<>) {       # Can do this because @ARGV has been primed
        if (/$pattern/o) {
            print "$ARGV\[$.\]: $_"; # File, line number, match line
        }
    }
}

search_files takes two string parameters and returns nothing. There are several ways of calling this procedure from C. Let's start with perl_call_argv() , since it takes string arguments. The piece of code in Example 19.2 searches for the word "struct" in all C header files.

#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;  
main(int argc, char **argv, char **env) {

    char *my_argv[] = {"struct", "*.h", NULL};

    my_perl = perl_alloc();
    perl_construct(my_perl);
    perl_parse(my_perl, NULL, argc, argv, env);

    
perl_call_argv("search_files", G_DISCARD, my_argv);


perl_destruct(my_perl);
perl_free(my_perl);
}

By passing NULL instead of xs_init , we indicate to perl_parse that we are not interested in loading any extensions. In addition, instead of calling perl_run , we call search_files using perl_call_argv (with the G_DISCARD flag to tell it to discard all returned results). This is how I compile and link this code on a Linux box:[ 3 ]

% 
gcc -o ex -I/usr/local/lib/perl5/i586-linux/5.004/CORE \
            -L/usr/local/lib/perl5/i586-linux/5.004/CORE \
            -Dbool=char -DHAS_BOOL                       \
         ex.c -lperl -lm

[3] You don't have to remember or look up the include and library directory paths. The last section in this chapter discusses a module called ExtUtils::Embed that makes creating embedded interpreters a snap.

We have created our first custom Perl interpreter. Since perl_parse is given all the command-line arguments, ex can be invoked just like Perl, as shown:

% ex search.pl

This outputs something like this (when invoked in the Perl source directory):

av.h[10]: struct xpvav {
cop.h[58]: struct cop {
cop.h[60]:     char *   cop_label;      /* label for this construct */
cop.h[75]: struct block_sub {
cop.h[98]:      { struct block_sub cxsub;
...

We need to give the name of the script as an argument because perl_parse is given the command-line arguments untranslated.

Instead of using perl_call_argv , we could have used the other two calls instead, as follows:

perl_eval_va("search_files (qw(struct *.h))",
              NULL);           // No return parameters 

or

perl_call_va ("search_files", 
              "s", "struct",    // First parameter of type string
              "s", "*.h",       // Second parameter also of type string
              NULL);

Clearly, the perl_eval_va approach is the easiest of the lot in this particular example. Incidentally, did you notice how we used the qw operator to avoid embedded quotes?

Let us now take a look at another small example that requires us to pass in a mixture of parameter types. This time we call a Perl subroutine, nice_number , to insert commas into big numbers (1000000 is formatted as "1,000,000"). The subroutine, shown below, interposes a comma whenever it sees a group of four consecutive digits, and continues to do so until it no longer matches this pattern. To test this subroutine, we use an additional subroutine called test_nice , which, given a number n , generates an n -digit number composed of 1's and feeds it to nice_number:

sub nice_number {
    my $num = shift;
    1 while ($num =~ s/(.*\d)(\d\d\d)/$1,$2/g);
    $num;
}
sub test_nice {                   # test_nice(4) produces 1,111
    my $len = shift; 
    nice_number(1 x $len);
}

Instead of putting this code into a file and parsing it using perl_parse (as we did earlier), we use perl_eval_va to parse and load this subroutine. It so happens that perl_parse does some crucial initializations, so we have to call it.[ 4 ] If we give it a null argc / argv array, it has the unfortunate property of waiting on standard input, as you normally expect Perl to do. For this reason, we give it the shortest possible script that compiles cleanly and doesn't take any time to finish, as shown in the following command line:

perl -e 0

[4] In fact, perl_parse should be called at most once, because it reinitializes the interpreter without checking that it has already been done.

The only way to have a shorter script is to reduce the font size! Note the call to perl_parse in Example 19.3 .

#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;  
main() {
    static char *dummy_argv[] = {"","-e","0"}; int num;
    my_perl = perl_alloc();
    perl_construct(my_perl);

    perl_parse(my_perl, NULL, 3, dummy_argv, env);

    if (perl_eval_va (                         # define code inline
                  "sub main::nice_number {"
                      "my $num = shift;"
                      "1 while ($num =~ s/(.*\\d)(\\d\\d\\d)/$1,$2/g);"
                      "$num;"
                 "}"
                 "sub main::test_nice {"
                     "my $num = shift;"
                     "nice_number (1 x $num);"
                 "}", 
                 NULL ) == -1) {
            fprintf (stderr, "Eval unsuccessful. Aborted\n");
            exit(1);
    }
    # Subroutines defined. Now call test_nice
    for (num = 1; num <= 7; num++) {
        char buf[20];
        *buf = '\0';
        perl_call_va ("test_nice",
                      "i",  num,        /* Input parameters */
                      "OUT",
                      "s",  buf,        /* Output parameter */
                      NULL);            /* Don't forget this! */
        printf ("%d: %s\n", num, buf);
    }
    perl_close();
}

This prints

1: 1
2: 11
3: 111
4: 1,111
5: 11,111
6: 111,111




7: 1,111,111