NetWare/interface.c

   1
   2 /*
   3  * Copyright © 2001 Novell, Inc. All Rights Reserved.
   4  *
   5  * You may distribute under the terms of either the GNU General Public
   6  * License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * FILENAME     :   interface.c
  12  * DESCRIPTION  :   Calling Perl APIs.
  13  * Author       :   SGP
  14  * Date Created :   January 2001.
  15  * Date Modified:   July 2nd 2001.
  16  */
  17
  18
  19
  20 #include "interface.h"
  21 #include "nwtinfo.h"
  22
  23 static void xs_init(pTHX);
  24
  25 EXTERN_C int RunPerl(int argc, char **argv, char **env);
  26 EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp);
  27 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
  28
  29 EXTERN_C BOOL Remove_Thread_Ctx(void);
  30
  31
  32 ClsPerlHost::ClsPerlHost()
  33 {
  34
  35 }
  36
  37 ClsPerlHost::~ClsPerlHost()
  38 {
  39
  40 }
  41
  42 ClsPerlHost::VersionNumber()
  43 {
  44         return 0;
  45 }
  46
  47 bool
  48 ClsPerlHost::RegisterWithThreadTable()
  49 {
  50         return(fnRegisterWithThreadTable());
  51 }
  52
  53 bool
  54 ClsPerlHost::UnregisterWithThreadTable()
  55 {
  56         return(fnUnregisterWithThreadTable());
  57 }
  58
  59 int
  60 ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
  61 {
  62 /*      if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
  63                 return (1);*/
  64     perl_construct(my_perl);
  65
  66         return 1;
  67 }
  68
  69 int
  70 ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env)
  71 {
  72         return(perl_parse(my_perl, xs_init, argc, argv, env));          // Parse the command line.
  73 }
  74
  75 int
  76 ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
  77 {
  78         return(perl_run(my_perl));      // Run Perl.
  79 }
  80
  81 int
  82 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
  83 {
  84         return(perl_destruct(my_perl));         // Destructor for Perl.
  85 }
  86
  87 void
  88 ClsPerlHost::PerlFree(PerlInterpreter *my_perl)
  89 {
  90         perl_free(my_perl);                     // Free the memory allocated for Perl.
  91
  92         // Remove the thread context set during Perl_set_context
  93         // This is added here since for web script there is no other place this gets executed
  94         // and it cannot be included into cgi2perl.xs unless this symbol is exported.
  95         Remove_Thread_Ctx();
  96 }
  97
  98 /*============================================================================================
  99
 100  Function               :       xs_init
 101
 102  Description    :
 103
 104  Parameters     :       pTHX    (IN)    -
 105
 106  Returns                :       Nothing.
 107
 108 ==============================================================================================*/
 109
 110 static void xs_init(pTHX)
 111 {
 112         char *file = __FILE__;
 113
 114         dXSUB_SYS;
 115         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 116 }
 117
 118
 119 EXTERN_C
 120 int RunPerl(int argc, char **argv, char **env)
 121 {
 122         int exitstatus = 0;
 123         ClsPerlHost nlm;
 124
 125         PerlInterpreter *my_perl = NULL;                // defined in Perl.h
 126         PerlInterpreter *new_perl = NULL;               // defined in Perl.h
 127
 128         PERL_SYS_INIT(&argc, &argv);
 129
 130         if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
 131                 return (1);
 132
 133         if(nlm.PerlCreate(my_perl))
 134         {
 135                 PL_perl_destruct_level = 0;
 136
 137                 if(!nlm.PerlParse(my_perl, argc, argv, env))
 138                 {
 139                         #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
 140                                 new_perl = perl_clone(my_perl, 1);
 141
 142                                 (void) perl_run(new_perl);      // Run Perl.
 143                                 PERL_SET_THX(my_perl);
 144                         #else
 145                                 (void) nlm.PerlRun(my_perl);
 146                         #endif
 147                 }
 148                 exitstatus = nlm.PerlDestroy(my_perl);
 149         }
 150         if(my_perl)
 151                 nlm.PerlFree(my_perl);
 152
 153         #ifdef USE_ITHREADS
 154                 if (new_perl)
 155                 {
 156                         PERL_SET_THX(new_perl);
 157                         exitstatus = nlm.PerlDestroy(new_perl);
 158                         nlm.PerlFree(my_perl);
 159                 }
 160         #endif
 161
 162         PERL_SYS_TERM();
 163         return exitstatus;
 164 }
 165
 166
 167 // FUNCTION: AllocStdPerl
 168 //
 169 // DESCRIPTION:
 170 //      Allocates a standard perl handler that other perl handlers
 171 //      may delegate to. You should call FreeStdPerl to free this
 172 //      instance when you are done with it.
 173 //
 174 IPerlHost* AllocStdPerl()
 175 {
 176         return (IPerlHost*) new ClsPerlHost();
 177 }
 178
 179
 180 // FUNCTION: FreeStdPerl
 181 //
 182 // DESCRIPTION:
 183 //      Frees an instance of a standard perl handler allocated by
 184 //      AllocStdPerl.
 185 //
 186 void FreeStdPerl(IPerlHost* pPerlHost)
 187 {
 188         if (pPerlHost)
 189                 delete (ClsPerlHost*) pPerlHost;
 190 }
 191