NetWare/interface.cpp

   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  :       Perl parsing and running functions.
  13  * Author               :       SGP
  14  * Date                 :       January 2001.
  15  *
  16  */
  17
  18
  19
  20 #include "interface.h"
  21
  22 #include "win32ish.h"           // For "BOOL", "TRUE" and "FALSE"
  23
  24
  25 static void xs_init(pTHX);
  26 //static void xs_init(pTHXo); //(J)
  27
  28 EXTERN_C int RunPerl(int argc, char **argv, char **env);
  29 EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp);
  30 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);   // (J) pTHXo_
  31
  32 EXTERN_C BOOL Remove_Thread_Ctx(void);
  33
  34
  35 ClsPerlHost::ClsPerlHost()
  36 {
  37
  38 }
  39
  40 ClsPerlHost::~ClsPerlHost()
  41 {
  42
  43 }
  44
  45 ClsPerlHost::VersionNumber()
  46 {
  47         return 0;
  48 }
  49
  50 int
  51 ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
  52 {
  53 /*      if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
  54                 return (1);*/
  55     perl_construct(my_perl);
  56     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
  57
  58         return 1;
  59 }
  60
  61 int
  62 ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env)
  63 {
  64         return(perl_parse(my_perl, xs_init, argc, argv, env));          // Parse the command line.
  65 }
  66
  67 int
  68 ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
  69 {
  70         return(perl_run(my_perl));      // Run Perl.
  71 }
  72
  73 int
  74 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
  75 {
  76         int ret = perl_destruct(my_perl);               // Destructor for Perl.
  77 ////    perl_free(my_perl);                     // Free the memory allocated for Perl.
  78         return(ret);
  79 }
  80
  81 void
  82 ClsPerlHost::PerlFree(PerlInterpreter *my_perl)
  83 {
  84         perl_free(my_perl);                     // Free the memory allocated for Perl.
  85
  86         // Remove the thread context set during Perl_set_context
  87         // This is added here since for web script there is no other place this gets executed
  88         // and it cannot be included into cgi2perl.xs unless this symbol is exported.
  89         Remove_Thread_Ctx();
  90 }
  91
  92 /*============================================================================================
  93
  94  Function               :       xs_init
  95
  96  Description    :
  97
  98  Parameters     :       pTHX    (IN)    -
  99
 100  Returns                :       Nothing.
 101
 102 ==============================================================================================*/
 103
 104 static void xs_init(pTHX)
 105 //static void xs_init(pTHXo) //J
 106 {
 107         char *file = __FILE__;
 108
 109         dXSUB_SYS;
 110         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 111 }
 112
 113
 114 EXTERN_C
 115 int RunPerl(int argc, char **argv, char **env)
 116 {
 117         int exitstatus = 0;
 118         ClsPerlHost nlm;
 119
 120         PerlInterpreter *my_perl = NULL;                // defined in Perl.h
 121         PerlInterpreter *new_perl = NULL;               // defined in Perl.h
 122
 123         //__asm{int 3};
 124         #ifdef PERL_GLOBAL_STRUCT
 125                 #define PERLVAR(prefix,var,type)
 126                 #define PERLVARA(prefix,var,type)
 127                 #define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
 128                 #define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init;
 129
 130                 #include "perlvars.h"
 131
 132                 #undef PERLVAR
 133                 #undef PERLVARA
 134                 #undef PERLVARI
 135                 #undef PERLVARIC
 136         #endif
 137
 138         PERL_SYS_INIT(&argc, &argv);
 139
 140         if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
 141                 return (1);
 142
 143         if(nlm.PerlCreate(my_perl))
 144         {
 145                 PL_perl_destruct_level = 0;
 146
 147                 if(!nlm.PerlParse(my_perl, argc, argv, env))
 148                 {
 149                         #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
 150                                 #  ifdef PERL_OBJECT
 151                                         CPerlHost *h = new CPerlHost();
 152                                         new_perl = perl_clone_using(my_perl, 1,
 153                                                                                 h->m_pHostperlMem,
 154                                                                                 h->m_pHostperlMemShared,
 155                                                                                 h->m_pHostperlMemParse,
 156                                                                                 h->m_pHostperlEnv,
 157                                                                                 h->m_pHostperlStdIO,
 158                                                                                 h->m_pHostperlLIO,
 159                                                                                 h->m_pHostperlDir,
 160                                                                                 h->m_pHostperlSock,
 161                                                                                 h->m_pHostperlProc
 162                                                                                 );
 163                                         CPerlObj *pPerl = (CPerlObj*)new_perl;
 164                                 #  else
 165                                         new_perl = perl_clone(my_perl, 1);
 166                                 #  endif
 167
 168                                 (void) perl_run(new_perl);      // Run Perl.
 169                                 PERL_SET_THX(my_perl);
 170                         #else
 171                                 (void) nlm.PerlRun(my_perl);
 172                         #endif
 173                 }
 174                 exitstatus = nlm.PerlDestroy(my_perl);
 175         }
 176         if(my_perl)
 177                 nlm.PerlFree(my_perl);
 178
 179         #ifdef USE_ITHREADS
 180                 if (new_perl)
 181                 {
 182                         PERL_SET_THX(new_perl);
 183                         exitstatus = nlm.PerlDestroy(new_perl);
 184                         nlm.PerlFree(my_perl);
 185                 }
 186         #endif
 187
 188         PERL_SYS_TERM();
 189         return exitstatus;
 190 }
 191
 192
 193 // FUNCTION: AllocStdPerl
 194 //
 195 // DESCRIPTION:
 196 //      Allocates a standard perl handler that other perl handlers
 197 //      may delegate to. You should call FreeStdPerl to free this
 198 //      instance when you are done with it.
 199 //
 200 IPerlHost* AllocStdPerl()
 201 {
 202         return (IPerlHost*) new ClsPerlHost();
 203 }
 204
 205
 206 // FUNCTION: FreeStdPerl
 207 //
 208 // DESCRIPTION:
 209 //      Frees an instance of a standard perl handler allocated by
 210 //      AllocStdPerl.
 211 //
 212 void FreeStdPerl(IPerlHost* pPerlHost)
 213 {
 214         if (pPerlHost)
 215                 delete (ClsPerlHost*) pPerlHost;
 216 ////            delete pPerlHost;
 217 }
 218