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