vdw/trunk/exec_sql.c

/*
 *  This code is copied from the O'Reilly Lex & Yacc book, 2nd Edition,
 *  1995, by John R. Levine, Tony Mason, and Doug Brown.
 *
 *  Enhancements added:  exec_sql() and embedded perl.
 *  Jeremy Hickerson, 5/8/2002
 */

#include <stdio.h>
#include <string.h>
#include <EXTERN.h>

#include <perl.h>
#include "flexdef.h"

#include "obj_srvr.tab.h"

#include "obj_srvr.h"

static PerlInterpreter *my_perl;

extern FILE *yyout;       /* lex output file */

#define EMBED_PERL(arg_expr, call_expr)    \
    dSP; \
    int i, count; \
    ENTER; \
    SAVETMPS; \
    PUSHMARK(SP); \
    arg_expr \
    PUTBACK; \
    call_expr \
    SPAGAIN ; \
    if (count != 1) \
        croak("Big trouble\n") ; \
    strcpy(perl_buf, POPp); \
    PUTBACK ; \
    FREETMPS; \
    LEAVE;

char save_buf[SQL_SIZE];      /* buffer for SQL command */
char *savebp;                 /* current buffer pointer */
char buf[BUFSIZE];
char perl_buf[BUFSIZE];
char args[10][ARGSIZE];

/* external prototypes */

EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);


EXTERN_C void
xs_init(pTHX)
{
        char *file = __FILE__;
        /* DynaLoader is a special case */
        newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}

/* local prototypes */
int exec_sql();
int call_perl_get_data();
int call_perl_sub(char *sub, int argc);


/* start an embedded command after EXEC SQL */
start_save(void) {
    savebp = save_buf;
    glb_errflag = 0;
    savebp[0] = '\0';                   /* discard previous text */
}

/* save a SQL token */
save_str(char *s) {

    strcpy(savebp, s);
    savebp += strlen(s);

    strcpy(yylval.strval, strdup(s) );

}


/* end of SQL command, now write it out */
end_sql(void) {
    int i;
    register char *cp;
    savebp--;  /* back over the closing semicolon */  /* jhjh - don't want? */

    /* jdh, 5/8/2002:  call "exec_sql" function */
    exec_sql();

    /* return scanner to regular mode */
    un_sql();
}


/* jdh, 10/22/2002 */
int exec_sql() {

    if (glb_errflag)
        return 0;  /* don't abort; error message will have been returned */

    /* fall-through */
    call_perl_get_data();
                  
    return 0;
}

/* jdh, 10/22/2002 */
int call_perl_get_data() {

    strcpy(args[0], parsed_sql.column_list);
    strcpy(args[1], parsed_sql.table_list);
    strcpy(args[2], parsed_sql.where_clause);
    strcpy(args[3], parsed_sql.order_by);

    call_perl_sub("get_data", 4);

    return 0;
}

char *call_perl_like2re(char *word1, char *word2, char *word3, char *word4) {

    EMBED_PERL( 

        XPUSHs(sv_2mortal(newSVpv(word1, 0)));
        XPUSHs(sv_2mortal(newSVpv(word2, 0)));
        XPUSHs(sv_2mortal(newSVpv(word3, 0)));
        XPUSHs(sv_2mortal(newSVpv(word4, 0)));,

        count = call_pv("like2re", G_SCALAR); )

    return perl_buf;
}

char *call_perl_tr_op(char *table, char *word1, char *word2, char *word3) {

    EMBED_PERL( 

        XPUSHs(sv_2mortal(newSVpv(table, 0)));
        XPUSHs(sv_2mortal(newSVpv(word1, 0)));
        XPUSHs(sv_2mortal(newSVpv(word2, 0)));
        XPUSHs(sv_2mortal(newSVpv(word3, 0)));,

        count = call_pv("tr_op", G_SCALAR); )

    return perl_buf;
}

int call_perl_connect2client(char *remote, char *port) {

    strcpy(args[0], remote);
    strcpy(args[1], port);

    call_perl_sub("connect2client", 2);

    return 0;
}

