2 /* This work is part of OpenLDAP Software <http://www.openldap.org/>.
4 * Copyright 1999-2003 The OpenLDAP Foundation.
5 * Portions Copyright 1999 John C. Quillan.
6 * Portions Copyright 2002 myinternet Limited.
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted only as authorized by the OpenLDAP
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>.
20 #undef _ /* #defined by both Perl and ac/localize.h */
22 #ifdef HAVE_WIN32_ASPERL
23 #include "asperl_undefs.h"
32 #include "perl_back.h"
35 /**********************************************************
39 **********************************************************/
50 PerlBackend *perl_back = (PerlBackend *) be->be_private;
51 char eval_str[EVAL_BUF_SIZE];
57 if ( strcasecmp( argv[0], "perlModule" ) == 0 ) {
59 Debug( LDAP_DEBUG_ANY,
60 "%s.pm: line %d: missing module in \"perlModule <module>\" line\n",
66 snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", argv[1] );
67 eval_pv( eval_str, 0 );
72 fprintf(stderr , "Error %s\n", SvPV(ERRSV, n_a)) ;
75 snprintf( eval_str, EVAL_BUF_SIZE, "%s.pm", argv[1] );
76 perl_require_pv( eval_str );
78 if (SvTRUE(GvSV(errgv))) {
79 fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ;
81 #endif /* PERL_IS_5_6 */
85 XPUSHs(sv_2mortal(newSVpv(argv[1], 0)));
89 count = call_method("new", G_SCALAR);
91 count = perl_call_method("new", G_SCALAR);
97 croak("Big trouble in config\n") ;
100 perl_back->pb_obj_ref = newSVsv(POPs);
102 PUTBACK; FREETMPS; LEAVE ;
105 } else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) {
108 "%s: line %d: missing module in \"PerlModulePath <module>\" line\n",
113 snprintf( eval_str, EVAL_BUF_SIZE, "push @INC, '%s';", argv[1] );
115 loc_sv = eval_pv( eval_str, 0 );
117 loc_sv = perl_eval_pv( eval_str, 0 );
120 /* XXX loc_sv return value is ignored. */
122 } else if ( strcasecmp( argv[0], "filterSearchResults" ) == 0 ) {
123 perl_back->pb_filter_search_results = 1;
126 * Pass it to Perl module if defined
130 dSP ; ENTER ; SAVETMPS;
133 XPUSHs( perl_back->pb_obj_ref );
135 /* Put all arguments on the perl stack */
136 for( args = 0; args < argc; args++ ) {
137 XPUSHs(sv_2mortal(newSVpv(argv[args], 0)));
143 count = call_method("config", G_SCALAR);
145 count = perl_call_method("config", G_SCALAR);
151 croak("Big trouble in config\n") ;
156 PUTBACK ; FREETMPS ; LEAVE ;
160 /* if the module rejected it then we should reject it */
161 if ( return_code != 0 ) {
163 "Unknown perl backend config: %s\n", argv[0]);
164 exit( EXIT_FAILURE );