/[webpac]/openisis/current/perl/OpenIsis.xs
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/current/perl/OpenIsis.xs

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years ago) by dpavlin
File size: 5210 byte(s)
initial import of openisis 0.9.0 vendor drop

1 /*
2 openisis - an open implementation of the CDS/ISIS database
3 Version 0.8.x (patchlevel see file Version)
4 Copyright (C) 2001-2003 by Erik Grziwotz, erik@openisis.org
5
6 This library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU Lesser General Public
8 License as published by the Free Software Foundation; either
9 version 2.1 of the License, or (at your option) any later version.
10
11 This library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 Lesser General Public License for more details.
15
16 You should have received a copy of the GNU Lesser General Public
17 License along with this library; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19
20 see README for more information
21 EOH */
22
23 /*
24 $Id: OpenIsis.xs,v 1.5 2003/04/08 00:20:53 kripke Exp $
25 the openisis XSUB
26 */
27
28
29 #include "EXTERN.h"
30 #include "perl.h"
31 #include "XSUB.h"
32
33 #ifdef assert
34 #undef assert /* perl.h assert doesn't really assert */
35 #endif
36 #include <assert.h>
37
38 /*
39 XSUB.h:
40 #if (defined(PERL_CAPI) || defined(PERL_IMPLICIT_SYS)) && !defined(PERL_CORE)
41 # define malloc PerlMem_malloc
42 # define free PerlMem_free
43 but we need to free memory that was acquired by real malloc
44
45 I don't now wether these should be defined or not,
46 they are on some Serhij's windows box
47 and aren't on my linux !??
48
49 However, we will have to move to OpenIsisMFree, anyway ...
50 */
51 #ifdef free
52 #define PERLFREE PerlMem_free
53 #undef free
54 #else
55 #define PERLFREE free
56 #endif
57
58
59 #define OPENISIS_NOPRE09
60 #include "openisis.h"
61
62
63 /* turn negative error codes in nice little numbers */
64 static int sherr ( int x ) {
65 return -(1<<OPENISIS_ERR_SHIFT) <= x ? x : -(-x >> OPENISIS_ERR_SHIFT);
66 }
67
68 MODULE = OpenIsis PACKAGE = OpenIsis
69 PROTOTYPES: ENABLE
70 VERSIONCHECK: ENABLE
71
72 void
73 log( level, file )
74 int level
75 char* file
76 CODE:
77 openIsisCLog( level, *file ? file : 0 );
78
79 int
80 open( name, ... )
81 char* name
82 CODE:
83 {
84 const char **argv = 0;
85 int argc = 0;
86 if ( 1 < items ) {
87 STRLEN n_a;
88 int i;
89 argv = (const char **)malloc( (items-1) * sizeof(argv[0]) );
90 for ( i=1; i<items; i++ )
91 /* TODO: should take care to make 0-term copies */
92 argv[i-1] = (char *)SvPV(ST(i), n_a);
93 argc = items-1;
94 }
95 RETVAL = sherr( openIsisCDOpenv( name, argv, argc ) );
96 if ( argv )
97 PERLFREE( argv );
98 }
99 OUTPUT:
100 RETVAL
101
102 int
103 maxRowid( db )
104 int db
105 CODE:
106 RETVAL = sherr( openIsisDMaxId( db ) );
107 OUTPUT:
108 RETVAL
109
110 SV*
111 2html( str )
112 char* str
113 CODE:
114 {
115 str = openIsisToHtml( str, -1 );
116 RETVAL = newSVpv( str, 0 );
117 }
118 OUTPUT:
119 RETVAL
120
121 SV*
122 read( db, rowid, ... )
123 int db
124 int rowid
125 CODE:
126 {
127 HV *hv = newHV();
128 OpenIsisRec *r = openIsisDRead( db, rowid );
129 if ( r ) {
130 union { OpenIsisRec r; char buf[10000]; } x;
131 int i;
132 hv_store( hv, "mfn", 3, newSViv( r->rowid ), 0 );
133 if ( items > 2 ) {
134 #ifdef SvPV_nolen
135 /* 5.6.x has this. see man perlguts for why it's useful. */
136 char *fmt = (char *)SvPV_nolen( ST(2) );
137 #else
138 STRLEN unused;
139 char *fmt = (char *)SvPV( ST(2), unused );
140 #endif
141 OpenIsisRec *q;
142 OPENISIS_INITBUF(x);
143 q = openIsisRFmt( &x.r, fmt, r );
144 free( r );
145 r = q;
146 }
147 for ( i=0; i < r->len; i++ ) {
148 char buf[7];
149 AV *ar;
150 SV *ref, **entry;
151 SV *val;
152 val = newSVpv( (char*)r->field[i].val, r->field[i].len );
153 snprintf( buf, sizeof(buf), "%hu", r->field[i].tag );
154 buf[sizeof(buf)-1] = 0;
155 entry = hv_fetch( hv, buf, strlen(buf), 1 );
156 assert ( entry ); /* out of memory */
157 if ( ! *entry || ! SvROK(*entry) ) {
158 ar = newAV();
159 *entry = newRV_noinc((SV*)ar);
160 } else {
161 ar = (AV*)SvRV(*entry);
162 assert( SVt_PVAV == SvTYPE(ar) );
163 }
164 av_push( ar, val );
165 }
166 if ( r != &x.r )
167 free( r );
168 }
169 RETVAL = newRV_noinc( (SV*)hv );
170 }
171 OUTPUT:
172 RETVAL
173
174 SV*
175 subfields( field )
176 char *field
177 CODE:
178 {
179 OpenIsisField f;
180 OpenIsisRec *r;
181 HV *hv = newHV();
182
183 f.tag = 0;
184 f.val = field;
185 f.len = strlen(field);
186 r = openIsisRSplitf( 0, &f );
187 if ( r ) {
188 int i;
189 char buf[2];
190 buf[sizeof(buf)-1] = 0;
191 for ( i=0; i < r->len; i++ ) {
192 buf[0] = (char)r->field[i].tag;
193 hv_store( hv, buf, buf[0] ? 1 : 0,
194 newSVpv( (char*)r->field[i].val, r->field[i].len ), 0 );
195 }
196 free( r );
197 }
198 RETVAL = newRV_noinc( (SV*)hv );
199 }
200 OUTPUT:
201 RETVAL
202
203 void
204 query( db, key, ... )
205 int db
206 char *key
207 PPCODE:
208 {
209 int mode = OPENISIS_QRY_SIMPLE;
210 int skip = 0;
211 int got;
212 OpenIsisSet set;
213 set.len = 0;
214 got = (int)openIsisDQuery( &set, db, key, mode, skip );
215 if ( 0 < got ) {
216 int i;
217 EXTEND(SP,got);
218 for ( i=0; i<got; i++ )
219 PUSHs(sv_2mortal(newSViv(set.id[i])));
220 }
221 }
222
223 void
224 terms( db, key )
225 int db
226 char *key
227 PPCODE:
228 {
229 int got = 0, i;
230 union { OpenIsisRec r; char buf[10000]; } x;
231 x.r.len = 0;
232 x.r.bytes = sizeof(x);
233 while ( openIsisDTerm( &x.r, db, key ) && x.r.len ) {
234 got += (int)x.r.len;
235 EXTEND(SP,got);
236 /* printf( "%ld terms\n", x.r.len ); */
237 for ( i=0; i<x.r.len; i++ )
238 PUSHs(sv_2mortal(newSVpv( (char*)x.r.field[i].val, x.r.field[i].len )));
239
240 }
241 }

  ViewVC Help
Powered by ViewVC 1.1.26