perl-module/PSPP.xs

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 2007 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/value.h>
  38 #include <data/format.h>
  39 #include <data/data-in.h>
  40 #include <string.h>
  41
  42 typedef struct fmt_spec input_format ;
  43 typedef struct fmt_spec output_format ;
  44
  45
  46 /*  A thin wrapper around sfm_writer */
  47 struct sysfile_info
  48 {
  49   bool opened;
  50
  51   /* A pointer to the writer. The writer is owned by the struct */
  52   struct casewriter *writer;
  53
  54   /* A pointer to the dictionary. Owned externally */
  55   const struct dictionary *dict;
  56 };
  57
  58
  59 /*  A message handler which writes messages to PSPP::errstr */
  60 static void
  61 message_handler (const struct msg *m)
  62 {
  63  SV *errstr = get_sv("PSPP::errstr", TRUE);
  64  sv_setpv (errstr, m->text);
  65 }
  66
  67 static int
  68 sysfile_close (struct sysfile_info *sfi)
  69 {
  70   int retval ;
  71   if ( ! sfi->opened )
  72     return 0;
  73
  74   retval = casewriter_destroy (sfi->writer);
  75   if (retval > 0 )
  76     sfi->opened = false;
  77
  78   return retval;
  79 }
  80
  81 static void
  82 scalar_to_value (union value *val, SV *scalar)
  83 {
  84   if ( looks_like_number (scalar))
  85     {
  86         val->f = SvNV (scalar);
  87     }
  88   else
  89     {
  90         STRLEN len;
  91         char *p = SvPV (scalar, len);
  92         memset (val->s, ' ', MAX_SHORT_STRING);
  93         memcpy (val->s, p, len);
  94     }
  95 }
  96
  97
  98 MODULE = PSPP
  99
 100 BOOT:
 101  msg_init (NULL, message_handler);
 102  settings_init (0, 0);
 103  fh_init ();
 104
 105
 106 MODULE = PSPP           PACKAGE = PSPP::Dict
 107
 108 struct dictionary *
 109 _dict_new()
 110 CODE:
 111  RETVAL = dict_create ();
 112 OUTPUT:
 113  RETVAL
 114
 115
 116 void
 117 DESTROY (dict)
 118  struct dictionary *dict
 119 CODE:
 120  dict_destroy (dict);
 121
 122
 123 void
 124 set_label (dict, label)
 125  struct dictionary *dict
 126  char *label
 127 CODE:
 128  dict_set_label (dict, label);
 129
 130 void
 131 set_documents (dict, docs)
 132  struct dictionary *dict
 133  char *docs
 134 CODE:
 135  dict_set_documents (dict, docs);
 136
 137
 138 void
 139 add_document (dict, doc)
 140  struct dictionary *dict
 141  char *doc
 142 CODE:
 143  dict_add_document_line (dict, doc);
 144
 145
 146 void
 147 clear_documents (dict)
 148  struct dictionary *dict
 149 CODE:
 150  dict_clear_documents (dict);
 151
 152
 153 void
 154 set_weight (dict, var)
 155  struct dictionary *dict
 156  struct variable *var
 157 CODE:
 158  dict_set_weight (dict, var);
 159
 160
 161
 162 MODULE = PSPP           PACKAGE = PSPP::Var
 163
 164 struct variable *
 165 _dict_create_var (dict, name, ip_fmt)
 166  struct dictionary * dict
 167  char *name
 168  input_format ip_fmt
 169 INIT:
 170  SV *errstr = get_sv("PSPP::errstr", TRUE);
 171  sv_setpv (errstr, "");
 172  if ( ! var_is_plausible_name (name, false))
 173   {
 174     sv_setpv (errstr, "The variable name is not valid.");
 175     XSRETURN_UNDEF;
 176   }
 177 CODE:
 178  struct fmt_spec op_fmt;
 179  struct fmt_spec *if_copy;
 180  struct variable *v;
 181  op_fmt = fmt_for_output_from_input (&ip_fmt);
 182  v = dict_create_var (dict, name,
 183         fmt_is_string (op_fmt.type) ? op_fmt.w : 0);
 184  if ( NULL == v )
 185   {
 186     sv_setpv (errstr, "The variable could not be created (probably already exists).");
 187     XSRETURN_UNDEF;
 188   }
 189  var_set_both_formats (v, &op_fmt);
 190  if_copy = malloc (sizeof (*if_copy));
 191  memcpy (if_copy, &ip_fmt, sizeof (ip_fmt));
 192  var_attach_aux (v, if_copy, var_dtor_free);
 193  RETVAL = v;
 194 OUTPUT:
 195  RETVAL
 196
 197
 198 int
 199 set_missing_values (var, v1, ...)
 200  struct variable *var;
 201  SV *v1;
 202 INIT:
 203  int i;
 204  union value val[3];
 205
 206  if ( items > 4 )
 207   croak ("No more than 3 missing values are permitted");
 208
 209  for (i = 0; i < items - 1; ++i)
 210    scalar_to_value (&val[i], ST(i+1));
 211 CODE:
 212  struct missing_values mv;
 213  mv_init (&mv, var_get_width (var));
 214  for (i = 0 ; i < items - 1; ++i )
 215    mv_add_value (&mv, &val[i]);
 216  var_set_missing_values (var, &mv);
 217
 218
 219 void
 220 set_label (var, label)
 221  struct variable *var;
 222  char *label
 223 CODE:
 224   var_set_label (var, label);
 225
 226
 227 void
 228 clear_value_labels (var)
 229  struct variable *var;
 230 CODE:
 231  var_clear_value_labels (var);
 232
 233 void
 234 _set_write_format (var, fmt)
 235  struct variable *var
 236  output_format fmt
 237 CODE:
 238  var_set_write_format (var, &fmt);
 239
 240
 241 void
 242 _set_print_format (var, fmt)
 243  struct variable *var
 244  output_format fmt
 245 CODE:
 246  var_set_print_format (var, &fmt);
 247
 248 void
 249 _set_output_format (var, fmt)
 250  struct variable *var
 251  output_format fmt
 252 CODE:
 253  var_set_both_formats (var, &fmt);
 254
 255
 256 int
 257 add_value_label (var, key, label)
 258  struct variable *var
 259  SV *key
 260  char *label
 261 INIT:
 262  SV *errstr = get_sv("PSPP::errstr", TRUE);
 263  sv_setpv (errstr, "");
 264 CODE:
 265  union value the_value;
 266
 267  if ( var_is_numeric (var))
 268  {
 269   if ( ! looks_like_number (key))
 270     {
 271       sv_setpv (errstr, "Cannot add label with string key to a numeric variable");
 272       XSRETURN_IV (0);
 273     }
 274   the_value.f = SvNV (key);
 275  }
 276  else
 277  {
 278    if ( var_is_long_string (var) )
 279      {
 280       sv_setpv (errstr, "Cannot add label to a long string variable");
 281       XSRETURN_IV (0);
 282      }
 283   strncpy (the_value.s, SvPV_nolen(key), MAX_SHORT_STRING);
 284  }
 285  if (! var_add_value_label (var, &the_value, label) )
 286  {
 287    sv_setpv (errstr, "Something went wrong");
 288    XSRETURN_IV (0);
 289  }
 290  XSRETURN_IV (1);
 291
 292
 293
 294 MODULE = PSPP           PACKAGE = PSPP::Sysfile
 295
 296
 297 struct sysfile_info *
 298 _create_sysfile (name, dict, opts_hr)
 299  char * name
 300  struct dictionary * dict
 301  SV *opts_hr
 302 INIT:
 303  struct sfm_write_options opts;
 304  if (!SvROK (opts_hr))
 305   {
 306     opts = sfm_writer_default_options ();
 307   }
 308  else
 309   {
 310     HV *opt_h = (HV *) SvRV (opts_hr);
 311     SV** readonly = hv_fetch(opt_h, "readonly", 8, 0);
 312     SV** compress = hv_fetch(opt_h, "compress", 8, 0);
 313     SV** version = hv_fetch(opt_h, "version", 7, 0);
 314
 315     opts.create_writeable = readonly ? ! SvIV (*readonly) : true;
 316     opts.compress = compress ? SvIV (*compress) : false;
 317     opts.version = version ? SvIV (*version) : 3 ;
 318   }
 319 CODE:
 320  struct file_handle *fh =
 321   fh_create_file (NULL, name, fh_default_properties () );
 322  struct sysfile_info *sfi = xmalloc (sizeof (*sfi));
 323  sfi->writer = sfm_open_writer (fh, dict, opts);
 324  sfi->dict = dict;
 325  sfi->opened = true;
 326  RETVAL = sfi;
 327  OUTPUT:
 328 RETVAL
 329
 330 int
 331 close (sfi)
 332  struct sysfile_info *sfi
 333 CODE:
 334  RETVAL = sysfile_close (sfi);
 335 OUTPUT:
 336  RETVAL
 337
 338 void
 339 DESTROY (sfi)
 340  struct sysfile_info *sfi
 341 CODE:
 342  sysfile_close (sfi);
 343  free (sfi);
 344
 345 int
 346 append_case (sfi, ccase)
 347  struct sysfile_info *sfi
 348  SV *ccase
 349 INIT:
 350  SV *errstr = get_sv("PSPP::errstr", TRUE);
 351  sv_setpv (errstr, "");
 352  if ( (!SvROK(ccase)))
 353   {
 354     XSRETURN_UNDEF;
 355   }
 356 CODE:
 357  int i = 0;
 358  AV *av_case = (AV*) SvRV (ccase);
 359
 360  const struct variable **vv;
 361  size_t nv;
 362  struct ccase c;
 363
 364  if ( av_len (av_case) >= dict_get_var_cnt (sfi->dict))
 365    XSRETURN_UNDEF;
 366
 367  case_create (&c, dict_get_next_value_idx (sfi->dict));
 368
 369  dict_get_vars (sfi->dict, &vv, &nv, 1u << DC_ORDINARY | 1u << DC_SYSTEM);
 370
 371  SV *sv ;
 372  for (sv = av_shift (av_case); SvOK (sv);  sv = av_shift (av_case))
 373  {
 374     const struct variable *v = vv[i++];
 375     struct substring ss = ss_cstr (SvPV_nolen (sv));
 376     struct fmt_spec *ifmt = var_get_aux (v);
 377
 378     if ( ! data_in (ss, LEGACY_NATIVE, ifmt->type, 0, 0, 0, case_data_rw (&c, v),
 379         var_get_width (v)) )
 380      {
 381         RETVAL = 0;
 382         goto finish;
 383      }
 384  }
 385  /* The remaining variables must be sysmis or blank string */
 386  while (i < dict_get_var_cnt (sfi->dict))
 387  {
 388    const struct variable *v = vv[i++];
 389    union value *val = case_data_rw (&c, v);
 390    if ( var_is_numeric (v))
 391         val->f = SYSMIS;
 392    else
 393         memset (val->s, ' ', var_get_width (v));
 394  }
 395  RETVAL = casewriter_write (sfi->writer, &c);
 396  finish:
 397  case_destroy (&c);
 398  free (vv);
 399 OUTPUT:
 400  RETVAL