Perl subroutine calltips - with PythonScript

Ekopalypse

Ok, I should have installed strawberry perl in first place, solved all my issues.

First success

from ctypes import CDLL, POINTER, c_int, c_char_p

perllib = CDLL(r'D:\strawberry\perl\bin\perl532.dll')

perllib.RunPerl.restype = c_int
perllib.RunPerl.argtypes = c_int, POINTER(c_char_p), POINTER(c_char_p)

__args = [b"",
          b"-le",
          b"use Win32::Mechanize::NotepadPlusPlus qw/:main/; notepad->newFile();"]
          
args = (c_char_p * len(__args))(*__args)
x = perllib.RunPerl(len(args), args, None)
print(x)

This works, but only one time. A second call results in a
OSError: exception: access violation writing 0x0000000000000024

Seems some cleanup needs to be done afterwards.

Michael Vincent

@Ekopalypse said in Perl subroutine calltips - with PythonScript:

Seems some cleanup needs to be done afterwards.

Yes, in my late night Google-ing I saw lots of references to free(args) after the RunPerl() call.

Examples:
https://comp.lang.perl.misc.narkive.com/r7M6eENL/dll-unload-question-for-embedded-perl-on-windows
https://www.nntp.perl.org/group/perl.wxperl.users/2017/01/msg9715.html

Cheers.

PeterJones

@Ekopalypse said in Perl subroutine calltips - with PythonScript:

