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 void
  82 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
  83 {
  84         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         #ifdef PERL_GLOBAL_STRUCT
 129                 #define PERLVAR(prefix,var,type)
 130                 #define PERLVARA(prefix,var,type)
 131                 #define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
 132                 #define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init;
 133
 134                 #include "perlvars.h"
 135
 136                 #undef PERLVAR
 137                 #undef PERLVARA
 138                 #undef PERLVARI
 139                 #undef PERLVARIC
 140         #endif
 141
 142         PERL_SYS_INIT(&argc, &argv);
 143
 144         if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
 145                 return (1);
 146
 147         if(nlm.PerlCreate(my_perl))
 148         {
 149                 PL_perl_destruct_level = 0;
 150
 151                 exitstatus = nlm.PerlParse(my_perl, argc, argv, env);
 152                 if(exitstatus == 0)
 153                 {
 154                         #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
 155                                 new_perl = perl_clone(my_perl, 1);
 156
 157                                 exitstatus = perl_run(new_perl);        // Run Perl.
 158                                 PERL_SET_THX(my_perl);
 159                         #else
 160                                 exitstatus = nlm.PerlRun(my_perl);
 161                         #endif
 162                 }
 163                 nlm.PerlDestroy(my_perl);
 164         }
 165         if(my_perl)
 166                 nlm.PerlFree(my_perl);
 167
 168         #ifdef USE_ITHREADS
 169                 if (new_perl)
 170                 {
 171                         PERL_SET_THX(new_perl);
 172                         nlm.PerlDestroy(new_perl);
 173                         nlm.PerlFree(my_perl);
 174                 }
 175         #endif
 176
 177         PERL_SYS_TERM();
 178         return exitstatus;
 179 }
 180
 181
 182 // FUNCTION: AllocStdPerl
 183 //
 184 // DESCRIPTION:
 185 //      Allocates a standard perl handler that other perl handlers
 186 //      may delegate to. You should call FreeStdPerl to free this
 187 //      instance when you are done with it.
 188 //
 189 IPerlHost* AllocStdPerl()
 190 {
 191         return (IPerlHost*) new ClsPerlHost();
 192 }
 193
 194
 195 // FUNCTION: FreeStdPerl
 196 //
 197 // DESCRIPTION:
 198 //      Frees an instance of a standard perl handler allocated by
 199 //      AllocStdPerl.
 200 //
 201 void FreeStdPerl(IPerlHost* pPerlHost)
 202 {
 203         if (pPerlHost)
 204                 delete (ClsPerlHost*) pPerlHost;
 205 }
 206