perl-module/PSPP.xs

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 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 <config.h>
  21
  22 /* The Gnulib "strftime" module defines my_strftime in <config.h> for use by
  23    gl/strftime.c.  Perl also defines my_strftime in embed.h for some other
  24    purpose.  The former definition doesn't matter in this file, so suppress it
  25    to avoid a compiler warning. */
  26 #undef my_strftime
  27
  28 #include "EXTERN.h"
  29 #include "perl.h"
  30 #include "XSUB.h"
  31
  32 #include "ppport.h"
  33
  34 #include "minmax.h"
  35 #include <libpspp/message.h>
  36 #include <libpspp/version.h>
  37 #include <libpspp/i18n.h>
  38 #include <gl/xalloc.h>
  39 #include <data/dictionary.h>
  40 #include <data/case.h>
  41 #include <data/casereader.h>
  42 #include <data/casewriter.h>
  43 #include <data/variable.h>
  44 #include <data/attributes.h>
  45 #include <data/file-handle-def.h>
  46 #include <data/identifier.h>
  47 #include <data/settings.h>
  48 #include <data/sys-file-writer.h>
  49 #include <data/value.h>
  50 #include <data/vardict.h>
  51 #include <data/value-labels.h>
  52 #include <data/format.h>
  53 #include <data/data-in.h>
  54 #include <data/data-out.h>
  55 #include <string.h>
  56
  57 typedef struct fmt_spec input_format ;
  58 typedef struct fmt_spec output_format ;
  59
  60
  61 /*  A thin wrapper around sfm_writer */
  62 struct syswriter_info
  63 {
  64   bool opened;
  65
  66   /* A pointer to the writer. The writer is owned by the struct */
  67   struct casewriter *writer;
  68
  69   /* A pointer to the dictionary. Owned externally */
  70   const struct pspp_dict *dict;
  71
  72   /* The scalar containing the dictionary */
  73   SV *dict_sv;
  74 };
  75
  76
  77 /*  A thin wrapper around sfm_reader */
  78 struct sysreader_info
  79 {
  80   struct any_read_info opts;
  81
  82   /* A pointer to the reader. The reader is owned by the struct */
  83   struct casereader *reader;
  84
  85   /* A pointer to the dictionary. */
  86   struct pspp_dict *dict;
  87 };
  88
  89
  90 struct input_format {
  91   struct hmap_node hmap_node;   /* In struct pspp_dict's input_formats map. */
  92   const struct variable *var;
  93   struct fmt_spec input_format;
  94 };
  95
  96 /* A thin wrapper around struct dictionary.*/
  97 struct pspp_dict {
  98   struct dictionary *dict;
  99   struct hmap input_formats;    /* Contains struct input_format. */
 100 };
 101
 102
 103 /*  A message handler which writes messages to PSPP::errstr */
 104 static void
 105 message_handler (const struct msg *m, void *aux)
 106 {
 107  SV *errstr = get_sv("PSPP::errstr", TRUE);
 108  sv_setpv (errstr, m->text);
 109 }
 110
 111 static int
 112 sysfile_close (struct syswriter_info *swi)
 113 {
 114   int retval ;
 115   if ( ! swi->opened )
 116     return 0;
 117
 118   retval = casewriter_destroy (swi->writer);
 119   if (retval > 0 )
 120     swi->opened = false;
 121
 122   return retval;
 123 }
 124
 125 static void
 126 scalar_to_value (union value *val, SV *scalar, const struct variable *var)
 127 {
 128   if ( var_is_numeric (var))
 129     {
 130         if ( SvNOK (scalar) || SvIOK (scalar) )
 131            val->f = SvNV (scalar);
 132         else
 133            val->f = SYSMIS;
 134     }
 135   else
 136     {
 137         STRLEN len;
 138         const char *p = SvPV (scalar, len);
 139         int width = var_get_width (var);
 140         value_set_missing (val, width);
 141         memcpy (value_str_rw (val, width), p, len);
 142     }
 143 }
 144
 145
 146 static SV *
 147 value_to_scalar (const union value *val, const struct variable *var)
 148 {
 149   if ( var_is_numeric (var))
 150     {
 151       if ( var_is_value_missing (var, val, MV_SYSTEM))
 152         return newSVpvn ("", 0);
 153
 154       return newSVnv (val->f);
 155     }
 156   else
 157     {
 158       int width = var_get_width (var);
 159       return newSVpvn (value_str (val, width), width);
 160     }
 161 }
 162
 163
 164 static void
 165 make_value_from_scalar (union value *uv, SV *val, const struct variable *var)
 166 {
 167  value_init (uv, var_get_width (var));
 168  scalar_to_value (uv, val, var);
 169 }
 170
 171 static struct pspp_dict *
 172 create_pspp_dict (struct dictionary *dict)
 173 {
 174   struct pspp_dict *pspp_dict = xmalloc (sizeof *pspp_dict);
 175   pspp_dict->dict = dict;
 176   hmap_init (&pspp_dict->input_formats);
 177   return pspp_dict;
 178 }
 179
 180 static const struct fmt_spec *
 181 find_input_format (const struct pspp_dict *dict, const struct variable *var)
 182 {
 183   struct input_format *input_format;
 184
 185   HMAP_FOR_EACH_IN_BUCKET (input_format, struct input_format, hmap_node,
 186                            hash_pointer (var, 0), &dict->input_formats)
 187     if (input_format->var == var)
 188       return &input_format->input_format;
 189
 190   return NULL;
 191 }
 192
 193
 194 MODULE = PSPP
 195
 196 MODULE = PSPP           PACKAGE = PSPP
 197
 198 PROTOTYPES: ENABLE
 199
 200 void
 201 onBoot (ver)
 202  const char *ver
 203 CODE:
 204  /* Check that the version is correct up to the length of 'ver'.
 205     This allows PSPP autobuilders to add a "-build#" suffix to the
 206     PSPP version without causing failures here. */
 207  assert (0 == strncmp (ver, bare_version, strlen (ver)));
 208
 209  i18n_init ();
 210  msg_set_handler (message_handler, NULL);
 211  settings_init ();
 212  fh_init ();
 213
 214 SV *
 215 format_value (val, var)
 216  SV *val
 217  struct variable *var
 218 CODE:
 219  SV *ret;
 220  const struct fmt_spec *fmt = var_get_print_format (var);
 221  union value uv;
 222  char *s;
 223  make_value_from_scalar (&uv, val, var);
 224  s = data_out (&uv, var_get_encoding (var), fmt);
 225  value_destroy (&uv, var_get_width (var));
 226  ret = newSVpv (s, fmt->w);
 227  free (s);
 228  RETVAL = ret;
 229  OUTPUT:
 230 RETVAL
 231
 232
 233 int
 234 value_is_missing (val, var)
 235  SV *val
 236  struct variable *var
 237 CODE:
 238  union value uv;
 239  int ret;
 240  make_value_from_scalar (&uv, val, var);
 241  ret = var_is_value_missing (var, &uv, MV_ANY);
 242  value_destroy (&uv, var_get_width (var));
 243  RETVAL = ret;
 244  OUTPUT:
 245 RETVAL
 246
 247
 248
 249 MODULE = PSPP           PACKAGE = PSPP::Dict
 250
 251 struct pspp_dict *
 252 pxs_dict_new()
 253 CODE:
 254  RETVAL = create_pspp_dict (dict_create ("UTF-8"));
 255 OUTPUT:
 256  RETVAL
 257
 258
 259 void
 260 DESTROY (dict)
 261  struct pspp_dict *dict
 262 CODE:
 263  if (dict != NULL)
 264    {
 265      struct input_format *input_format, *next_input_format;
 266
 267      HMAP_FOR_EACH_SAFE (input_format, next_input_format,
 268                          struct input_format, hmap_node, &dict->input_formats)
 269        {
 270          hmap_delete (&dict->input_formats, &input_format->hmap_node);
 271          free (input_format);
 272        }
 273      hmap_destroy (&dict->input_formats);
 274      dict_destroy (dict->dict);
 275      free (dict);
 276    }
 277
 278 int
 279 get_var_cnt (dict)
 280  struct pspp_dict *dict
 281 CODE:
 282  RETVAL = dict_get_var_cnt (dict->dict);
 283 OUTPUT:
 284 RETVAL
 285
 286 void
 287 set_label (dict, label)
 288  struct pspp_dict *dict
 289  char *label
 290 CODE:
 291  dict_set_label (dict->dict, label);
 292
 293 void
 294 set_documents (dict, docs)
 295  struct pspp_dict *dict
 296  char *docs
 297 CODE:
 298  dict_set_documents_string (dict->dict, docs);
 299
 300
 301 void
 302 add_document (dict, doc)
 303  struct pspp_dict *dict
 304  char *doc
 305 CODE:
 306  dict_add_document_line (dict->dict, doc, false);
 307
 308
 309 void
 310 clear_documents (dict)
 311  struct pspp_dict *dict
 312 CODE:
 313  dict_clear_documents (dict->dict);
 314
 315
 316 void
 317 set_weight (dict, var)
 318  struct pspp_dict *dict
 319  struct variable *var
 320 CODE:
 321  dict_set_weight (dict->dict, var);
 322
 323
 324 struct variable *
 325 pxs_get_variable (dict, idx)
 326  struct pspp_dict *dict
 327  SV *idx
 328 INIT:
 329  SV *errstr = get_sv("PSPP::errstr", TRUE);
 330  sv_setpv (errstr, "");
 331  if ( SvIV (idx) >= dict_get_var_cnt (dict->dict))
 332   {
 333     sv_setpv (errstr, "The dictionary doesn't have that many variables.");
 334     XSRETURN_UNDEF;
 335   }
 336 CODE:
 337  RETVAL = dict_get_var (dict->dict, SvIV (idx));
 338  OUTPUT:
 339 RETVAL
 340
 341
 342 struct variable *
 343 pxs_get_var_by_name (dict, name)
 344  struct pspp_dict *dict
 345  const char *name
 346 INIT:
 347  SV *errstr = get_sv("PSPP::errstr", TRUE);
 348  sv_setpv (errstr, "");
 349 CODE:
 350  struct variable *var = dict_lookup_var (dict->dict, name);
 351  if ( ! var )
 352       sv_setpv (errstr, "No such variable.");
 353  RETVAL = var;
 354  OUTPUT:
 355 RETVAL
 356
 357
 358 MODULE = PSPP           PACKAGE = PSPP::Var
 359
 360
 361 struct variable *
 362 pxs_dict_create_var (dict, name, ip_fmt)
 363  struct pspp_dict * dict
 364  char *name
 365  input_format ip_fmt
 366 INIT:
 367  SV *errstr = get_sv("PSPP::errstr", TRUE);
 368  sv_setpv (errstr, "");
 369  if ( ! id_is_plausible (name, false))
 370   {
 371     sv_setpv (errstr, "The variable name is not valid.");
 372     XSRETURN_UNDEF;
 373   }
 374 CODE:
 375  struct fmt_spec op_fmt;
 376  struct input_format *input_format;
 377
 378  struct variable *v;
 379  op_fmt = fmt_for_output_from_input (&ip_fmt);
 380  v = dict_create_var (dict->dict, name,
 381         fmt_is_string (op_fmt.type) ? op_fmt.w : 0);
 382  if ( NULL == v )
 383   {
 384     sv_setpv (errstr, "The variable could not be created (probably already exists).");
 385     XSRETURN_UNDEF;
 386   }
 387  var_set_both_formats (v, &op_fmt);
 388
 389  input_format = xmalloc (sizeof *input_format);
 390  input_format->var = v;
 391  input_format->input_format = ip_fmt;
 392  hmap_insert (&dict->input_formats, &input_format->hmap_node,
 393               hash_pointer (v, 0));
 394
 395  RETVAL = v;
 396 OUTPUT:
 397  RETVAL
 398
 399
 400 int
 401 set_missing_values (var, v1, ...)
 402  struct variable *var;
 403  SV *v1;
 404 INIT:
 405  int i;
 406  union value val[3];
 407
 408  if ( items > 4 )
 409   croak ("No more than 3 missing values are permitted");
 410
 411  for (i = 0; i < items - 1; ++i)
 412    scalar_to_value (&val[i], ST(i+1), var);
 413 CODE:
 414  struct missing_values mv;
 415  mv_init (&mv, var_get_width (var));
 416  for (i = 0 ; i < items - 1; ++i )
 417    mv_add_value (&mv, &val[i]);
 418  var_set_missing_values (var, &mv);
 419
 420
 421 void
 422 set_label (var, label)
 423  struct variable *var;
 424  char *label
 425 CODE:
 426   var_set_label (var, label);
 427
 428
 429 void
 430 clear_value_labels (var)
 431  struct variable *var;
 432 CODE:
 433  var_clear_value_labels (var);
 434
 435 SV *
 436 get_write_format (var)
 437  struct variable *var
 438 CODE:
 439  HV *fmthash = (HV *) sv_2mortal ((SV *) newHV());
 440  const struct fmt_spec *fmt = var_get_write_format (var);
 441
 442  hv_store (fmthash, "fmt", 3, newSVnv (fmt->type), 0);
 443  hv_store (fmthash, "decimals", 8, newSVnv (fmt->d), 0);
 444  hv_store (fmthash, "width", 5, newSVnv (fmt->w), 0);
 445
 446  RETVAL = newRV ((SV *) fmthash);
 447  OUTPUT:
 448 RETVAL
 449
 450 SV *
 451 get_print_format (var)
 452  struct variable *var
 453 CODE:
 454  HV *fmthash = (HV *) sv_2mortal ((SV *) newHV());
 455  const struct fmt_spec *fmt = var_get_print_format (var);
 456
 457  hv_store (fmthash, "fmt", 3, newSVnv (fmt->type), 0);
 458  hv_store (fmthash, "decimals", 8, newSVnv (fmt->d), 0);
 459  hv_store (fmthash, "width", 5, newSVnv (fmt->w), 0);
 460
 461  RETVAL = newRV ((SV *) fmthash);
 462  OUTPUT:
 463 RETVAL
 464
 465
 466 void
 467 pxs_set_write_format (var, fmt)
 468  struct variable *var
 469  output_format fmt
 470 CODE:
 471  var_set_write_format (var, &fmt);
 472
 473
 474 void
 475 pxs_set_print_format (var, fmt)
 476  struct variable *var
 477  output_format fmt
 478 CODE:
 479  var_set_print_format (var, &fmt);
 480
 481 void
 482 pxs_set_output_format (var, fmt)
 483  struct variable *var
 484  output_format fmt
 485 CODE:
 486  var_set_both_formats (var, &fmt);
 487
 488
 489 int
 490 add_value_label (var, key, label)
 491  struct variable *var
 492  SV *key
 493  char *label
 494 INIT:
 495  SV *errstr = get_sv("PSPP::errstr", TRUE);
 496  sv_setpv (errstr, "");
 497 CODE:
 498  union value the_value;
 499  int width = var_get_width (var);
 500  int ok;
 501
 502  value_init (&the_value, width);
 503  if ( var_is_numeric (var))
 504  {
 505   if ( ! looks_like_number (key))
 506     {
 507       sv_setpv (errstr, "Cannot add label with string key to a numeric variable");
 508       value_destroy (&the_value, width);
 509       XSRETURN_IV (0);
 510     }
 511   the_value.f = SvNV (key);
 512  }
 513  else
 514  {
 515   value_copy_str_rpad (&the_value, width, SvPV_nolen(key), ' ');
 516  }
 517  ok = var_add_value_label (var, &the_value, label);
 518  value_destroy (&the_value, width);
 519  if (!ok)
 520  {
 521    sv_setpv (errstr, "Something went wrong");
 522    XSRETURN_IV (0);
 523  }
 524  XSRETURN_IV (1);
 525
 526
 527 SV *
 528 get_attributes (var)
 529  struct variable *var
 530 CODE:
 531  HV *attrhash = (HV *) sv_2mortal ((SV *) newHV());
 532
 533  struct attrset *as = var_get_attributes (var);
 534
 535  if ( as )
 536    {
 537      struct attrset_iterator iter;
 538      struct attribute *attr;
 539
 540      for (attr = attrset_first (as, &iter);
 541           attr;
 542           attr = attrset_next (as, &iter))
 543        {
 544          int i;
 545          const char *name = attribute_get_name (attr);
 546
 547          AV *values = newAV ();
 548
 549          for (i = 0 ; i < attribute_get_n_values (attr); ++i )
 550            {
 551              const char *value = attribute_get_value (attr, i);
 552              av_push (values, newSVpv (value, 0));
 553            }
 554
 555          hv_store (attrhash, name, strlen (name),
 556                    newRV_noinc ((SV*) values), 0);
 557        }
 558    }
 559
 560  RETVAL = newRV ((SV *) attrhash);
 561  OUTPUT:
 562 RETVAL
 563
 564
 565 const char *
 566 get_name (var)
 567  struct variable * var
 568 CODE:
 569  RETVAL = var_get_name (var);
 570  OUTPUT:
 571 RETVAL
 572
 573
 574 const char *
 575 get_label (var)
 576  struct variable * var
 577 CODE:
 578  RETVAL = var_get_label (var);
 579  OUTPUT:
 580 RETVAL
 581
 582
 583 SV *
 584 get_value_labels (var)
 585  struct variable *var
 586 CODE:
 587  HV *labelhash = (HV *) sv_2mortal ((SV *) newHV());
 588  const struct val_lab *vl;
 589  struct val_labs_iterator *viter = NULL;
 590  const struct val_labs *labels = var_get_value_labels (var);
 591
 592  if ( labels )
 593    {
 594      for (vl = val_labs_first (labels);
 595           vl;
 596           vl = val_labs_next (labels, vl))
 597        {
 598          SV *sv = value_to_scalar (&vl->value, var);
 599          STRLEN len;
 600          const char *s = SvPV (sv, len);
 601          hv_store (labelhash, s, len, newSVpv (val_lab_get_label (vl), 0), 0);
 602        }
 603    }
 604
 605  RETVAL = newRV ((SV *) labelhash);
 606  OUTPUT:
 607 RETVAL
 608
 609
 610
 611 MODULE = PSPP           PACKAGE = PSPP::Sysfile
 612
 613
 614 struct syswriter_info *
 615 pxs_create_sysfile (name, dict, opts_hr)
 616  char *name
 617  struct pspp_dict *dict;
 618  SV *opts_hr
 619 INIT:
 620  SV *dict_sv = ST(1);
 621  struct sfm_write_options opts;
 622  if (!SvROK (opts_hr))
 623   {
 624     opts = sfm_writer_default_options ();
 625   }
 626  else
 627   {
 628     HV *opt_h = (HV *) SvRV (opts_hr);
 629     SV** readonly = hv_fetch(opt_h, "readonly", 8, 0);
 630     SV** compress = hv_fetch(opt_h, "compress", 8, 0);
 631     SV** version = hv_fetch(opt_h, "version", 7, 0);
 632
 633     opts.create_writeable = readonly ? ! SvIV (*readonly) : true;
 634     opts.compression = (compress && SvIV (*compress)
 635                         ? ANY_COMP_SIMPLE
 636                         : ANY_COMP_NONE);
 637     opts.version = version ? SvIV (*version) : 3 ;
 638   }
 639 CODE:
 640  struct file_handle *fh =
 641   fh_create_file (NULL, name, fh_default_properties () );
 642  struct syswriter_info *swi = xmalloc (sizeof (*swi));
 643  swi->writer = sfm_open_writer (fh, dict->dict, opts);
 644  swi->dict = dict;
 645  swi->opened = true;
 646  swi->dict_sv = dict_sv;
 647  SvREFCNT_inc (swi->dict_sv);
 648
 649  RETVAL = swi;
 650  OUTPUT:
 651 RETVAL
 652
 653 int
 654 close (swi)
 655  struct syswriter_info *swi
 656 CODE:
 657  RETVAL = sysfile_close (swi);
 658 OUTPUT:
 659  RETVAL
 660
 661 void
 662 DESTROY (swi)
 663  struct syswriter_info *swi
 664 CODE:
 665  sysfile_close (swi);
 666  SvREFCNT_dec (swi->dict_sv);
 667  free (swi);
 668
 669 int
 670 append_case (swi, ccase)
 671  struct syswriter_info *swi
 672  SV *ccase
 673 INIT:
 674  SV *errstr = get_sv("PSPP::errstr", TRUE);
 675  sv_setpv (errstr, "");
 676  if ( (!SvROK(ccase)))
 677   {
 678     XSRETURN_UNDEF;
 679   }
 680 CODE:
 681  int i = 0;
 682  AV *av_case = (AV*) SvRV (ccase);
 683
 684  const struct variable **vv;
 685  size_t nv;
 686  struct ccase *c;
 687  SV *sv;
 688
 689  if ( av_len (av_case) >= dict_get_var_cnt (swi->dict->dict))
 690    XSRETURN_UNDEF;
 691
 692  c =  case_create (dict_get_proto (swi->dict->dict));
 693
 694  dict_get_vars (swi->dict->dict, &vv, &nv,
 695                 1u << DC_ORDINARY | 1u << DC_SYSTEM);
 696
 697  for (sv = av_shift (av_case); SvOK (sv);  sv = av_shift (av_case))
 698  {
 699     const struct variable *v = vv[i++];
 700     const struct fmt_spec *ifmt = find_input_format (swi->dict, v);
 701
 702     /* If an input format has been set, then use it.
 703        Otherwise just convert the raw value.
 704     */
 705     if ( ifmt )
 706       {
 707         struct substring ss = ss_cstr (SvPV_nolen (sv));
 708         char *error;
 709         bool ok;
 710
 711         error = data_in (ss, SvUTF8(sv) ? UTF8: "iso-8859-1", ifmt->type,
 712                          case_data_rw (c, v), var_get_width (v),
 713                          dict_get_encoding (swi->dict->dict));
 714         ok = error == NULL;
 715         free (error);
 716
 717         if ( !ok )
 718           {
 719             RETVAL = 0;
 720             goto finish;
 721           }
 722       }
 723     else
 724       {
 725         scalar_to_value (case_data_rw (c, v), sv, v);
 726       }
 727  }
 728
 729  /* The remaining variables must be sysmis or blank string */
 730  while (i < dict_get_var_cnt (swi->dict->dict))
 731  {
 732    const struct variable *v = vv[i++];
 733    union value *val = case_data_rw (c, v);
 734    value_set_missing (val, var_get_width (v));
 735  }
 736  casewriter_write (swi->writer, c);
 737  RETVAL = 1;
 738  finish:
 739  free (vv);
 740 OUTPUT:
 741  RETVAL
 742
 743
 744 \f
 745
 746 MODULE = PSPP           PACKAGE = PSPP::Reader
 747
 748 struct sysreader_info *
 749 pxs_open_sysfile (name)
 750  char * name
 751 CODE:
 752  struct casereader *reader;
 753  struct sysreader_info *sri = NULL;
 754  struct file_handle *fh =
 755          fh_create_file (NULL, name, fh_default_properties () );
 756  struct dictionary *dict;
 757
 758  sri = xmalloc (sizeof (*sri));
 759  sri->reader = any_reader_open_and_decode (fh, NULL, &dict, &sri->opts);
 760  if (sri->reader)
 761    sri->dict = create_pspp_dict (dict);
 762  else
 763    {
 764      free (sri);
 765      sri = NULL;
 766    }
 767
 768  RETVAL = sri;
 769  OUTPUT:
 770 RETVAL
 771
 772
 773 struct pspp_dict *
 774 pxs_get_dict (reader)
 775  struct sysreader_info *reader;
 776 CODE:
 777  RETVAL = reader->dict;
 778  OUTPUT:
 779 RETVAL
 780
 781 SV *
 782 get_case_cnt (sfr)
 783  struct sysreader_info *sfr;
 784 CODE:
 785  SV *ret;
 786  casenumber n = casereader_get_case_cnt (sfr->reader);
 787  if (n == CASENUMBER_MAX)
 788   ret = &PL_sv_undef;
 789  else
 790   ret = newSViv (n);
 791  RETVAL = ret;
 792  OUTPUT:
 793 RETVAL
 794
 795
 796
 797 void
 798 get_next_case (sfr)
 799  struct sysreader_info *sfr;
 800 PPCODE:
 801  struct ccase *c;
 802
 803  if ((c = casereader_read (sfr->reader)) != NULL)
 804  {
 805   int v;
 806
 807   EXTEND (SP, dict_get_var_cnt (sfr->dict->dict));
 808   for (v = 0; v < dict_get_var_cnt (sfr->dict->dict); ++v )
 809     {
 810       const struct variable *var = dict_get_var (sfr->dict->dict, v);
 811       const union value *val = case_data (c, var);
 812
 813       PUSHs (sv_2mortal (value_to_scalar (val, var)));
 814     }
 815
 816   case_unref (c);
 817  }