]> git.sur5r.net Git - openldap/blob - servers/slapd/back-perl/compare.c
Notices
[openldap] / servers / slapd / back-perl / compare.c
1 /* $OpenLDAP$ */
2 /* This work is part of OpenLDAP Software <http://www.openldap.org/>.
3  *
4  * Copyright 1999-2003 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 <EXTERN.h>
19 #include <perl.h>
20 #undef _ /* #defined by both Perl and ac/localize.h */
21
22 #ifdef HAVE_WIN32_ASPERL
23 #include "asperl_undefs.h"
24 #endif
25
26 #include "portable.h"
27
28 #include <stdio.h>
29
30 #include "slap.h"
31
32 #include "lutil.h"
33 #include "perl_back.h"
34
35 /**********************************************************
36  *
37  * Compare
38  *
39  **********************************************************/
40
41 int
42 perl_back_compare(
43         Operation       *op,
44         SlapReply       *rs )
45 {
46         int count;
47         char *avastr, *ptr;
48
49         PerlBackend *perl_back = (PerlBackend *)op->o_bd->be_private;
50
51         avastr = ch_malloc( op->orc_ava->aa_desc->ad_cname.bv_len + 1 +
52                 op->orc_ava->aa_value.bv_len + 1 );
53         
54         lutil_strcopy( lutil_strcopy( lutil_strcopy( avastr,
55                 op->orc_ava->aa_desc->ad_cname.bv_val ), "=" ),
56                 op->orc_ava->aa_value.bv_val );
57
58         ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );  
59
60         {
61                 dSP; ENTER; SAVETMPS;
62
63                 PUSHMARK(sp);
64                 XPUSHs( perl_back->pb_obj_ref );
65                 XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , 0)));
66                 XPUSHs(sv_2mortal(newSVpv( avastr , 0)));
67                 PUTBACK;
68
69 #ifdef PERL_IS_5_6
70                 count = call_method("compare", G_SCALAR);
71 #else
72                 count = perl_call_method("compare", G_SCALAR);
73 #endif
74
75                 SPAGAIN;
76
77                 if (count != 1) {
78                         croak("Big trouble in back_compare\n");
79                 }
80
81                 rs->sr_err = POPi;
82
83                 PUTBACK; FREETMPS; LEAVE;
84         }
85
86         ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );        
87
88         ch_free( avastr );
89
90         send_ldap_result( op, rs );
91
92         Debug( LDAP_DEBUG_ANY, "Perl COMPARE\n", 0, 0, 0 );
93
94         return (0);
95 }
96