]> git.sur5r.net Git - openldap/blob - servers/slapd/back-perl/modrdn.c
20bdf3c8bdb44adff56dd87cdebc4cd64d34fc00
[openldap] / servers / slapd / back-perl / modrdn.c
1 /* $OpenLDAP$ */
2 /*
3  * Copyright 1999-2003 The OpenLDAP Foundation, All Rights Reserved.
4  * COPYING RESTRICTIONS APPLY, see COPYRIGHT file
5  */
6 /*
7  *       Copyright 1999, John C. Quillan, All rights reserved.
8  *       Portions Copyright 2002, myinternet Limited. All rights reserved.
9  *
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.
14  */
15
16 /*
17  * LDAP v3 newSuperior support.
18  *
19  * Copyright 1999, Juan C. Gomez, All rights reserved.
20  * This software is not subject to any license of Silicon Graphics 
21  * Inc. or Purdue University.
22  *
23  * Redistribution and use in source and binary forms are permitted
24  * without restriction or fee of any kind as long as this notice
25  * is preserved.
26  *
27  */
28
29 #include "portable.h"
30
31 #include <stdio.h>
32
33 #include "slap.h"
34 #ifdef HAVE_WIN32_ASPERL
35 #include "asperl_undefs.h"
36 #endif
37
38 #include <EXTERN.h>
39 #include <perl.h>
40
41 #include "perl_back.h"
42
43 int
44 perl_back_modrdn(
45         Operation       *op,
46         SlapReply       *rs )
47 {
48         PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
49         int count;
50
51         ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );  
52
53         {
54                 dSP; ENTER; SAVETMPS;
55                 
56                 PUSHMARK(sp) ;
57                 XPUSHs( perl_back->pb_obj_ref );
58                 XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , 0 )));
59                 XPUSHs(sv_2mortal(newSVpv( op->orr_newrdn.bv_val , 0 )));
60                 XPUSHs(sv_2mortal(newSViv( op->orr_deleteoldrdn )));
61                 if ( op->orr_newSup != NULL ) {
62                         XPUSHs(sv_2mortal(newSVpv( op->orr_newSup->bv_val , 0 )));
63                 }
64                 PUTBACK ;
65
66 #ifdef PERL_IS_5_6
67                 count = call_method("modrdn", G_SCALAR);
68 #else
69                 count = perl_call_method("modrdn", G_SCALAR);
70 #endif
71
72                 SPAGAIN ;
73
74                 if (count != 1) {
75                         croak("Big trouble in back_modrdn\n") ;
76                 }
77                                                          
78                 rs->sr_err = POPi;
79
80                 PUTBACK; FREETMPS; LEAVE ;
81         }
82
83         ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
84         
85         send_ldap_result( op, rs );
86
87         Debug( LDAP_DEBUG_ANY, "Perl MODRDN\n", 0, 0, 0 );
88         return( 0 );
89 }