PApp-SQL/SQL.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6))
# define get_sv perl_get_sv
# define call_method perl_call_method
#endif

#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))

typedef struct lru_node {
  struct lru_node *next;
  struct lru_node *prev;
  U32 hash;
  SV *dbh;
  SV *sql;

  SV *sth;
#if 0 /* method cache */
  GV *execute;
  GV *bind_columns;
  GV *fetch;
#endif
} lru_node;

static lru_node lru_list;
static int lru_size;
static int lru_maxsize;

#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */

/* this is primitive, yet effective */
/* the returned value must never be zero (or bad things will happen) */
#define lru_hash do {   \
        hash = (((U32)dbh)>>2); \
        hash += *statement;\
        hash += len;            \
} while (0)

/* fetch and "use" */
/* could be done using a single call (we could call prepare!) */
static SV *lru_fetch(SV *dbh, SV *sql)
{
  lru_node *n;

  U32 hash;
  STRLEN len;
  char *statement = SvPV (sql, len);

  dbh = SvRV (dbh);

  lru_hash;

  /*fprintf (stderr, "F: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/

  n = &lru_list;
  do {
    n = n->next;
    if (!n->hash)
      return 0;
  } while (n->hash != hash
           || !sv_eq (n->sql, sql)
           || n->dbh != dbh);

  /* found, so return to the start of the list */
  n->prev->next = n->next;
  n->next->prev = n->prev;

  n->next = lru_list.next;
  n->prev = &lru_list;
  lru_list.next->prev = n;
  lru_list.next = n;

  return n->sth;
}

static void lru_nukeone(void)
{
  lru_node *n;
  /* nuke at the end */

  n = lru_list.prev;

  lru_list.prev = n->prev;
  n->prev->next = &lru_list;

  /*fprintf (stderr, "N: %s\n", SvPV_nolen (n->sql));/*D*/

  SvREFCNT_dec (n->dbh);
  SvREFCNT_dec (n->sql);
  SvREFCNT_dec (n->sth);
  Safefree (n);
  
  lru_size--;
}

/* store a not-yet existing entry(!) */
static void lru_store(SV *dbh, SV *sql, SV *sth)
{
  lru_node *n;

  U32 hash;
  STRLEN len;
  char *statement = SvPV (sql, len);

  dbh = SvRV (dbh);

  lru_hash;

  /*fprintf (stderr, "S: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/

  lru_size++;
  if (lru_size > lru_maxsize)
    lru_nukeone ();

  New (0, n, 1, lru_node);

  n->hash = hash;
  n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
  n->sql = newSVsv (sql);
  n->sth = sth; SvREFCNT_inc (sth);

  n->next = lru_list.next;
  n->prev = &lru_list;
  lru_list.next->prev = n;
  lru_list.next = n;
}

static void lru_cachesize (int size)
{
  if (size >= 0)
    {
      lru_maxsize = size;
      while (lru_size > lru_maxsize)
        lru_nukeone ();
    }
}

static GV *sql_exec;
static GV *DBH;

MODULE = PApp::SQL              PACKAGE = PApp::SQL

PROTOTYPES: DISABLE

BOOT:
{
   sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
   DBH      = gv_fetchpv ("PApp::SQL::DBH"     , TRUE, SVt_PV);

   /* apache might BOOT: twice :( */
   if (lru_size)
     lru_cachesize (0);

   lru_init;
   lru_cachesize (50);
}

int
cachesize(size = -1)
        int     size
        CODE:
        RETVAL = lru_maxsize;
        lru_cachesize (size);
        OUTPUT:
        RETVAL

