Open Forum > What's New
Perl Extension Module
Support:
I'm done with the Perl extension module in its current form. I see no purpose going through all the work of calling Perl functions from C directly and having to do all the crazy low level stack stuff. The Perl Eval function does everything I need at the moment and works like the TinyScheme extension module.
--- Code: Script BASIC ---DECLARE SUB pl_Init ALIAS "pl_Init" LIB "sbperl"DECLARE SUB pl_Eval ALIAS "pl_Eval" LIB "sbperl"DECLARE SUB pl_GetInt ALIAS "pl_GetInt" LIB "sbperl"DECLARE SUB pl_GetDbl ALIAS "pl_GetDbl" LIB "sbperl"DECLARE SUB pl_GetStr ALIAS "pl_GetStr" LIB "sbperl"DECLARE SUB pl_Destroy ALIAS "pl_Destroy" LIB "sbperl" pl_Init pl_code = """sub Average{ # get total number of arguments passed. $n = scalar(@_); $sum = 0; foreach $item (@_){ $sum += $item; } $average = $sum / $n; return $average;}"""pl_Eval pl_codepl_Eval "$num = Average(10, 20, 30);"PRINT pl_GetInt("num"),"\n" pl_Destroy
jrs@laptop:~/sb/sb22/test$ scriba perlfunc.sb
20
jrs@laptop:~/sb/sb22/test$
Support:
Here is an example of getting the SB filedesc.sb script file info by calling a Perl function.
--- Code: Script BASIC ---DECLARE SUB pl_Init ALIAS "pl_Init" LIB "sbperl"DECLARE SUB pl_Eval ALIAS "pl_Eval" LIB "sbperl"DECLARE SUB pl_GetInt ALIAS "pl_GetInt" LIB "sbperl"DECLARE SUB pl_GetDbl ALIAS "pl_GetDbl" LIB "sbperl"DECLARE SUB pl_GetStr ALIAS "pl_GetStr" LIB "sbperl"DECLARE SUB pl_Destroy ALIAS "pl_Destroy" LIB "sbperl" pl_Init pl_code = """my $file = "filedesc.sb";my (@description, $size);if (-e $file){ push @description, 'binary' if (-B _); push @description, 'a socket' if (-S _); push @description, 'a text file' if (-T _); push @description, 'a block special file' if (-b _); push @description, 'a character special file' if (-c _); push @description, 'a directory' if (-d _); push @description, 'executable' if (-x _); push @description, (($size = -s _)) ? "$size bytes" : 'empty'; print "$file is ", join(', ',@description),"\n";}"""pl_Eval pl_code pl_Destroy
jrs@laptop:~/sb/sb22/test$ scriba filedesc.sb
filedesc.sb is a text file, 898 bytes
jrs@laptop:~/sb/sb22/test$ ls -l filedesc.sb
-rw-rw-r-- 1 jrs jrs 898 Apr 8 00:15 filedesc.sb
jrs@laptop:~/sb/sb22/test$
Support:
Here is the current Script BASIC interface.c (sbperl.so) extension module source.
Perl Embedding API Documentation
--- Code: C ---/* Perl - Script BASIC extension module UXLIBS: -lperl */ #include <stdio.h>#include <stdlib.h>#include <string.h>#include <ctype.h>#include <math.h>#include <time.h>#include "../../basext.h"#include "cbasic.h" #include <EXTERN.h>#include <perl.h> static PerlInterpreter *my_perl; /**************************** Extension Module Functions****************************/ besVERSION_NEGOTIATE RETURN_FUNCTION((int)INTERFACE_VERSION);besEND besSUB_START DIM AS long PTR p; besMODULEPOINTER = besALLOC(sizeof(long)); IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0); p = (long PTR)besMODULEPOINTER; RETURN_FUNCTION(0);besEND besSUB_FINISH DIM AS long PTR p; p = (long PTR)besMODULEPOINTER; IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0); RETURN_FUNCTION(0);besEND /**************** Perl Functions****************/ besFUNCTION(pl_Init) DIM AS char *embedding[] = { "", "-e", "0" }; my_perl = perl_alloc(); perl_construct(my_perl); perl_parse(my_perl, NULL, 3, embedding, NULL); perl_run(my_perl); besRETURN_LONG(my_perl);besEND besFUNCTION(pl_Eval) DIM AS const char PTR cmdstr; besARGUMENTS("z") AT cmdstr besARGEND eval_pv(cmdstr, TRUE); besRETURNVALUE = NULL;besEND besFUNCTION(pl_GetInt) DIM AS const char PTR cmdstr; DIM AS int rtnval; besARGUMENTS("z") AT cmdstr besARGEND rtnval = SvIV(get_sv(cmdstr, FALSE)); besRETURN_LONG(rtnval);besEND besFUNCTION(pl_GetDbl) DIM AS const char PTR cmdstr; DIM AS double rtnval; besARGUMENTS("z") AT cmdstr besARGEND rtnval = SvNV(get_sv(cmdstr, FALSE)); besRETURN_DOUBLE(rtnval);besEND besFUNCTION(pl_GetStr) DIM AS const char PTR cmdstr; DIM AS char PTR rtnval; DIM AS STRLEN n_a; besARGUMENTS("z") AT cmdstr besARGEND rtnval = SvPV(get_sv(cmdstr, FALSE), n_a); besRETURN_STRING(rtnval);besEND besFUNCTION(pl_Destroy) perl_destruct(my_perl); perl_free(my_perl); besRETURNVALUE = NULL;besEND
Support:
Perl has an console interactive (debugger) mode you can play with.
jrs@laptop:~/sb/sb22/test$ perl -d -e 1
Loading DB routines from perl5db.pl version 1.39_10
Editor support available.
Enter h or 'h h' for help, or 'man perldebug' for more help.
main::(-e:1): 1
DB<1> h
List/search source lines: Control script execution:
l [ln|sub] List source code T Stack trace
- or . List previous/current line s [expr] Single step [in expr]
v [line] View around line n [expr] Next, steps over subs
f filename View source in file <CR/Enter> Repeat last n or s
/pattern/ ?patt? Search forw/backw r Return from subroutine
M Show module versions c [ln|sub] Continue until position
Debugger controls: L List break/watch/actions
o [...] Set debugger options t [n] [expr] Toggle trace [max depth] ][trace expr]
<[<]|{[{]|>[>] [cmd] Do pre/post-prompt b [ln|event|sub] [cnd] Set breakpoint
! [N|pat] Redo a previous command B ln|* Delete a/all breakpoints
H [-num] Display last num commands a [ln] cmd Do cmd before line
= [a val] Define/list an alias A ln|* Delete a/all actions
h [db_cmd] Get help on command w expr Add a watch expression
h h Complete help page W expr|* Delete a/all watch exprs
|[|]db_cmd Send output to pager ![!] syscmd Run cmd in a subprocess
q or ^D Quit R Attempt a restart
Data Examination: expr Execute perl code, also see: s,n,t expr
x|m expr Evals expr in list context, dumps the result or lists methods.
p expr Print expression (uses script's current package).
S [[!]pat] List subroutine names [not] matching pattern
V [Pk [Vars]] List Variables in Package. Vars can be ~pattern or !pattern.
X [Vars] Same as "V current_package [Vars]". i class inheritance tree.
y [n [Vars]] List lexicals in higher scope <n>. Vars same as V.
e Display thread id E Display all thread ids.
For more help, type h cmd_letter, or run man perldebug for all docs.
DB<1>
Support:
The following is a Perl example of using regular expression parsing. (regx)
--- Code: Script BASIC ---DECLARE SUB pl_Init ALIAS "pl_Init" LIB "sbperl"DECLARE SUB pl_Eval ALIAS "pl_Eval" LIB "sbperl"DECLARE SUB pl_GetInt ALIAS "pl_GetInt" LIB "sbperl"DECLARE SUB pl_GetDbl ALIAS "pl_GetDbl" LIB "sbperl"DECLARE SUB pl_GetStr ALIAS "pl_GetStr" LIB "sbperl"DECLARE SUB pl_Destroy ALIAS "pl_Destroy" LIB "sbperl" pl_Init pl_code = """sub test($$) { my $lookfor = shift; my $string = shift; print "\n$lookfor "; if($string =~ m/($lookfor)/) { print " is in "; } else { print " is NOT in "; } print "$string."; if(defined($1)) { print " <$1>"; } print "\n"; } test("st.v.", "steve was here");test("st.v.", "kitchen stove");test("st.v.", "kitchen store");"""PRINTNL pl_Eval pl_code pl_Destroy
Output
jrs@laptop:~/sb/sb22/test$ time scriba perlmatch.sb
st.v. is in steve was here. <steve>
st.v. is in kitchen stove. <stove>
st.v. is NOT in kitchen store.
real 0m0.004s
user 0m0.000s
sys 0m0.004s
jrs@laptop:~/sb/sb22/test$
Navigation
[0] Message Index
[#] Next page
Go to full version