char *call_perl_get_yyin(int size) {

    EMBED_PERL(XPUSHs(sv_2mortal(newSViv(size))); ,

               count = call_pv("get_yyin", G_SCALAR); )

    return perl_buf;
}

int call_perl_send_yyout(char *s) {

    strcpy(args[0], s);

    call_perl_sub("send_yyout", 1);

    return 0;
}

/* jdh, 10/22/2002 */
/* Note:  all args must be (char *); we will convert these in perl sub.
 * Sub must return (char *) */
int call_perl_sub(char *sub, int argc) {

    EMBED_PERL(

    for(i = 0; i < argc; i++) {
        XPUSHs(sv_2mortal(newSVpv(args[i], 0)));
    },

    count = call_pv(sub, G_SCALAR); )

    return 0;
}


/* jdh, 5/8/2002                                                             */
/* note to self:  embed_perl is called from C code generated from obj_srvr.l */
/* thus:  embed_perl_obj_srvr(2, perl_argv, NULL);                           */
/* where static char *perl_argv[] = {"obj_srvr", "obj_srvr.pl", "uid",   */
/*                                     "passwd", stdout};                    */
int embed_perl_obj_srvr(int argc, char **argv, char **env) {

   my_perl = perl_alloc();
   perl_construct(my_perl);

   perl_parse(my_perl, xs_init, argc, argv, env);
   perl_run(my_perl);  /* just to initialize */

   return 0;
}


/* jdh, 5/8/2002 */
end_perl(void) {
   perl_destruct(my_perl);
   perl_free(my_perl);
}


