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
  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                                 new_perl = perl_clone(my_perl, 1);
 145
 146                                 exitstatus = perl_run(new_perl);        // Run Perl.
 147                                 PERL_SET_THX(my_perl);
 148                         #else
 149                                 exitstatus = nlm.PerlRun(my_perl);
 150                         #endif
 151                 }
 152                 nlm.PerlDestroy(my_perl);
 153         }
 154
 155         #ifdef USE_ITHREADS
 156                 if (new_perl)
 157                 {
 158                         PERL_SET_THX(new_perl);
 159                         nlm.PerlDestroy(new_perl);
 160                 }
 161         #endif
 162
 163         PERL_SYS_TERM();
 164         return exitstatus;
 165 }
 166
 167
 168 // FUNCTION: AllocStdPerl
 169 //
 170 // DESCRIPTION:
 171 //      Allocates a standard perl handler that other perl handlers
 172 //      may delegate to. You should call FreeStdPerl to free this
 173 //      instance when you are done with it.
 174 //
 175 IPerlHost* AllocStdPerl()
 176 {
 177         return new ClsPerlHost();
 178 }
 179
 180
 181 // FUNCTION: FreeStdPerl
 182 //
 183 // DESCRIPTION:
 184 //      Frees an instance of a standard perl handler allocated by
 185 //      AllocStdPerl.
 186 //
 187 void FreeStdPerl(IPerlHost* pPerlHost)
 188 {
 189         delete (ClsPerlHost*) pPerlHost;
 190 }
 191
 192