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];

/* 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, NULL, 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			/* local prototypes */
48			int exec_sql();
49			int call_perl_get_data();
50			int call_perl_sub(char *sub, int argc);
51
52
53			/* start an embedded command after EXEC SQL */
54			start_save(void) {
55			savebp = save_buf;
56			glb_errflag = 0;
57			savebp[0] = '\0'; /* discard previous text */
58			}
59
60			/* save a SQL token */
61			save_str(char *s) {
62
63			strcpy(savebp, s);
64			savebp += strlen(s);
65
66			strcpy(yylval.strval, strdup(s) );
67
68			}
69
70
71			/* end of SQL command, now write it out */
72			end_sql(void) {
73			int i;
74			register char *cp;
75			savebp--; /* back over the closing semicolon / / jhjh - don't want? */
76
77			/* jdh, 5/8/2002: call "exec_sql" function */
78			exec_sql();
79
80			/* return scanner to regular mode */
81			un_sql();
82			}
83
84
85			/* jdh, 10/22/2002 */
86			int exec_sql() {
87
88			if (glb_errflag)
89			return 0; /* don't abort; error message will have been returned */
90
91			/* fall-through */
92			call_perl_get_data();
93
94			return 0;
95			}
96
97			/* jdh, 10/22/2002 */
98			int call_perl_get_data() {
99
100			strcpy(args[0], parsed_sql.column_list);
101			strcpy(args[1], parsed_sql.table_list);
102			strcpy(args[2], parsed_sql.where_clause);
103			strcpy(args[3], parsed_sql.order_by);
104
105			call_perl_sub("get_data", 4);
106
107			return 0;
108			}
109
110			char call_perl_like2re(char word1, char word2, char word3, char *word4) {
111
112			EMBED_PERL(
113
114			XPUSHs(sv_2mortal(newSVpv(word1, 0)));
115			XPUSHs(sv_2mortal(newSVpv(word2, 0)));
116			XPUSHs(sv_2mortal(newSVpv(word3, 0)));
117			XPUSHs(sv_2mortal(newSVpv(word4, 0)));,
118
119			count = call_pv("like2re", G_SCALAR); )
120
121			return perl_buf;
122			}
123
124			char call_perl_tr_op(char table, char word1, char word2, char *word3) {
125
126			EMBED_PERL(
127
128			XPUSHs(sv_2mortal(newSVpv(table, 0)));
129			XPUSHs(sv_2mortal(newSVpv(word1, 0)));
130			XPUSHs(sv_2mortal(newSVpv(word2, 0)));
131			XPUSHs(sv_2mortal(newSVpv(word3, 0)));,
132
133			count = call_pv("tr_op", G_SCALAR); )
134
135			return perl_buf;
136			}
137
138			int call_perl_connect2client(char remote, char port) {
139
140			strcpy(args[0], remote);
141			strcpy(args[1], port);
142
143			call_perl_sub("connect2client", 2);
144
145			return 0;
146			}
147
148			char *call_perl_get_yyin(int size) {
149
150			EMBED_PERL(XPUSHs(sv_2mortal(newSViv(size))); ,
151
152			count = call_pv("get_yyin", G_SCALAR); )
153
154			return perl_buf;
155			}
156
157			int call_perl_send_yyout(char *s) {
158
159			strcpy(args[0], s);
160
161			call_perl_sub("send_yyout", 1);
162
163			return 0;
164			}
165
166			/* jdh, 10/22/2002 */
167			/* Note: all args must be (char *); we will convert these in perl sub.
168			* Sub must return (char ) /
169			int call_perl_sub(char *sub, int argc) {
170
171			EMBED_PERL(
172
173			for(i = 0; i < argc; i++) {
174			XPUSHs(sv_2mortal(newSVpv(args[i], 0)));
175			},
176
177			count = call_pv(sub, G_SCALAR); )
178
179			return 0;
180			}
181
182
183			/* jdh, 5/8/2002 */
184			/* note to self: embed_perl is called from C code generated from obj_srvr.l */
185			/* thus: embed_perl_obj_srvr(2, perl_argv, NULL); */
186			/* where static char perl_argv[] = {"obj_srvr", "obj_srvr.pl", "uid", /
187			/* "passwd", stdout}; */
188			int embed_perl_obj_srvr(int argc, char argv, char env) {
189
190			my_perl = perl_alloc();
191			perl_construct(my_perl);
192
193	dpavlin	5	perl_parse(my_perl, NULL, argc, argv, env);
194	dpavlin	1	perl_run(my_perl); /* just to initialize */
195
196			return 0;
197			}
198
199
200			/* jdh, 5/8/2002 */
201			end_perl(void) {
202			perl_destruct(my_perl);
203			perl_free(my_perl);
204			}
205
206