1	dpavlin	1	/*
2			* This code is copied from the O'Reilly Lex & Yacc book, 2nd Edition,
3			* 1995, by John R. Levine, Tony Mason, and Doug Brown.
4			*
5			* Enhancements added: exec_sql() and embedded perl.
6			* Jeremy Hickerson, 5/8/2002
7			*/
8
9			#include <stdio.h>
10			#include <string.h>
11			#include <EXTERN.h>
12
13			#include <perl.h>
14	dpavlin	5	#include "flexdef.h"
15	dpavlin	1
16	dpavlin	3	#include "obj_srvr.tab.h"
17	dpavlin	1
18			#include "obj_srvr.h"
19
20			static PerlInterpreter *my_perl;
21
22			extern FILE yyout; / lex output file */
23
24			#define EMBED_PERL(arg_expr, call_expr) \
25			dSP; \
26			int i, count; \
27			ENTER; \
28			SAVETMPS; \
29			PUSHMARK(SP); \
30			arg_expr \
31			PUTBACK; \
32			call_expr \
33			SPAGAIN ; \
34			if (count != 1) \
35			croak("Big trouble\n") ; \
36			strcpy(perl_buf, POPp); \
37			PUTBACK ; \
38			FREETMPS; \
39			LEAVE;
40
41			char save_buf[SQL_SIZE]; /* buffer for SQL command */
42			char savebp; / current buffer pointer */
43			char buf[BUFSIZE];
44			char perl_buf[BUFSIZE];
45			char args[10][ARGSIZE];
46
47	dpavlin	7	/* external prototypes */
48
49			EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
50
51
52			EXTERN_C void
53			xs_init(pTHX)
54			{
55			char *file = __FILE__;
56			/* DynaLoader is a special case */
57			newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
58			}
59
60	dpavlin	1	/* local prototypes */
61			int exec_sql();
62			int call_perl_get_data();
63			int call_perl_sub(char *sub, int argc);
64
65
66			/* start an embedded command after EXEC SQL */
67			start_save(void) {
68			savebp = save_buf;
69			glb_errflag = 0;
70			savebp[0] = '\0'; /* discard previous text */
71			}
72
73			/* save a SQL token */
74			save_str(char *s) {
75
76			strcpy(savebp, s);
77			savebp += strlen(s);
78
79			strcpy(yylval.strval, strdup(s) );
80
81			}
82
83
84			/* end of SQL command, now write it out */
85			end_sql(void) {
86			int i;
87			register char *cp;
88			savebp--; /* back over the closing semicolon / / jhjh - don't want? */
89
90			/* jdh, 5/8/2002: call "exec_sql" function */
91			exec_sql();
92
93			/* return scanner to regular mode */
94			un_sql();
95			}
96
97
98			/* jdh, 10/22/2002 */
99			int exec_sql() {
100
101			if (glb_errflag)
102			return 0; /* don't abort; error message will have been returned */
103
104			/* fall-through */
105			call_perl_get_data();
106
107			return 0;
108			}
109
110			/* jdh, 10/22/2002 */
111			int call_perl_get_data() {
112
113			strcpy(args[0], parsed_sql.column_list);
114			strcpy(args[1], parsed_sql.table_list);
115			strcpy(args[2], parsed_sql.where_clause);
116			strcpy(args[3], parsed_sql.order_by);
117
118			call_perl_sub("get_data", 4);
119
120			return 0;
121			}
122
123			char call_perl_like2re(char word1, char word2, char word3, char *word4) {
124
125			EMBED_PERL(
126
127			XPUSHs(sv_2mortal(newSVpv(word1, 0)));
128			XPUSHs(sv_2mortal(newSVpv(word2, 0)));
129			XPUSHs(sv_2mortal(newSVpv(word3, 0)));
130			XPUSHs(sv_2mortal(newSVpv(word4, 0)));,
131
132			count = call_pv("like2re", G_SCALAR); )
133
134			return perl_buf;
135			}
136
137			char call_perl_tr_op(char table, char word1, char word2, char *word3) {
138
139			EMBED_PERL(
140
141			XPUSHs(sv_2mortal(newSVpv(table, 0)));
142			XPUSHs(sv_2mortal(newSVpv(word1, 0)));
143			XPUSHs(sv_2mortal(newSVpv(word2, 0)));
144			XPUSHs(sv_2mortal(newSVpv(word3, 0)));,
145
146			count = call_pv("tr_op", G_SCALAR); )
147
148			return perl_buf;
149			}
150
151			int call_perl_connect2client(char remote, char port) {
152
153			strcpy(args[0], remote);
154			strcpy(args[1], port);
155
156			call_perl_sub("connect2client", 2);
157
158			return 0;
159			}
160
161			char *call_perl_get_yyin(int size) {
162
163			EMBED_PERL(XPUSHs(sv_2mortal(newSViv(size))); ,
164
165			count = call_pv("get_yyin", G_SCALAR); )
166
167			return perl_buf;
168			}
169
170			int call_perl_send_yyout(char *s) {
171
172			strcpy(args[0], s);
173
174			call_perl_sub("send_yyout", 1);
175
176			return 0;
177			}
178
179			/* jdh, 10/22/2002 */
180			/* Note: all args must be (char *); we will convert these in perl sub.
181			* Sub must return (char ) /
182			int call_perl_sub(char *sub, int argc) {
183
184			EMBED_PERL(
185
186			for(i = 0; i < argc; i++) {
187			XPUSHs(sv_2mortal(newSVpv(args[i], 0)));
188			},
189
190			count = call_pv(sub, G_SCALAR); )
191
192			return 0;
193			}
194
195
196			/* jdh, 5/8/2002 */
197			/* note to self: embed_perl is called from C code generated from obj_srvr.l */
198			/* thus: embed_perl_obj_srvr(2, perl_argv, NULL); */
199			/* where static char perl_argv[] = {"obj_srvr", "obj_srvr.pl", "uid", /
200			/* "passwd", stdout}; */
201			int embed_perl_obj_srvr(int argc, char argv, char env) {
202
203			my_perl = perl_alloc();
204			perl_construct(my_perl);
205
206	dpavlin	7	perl_parse(my_perl, xs_init, argc, argv, env);
207	dpavlin	1	perl_run(my_perl); /* just to initialize */
208
209			return 0;
210			}
211
212
213			/* jdh, 5/8/2002 */
214			end_perl(void) {
215			perl_destruct(my_perl);
216			perl_free(my_perl);
217			}
218
219