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