perl-module/PSPP.xs

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