PApp-SQL/SQL.xs

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

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

            /* 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_nolen (sql),
                         SvPV_nolen (get_sv ("DBI::errstr", TRUE)));

                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_nolen (sql),
                     SvPV_nolen (get_sv ("DBI::errstr", TRUE)));

            execute = POPs;

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

            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_nolen (sql),
                         SvPV_nolen (get_sv ("DBI::errstr", TRUE)));

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

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