Community
    • Login

    Perl subroutine calltips - with PythonScript

    Scheduled Pinned Locked Moved General Discussion
    52 Posts 4 Posters 3.6k Views
    Loading More Posts
    • Oldest to Newest
    • Newest to Oldest
    • Most Votes
    Reply
    • Reply as topic
    Log in to reply
    This topic has been deleted. Only users with topic management privileges can see it.
    • Michael VincentM
      Michael Vincent @Ekopalypse
      last edited by 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.

      1 Reply Last reply Reply Quote 2
      • PeterJonesP
        PeterJones @Ekopalypse
        last edited by

        @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 VincentM 1 Reply Last reply Reply Quote 2
        • Michael VincentM
          Michael Vincent @PeterJones
          last edited by

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

          1 Reply Last reply Reply Quote 2
          • EkopalypseE
            Ekopalypse
            last edited by

            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

            6adc4473-18cb-43e8-acb2-48c5cb32b519-image.png

            1 Reply Last reply Reply Quote 1
            • EkopalypseE
              Ekopalypse
              last edited by 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.

              1 Reply Last reply Reply Quote 3
              • EkopalypseE
                Ekopalypse
                last edited by

                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 VincentM 1 Reply Last reply Reply Quote 1
                • Michael VincentM
                  Michael Vincent @Ekopalypse
                  last edited by

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

                  EkopalypseE 2 Replies Last reply Reply Quote 0
                  • EkopalypseE
                    Ekopalypse @Michael Vincent
                    last edited by

                    @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?

                    1 Reply Last reply Reply Quote 0
                    • EkopalypseE
                      Ekopalypse @Michael Vincent
                      last edited by

                      @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

                      1 Reply Last reply Reply Quote 0
                      • EkopalypseE
                        Ekopalypse
                        last edited by

                        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 VincentM 1 Reply Last reply Reply Quote 2
                        • Michael VincentM
                          Michael Vincent @Ekopalypse
                          last edited by

                          @Ekopalypse said in Perl subroutine calltips - with PythonScript:

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

                          That worked!

                          1 Reply Last reply Reply Quote 2
                          • First post
                            Last post
                          The Community of users of the Notepad++ text editor.
                          Powered by NodeBB | Contributors