__args = [b"", …

Weird. If I don’t have the empty zeroth argument, the call fails (x==9). I wonder why it needs the blank argument…

Michael Vincent

@PeterJones said in Perl subroutine calltips - with PythonScript:

I wonder why it needs the blank argument…

I read some stuff on Par::Packer and it seems the first argument may be the optional path to the perl executable.

https://oliverbetz.de/pages/Artikel/Portable-Perl-Applications

Cheers.

Ekopalypse

Hmm … it looks like freeing the interpreter is the issue.
I tried to replicate what RunPerl is doing and when I use this

from ctypes import CDLL, POINTER, c_int, c_char_p, c_void_p, byref

perllib = CDLL(r'D:\strawberry\perl\bin\perl532.dll')

# perllib.RunPerl.restype = c_int
# perllib.RunPerl.argtypes = [c_int, POINTER(c_char_p), POINTER(c_char_p)]

# Perl_sys_init3(int* argc, char*** argv, char*** env)
perllib.Perl_sys_init3.argtypes = [POINTER(c_int), POINTER(POINTER(c_char_p)), POINTER(POINTER(c_char_p))]

# PerlInterpreter * perl_alloc(void)
perllib.perl_alloc.restype = c_void_p
perllib.perl_alloc.argtypes = []

# void perl_construct(pTHXx)
perllib.perl_construct.argtypes = [c_void_p]

# int perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)  # only 4 params ??
perllib.perl_parse.restype = c_int
perllib.perl_parse.argtypes = [c_void_p, c_void_p, c_int, POINTER(c_char_p), POINTER(c_char_p)]  # we need 5 params according to RunPerl

# int perl_run(pTHXx)
perllib.perl_run.restype = c_int
perllib.perl_run.argtypes = [c_void_p]

__args = [b"", b"D:\\scripts\\perl\\1.pl" ]
# ********************************  content of 1.pl  ********************************
# use strict;
# use warnings;

# my $timestamp = localtime(time);

# sub logit {
	# my $message = shift;
	# my $filename = 'D:/report.txt';
	# open(my $fh, '>>', $filename) or die "Could not open file '$filename' $!";
	# print $fh $timestamp, " $message\n";
	# close $fh;
# }

# logit("test");
# **********************************************************************************


args = (c_char_p * len(__args))(*__args)

perllib.Perl_sys_init3(byref(c_int(len(args))), None, None)
my_perl = perllib.perl_alloc()
perllib.perl_construct(my_perl)
result = perllib.perl_parse(my_perl, None, len(args), args, None)
print('perl_parse', result)
result = perllib.perl_run(my_perl)
print('perl_run', result)
print(open(r'D:\report.txt', 'r').read())

I can run 1.pl multiple times

Ekopalypse

I guess I have a working “embedded” perl instance.


from ctypes import CDLL, POINTER, c_int, c_char_p, c_void_p, byref

perllib = CDLL(r'D:\strawberry\perl\bin\perl532.dll')

# Perl_sys_init3(int* argc, char*** argv, char*** env)
perllib.Perl_sys_init3.argtypes = [POINTER(c_int), POINTER(POINTER(c_char_p)), POINTER(POINTER(c_char_p))]

# PerlInterpreter * perl_alloc(void)
perllib.perl_alloc.restype = c_void_p
perllib.perl_alloc.argtypes = []

# void perl_construct(pTHXx)
perllib.perl_construct.argtypes = [c_void_p]

# int perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)  # only 4 params ??
perllib.perl_parse.restype = c_int
perllib.perl_parse.argtypes = [c_void_p, c_void_p, c_int, POINTER(c_char_p), POINTER(c_char_p)]  # we need 5 params according to RunPerl

# int perl_run(pTHXx)
perllib.perl_run.restype = c_int
perllib.perl_run.argtypes = [c_void_p]

# int perl_destruct(pTHXx)
perllib.perl_destruct.restype = c_int
perllib.perl_destruct.argtypes = [c_void_p]

# SV* Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
perllib.Perl_eval_pv.restype = c_void_p
perllib.Perl_eval_pv.argtypes = [c_void_p, c_char_p, c_int]

# # SV * Perl_sv_pv(pTHX_ const IV i)
perllib.Perl_sv_pv.restype = c_char_p
perllib.Perl_sv_pv.argtypes = [c_void_p, c_void_p]


__args = [b"", b"-e", b"0"]  # test_npp
args = (c_char_p * len(__args))(*__args)

perllib.Perl_sys_init3(byref(c_int(len(args))), None, None)
my_perl = perllib.perl_alloc()
perllib.perl_construct(my_perl)
if perllib.perl_parse(my_perl, None, len(args), args, None) == 0:
    for perlcode in [b"reverse 'rekcaH lreP rehtonA tsuJ'", b"$a = 3; $a **= 2", b"$a = 3; $a **= "]:
        val = perllib.Perl_eval_pv(my_perl, c_char_p(perlcode), 0)
        print(perllib.Perl_sv_pv(my_perl, val))
else:
    print('Perl interpreter setup error.')

print(perllib.perl_destruct(my_perl))

Next step would be to identify errors (see last example code)
and make additional modules working. I assume this has something
to do with the @INC …
and of course make a class out of it for easy reuse.

Ekopalypse

I guess I have a working solution.
I’m afraid, it works, currently, only with PythonScript version 3.x
There is one open point, see TODO, which I can’t seem to find a solution for.

from ctypes import CDLL, POINTER, c_int, c_char_p, c_void_p, byref, CFUNCTYPE
from Npp import console

perllib = CDLL(r'D:\strawberry\perl\bin\perl532.dll')

# Perl_sys_init3(int* argc, char*** argv, char*** env)
Perl_sys_init3 = perllib.Perl_sys_init3
Perl_sys_init3.argtypes = [POINTER(c_int), POINTER(POINTER(c_char_p)), POINTER(POINTER(c_char_p))]

# PerlInterpreter * perl_alloc(void)
perl_alloc = perllib.perl_alloc
perl_alloc.restype = c_void_p
perl_alloc.argtypes = []

# void perl_construct(pTHXx)
perl_construct = perllib.perl_construct
perl_construct.argtypes = [c_void_p]

# int perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)  # only 4 params but pTHXx_ is a macro resulting in 5 params
xsinit = CFUNCTYPE(None, c_void_p)
perl_parse = perllib.perl_parse
perl_parse.restype = c_int
perl_parse.argtypes = [c_void_p, xsinit, c_int, POINTER(c_char_p), POINTER(c_char_p)]

# int perl_run(pTHXx)
perl_run = perllib.perl_run
perl_run.restype = c_int
perl_run.argtypes = [c_void_p]

# int perl_destruct(pTHXx)
perl_destruct = perllib.perl_destruct
perl_destruct.restype = c_int
perl_destruct.argtypes = [c_void_p]

# SV* Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
Perl_eval_pv = perllib.Perl_eval_pv
Perl_eval_pv.restype = c_void_p
Perl_eval_pv.argtypes = [c_void_p, c_char_p, c_int]

# SV * Perl_sv_pv(pTHX_ const IV i)
Perl_sv_pv = perllib.Perl_sv_pv
Perl_sv_pv.restype = c_char_p
Perl_sv_pv.argtypes = [c_void_p, c_void_p]

# SV * Perl_sv_string_from_errnum(pTHX_ int errnum, SV *tgtsv)
Perl_sv_string_from_errnum = perllib.Perl_sv_string_from_errnum
Perl_sv_string_from_errnum.restype = c_void_p
Perl_sv_string_from_errnum.argtypes = [c_void_p, c_int, c_void_p]

# SV* Perl_get_sv(pTHX_ const char *name, I32 flags)
Perl_get_sv = perllib.Perl_get_sv
Perl_get_sv.restype = c_void_p
Perl_get_sv.argtypes = [c_void_p, c_char_p, c_int]

# void boot_DynaLoader (pTHX_ CV* cv)
boot_DynaLoader = perllib.boot_DynaLoader
boot_DynaLoader.argtypes = [c_void_p, c_char_p]

# Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
Perl_newXS = perllib.Perl_newXS
Perl_newXS.argtypes = [c_void_p, c_char_p, c_void_p, c_char_p]


class PerlInterpreter:

    def __init__(self):
        Perl_sys_init3(byref(c_int(3)), None, None)


    @staticmethod
    def call(perlcode):
        # TODO: https://perldoc.perl.org/perlembed#Maintaining-a-persistent-interpreter
        # PL_exit_flags |= 0x2  # PERL_EXIT_DESTRUCT_END 
        # I assume, that this would avoid calling alloc, construct and parse over and over again.
        # but how can we set it, seems not to be exported.
        # Following code fails: ValueError: symbol 'PL_exit_flags' not found

        # exit_flags = c_int.in_dll(perllib, 'PL_exit_flags')
        # exit_flags.value |= 2
        
        my_perl = perl_alloc()
        perl_construct(my_perl)
        
        def xs_init(pTHX):
            # https://perldoc.perl.org/perlembed#Using-Perl-modules,-which-themselves-use-C-libraries,-from-your-C-program
            Perl_newXS(pTHX, 
                       b"DynaLoader::boot_DynaLoader", 
                       boot_DynaLoader, 
                       b'__FILE__' # Seems to work, but ... ??
                       )

        res = perl_parse(my_perl, xsinit(xs_init), 3, (c_char_p * 3)(*[b"", b"-e", b"0"]), None)
        if res != 0:
            _error = Perl_sv_pv(my_perl, 
                                Perl_sv_string_from_errnum(my_perl, res, None))

            perl_destruct(my_perl)
            raise(RuntimeError(f'Perl interpreter setup error. {_error.decode()}'))

        result = Perl_sv_pv(my_perl, 
                            Perl_eval_pv(my_perl, c_char_p(perlcode.encode()), 0))
        
        error = Perl_sv_pv(my_perl, Perl_get_sv(my_perl, "@".encode(), 0)).decode()

        perl_destruct(my_perl)
        return error, result.decode()


if __name__ == '__main__':
    perl = PerlInterpreter()
    for perlcode in [
                     "use Win32::Mechanize::NotepadPlusPlus qw/:main/; notepad->newFile();",
                     "reverse 'rekcaH lreP rehtonA tsuJ'", 
                     "$a = 3; $a **= 2",
                     "$a = 3; $a **= ",
                     ]:
        error, result = perl.call(perlcode)
        if error:
            console.writeError(error+'\n')
        else:
            print(result)

Michael Vincent

@Ekopalypse said in Perl subroutine calltips - with PythonScript:

I’m afraid, it works, currently, only with PythonScript version 3.x

And maybe “newer” Perl as well. I’m on Strawberry 5.24 and get this:

Traceback (most recent call last):
  File "C:\usr\bin\npp64\plugins\PythonScript\scripts\EmbeddedPerl.py", line 46, in <module>
    Perl_sv_string_from_errnum = perllib.Perl_sv_string_from_errnum
  File "C:\usr\bin\npp64\plugins\PythonScript\lib\ctypes\__init__.py", line 386, in __getattr__
    func = self.__getitem__(name)
  File "C:\usr\bin\npp64\plugins\PythonScript\lib\ctypes\__init__.py", line 391, in __getitem__
    func = self._FuncPtr((name_or_ordinal, self))
AttributeError: function 'Perl_sv_string_from_errnum' not found

I don’t want to sound ungrateful - what you’ve done is amazing, just thought you should know.

Cheers.

Ekopalypse

@Michael-Vincent

Thx for testing. I think I’m using the newer version, mine is called 5.32.
Any thoughts on what a reasonable version to start with might be?

Ekopalypse

@Michael-Vincent

according to git this api function was introduced in 2017

658db62260a (Zefram                   2017-08-13 01:59:43 +0100  689) #define sv_string_from_errnum(a,b)        Perl_sv_string_from_errnum(aTHX_ a,b)

but 5.24 has been released on May 8, 2016

Ekopalypse

Just to make clear, this function is not really needed.
It just provides a textual description of an error number.
One can comment

            # _error = Perl_sv_pv(my_perl, 
            #                    Perl_sv_string_from_errnum(my_perl, res, None))

and change the runtime raise to

raise(RuntimeError(f'Perl interpreter setup error. {res}'))

and it should work. Hopefully.

Michael Vincent

@Ekopalypse said in Perl subroutine calltips - with PythonScript:

Just to make clear, this function is not really needed.

That worked!