Update module to reflect new case API
[pspp-builds.git] / perl-module / PSPP.xs
1 /* PSPP - computes sample statistics.
2    Copyright (C) 2007, 2008 Free Software Foundation, Inc.
3
4    This program is free software; you can redistribute it and/or
5    modify it under the terms of the GNU General Public License as
6    published by the Free Software Foundation; either version 2 of the
7    License, or (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful, but
10    WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17    02110-1301, USA. */
18
19
20 #include "EXTERN.h"
21 #include "perl.h"
22 #include "XSUB.h"
23
24 #include <config.h>
25
26 #include "ppport.h"
27
28 #include "minmax.h"
29 #include <libpspp/message.h>
30 #include <libpspp/version.h>
31 #include <gl/xalloc.h>
32 #include <data/dictionary.h>
33 #include <data/case.h>
34 #include <data/variable.h>
35 #include <data/file-handle-def.h>
36 #include <data/sys-file-writer.h>
37 #include <data/sys-file-reader.h>
38 #include <data/value.h>
39 #include <data/value-labels.h>
40 #include <data/format.h>
41 #include <data/data-in.h>
42 #include <string.h>
43
44 typedef struct fmt_spec input_format ;
45 typedef struct fmt_spec output_format ;
46
47
48 /*  A thin wrapper around sfm_writer */
49 struct sysfile_info
50 {
51   bool opened;
52
53   /* A pointer to the writer. The writer is owned by the struct */
54   struct casewriter *writer;
55
56   /* A pointer to the dictionary. Owned externally */
57   const struct dictionary *dict;
58
59   /* The scalar containing the dictionary */
60   SV *dict_sv;
61 };
62
63
64 /*  A thin wrapper around sfm_reader */
65 struct sysreader_info
66 {
67   struct sfm_read_info opts;
68
69   /* A pointer to the reader. The reader is owned by the struct */
70   struct casereader *reader;
71
72   /* A pointer to the dictionary. */
73   struct dictionary *dict;
74 };
75
76
77
78 /*  A message handler which writes messages to PSPP::errstr */
79 static void
80 message_handler (const struct msg *m)
81 {
82  SV *errstr = get_sv("PSPP::errstr", TRUE);
83  sv_setpv (errstr, m->text);
84 }
85
86 static int
87 sysfile_close (struct sysfile_info *sfi)
88 {
89   int retval ;
90   if ( ! sfi->opened )
91     return 0;
92
93   retval = casewriter_destroy (sfi->writer);
94   if (retval > 0 )
95     sfi->opened = false;
96
97   return retval;
98 }
99
100 static void
101 scalar_to_value (union value *val, SV *scalar, const struct variable *var)
102 {
103   if ( var_is_numeric (var))
104     {
105         if ( SvNOK (scalar) || SvIOK (scalar) )
106            val->f = SvNV (scalar);
107         else
108            val->f = SYSMIS;
109     }
110   else
111     {
112         STRLEN len;
113         const char *p = SvPV (scalar, len);
114         memset (val->s, ' ', var_get_width (var));
115         memcpy (val->s, p, len);
116     }
117 }
118
119
120 static SV *
121 value_to_scalar (const union value *val, const struct variable *var)
122 {
123   if ( var_is_numeric (var))
124     {
125       if ( var_is_value_missing (var, val, MV_SYSTEM))
126         return newSVpvn ("", 0);
127
128       return newSVnv (val->f);
129     }
130   else
131     return newSVpvn (val->s, var_get_width (var));
132 }
133
134
135 static void
136 var_set_input_format (struct variable *v, input_format ip_fmt)
137 {
138   struct fmt_spec *if_copy = malloc (sizeof (*if_copy));
139   memcpy (if_copy, &ip_fmt, sizeof (ip_fmt));
140   var_attach_aux (v, if_copy, var_dtor_free);
141 }
142
143 static union value *
144 make_value_from_scalar (SV *val, const struct variable *var)
145 {
146  union value *uv = value_create (var_get_width (var));
147  scalar_to_value (uv, val, var);
148  return uv;
149 }
150
151
152 MODULE = PSPP
153
154 MODULE = PSPP           PACKAGE = PSPP
155
156 void
157 onBoot (ver)
158  const char *ver
159 CODE:
160  assert (0 == strcmp (ver, bare_version));
161  msg_init (NULL, message_handler);
162  settings_init (0, 0);
163  fh_init ();
164
165 SV *
166 format_value (val, var)
167  SV *val
168  struct variable *var
169 CODE:
170  SV *ret;
171  const struct fmt_spec *fmt = var_get_print_format (var);
172  union value *uv = make_value_from_scalar (val, var);
173  char *s;
174  s = malloc (fmt->w);
175  memset (s, '\0', fmt->w);
176  data_out (uv, fmt, s);
177  free (uv);
178  ret = newSVpv (s, fmt->w);
179  free (s);
180  RETVAL = ret;
181  OUTPUT:
182 RETVAL
183  
184
185 int
186 value_is_missing (val, var)
187  SV *val
188  struct variable *var
189 CODE:
190  union value *uv = make_value_from_scalar (val, var);
191  int ret = var_is_value_missing (var, uv, MV_ANY);
192  free (uv);
193  RETVAL = ret;
194  OUTPUT:
195 RETVAL
196
197
198
199 MODULE = PSPP           PACKAGE = PSPP::Dict
200
201 struct dictionary *
202 pxs_dict_new()
203 CODE:
204  RETVAL = dict_create ();
205 OUTPUT:
206  RETVAL
207
208
209 void
210 DESTROY (dict)
211  struct dictionary *dict
212 CODE:
213  dict_destroy (dict);
214
215
216 int
217 get_var_cnt (dict)
218  struct dictionary *dict
219 CODE:
220  RETVAL = dict_get_var_cnt (dict);
221 OUTPUT:
222 RETVAL
223
224 void
225 set_label (dict, label)
226  struct dictionary *dict
227  char *label
228 CODE:
229  dict_set_label (dict, label);
230
231 void
232 set_documents (dict, docs)
233  struct dictionary *dict
234  char *docs
235 CODE:
236  dict_set_documents (dict, docs);
237
238
239 void
240 add_document (dict, doc)
241  struct dictionary *dict
242  char *doc
243 CODE:
244  dict_add_document_line (dict, doc);
245
246
247 void
248 clear_documents (dict)
249  struct dictionary *dict
250 CODE:
251  dict_clear_documents (dict);
252
253
254 void
255 set_weight (dict, var)
256  struct dictionary *dict
257  struct variable *var
258 CODE:
259  dict_set_weight (dict, var);
260
261
262 struct variable *
263 pxs_get_variable (dict, idx)
264  struct dictionary *dict
265  SV *idx
266 INIT:
267  SV *errstr = get_sv("PSPP::errstr", TRUE);
268  sv_setpv (errstr, "");
269  if ( SvIV (idx) >= dict_get_var_cnt (dict))
270   {
271     sv_setpv (errstr, "The dictionary doesn't have that many variables.");
272     XSRETURN_UNDEF;
273   }
274 CODE:
275  RETVAL = dict_get_var (dict, SvIV (idx));
276  OUTPUT:
277 RETVAL
278
279
280 struct variable *
281 pxs_get_var_by_name (dict, name)
282  struct dictionary *dict
283  const char *name
284 INIT:
285  SV *errstr = get_sv("PSPP::errstr", TRUE);
286  sv_setpv (errstr, "");
287 CODE:
288  struct variable *var = dict_lookup_var (dict, name);
289  if ( ! var )
290       sv_setpv (errstr, "No such variable.");
291  RETVAL = var;
292  OUTPUT:
293 RETVAL
294
295
296 MODULE = PSPP           PACKAGE = PSPP::Var
297
298
299 struct variable *
300 pxs_dict_create_var (dict, name, ip_fmt)
301  struct dictionary * dict
302  char *name
303  input_format ip_fmt
304 INIT:
305  SV *errstr = get_sv("PSPP::errstr", TRUE);
306  sv_setpv (errstr, "");
307  if ( ! var_is_plausible_name (name, false))
308   {
309     sv_setpv (errstr, "The variable name is not valid.");
310     XSRETURN_UNDEF;
311   }
312 CODE:
313  struct fmt_spec op_fmt;
314
315  struct variable *v;
316  op_fmt = fmt_for_output_from_input (&ip_fmt);
317  v = dict_create_var (dict, name,
318         fmt_is_string (op_fmt.type) ? op_fmt.w : 0);
319  if ( NULL == v )
320   {
321     sv_setpv (errstr, "The variable could not be created (probably already exists).");
322     XSRETURN_UNDEF;
323   }
324  var_set_both_formats (v, &op_fmt);
325  var_set_input_format (v, ip_fmt);
326  RETVAL = v;
327 OUTPUT:
328  RETVAL
329
330
331 int
332 set_missing_values (var, v1, ...)
333  struct variable *var;
334  SV *v1;
335 INIT:
336  int i;
337  union value val[3];
338
339  if ( items > 4 )
340   croak ("No more than 3 missing values are permitted");
341
342  for (i = 0; i < items - 1; ++i)
343    scalar_to_value (&val[i], ST(i+1), var);
344 CODE:
345  struct missing_values mv;
346  mv_init (&mv, var_get_width (var));
347  for (i = 0 ; i < items - 1; ++i )
348    mv_add_value (&mv, &val[i]);
349  var_set_missing_values (var, &mv);
350
351
352 void
353 set_label (var, label)
354  struct variable *var;
355  char *label
356 CODE:
357   var_set_label (var, label);
358
359
360 void
361 clear_value_labels (var)
362  struct variable *var;
363 CODE:
364  var_clear_value_labels (var);
365
366 void
367 pxs_set_write_format (var, fmt)
368  struct variable *var
369  output_format fmt
370 CODE:
371  var_set_write_format (var, &fmt);
372
373
374 void
375 pxs_set_print_format (var, fmt)
376  struct variable *var
377  output_format fmt
378 CODE:
379  var_set_print_format (var, &fmt);
380
381 void
382 pxs_set_output_format (var, fmt)
383  struct variable *var
384  output_format fmt
385 CODE:
386  var_set_both_formats (var, &fmt);
387
388
389 int
390 add_value_label (var, key, label)
391  struct variable *var
392  SV *key
393  char *label
394 INIT:
395  SV *errstr = get_sv("PSPP::errstr", TRUE);
396  sv_setpv (errstr, "");
397 CODE:
398  union value the_value;
399
400  if ( var_is_numeric (var))
401  {
402   if ( ! looks_like_number (key))
403     {
404       sv_setpv (errstr, "Cannot add label with string key to a numeric variable");
405       XSRETURN_IV (0);
406     }
407   the_value.f = SvNV (key);
408  }
409  else
410  {
411    if ( var_is_long_string (var) )
412      {
413       sv_setpv (errstr, "Cannot add label to a long string variable");
414       XSRETURN_IV (0);
415      }
416   strncpy (the_value.s, SvPV_nolen(key), MAX_SHORT_STRING);
417  }
418  if (! var_add_value_label (var, &the_value, label) )
419  {
420    sv_setpv (errstr, "Something went wrong");
421    XSRETURN_IV (0);
422  }
423  XSRETURN_IV (1);
424
425
426
427 const char *
428 get_name (var)
429  struct variable * var
430 CODE:
431  RETVAL = var_get_name (var);
432  OUTPUT:
433 RETVAL
434
435
436 const char *
437 get_label (var)
438  struct variable * var
439 CODE:
440  RETVAL = var_get_label (var);
441  OUTPUT:
442 RETVAL
443
444
445 SV *
446 get_value_labels (var)
447  struct variable *var
448 CODE:
449  HV *labelhash = (HV *) sv_2mortal ((SV *) newHV());
450  struct val_lab *vl;
451  struct val_labs_iterator *viter = NULL;
452  const struct val_labs *labels = var_get_value_labels (var);
453
454  if ( labels )
455    {
456      for (vl = val_labs_first (labels, &viter);
457           vl;
458           vl = val_labs_next (labels, &viter))
459        {
460          SV *sv = value_to_scalar (&vl->value, var);
461          STRLEN len;
462          const char *s = SvPV (sv, len);
463          hv_store (labelhash, s, len, newSVpv (vl->label, 0), 0);
464        }
465    }
466
467  RETVAL = newRV ((SV *) labelhash);
468  OUTPUT:
469 RETVAL
470
471
472
473 MODULE = PSPP           PACKAGE = PSPP::Sysfile
474
475
476 struct sysfile_info *
477 pxs_create_sysfile (name, dict_ref, opts_hr)
478  char *name
479  SV *dict_ref
480  SV *opts_hr
481 INIT:
482  SV *dict_sv = SvRV (dict_ref);
483  struct dictionary *dict = (void *) SvIV (dict_sv);
484  struct sfm_write_options opts;
485  if (!SvROK (opts_hr))
486   {
487     opts = sfm_writer_default_options ();
488   }
489  else
490   {
491     HV *opt_h = (HV *) SvRV (opts_hr);
492     SV** readonly = hv_fetch(opt_h, "readonly", 8, 0);
493     SV** compress = hv_fetch(opt_h, "compress", 8, 0);
494     SV** version = hv_fetch(opt_h, "version", 7, 0);
495
496     opts.create_writeable = readonly ? ! SvIV (*readonly) : true;
497     opts.compress = compress ? SvIV (*compress) : false;
498     opts.version = version ? SvIV (*version) : 3 ;
499   }
500 CODE:
501  struct file_handle *fh =
502   fh_create_file (NULL, name, fh_default_properties () );
503  struct sysfile_info *sfi = xmalloc (sizeof (*sfi));
504  sfi->writer = sfm_open_writer (fh, dict, opts);
505  sfi->dict = dict;
506  sfi->opened = true;
507  sfi->dict_sv = dict_sv;
508  SvREFCNT_inc (sfi->dict_sv);
509  
510  RETVAL = sfi;
511  OUTPUT:
512 RETVAL
513
514 int
515 close (sfi)
516  struct sysfile_info *sfi
517 CODE:
518  RETVAL = sysfile_close (sfi);
519 OUTPUT:
520  RETVAL
521
522 void
523 DESTROY (sfi)
524  struct sysfile_info *sfi
525 CODE:
526  sysfile_close (sfi);
527  SvREFCNT_dec (sfi->dict_sv);
528  free (sfi);
529
530 int
531 append_case (sfi, ccase)
532  struct sysfile_info *sfi
533  SV *ccase
534 INIT:
535  SV *errstr = get_sv("PSPP::errstr", TRUE);
536  sv_setpv (errstr, "");
537  if ( (!SvROK(ccase)))
538   {
539     XSRETURN_UNDEF;
540   }
541 CODE:
542  int i = 0;
543  AV *av_case = (AV*) SvRV (ccase);
544
545  const struct variable **vv;
546  size_t nv;
547  struct ccase *c;
548  SV *sv;
549
550  if ( av_len (av_case) >= dict_get_var_cnt (sfi->dict))
551    XSRETURN_UNDEF;
552
553  c =  case_create (dict_get_next_value_idx (sfi->dict));
554
555  dict_get_vars (sfi->dict, &vv, &nv, 1u << DC_ORDINARY | 1u << DC_SYSTEM);
556
557  for (sv = av_shift (av_case); SvOK (sv);  sv = av_shift (av_case))
558  {
559     const struct variable *v = vv[i++];
560     const struct fmt_spec *ifmt = var_get_aux (v);
561
562     /* If an input format has been set, then use it.
563        Otherwise just convert the raw value.
564     */
565     if ( ifmt )
566       {
567         struct substring ss = ss_cstr (SvPV_nolen (sv));
568         if ( ! data_in (ss, LEGACY_NATIVE, ifmt->type, 0, 0, 0,
569                         case_data_rw (c, v),
570                         var_get_width (v)) )
571           {
572             RETVAL = 0;
573             goto finish;
574           }
575       }
576     else
577       {
578         scalar_to_value (case_data_rw (c, v), sv, v);
579       }
580  }
581
582  /* The remaining variables must be sysmis or blank string */
583  while (i < dict_get_var_cnt (sfi->dict))
584  {
585    const struct variable *v = vv[i++];
586    union value *val = case_data_rw (c, v);
587    if ( var_is_numeric (v))
588         val->f = SYSMIS;
589    else
590         memset (val->s, ' ', var_get_width (v));
591  }
592  RETVAL = casewriter_write (sfi->writer, c);
593  finish:
594  free (vv);
595 OUTPUT:
596  RETVAL
597
598
599 \f
600
601 MODULE = PSPP           PACKAGE = PSPP::Reader
602
603 struct sysreader_info *
604 pxs_open_sysfile (name)
605  char * name
606 CODE:
607  struct casereader *reader;
608  struct sysreader_info *sri = NULL;
609  struct file_handle *fh =
610          fh_create_file (NULL, name, fh_default_properties () );
611
612  sri = xmalloc (sizeof (*sri));
613  sri->reader = sfm_open_reader (fh, &sri->dict, &sri->opts);
614
615  if ( NULL == sri->reader)
616  {
617    free (sri);
618    sri = NULL;
619  }
620
621  RETVAL = sri;
622  OUTPUT:
623 RETVAL
624
625
626 struct dictionary *
627 pxs_get_dict (reader)
628  struct sysreader_info *reader;
629 CODE:
630  RETVAL = reader->dict;
631  OUTPUT:
632 RETVAL
633
634
635 SV *
636 get_next_case (sfr)
637  struct sysreader_info *sfr;
638 CODE:
639  struct ccase *c;
640
641  if (! (c = casereader_read (sfr->reader)))
642  {
643   RETVAL = 0;
644  }
645  else
646  {
647   int v;
648   AV *av_case = (AV *) sv_2mortal ((SV *) newAV());
649
650   for (v = 0; v < dict_get_var_cnt (sfr->dict); ++v )
651     {
652       const struct variable *var = dict_get_var (sfr->dict, v);
653       const union value *val = case_data (c, var);
654
655       av_push (av_case, value_to_scalar (val, var));
656     }
657
658   case_unref (c);
659   RETVAL = newRV ((SV *) av_case);
660  }
661 OUTPUT:
662  RETVAL
663