3 * Copyright 1999-2003 The OpenLDAP Foundation, All Rights Reserved.
4 * COPYING RESTRICTIONS APPLY, see COPYRIGHT file
7 * Copyright 1999, John C. Quillan, All rights reserved.
8 * Portions Copyright 2002, myinternet Limited. All rights reserved.
10 * Redistribution and use in source and binary forms are permitted only
11 * as authorized by the OpenLDAP Public License. A copy of this
12 * license is available at http://www.OpenLDAP.org/license.html or
13 * in file LICENSE in the top-level directory of the distribution.
18 #undef _ /* #defined by both Perl and ac/localize.h */
20 #ifdef HAVE_WIN32_ASPERL
21 #include "asperl_undefs.h"
30 #include "perl_back.h"
33 /**********************************************************
37 **********************************************************/
48 PerlBackend *perl_back = (PerlBackend *) be->be_private;
49 char eval_str[EVAL_BUF_SIZE];
55 if ( strcasecmp( argv[0], "perlModule" ) == 0 ) {
57 Debug( LDAP_DEBUG_ANY,
58 "%s.pm: line %d: missing module in \"perlModule <module>\" line\n",
64 snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", argv[1] );
65 eval_pv( eval_str, 0 );
70 fprintf(stderr , "Error %s\n", SvPV(ERRSV, n_a)) ;
73 snprintf( eval_str, EVAL_BUF_SIZE, "%s.pm", argv[1] );
74 perl_require_pv( eval_str );
76 if (SvTRUE(GvSV(errgv))) {
77 fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ;
79 #endif /* PERL_IS_5_6 */
83 XPUSHs(sv_2mortal(newSVpv(argv[1], 0)));
87 count = call_method("new", G_SCALAR);
89 count = perl_call_method("new", G_SCALAR);
95 croak("Big trouble in config\n") ;
98 perl_back->pb_obj_ref = newSVsv(POPs);
100 PUTBACK; FREETMPS; LEAVE ;
103 } else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) {
106 "%s: line %d: missing module in \"PerlModulePath <module>\" line\n",
111 snprintf( eval_str, EVAL_BUF_SIZE, "push @INC, '%s';", argv[1] );
113 loc_sv = eval_pv( eval_str, 0 );
115 loc_sv = perl_eval_pv( eval_str, 0 );
118 /* XXX loc_sv return value is ignored. */
120 } else if ( strcasecmp( argv[0], "filterSearchResults" ) == 0 ) {
121 perl_back->pb_filter_search_results = 1;
124 * Pass it to Perl module if defined
128 dSP ; ENTER ; SAVETMPS;
131 XPUSHs( perl_back->pb_obj_ref );
133 /* Put all arguments on the perl stack */
134 for( args = 0; args < argc; args++ ) {
135 XPUSHs(sv_2mortal(newSVpv(argv[args], 0)));
141 count = call_method("config", G_SCALAR);
143 count = perl_call_method("config", G_SCALAR);
149 croak("Big trouble in config\n") ;
154 PUTBACK ; FREETMPS ; LEAVE ;
158 /* if the module rejected it then we should reject it */
159 if ( return_code != 0 ) {
161 "Unknown perl backend config: %s\n", argv[0]);
162 exit( EXIT_FAILURE );