[Chapter 19] 19.3 Examples
Author: Sriram Srinivasan
Date: 1999-07-02T01:40:39Z

#

| Chapter 19 Embedding Perl:The Easy Way |

## 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.

#### Example 19.1: search.pl

    # 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.

#### Example 19.2: ex.c: Embedding Perl

    #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.

#### Example 19.3: ex2.c: Embedding Perl

    #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

19.2 Embedding Overview |  | 19.4 Adding Extensions