ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.xs
(Generate patch)

Comparing PApp-SQL/SQL.xs (file contents):
Revision 1.21 by root, Sun Jun 21 00:28:18 2009 UTC vs.
Revision 1.22 by root, Sun Jun 21 03:30:00 2009 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.h" 3#include "XSUB.h"
4
5/* import some stuff from DBIXS.h and DBI.xs */
6#define DBIXS_VERSION 93
7#define DBI_MAGIC '~'
8
9#define DBISTATE_PERLNAME "DBI::_dbistate"
10#define DBISTATE_ADDRSV (perl_get_sv(DBISTATE_PERLNAME, 0x05))
11#define DBIS_PUBLISHED_LVALUE (*(INT2PTR(dbistate_t**, &SvIVX(DBISTATE_ADDRSV))))
12
13struct dbistate_st {
14#define DBISTATE_VERSION 94 /* Must change whenever dbistate_t does */
15 /* this must be the first member in structure */
16 void (*check_version) _((const char *name,
17 int dbis_cv, int dbis_cs, int need_dbixs_cv,
18 int drc_s, int dbc_s, int stc_s, int fdc_s));
19
20 /* version and size are used to check for DBI/DBD version mis-match */
21 U16 version; /* version of this structure */
22 U16 size;
23 U16 xs_version; /* version of the overall DBIXS / DBD interface */
24 U16 spare_pad;
25};
26typedef struct dbistate_st dbistate_t;
27
28#define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before clear */
29
30typedef U32 imp_sth;
31
32/* not strictly part of the API... */
33static imp_sth *
34sth_get_imp (SV *sth)
35{
36 MAGIC *mg = mg_find (SvRV (sth), PERL_MAGIC_tied);
37 sth = mg->mg_obj;
38 mg = mg_find (SvRV (sth), DBI_MAGIC);
39 return (imp_sth *)SvPVX (mg->mg_obj);
40}
41
42#define DBI_STH_ACTIVE(imp) (*(imp) & DBIcf_ACTIVE)
43
44/* end of import section */
4 45
5#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) 46#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6))
6# define get_sv perl_get_sv 47# define get_sv perl_get_sv
7# define call_method perl_call_method 48# define call_method perl_call_method
8# define call_sv perl_call_sv 49# define call_sv perl_call_sv
… …
10 51
11#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) 52#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6))
12# define CAN_UTF8 1 53# define CAN_UTF8 1
13#endif 54#endif
14 55
15#define MAX_CACHED_STATEMENT_SIZE 8192 56#define MAX_CACHED_STATEMENT_SIZE 2048
16 57
17static SV * 58static SV *
18sql_upgrade_utf8 (SV *sv) 59sql_upgrade_utf8 (SV *sv)
19{ 60{
20#if CAN_UTF8 61#if CAN_UTF8
… …
40#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) 81#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))
41 82
42typedef struct lru_node { 83typedef struct lru_node {
43 struct lru_node *next; 84 struct lru_node *next;
44 struct lru_node *prev; 85 struct lru_node *prev;
45 U32 hash; 86 U32 hash; /* bit 31 is used to mark active nodes */
46 SV *dbh; 87 SV *dbh;
47 SV *sql; 88 SV *sql;
48 89
49 SV *sth; 90 SV *sth;
91 imp_sth *sth_imp;
50#if 0 /* method cache */ 92#if 0 /* method cache */
51 GV *execute; 93 GV *execute;
52 GV *bind_columns; 94 GV *bind_columns;
53 GV *fetch; 95 GV *fetch;
54 GV *finish; 96 GV *finish;
… …
57 99
58static lru_node lru_list; 100static lru_node lru_list;
59static int lru_size; 101static int lru_size;
60static int lru_maxsize; 102static int lru_maxsize;
61 103
62#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ 104#define lru_init() lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */
63 105
64/* this is primitive, yet effective */ 106/* this is primitive, yet effective */
65/* the returned value must never be zero (or bad things will happen) */ 107/* the returned value must never be zero (or bad things will happen) */
66#define lru_hash do { \ 108#define lru_hash \
109 do { \
67 hash = (((U32)(long)dbh)>>2); \ 110 hash = (((U32)(long)dbh)>>4); \
68 hash += *statement;\ 111 hash += *statement; \
69 hash += len; \ 112 hash += len; \
70} while (0) 113 } while (0)
71 114
72/* fetch and "use" */ 115/* fetch and "use" */
73/* could be done using a single call (we could call prepare!) */ 116/* could be done using a single call (we could call prepare!) */
117static SV *
74static SV *lru_fetch(SV *dbh, SV *sql) 118lru_fetch (SV *dbh, SV *sql)
75{ 119{
76 lru_node *n; 120 lru_node *n;
77 121
78 U32 hash; 122 U32 hash;
79 STRLEN len; 123 STRLEN len;
… …
84 lru_hash; 128 lru_hash;
85 129
86 n = &lru_list; 130 n = &lru_list;
87 do { 131 do {
88 n = n->next; 132 n = n->next;
133
89 if (!n->hash) 134 if (!n->hash)
90 return 0; 135 return 0;
91 } while (n->hash != hash 136 } while (n->hash != hash
137 || DBI_STH_ACTIVE (n->sth_imp)
92 || !sv_eq (n->sql, sql) 138 || !sv_eq (n->sql, sql)
93 || n->dbh != dbh); 139 || n->dbh != dbh);
94 140
95 /* found, so return to the start of the list */ 141 /* found, so return to the start of the list */
96 n->prev->next = n->next; 142 n->prev->next = n->next;
… …
99 n->next = lru_list.next; 145 n->next = lru_list.next;
100 n->prev = &lru_list; 146 n->prev = &lru_list;
101 lru_list.next->prev = n; 147 lru_list.next->prev = n;
102 lru_list.next = n; 148 lru_list.next = n;
103 149
104 return n->sth; 150 return sv_2mortal (SvREFCNT_inc (n->sth));
105} 151}
106 152
107static void lru_nukeone(void) 153static void
154lru_trim (void)
155{
156 while (lru_size > lru_maxsize)
157 {
158 /* nuke at the end */
159 lru_node *n = lru_list.prev;
160
161 n = lru_list.prev;
162
163 lru_list.prev = n->prev;
164 n->prev->next = &lru_list;
165
166 SvREFCNT_dec (n->dbh);
167 SvREFCNT_dec (n->sql);
168 SvREFCNT_dec (n->sth);
169 Safefree (n);
170
171 lru_size--;
172 }
173}
174
175/* store a not-yet existing entry(!) */
176static void
177lru_store (SV *dbh, SV *sql, SV *sth)
108{ 178{
109 lru_node *n; 179 lru_node *n;
110 /* nuke at the end */
111
112 n = lru_list.prev;
113
114 lru_list.prev = n->prev;
115 n->prev->next = &lru_list;
116
117 SvREFCNT_dec (n->dbh);
118 SvREFCNT_dec (n->sql);
119 SvREFCNT_dec (n->sth);
120 Safefree (n);
121
122 lru_size--;
123}
124
125/* store a not-yet existing entry(!) */
126static void lru_store(SV *dbh, SV *sql, SV *sth)
127{
128 lru_node *n;
129
130 U32 hash; 180 U32 hash;
131 STRLEN len; 181 STRLEN len;
182 char *statement;
183
184 if (!lru_maxsize)
185 return;
186
132 char *statement = SvPV (sql, len); 187 statement = SvPV (sql, len);
133
134 dbh = SvRV (dbh); 188 dbh = SvRV (dbh);
135 189
136 lru_hash; 190 lru_hash;
137 191
138 lru_size++; 192 lru_size++;
139 if (lru_size > lru_maxsize) 193 lru_trim ();
140 lru_nukeone ();
141 194
142 New (0, n, 1, lru_node); 195 New (0, n, 1, lru_node);
143 196
144 n->hash = hash; 197 n->hash = hash;
145 n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */ 198 n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
146 n->sql = newSVsv (sql); 199 n->sql = newSVsv (sql);
147 n->sth = sth; SvREFCNT_inc (sth); 200 n->sth = sth; SvREFCNT_inc (sth);
201 n->sth_imp = sth_get_imp (sth);
148 202
149 n->next = lru_list.next; 203 n->next = lru_list.next;
150 n->prev = &lru_list; 204 n->prev = &lru_list;
151 lru_list.next->prev = n; 205 lru_list.next->prev = n;
152 lru_list.next = n; 206 lru_list.next = n;
153} 207}
154 208
209static void
155static void lru_cachesize (int size) 210lru_cachesize (int size)
156{ 211{
157 if (size >= 0) 212 if (size >= 0)
158 { 213 {
159 lru_maxsize = size; 214 lru_maxsize = size;
160 while (lru_size > lru_maxsize) 215 lru_trim ();
161 lru_nukeone ();
162 } 216 }
163} 217}
164 218
165static GV *sql_exec; 219static GV *sql_exec;
166static GV *DBH; 220static GV *DBH;
… …
174 228
175PROTOTYPES: DISABLE 229PROTOTYPES: DISABLE
176 230
177BOOT: 231BOOT:
178{ 232{
233 struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE;
234
235 /* this is atcually wrong, we should call the check member, apparently */
236 assert (dbis->version == DBISTATE_VERSION);
237 assert (dbis->xs_version == DBIXS_VERSION);
238
179 sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); 239 sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
180 DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); 240 DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV);
181 241
182 if (!sv_prepare) 242 if (!sv_prepare)
183 { 243 {
… …
191 251
192 /* apache might BOOT: twice :( */ 252 /* apache might BOOT: twice :( */
193 if (lru_size) 253 if (lru_size)
194 lru_cachesize (0); 254 lru_cachesize (0);
195 255
196 lru_init; 256 lru_init ();
197 lru_cachesize (50); 257 lru_cachesize (50);
198} 258}
199 259
200int 260int
201cachesize(size = -1) 261cachesize(size = -1)

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines