The Labs.Com Issue_04_Embedding

TPJ: Issue_04_Embedding

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

1. embed.c
2. regex.c
3. regex.pl
4. uri-url.c
5. More Samples on Embedding

Download embed.c

/* allocate the interpreter object */

PerlInterpreter *my_perl = perl_alloc();

/*

* initialize the interpreter

* set some global variables

* initialize the stack

*/

perl_construct(my_perl);

/*

* intialize global variables %INC, $/, $0, $$, etc.

* parse command line arguments

* create perl entry point to C libraries, e.g. DynaLoader

* "compile" the code into perl's interal format, or "parse tree"

*

*/

perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);

/*

* interpret the script (walk the parse tree)

*/

perl_run(my_perl);

/*

* "destroy" objects and free memory allocated for

* the script's symbols, etc.

*/

perl_destruct(my_perl);

/*

* free memory allocated for the PerlInterpreter object itself

*/

perl_free(my_perl);

Issue_04_Embedding 2. regex.c

Download regex.c

/* regex.c */

#include <stdio.h>

#include <EXTERN.h>

#include <perl.h>

static PerlInterpreter *my_perl;

/** regex(string, operation)

**

** Used for =~ operations

**

** Returns the number of successful matches, and

** modifies the input string if there were any.

**/

static int regex(char *string[], char *operation)

{

int n;

dSP;                            /* initialize stack pointer      */

ENTER;                          /* everything created after here */

SAVETMPS;                       /* ...is a temporary variable.   */

PUSHMARK(sp);                   /* remember the stack pointer    */

XPUSHs(sv_2mortal(newSVpv(*string,0))); /* push the string onto the \

stack  */

XPUSHs(sv_2mortal(newSVpv(operation,0))); /* push the operation onto\

stack */

PUTBACK;                      /* make local stack pointer global */

perl_call_pv("regex", G_ARRAY); /* call the function */

SPAGAIN;                        /* refresh stack pointer         */

*string = POPp; /* fetch the perhaps modified string */

n = POPi;       /* fetch the number of substiutions made */

PUTBACK;

FREETMPS;                       /* free that return value        */

LEAVE;                         /* ...and the XPUSHed "mortal" args.*\

/

return n;                     /* the number of substitutions made */

}

main (int argc, char **argv, char **env)

{

char *embedding[] = { "", "regex.pl" };

char *text = argv[1];

int num_matches;

my_perl = perl_alloc();

perl_construct( my_perl );

perl_parse(my_perl, NULL, 2, embedding, NULL);

if(num_matches = regex(&text, "m/([a-z]{4,6})/gi")) {

AV *array;

SV *match;

STRLEN len;

int i;

/* get a pointer to the @Matches array */

array = perl_get_av("Matches", FALSE);

/* take a look at each element of the @Matches array */

for(i=0; i < num_matches; i++) {

match = av_shift(array); /* just like '$match = shift @Matches;'\

*/

printf("%s ", SvPV(match, len));

}

printf("\n\n");

}

/** Remove all vowels from text **/

num_matches = regex(&text, "s/[aeiou]//gi");

if (num_matches) {

printf("regex: s/[aeiou]//gi...%d substitutions made.\n",

num_matches);

printf("Now text is: %s\n\n", text);

}

/** Can we replace Perl with C?? **/

if (!regex(&text, "s/Perl/C/")) {

printf("Sorry, can't replace Perl with C.\n\n");

}

perl_destruct(my_perl);

perl_free(my_perl);

}

Issue_04_Embedding 3. regex.pl

Download regex.pl

#regex.pl

use strict;

use vars qw(@Matches);

sub regex {

my($string, $operation) = @_;

my $n;

#hold matches in an array that our C program can access

@Matches = ();

#we use eval here so we can interpolate m//, s/// and tr///

#if we are trying to match something with m//

if($operation =~ m:^m:) {

eval "\@Matches = (\$string =~ $operation)";

$n = scalar @Matches;

}

else {

eval "\$n = (\$string =~ $operation)";

}

return($n, $string);

}

Issue_04_Embedding 4. uri-url.c

Download uri-url.c

#include <stdio.h>

#include <EXTERN.h>

#include <perl.h>

static PerlInterpreter *my_perl;

SV *

new_uri_url(char *url, char *base)

{

char code[200];

/* code to construct a new URI::URL object */

sprintf(code, "$url = new URI::URL qq(%s,%s);",

url, base);

/* eval the code */

perl_eval_sv(newSVpv(code,0), G_DISCARD | G_SCALAR);

/* fetch the $url object */

return perl_get_sv("url", FALSE);

}

char *

url_method(SV *obj, char *method, char *arg)

{

char *ret;

int count;

dSP;                            /* initialize stack pointer      */

ENTER;                          /* everything created after here */

SAVETMPS;                       /* ...is a temporary variable.   */

PUSHMARK(sp);                   /* remember the stack pointer    */

XPUSHs(sv_2mortal(newSVsv(obj)));   /* push the url object onto the \

stack */

XPUSHs(sv_2mortal(newSVpv(arg,0))); /* push an optional arg onto the\

stack */

PUTBACK;                        /* make local stack pointer global *\

/

count = perl_call_method(method, G_SCALAR); /* call the method */

SPAGAIN;                        /* refresh stack pointer         */

ret = POPp;                     /* pop the return value from stack *\

/

PUTBACK;

FREETMPS;                       /* free that return value        */

LEAVE;                       /* ...and the XPUSHed "mortal" args.*/

return ret;

}

int main (int argc, char **argv, char **env)

{

char *embedding[] = {"", "-MURI::URL", "-e", "0"};

SV *url;

char *ret;

url = sv_newmortal();

my_perl = perl_alloc();

perl_construct( my_perl );

perl_parse(my_perl, NULL, 4, embedding, NULL);

/* argv[1] is the fully qualified or relative url */

/* argv[2] is the URI::URL method to call */

/* argv[3] is the url base if needed to resolve relative url's */

url = new_uri_url(argv[1], NULL);

ret = url_method(url, argv[2], argv[3]);

printf ("%s = '%s'\n", argv[2], ret);

perl_destruct(my_perl);

perl_free(my_perl);

}

Issue_04_Embedding 5. More Samples on Embedding

• Issue_04_Embedding