//
// Copyright (C) 1999-2003 Toshikaz Hirabayashi
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to
// deal in the Software without restriction, including without limitation the
// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
// sell copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
// TOSHIKAZ HIRABAYASHI BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
// WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
// OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
// SOFTWARE.
//
// Except as contained in this notice, the name of Toshikaz Hirabayashi shall
// not be used in advertising or otherwise to promote the sale, use or other
// dealings in this Software without prior written authorization from
// Toshikaz Hirabayashi.

#include <WScom.h>
#include <WSCbase.h>
#include <WSCprocedure.h>
#include <stdio.h>

#ifdef __cplusplus
extern "C" {
#endif

#include <EXTERN.h>
#include <perl.h>

#ifdef __cplusplus
}
#endif

#if 0 //deleted by hirabayashi
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
EXTERN_C void boot_mpfc_perl (pTHX_ CV* cv);

EXTERN_C void
xs_init(pTHX)
{
  char *file = __FILE__;
  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
  newXS("mpfc::boot_mpfc", boot_mpfc_perl, file);
}
#endif

WSCindexData flist;
void WSGFfunctionRegister(char* fname, void* perlfunc){
  flist.setData(fname,(void*)perlfunc);
}

void _procedure_handler(char* fname, WSCbase* object)
{
#ifdef MULTIPLICITY
extern PerlInterpreter * current_interpreter;
  PerlInterpreter* my_perl = current_interpreter;
  if (my_perl == NULL){
printf("my_perl is NULL!\n");
    return;
  }
#endif
  PL_perl_destruct_level += 1;
  
  char filename[4096];
#ifdef _WIN32
  _snprintf(filename, 4096, "%s.pl", fname);
#else
  snprintf(filename, 4096, "%s.pl", fname);
#endif
#if 0   //deleted by hirabayashi
  char *my_argv[] = { fname,  filename};

  PerlInterpreter *ws_mpfc;
  ws_mpfc = perl_alloc();
  
  perl_construct(ws_mpfc);
  perl_parse(ws_mpfc, xs_init, 2, my_argv, (char **)NULL);

  //perl_run(ws_mpfc);
#endif

  perl_require_pv(filename); //added by hirabayashi

  SV* wstestobj = sv_newmortal();
  char cname1[1024];
  sprintf(cname1,"mpfc::%s",object->getClassName());
  sv_setref_pv(wstestobj, cname1, (void*)object->cast(object->getClassName()));

  dSP;                            /* initialize stack pointer      */
  ENTER;                          /* everything created after here */
  SAVETMPS;                       /* ...is a temporary variable.   */
  PUSHMARK(SP);                   /* remember the stack pointer    */
  XPUSHs(wstestobj);
  PUTBACK;                        /* make local stack pointer global */

  perl_call_pv(fname, G_SCALAR);       /* call the function             */

  SPAGAIN;                        /* refresh stack pointer         */
  PUTBACK;
  FREETMPS;                       /* free that return value        */
  LEAVE;                          /* ...and the XPUSHed "mortal" args.*/

#if 0  //deleted by hirabayashi
  //perl_destruct(ws_mpfc);
  perl_free(ws_mpfc);
#endif

  PL_perl_destruct_level -= 1;
}

class _perl_proc_init{
  public: _perl_proc_init(){
    WSGFsetProcedureHandler((void*)_procedure_handler);

  };
};
_perl_proc_init _exec_perl_init;
