miniperlmain.c

   1 /*
   2  * "The Road goes ever on and on, down from the door where it began."
   3  */
   4
   5 #ifdef __cplusplus
   6 extern "C" {
   7 #endif
   8
   9 #include "EXTERN.h"
  10 #include "perl.h"
  11
  12 #ifdef __cplusplus
  13 }
  14 #  define EXTERN_C extern "C"
  15 #else
  16 #  define EXTERN_C extern
  17 #endif
  18
  19 static void xs_init _((void));
  20 static PerlInterpreter *my_perl;
  21
  22 int
  23 perl_init_i18nl14n(printwarn)   /* XXX move to perl.c */
  24     int printwarn;
  25 {
  26     int ok = 1;
  27     /* returns
  28      *    1 = set ok or not applicable,
  29      *    0 = fallback to C locale,
  30      *   -1 = fallback to C locale failed
  31      */
  32 #if defined(HAS_SETLOCALE) && defined(LC_CTYPE)
  33     char * lang     = getenv("LANG");
  34     char * lc_all   = getenv("LC_ALL");
  35     char * lc_ctype = getenv("LC_CTYPE");
  36     int i;
  37
  38     if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) {
  39         if (printwarn) {
  40             fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n");
  41             fprintf(stderr,
  42               "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n",
  43               lc_all   ? lc_all   : "(null)",
  44               lc_ctype ? lc_ctype : "(null)",
  45               lang     ? lang     : "(null)"
  46               );
  47             fprintf(stderr, "warning: falling back to the \"C\" locale.\n");
  48         }
  49         ok = 0;
  50         if (setlocale(LC_CTYPE, "C") == NULL)
  51             ok = -1;
  52     }
  53
  54     for (i = 0; i < 256; i++) {
  55         if (isUPPER(i)) fold[i] = toLOWER(i);
  56         else if (isLOWER(i)) fold[i] = toUPPER(i);
  57         else fold[i] = i;
  58     }
  59 #endif
  60     return ok;
  61 }
  62
  63
  64 int
  65 #ifndef CAN_PROTOTYPE
  66 main(argc, argv, env)
  67 int argc;
  68 char **argv;
  69 char **env;
  70 #else  /* def(CAN_PROTOTYPE) */
  71 main(int argc, char **argv, char **env)
  72 #endif  /* def(CAN_PROTOTYPE) */
  73 {
  74     int exitstatus;
  75
  76     PERL_SYS_INIT(&argc,&argv);
  77
  78     perl_init_i18nl14n(1);
  79
  80     if (!do_undump) {
  81         my_perl = perl_alloc();
  82         if (!my_perl)
  83             exit(1);
  84         perl_construct( my_perl );
  85     }
  86
  87     exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
  88     if (exitstatus)
  89         exit( exitstatus );
  90
  91     exitstatus = perl_run( my_perl );
  92
  93     perl_destruct( my_perl );
  94     perl_free( my_perl );
  95
  96     exit( exitstatus );
  97 }
  98
  99 /* Register any extra external extensions */
 100
 101 /* Do not delete this line--writemain depends on it */
 102
 103 static void
 104 xs_init()
 105 {
 106 }