void
sql_exec(...)
        ALIAS:
                sql_fetch    = 1
                sql_fetchall = 2
                sql_exists   = 4
        PPCODE:
{
        if (items == 0)
          croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]");
        else
          {
            int arg = 0;
            int bind_first, bind_last;
            int count;
            SV *dbh = ST(0);
            SV *sth;
            SV *sql;
            SV *execute;
            STRLEN dc;

            /* save our arguments against destruction through function calls */
            SP += items;
            
            /* first check wether we should use an explicit db handle */
            if (!is_dbh (dbh))
              {
                dbh = get_sv ("DBH", FALSE);
                if (!is_dbh (dbh))
                  {
                    dbh = GvSV(DBH);
                    if (!is_dbh (dbh))
                      croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
                  }
              }
            else
              arg++; /* we consumed one argument */

            /* count the remaining references (for bind_columns) */
            bind_first = arg;
            while (items > arg && SvROK (ST(arg)))
              arg++;

            bind_last = arg;

            /* consume the sql-statement itself */
            if (items <= arg)
              croak ("sql_exec: required argument \"sql-statement\" missing");

            if (!SvPOK (ST(arg)))
              croak ("sql_exec: sql-statement must be a string");

            sql = ST(arg); arg++;

            if (ix == 4)
              {
                SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0));
                sv_catsv (neu, sql);
                sv_catpv (neu, " limit 1");
                sql = neu;
                ix = 1; /* sql_fetch */
              }

            /* check cache for existing statement handle (NYI) */
            sth = lru_fetch (dbh, sql);
            if (!sth)
              {
                PUSHMARK (SP);
                EXTEND (SP, 2);
                PUSHs (dbh);
                PUSHs (sql);
                PUTBACK;
                count = call_method ("prepare", G_SCALAR);
                SPAGAIN;

                if (count != 1)
                  croak ("sql_exec: unable to prepare() statement '%s': %s",
                         SvPV (sql, dc),
                         SvPV (get_sv ("DBI::errstr", TRUE), dc));

                sth = POPs;

                lru_store (dbh, sql, sth);
              }

            PUSHMARK (SP);
            EXTEND (SP, items - arg + 1);
            PUSHs (sth);
            while (items > arg)
              {
                PUSHs (ST(arg));
                arg++;
              }

            PUTBACK;
            /* { static GV *execute;
              if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0);
              count = call_sv(GvCV(execute), G_SCALAR);
             }*/
            count = call_method ("execute", G_SCALAR);
            SPAGAIN;

            if (count != 1)
              croak ("sql_exec: execute() didn't return any value ('%s'): %s",
                     SvPV (sql, dc),
                     SvPV (get_sv ("DBI::errstr", TRUE), dc));

            execute = POPs;

            if (!SvTRUE (execute))
              croak ("sql_exec: unable to execute statement '%s' (%s)",
                     SvPV (sql, dc),
                     SvPV (get_sv ("DBI::errstr", TRUE), dc));

            sv_setsv (GvSV(sql_exec), execute);

            if (bind_first != bind_last)
              {
                PUSHMARK (SP);
                EXTEND (SP, bind_last - bind_first + 2);
                PUSHs (sth);
                do {
                  PUSHs (ST(bind_first));
                  bind_first++;
                } while (bind_first != bind_last);

                PUTBACK;
                count = call_method ("bind_columns", G_SCALAR);
                SPAGAIN;

                if (count != 1)
                  croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
                         SvPV (sql, dc),
                         SvPV (get_sv ("DBI::errstr", TRUE), dc));

                if (!SvOK (POPs))
                  croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
                         SvPV (sql, dc),
                         SvPV (get_sv ("DBI::errstr", TRUE), dc));
              }

            /* free our arguments from the stack */
            SP -= items;

            if (ix == 1)
              { /* sql_fetch */
                SV *row;

                PUSHMARK (SP);
                XPUSHs (sth);
                PUTBACK;
                count = call_method ("fetchrow_arrayref", G_SCALAR);
                SPAGAIN;

                if (count != 1)
                  abort ();

                row = POPs;

                if (SvROK (row))
                  {
                    AV *av;

                    switch (GIMME_V)
                      {
                        case G_VOID:
                          /* no thing */
                          break;
                        case G_SCALAR:
                          /* the first element */
                          XPUSHs (*av_fetch ((AV *)SvRV (row), 0, 1));
                          break;
                        case G_ARRAY:
                          av = (AV *)SvRV (row);
                          count = AvFILL (av) + 1;
                          EXTEND (SP, count);
                          for (arg = 0; arg < count; arg++)
                            PUSHs (AvARRAY (av)[arg]);

                          break;
                        default:
                          abort ();
                      }
                 }
              }
            else if (ix == 2)
              { /* sql_fetchall */
                SV *rows;

                PUSHMARK (SP);
                XPUSHs (sth);
                PUTBACK;
                count = call_method ("fetchall_arrayref", G_SCALAR);
                SPAGAIN;

                if (count != 1)
                  abort ();

                rows = POPs;

                if (SvROK (rows))
                  {
                    AV *av = (AV *)SvRV (rows);
                    count = AvFILL (av) + 1;

                    if (count)
                      {
                        int columns = AvFILL ((AV *)SvRV (AvARRAY(av)[0])) + 1; /* columns? */

                        EXTEND (SP, count);
                        if (columns == 1)
                          for (arg = 0; arg < count; arg++)
                            PUSHs (AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]);
                        else
                          for (arg = 0; arg < count; arg++)
                            PUSHs (AvARRAY (av)[arg]);
                      }
                 }
              }
            else
              XPUSHs (sth);

            if (ix || GIMME_V == G_VOID)
              {
                PUSHMARK (SP);
                XPUSHs (sth);
                PUTBACK;
                (void) call_method ("finish", G_DISCARD);
                SPAGAIN;
              }
          }
}


