git.sur5r.net Git - openldap/blob - servers/slapd/back-perl/config.c

   1 /* $OpenLDAP$ */
   2 /* This work is part of OpenLDAP Software <http://www.openldap.org/>.
   3  *
   4  * Copyright 1999-2009 The OpenLDAP Foundation.
   5  * Portions Copyright 1999 John C. Quillan.
   6  * Portions Copyright 2002 myinternet Limited.
   7  * All rights reserved.
   8  *
   9  * Redistribution and use in source and binary forms, with or without
  10  * modification, are permitted only as authorized by the OpenLDAP
  11  * Public License.
  12  *
  13  * A copy of this license is available in file LICENSE in the
  14  * top-level directory of the distribution or, alternatively, at
  15  * <http://www.OpenLDAP.org/license.html>.
  16  */
  17
  18 #include "perl_back.h"
  19
  20
  21 /**********************************************************
  22  *
  23  * Config
  24  *
  25  **********************************************************/
  26 int
  27 perl_back_db_config(
  28          BackendDB *be,
  29          const char *fname,
  30          int lineno,
  31          int argc,
  32          char **argv
  33 )
  34 {
  35         SV* loc_sv;
  36         PerlBackend *perl_back = (PerlBackend *) be->be_private;
  37         char eval_str[EVAL_BUF_SIZE];
  38         int count ;
  39         int args;
  40         int return_code;
  41
  42
  43         if ( strcasecmp( argv[0], "perlModule" ) == 0 ) {
  44                 if ( argc < 2 ) {
  45                         Debug( LDAP_DEBUG_ANY,
  46                                  "%s.pm: line %d: missing module in \"perlModule <module>\" line\n",
  47                                 fname, lineno, 0 );
  48                         return( 1 );
  49                 }
  50
  51 #ifdef PERL_IS_5_6
  52                 snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", argv[1] );
  53                 eval_pv( eval_str, 0 );
  54
  55                 if (SvTRUE(ERRSV)) {
  56                         STRLEN n_a;
  57
  58                         fprintf(stderr , "Error %s\n", SvPV(ERRSV, n_a)) ;
  59                 }
  60 #else
  61                 snprintf( eval_str, EVAL_BUF_SIZE, "%s.pm", argv[1] );
  62                 perl_require_pv( eval_str );
  63
  64                 if (SvTRUE(GvSV(errgv))) {
  65                         fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ;
  66                 }
  67 #endif /* PERL_IS_5_6 */
  68                 else {
  69                         dSP; ENTER; SAVETMPS;
  70                         PUSHMARK(sp);
  71                         XPUSHs(sv_2mortal(newSVpv(argv[1], 0)));
  72                         PUTBACK;
  73
  74 #ifdef PERL_IS_5_6
  75                         count = call_method("new", G_SCALAR);
  76 #else
  77                         count = perl_call_method("new", G_SCALAR);
  78 #endif
  79
  80                         SPAGAIN;
  81
  82                         if (count != 1) {
  83                                 croak("Big trouble in config\n") ;
  84                         }
  85
  86                         perl_back->pb_obj_ref = newSVsv(POPs);
  87
  88                         PUTBACK; FREETMPS; LEAVE ;
  89                 }
  90
  91         } else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) {
  92                 if ( argc < 2 ) {
  93                         fprintf( stderr,
  94                                 "%s: line %d: missing module in \"PerlModulePath <module>\" line\n",
  95                                 fname, lineno );
  96                         return( 1 );
  97                 }
  98
  99                 snprintf( eval_str, EVAL_BUF_SIZE, "push @INC, '%s';", argv[1] );
 100 #ifdef PERL_IS_5_6
 101                 loc_sv = eval_pv( eval_str, 0 );
 102 #else
 103                 loc_sv = perl_eval_pv( eval_str, 0 );
 104 #endif
 105
 106                 /* XXX loc_sv return value is ignored. */
 107
 108         } else if ( strcasecmp( argv[0], "filterSearchResults" ) == 0 ) {
 109                 perl_back->pb_filter_search_results = 1;
 110         } else {
 111                 return_code = SLAP_CONF_UNKNOWN;
 112                 /*
 113                  * Pass it to Perl module if defined
 114                  */
 115
 116                 {
 117                         dSP ;  ENTER ; SAVETMPS;
 118
 119                         PUSHMARK(sp) ;
 120                         XPUSHs( perl_back->pb_obj_ref );
 121
 122                         /* Put all arguments on the perl stack */
 123                         for( args = 0; args < argc; args++ ) {
 124                                 XPUSHs(sv_2mortal(newSVpv(argv[args], 0)));
 125                         }
 126
 127                         PUTBACK ;
 128
 129 #ifdef PERL_IS_5_6
 130                         count = call_method("config", G_SCALAR);
 131 #else
 132                         count = perl_call_method("config", G_SCALAR);
 133 #endif
 134
 135                         SPAGAIN ;
 136
 137                         if (count != 1) {
 138                                 croak("Big trouble in config\n") ;
 139                         }
 140
 141                         return_code = POPi;
 142
 143                         PUTBACK ; FREETMPS ;  LEAVE ;
 144
 145                 }
 146
 147                 return return_code;
 148         }
 149
 150         return 0;
 151 }