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 (23 years, 5 months ago) by root
Branch:	MAIN
CVS Tags:	klinik_20010124
Changes since 1.2:	+16 -10 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5	root	1.3	#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	root	1.2	#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))
11	root	1.1
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	root	1.3	STRLEN dc;
189	root	1.1
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	root	1.3	SvPV (sql, dc),
247			SvPV (get_sv ("DBI::errstr", TRUE), dc));
248	root	1.1
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	root	1.3	SvPV (sql, dc),
274			SvPV (get_sv ("DBI::errstr", TRUE), dc));
275	root	1.1
276			execute = POPs;
277
278			if (!SvTRUE (execute))
279			croak ("sql_exec: unable to execute statement '%s' (%s)",
280	root	1.3	SvPV (sql, dc),
281			SvPV (get_sv ("DBI::errstr", TRUE), dc));
282	root	1.1
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	root	1.3	SvPV (sql, dc),
302			SvPV (get_sv ("DBI::errstr", TRUE), dc));
303	root	1.1
304			if (!SvOK (POPs))
305			croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
306	root	1.3	SvPV (sql, dc),
307			SvPV (get_sv ("DBI::errstr", TRUE), dc));
308	root	1.1	}
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