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 MODULE = PSPP           PACKAGE = PSPP::Var
 280
 281
 282 struct variable *
 283 pxs_dict_create_var (dict, name, ip_fmt)
 284  struct dictionary * dict
 285  char *name
 286  input_format ip_fmt
 287 INIT:
 288  SV *errstr = get_sv("PSPP::errstr", TRUE);
 289  sv_setpv (errstr, "");
 290  if ( ! var_is_plausible_name (name, false))
 291   {
 292     sv_setpv (errstr, "The variable name is not valid.");
 293     XSRETURN_UNDEF;
 294   }
 295 CODE:
 296  struct fmt_spec op_fmt;
 297
 298  struct variable *v;
 299  op_fmt = fmt_for_output_from_input (&ip_fmt);
 300  v = dict_create_var (dict, name,
 301         fmt_is_string (op_fmt.type) ? op_fmt.w : 0);
 302  if ( NULL == v )
 303   {
 304     sv_setpv (errstr, "The variable could not be created (probably already exists).");
 305     XSRETURN_UNDEF;
 306   }
 307  var_set_both_formats (v, &op_fmt);
 308  var_set_input_format (v, ip_fmt);
 309  RETVAL = v;
 310 OUTPUT:
 311  RETVAL
 312
 313
 314 int
 315 set_missing_values (var, v1, ...)
 316  struct variable *var;
 317  SV *v1;
 318 INIT:
 319  int i;
 320  union value val[3];
 321
 322  if ( items > 4 )
 323   croak ("No more than 3 missing values are permitted");
 324
 325  for (i = 0; i < items - 1; ++i)
 326    scalar_to_value (&val[i], ST(i+1), var);
 327 CODE:
 328  struct missing_values mv;
 329  mv_init (&mv, var_get_width (var));
 330  for (i = 0 ; i < items - 1; ++i )
 331    mv_add_value (&mv, &val[i]);
 332  var_set_missing_values (var, &mv);
 333
 334
 335 void
 336 set_label (var, label)
 337  struct variable *var;
 338  char *label
 339 CODE:
 340   var_set_label (var, label);
 341
 342
 343 void
 344 clear_value_labels (var)
 345  struct variable *var;
 346 CODE:
 347  var_clear_value_labels (var);
 348
 349 void
 350 pxs_set_write_format (var, fmt)
 351  struct variable *var
 352  output_format fmt
 353 CODE:
 354  var_set_write_format (var, &fmt);
 355
 356
 357 void
 358 pxs_set_print_format (var, fmt)
 359  struct variable *var
 360  output_format fmt
 361 CODE:
 362  var_set_print_format (var, &fmt);
 363
 364 void
 365 pxs_set_output_format (var, fmt)
 366  struct variable *var
 367  output_format fmt
 368 CODE:
 369  var_set_both_formats (var, &fmt);
 370
 371
 372 int
 373 add_value_label (var, key, label)
 374  struct variable *var
 375  SV *key
 376  char *label
 377 INIT:
 378  SV *errstr = get_sv("PSPP::errstr", TRUE);
 379  sv_setpv (errstr, "");
 380 CODE:
 381  union value the_value;
 382
 383  if ( var_is_numeric (var))
 384  {
 385   if ( ! looks_like_number (key))
 386     {
 387       sv_setpv (errstr, "Cannot add label with string key to a numeric variable");
 388       XSRETURN_IV (0);
 389     }
 390   the_value.f = SvNV (key);
 391  }
 392  else
 393  {
 394    if ( var_is_long_string (var) )
 395      {
 396       sv_setpv (errstr, "Cannot add label to a long string variable");
 397       XSRETURN_IV (0);
 398      }
 399   strncpy (the_value.s, SvPV_nolen(key), MAX_SHORT_STRING);
 400  }
 401  if (! var_add_value_label (var, &the_value, label) )
 402  {
 403    sv_setpv (errstr, "Something went wrong");
 404    XSRETURN_IV (0);
 405  }
 406  XSRETURN_IV (1);
 407
 408
 409
 410 const char *
 411 get_name (var)
 412  struct variable * var
 413 CODE:
 414  RETVAL = var_get_name (var);
 415  OUTPUT:
 416 RETVAL
 417
 418
 419 const char *
 420 get_label (var)
 421  struct variable * var
 422 CODE:
 423  RETVAL = var_get_label (var);
 424  OUTPUT:
 425 RETVAL
 426
 427
 428 SV *
 429 get_value_labels (var)
 430  struct variable *var
 431 CODE:
 432  HV *labelhash = (HV *) sv_2mortal ((SV *) newHV());
 433  struct val_lab *vl;
 434  struct val_labs_iterator *viter = NULL;
 435  const struct val_labs *labels = var_get_value_labels (var);
 436
 437  if ( labels )
 438    {
 439      for (vl = val_labs_first (labels, &viter);
 440           vl;
 441           vl = val_labs_next (labels, &viter))
 442        {
 443          SV *sv = value_to_scalar (&vl->value, var);
 444          STRLEN len;
 445          const char *s = SvPV (sv, len);
 446          hv_store (labelhash, s, len, newSVpv (vl->label, 0), 0);
 447        }
 448    }
 449
 450  RETVAL = newRV ((SV *) labelhash);
 451  OUTPUT:
 452 RETVAL
 453
 454
 455
 456 MODULE = PSPP           PACKAGE = PSPP::Sysfile
 457
 458
 459 struct sysfile_info *
 460 pxs_create_sysfile (name, dict_ref, opts_hr)
 461  char *name
 462  SV *dict_ref
 463  SV *opts_hr
 464 INIT:
 465  SV *dict_sv = SvRV (dict_ref);
 466  struct dictionary *dict = (void *) SvIV (dict_sv);
 467  struct sfm_write_options opts;
 468  if (!SvROK (opts_hr))
 469   {
 470     opts = sfm_writer_default_options ();
 471   }
 472  else
 473   {
 474     HV *opt_h = (HV *) SvRV (opts_hr);
 475     SV** readonly = hv_fetch(opt_h, "readonly", 8, 0);
 476     SV** compress = hv_fetch(opt_h, "compress", 8, 0);
 477     SV** version = hv_fetch(opt_h, "version", 7, 0);
 478
 479     opts.create_writeable = readonly ? ! SvIV (*readonly) : true;
 480     opts.compress = compress ? SvIV (*compress) : false;
 481     opts.version = version ? SvIV (*version) : 3 ;
 482   }
 483 CODE:
 484  struct file_handle *fh =
 485   fh_create_file (NULL, name, fh_default_properties () );
 486  struct sysfile_info *sfi = xmalloc (sizeof (*sfi));
 487  sfi->writer = sfm_open_writer (fh, dict, opts);
 488  sfi->dict = dict;
 489  sfi->opened = true;
 490  sfi->dict_sv = dict_sv;
 491  SvREFCNT_inc (sfi->dict_sv);
 492
 493  RETVAL = sfi;
 494  OUTPUT:
 495 RETVAL
 496
 497 int
 498 close (sfi)
 499  struct sysfile_info *sfi
 500 CODE:
 501  RETVAL = sysfile_close (sfi);
 502 OUTPUT:
 503  RETVAL
 504
 505 void
 506 DESTROY (sfi)
 507  struct sysfile_info *sfi
 508 CODE:
 509  sysfile_close (sfi);
 510  SvREFCNT_dec (sfi->dict_sv);
 511  free (sfi);
 512
 513 int
 514 append_case (sfi, ccase)
 515  struct sysfile_info *sfi
 516  SV *ccase
 517 INIT:
 518  SV *errstr = get_sv("PSPP::errstr", TRUE);
 519  sv_setpv (errstr, "");
 520  if ( (!SvROK(ccase)))
 521   {
 522     XSRETURN_UNDEF;
 523   }
 524 CODE:
 525  int i = 0;
 526  AV *av_case = (AV*) SvRV (ccase);
 527
 528  const struct variable **vv;
 529  size_t nv;
 530  struct ccase c;
 531  SV *sv;
 532
 533  if ( av_len (av_case) >= dict_get_var_cnt (sfi->dict))
 534    XSRETURN_UNDEF;
 535
 536  case_create (&c, dict_get_next_value_idx (sfi->dict));
 537
 538  dict_get_vars (sfi->dict, &vv, &nv, 1u << DC_ORDINARY | 1u << DC_SYSTEM);
 539
 540  for (sv = av_shift (av_case); SvOK (sv);  sv = av_shift (av_case))
 541  {
 542     const struct variable *v = vv[i++];
 543     const struct fmt_spec *ifmt = var_get_aux (v);
 544
 545     /* If an input format has been set, then use it.
 546        Otherwise just convert the raw value.
 547     */
 548     if ( ifmt )
 549       {
 550         struct substring ss = ss_cstr (SvPV_nolen (sv));
 551         if ( ! data_in (ss, LEGACY_NATIVE, ifmt->type, 0, 0, 0,
 552                         case_data_rw (&c, v),
 553                         var_get_width (v)) )
 554           {
 555             RETVAL = 0;
 556             goto finish;
 557           }
 558       }
 559     else
 560       {
 561         scalar_to_value (case_data_rw (&c, v), sv, v);
 562       }
 563  }
 564
 565  /* The remaining variables must be sysmis or blank string */
 566  while (i < dict_get_var_cnt (sfi->dict))
 567  {
 568    const struct variable *v = vv[i++];
 569    union value *val = case_data_rw (&c, v);
 570    if ( var_is_numeric (v))
 571         val->f = SYSMIS;
 572    else
 573         memset (val->s, ' ', var_get_width (v));
 574  }
 575  RETVAL = casewriter_write (sfi->writer, &c);
 576  finish:
 577 // Case_destroy (&c);
 578  free (vv);
 579 OUTPUT:
 580  RETVAL
 581
 582
 583 \f
 584
 585 MODULE = PSPP           PACKAGE = PSPP::Reader
 586
 587 struct sysreader_info *
 588 pxs_open_sysfile (name)
 589  char * name
 590 CODE:
 591  struct casereader *reader;
 592  struct sysreader_info *sri = NULL;
 593  struct file_handle *fh =
 594          fh_create_file (NULL, name, fh_default_properties () );
 595
 596  sri = xmalloc (sizeof (*sri));
 597  sri->reader = sfm_open_reader (fh, &sri->dict, &sri->opts);
 598
 599  if ( NULL == sri->reader)
 600  {
 601    free (sri);
 602    sri = NULL;
 603  }
 604
 605  RETVAL = sri;
 606  OUTPUT:
 607 RETVAL
 608
 609
 610 struct dictionary *
 611 pxs_get_dict (reader)
 612  struct sysreader_info *reader;
 613 CODE:
 614  RETVAL = reader->dict;
 615  OUTPUT:
 616 RETVAL
 617
 618
 619 SV *
 620 get_next_case (sfr)
 621  struct sysreader_info *sfr;
 622 CODE:
 623  struct ccase c;
 624
 625  if (! casereader_read (sfr->reader, &c))
 626  {
 627   RETVAL = 0;
 628  }
 629  else
 630  {
 631   int v;
 632   AV *av_case = (AV *) sv_2mortal ((SV *) newAV());
 633
 634   for (v = 0; v < dict_get_var_cnt (sfr->dict); ++v )
 635     {
 636       const struct variable *var = dict_get_var (sfr->dict, v);
 637       const union value *val = case_data (&c, var);
 638
 639       av_push (av_case, value_to_scalar (val, var));
 640     }
 641
 642   case_destroy (&c);
 643   RETVAL = newRV ((SV *) av_case);
 644  }
 645 OUTPUT:
 646  RETVAL
 647