Revision:	1.3
Committed:	Tue Dec 19 14:22:05 2000 UTC (25 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	klinik_20010124
Changes since 1.2:	+16 -10 lines
Log Message:	* empty log message *
#	Content
1	#include "EXTERN.h"
2	#include "perl.h"
3	#include "XSUB.h"
4
5	#if (PERL_VERSION < 5) \|\| ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6))
6	# define get_sv perl_get_sv
7	# define call_method perl_call_method
8	#endif
9
10	#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))
11
12	typedef struct lru_node {
13	struct lru_node *next;
14	struct lru_node *prev;
15	U32 hash;
16	SV *dbh;
17	SV *sql;
18
19	SV *sth;
20	#if 0 /* method cache */
21	GV *execute;
22	GV *bind_columns;
23	GV *fetch;
24	#endif
25	} lru_node;
26
27	static lru_node lru_list;
28	static int lru_size;
29	static int lru_maxsize;
30
31	#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */
32
33	/* this is primitive, yet effective */
34	/* the returned value must never be zero (or bad things will happen) */
35	#define lru_hash do { \
36	hash = (((U32)dbh)>>2); \
37	hash += *statement;\
38	hash += len; \
39	} while (0)
40
41	/* fetch and "use" */
42	/* could be done using a single call (we could call prepare!) */
43	static SV lru_fetch(SV dbh, SV *sql)
44	{
45	lru_node *n;
46
47	U32 hash;
48	STRLEN len;
49	char *statement = SvPV (sql, len);
50
51	dbh = SvRV (dbh);
52
53	lru_hash;
54
55	/fprintf (stderr, "F: %08lx %s\n", hash, SvPV_nolen (sql));/D*/
56
57	n = &lru_list;
58	do {
59	n = n->next;
60	if (!n->hash)
61	return 0;
62	} while (n->hash != hash
63	\|\| !sv_eq (n->sql, sql)
64	\|\| n->dbh != dbh);
65
66	/* found, so return to the start of the list */
67	n->prev->next = n->next;
68	n->next->prev = n->prev;
69
70	n->next = lru_list.next;
71	n->prev = &lru_list;
72	lru_list.next->prev = n;
73	lru_list.next = n;
74
75	return n->sth;
76	}
77
78	static void lru_nukeone(void)
79	{
80	lru_node *n;
81	/* nuke at the end */
82
83	n = lru_list.prev;
84
85	lru_list.prev = n->prev;
86	n->prev->next = &lru_list;
87
88	/fprintf (stderr, "N: %s\n", SvPV_nolen (n->sql));/D*/
89
90	SvREFCNT_dec (n->dbh);
91	SvREFCNT_dec (n->sql);
92	SvREFCNT_dec (n->sth);
93	Safefree (n);
94
95	lru_size--;
96	}
97
98	/* store a not-yet existing entry(!) */
99	static void lru_store(SV dbh, SV sql, SV *sth)
100	{
101	lru_node *n;
102
103	U32 hash;
104	STRLEN len;
105	char *statement = SvPV (sql, len);
106
107	dbh = SvRV (dbh);
108
109	lru_hash;
110
111	/fprintf (stderr, "S: %08lx %s\n", hash, SvPV_nolen (sql));/D*/
112
113	lru_size++;
114	if (lru_size > lru_maxsize)
115	lru_nukeone ();
116
117	New (0, n, 1, lru_node);
118
119	n->hash = hash;
120	n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
121	n->sql = newSVsv (sql);
122	n->sth = sth; SvREFCNT_inc (sth);
123
124	n->next = lru_list.next;
125	n->prev = &lru_list;
126	lru_list.next->prev = n;
127	lru_list.next = n;
128	}
129
130	static void lru_cachesize (int size)
131	{
132	if (size >= 0)
133	{
134	lru_maxsize = size;
135	while (lru_size > lru_maxsize)
136	lru_nukeone ();
137	}
138	}
139
140	static GV *sql_exec;
141	static GV *DBH;
142
143	MODULE = PApp::SQL PACKAGE = PApp::SQL
144
145	PROTOTYPES: DISABLE
146
147	BOOT:
148	{
149	sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
150	DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV);
151
152	/* apache might BOOT: twice :( */
153	if (lru_size)
154	lru_cachesize (0);
155
156	lru_init;
157	lru_cachesize (50);
158	}
159
160	int
161	cachesize(size = -1)
162	int size
163	CODE:
164	RETVAL = lru_maxsize;
165	lru_cachesize (size);
166	OUTPUT:
167	RETVAL
168
169	void
170	sql_exec(...)
171	ALIAS:
172	sql_fetch = 1
173	sql_fetchall = 2
174	sql_exists = 4
175	PPCODE:
176	{
177	if (items == 0)
178	croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]");
179	else
180	{
181	int arg = 0;
182	int bind_first, bind_last;
183	int count;
184	SV *dbh = ST(0);
185	SV *sth;
186	SV *sql;
187	SV *execute;
188	STRLEN dc;
189
190	/* save our arguments against destruction through function calls */
191	SP += items;
192
193	/* first check wether we should use an explicit db handle */
194	if (!is_dbh (dbh))
195	{
196	dbh = get_sv ("DBH", FALSE);
197	if (!is_dbh (dbh))
198	{
199	dbh = GvSV(DBH);
200	if (!is_dbh (dbh))
201	croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
202	}
203	}
204	else
205	arg++; /* we consumed one argument */
206
207	/* count the remaining references (for bind_columns) */
208	bind_first = arg;
209	while (items > arg && SvROK (ST(arg)))
210	arg++;
211
212	bind_last = arg;
213
214	/* consume the sql-statement itself */
215	if (items <= arg)
216	croak ("sql_exec: required argument \"sql-statement\" missing");
217
218	if (!SvPOK (ST(arg)))
219	croak ("sql_exec: sql-statement must be a string");
220
221	sql = ST(arg); arg++;
222
223	if (ix == 4)
224	{
225	SV neu = sv_2mortal (newSVpv ("select count() > 0 from ", 0));
226	sv_catsv (neu, sql);
227	sv_catpv (neu, " limit 1");
228	sql = neu;
229	ix = 1; /* sql_fetch */
230	}
231
232	/* check cache for existing statement handle (NYI) */
233	sth = lru_fetch (dbh, sql);
234	if (!sth)
235	{
236	PUSHMARK (SP);
237	EXTEND (SP, 2);
238	PUSHs (dbh);
239	PUSHs (sql);
240	PUTBACK;
241	count = call_method ("prepare", G_SCALAR);
242	SPAGAIN;
243
244	if (count != 1)
245	croak ("sql_exec: unable to prepare() statement '%s': %s",
246	SvPV (sql, dc),
247	SvPV (get_sv ("DBI::errstr", TRUE), dc));
248
249	sth = POPs;
250
251	lru_store (dbh, sql, sth);
252	}
253
254	PUSHMARK (SP);
255	EXTEND (SP, items - arg + 1);
256	PUSHs (sth);
257	while (items > arg)
258	{
259	PUSHs (ST(arg));
260	arg++;
261	}
262
263	PUTBACK;
264	/* { static GV *execute;
265	if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0);
266	count = call_sv(GvCV(execute), G_SCALAR);
267	}*/
268	count = call_method ("execute", G_SCALAR);
269	SPAGAIN;
270
271	if (count != 1)
272	croak ("sql_exec: execute() didn't return any value ('%s'): %s",
273	SvPV (sql, dc),
274	SvPV (get_sv ("DBI::errstr", TRUE), dc));
275
276	execute = POPs;
277
278	if (!SvTRUE (execute))
279	croak ("sql_exec: unable to execute statement '%s' (%s)",
280	SvPV (sql, dc),
281	SvPV (get_sv ("DBI::errstr", TRUE), dc));
282
283	sv_setsv (GvSV(sql_exec), execute);
284
285	if (bind_first != bind_last)
286	{
287	PUSHMARK (SP);
288	EXTEND (SP, bind_last - bind_first + 2);
289	PUSHs (sth);
290	do {
291	PUSHs (ST(bind_first));
292	bind_first++;
293	} while (bind_first != bind_last);
294
295	PUTBACK;
296	count = call_method ("bind_columns", G_SCALAR);
297	SPAGAIN;
298
299	if (count != 1)
300	croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
301	SvPV (sql, dc),
302	SvPV (get_sv ("DBI::errstr", TRUE), dc));
303
304	if (!SvOK (POPs))
305	croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
306	SvPV (sql, dc),
307	SvPV (get_sv ("DBI::errstr", TRUE), dc));
308	}
309
310	/* free our arguments from the stack */
311	SP -= items;
312
313	if (ix == 1)
314	{ /* sql_fetch */
315	SV *row;
316
317	PUSHMARK (SP);
318	XPUSHs (sth);
319	PUTBACK;
320	count = call_method ("fetchrow_arrayref", G_SCALAR);
321	SPAGAIN;
322
323	if (count != 1)
324	abort ();
325
326	row = POPs;
327
328	if (SvROK (row))
329	{
330	AV *av;
331
332	switch (GIMME_V)
333	{
334	case G_VOID:
335	/* no thing */
336	break;
337	case G_SCALAR:
338	/* the first element */
339	XPUSHs (av_fetch ((AV )SvRV (row), 0, 1));
340	break;
341	case G_ARRAY:
342	av = (AV *)SvRV (row);
343	count = AvFILL (av) + 1;
344	EXTEND (SP, count);
345	for (arg = 0; arg < count; arg++)
346	PUSHs (AvARRAY (av)[arg]);
347
348	break;
349	default:
350	abort ();
351	}
352	}
353	}
354	else if (ix == 2)
355	{ /* sql_fetchall */
356	SV *rows;
357
358	PUSHMARK (SP);
359	XPUSHs (sth);
360	PUTBACK;
361	count = call_method ("fetchall_arrayref", G_SCALAR);
362	SPAGAIN;
363
364	if (count != 1)
365	abort ();
366
367	rows = POPs;
368
369	if (SvROK (rows))
370	{
371	AV av = (AV )SvRV (rows);
372	count = AvFILL (av) + 1;
373
374	if (count)
375	{
376	int columns = AvFILL ((AV )SvRV (AvARRAY(av)[0])) + 1; / columns? */
377
378	EXTEND (SP, count);
379	if (columns == 1)
380	for (arg = 0; arg < count; arg++)
381	PUSHs (AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]);
382	else
383	for (arg = 0; arg < count; arg++)
384	PUSHs (AvARRAY (av)[arg]);
385	}
386	}
387	}
388	else
389	XPUSHs (sth);
390
391	if (ix \|\| GIMME_V == G_VOID)
392	{
393	PUSHMARK (SP);
394	XPUSHs (sth);
395	PUTBACK;
396	(void) call_method ("finish", G_DISCARD);
397	SPAGAIN;
398	}
399	}
400	}
401
402
403