lexer: Reimplement for better testability and internationalization.

[pspp-builds.git] / perl-module / PSPP.xs

diff --git a/perl-module/PSPP.xs b/perl-module/PSPP.xs
index 77a720caabf69cc17a172ab2c0b1233b7baa9987..58eac5b762b58080d7ec3dbb9abf79e3ed3b50ca 100644 (file)
--- a/perl-module/PSPP.xs
+++ b/perl-module/PSPP.xs
@@ -1,5 +1,5 @@
 /* PSPP - computes sample statistics.
-   Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License as
@@ -19,6 +19,12 @@
 
 #include <config.h>
 
+/* The Gnulib "strftime" module defines my_strftime in <config.h> for use by
+   gl/strftime.c.  Perl also defines my_strftime in embed.h for some other
+   purpose.  The former definition doesn't matter in this file, so suppress it
+   to avoid a compiler warning. */
+#undef my_strftime
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -28,6 +34,7 @@
 #include "minmax.h"
 #include <libpspp/message.h>
 #include <libpspp/version.h>
+#include <libpspp/i18n.h>
 #include <gl/xalloc.h>
 #include <data/dictionary.h>
 #include <data/case.h>
@@ -81,7 +88,7 @@ struct sysreader_info
 
 /*  A message handler which writes messages to PSPP::errstr */
 static void
-message_handler (const struct msg *m)
+message_handler (const struct msg *m, void *aux)
 {
  SV *errstr = get_sv("PSPP::errstr", TRUE);
  sv_setpv (errstr, m->text);
@@ -160,6 +167,8 @@ MODULE = PSPP
 
 MODULE = PSPP          PACKAGE = PSPP
 
+PROTOTYPES: ENABLE
+
 void
 onBoot (ver)
  const char *ver
@@ -170,7 +179,7 @@ CODE:
  assert (0 == strncmp (ver, bare_version, strlen (ver)));
 
  i18n_init ();
- msg_init (NULL, message_handler);
+ msg_set_handler (message_handler, NULL);
  settings_init (0, 0);
  fh_init ();
 
@@ -181,11 +190,10 @@ format_value (val, var)
 CODE:
  SV *ret;
  const struct fmt_spec *fmt = var_get_print_format (var);
- const struct dictionary *dict = var_get_vardict (var)->dict;
  union value uv;
  char *s;
  make_value_from_scalar (&uv, val, var);
- s = data_out (&uv, dict_get_encoding (dict), fmt);
+ s = data_out (&uv, var_get_encoding (var), fmt);
  value_destroy (&uv, var_get_width (var));
  ret = newSVpv (s, fmt->w);
  free (s);
@@ -247,7 +255,7 @@ set_documents (dict, docs)
  struct dictionary *dict
  char *docs
 CODE:
- dict_set_documents (dict, docs);
+ dict_set_documents_string (dict, docs);
 
 
 void
@@ -255,7 +263,7 @@ add_document (dict, doc)
  struct dictionary *dict
  char *doc
 CODE:
- dict_add_document_line (dict, doc);
+ dict_add_document_line (dict, doc, false);
 
 
 void
@@ -318,7 +326,7 @@ pxs_dict_create_var (dict, name, ip_fmt)
 INIT:
  SV *errstr = get_sv("PSPP::errstr", TRUE);
  sv_setpv (errstr, "");
- if ( ! var_is_plausible_name (name, false))
+ if ( ! id_is_plausible (name, false))
   {
     sv_setpv (errstr, "The variable name is not valid.");
     XSRETURN_UNDEF;
@@ -368,7 +376,7 @@ set_label (var, label)
  struct variable *var;
  char *label
 CODE:
-  var_set_label (var, label);
+  var_set_label (var, label, NULL, false);
 
 
 void
@@ -584,6 +592,7 @@ CODE:
  struct file_handle *fh =
   fh_create_file (NULL, name, fh_default_properties () );
  struct sysfile_info *sfi = xmalloc (sizeof (*sfi));
+ dict_set_encoding (dict, UTF8);
  sfi->writer = sfm_open_writer (fh, dict, opts);
  sfi->dict = dict;
  sfi->opened = true;
@@ -648,10 +657,16 @@ CODE:
     if ( ifmt )
       {
        struct substring ss = ss_cstr (SvPV_nolen (sv));
-       if ( ! data_in (ss, LEGACY_NATIVE, ifmt->type, 0, 0, 0,
-                       sfi->dict,
-                       case_data_rw (c, v),
-                       var_get_width (v)) )
+       char *error;
+       bool ok;
+
+       error = data_in (ss, SvUTF8(sv) ? UTF8: "iso-8859-1", ifmt->type,
+                        case_data_rw (c, v), var_get_width (v),
+                        dict_get_encoding (sfi->dict));
+        ok = error == NULL;
+        free (error);
+
+       if ( !ok )
          {
            RETVAL = 0;
            goto finish;
@@ -670,7 +685,8 @@ CODE:
    union value *val = case_data_rw (c, v);
    value_set_missing (val, var_get_width (v));
  }
- RETVAL = casewriter_write (sfi->writer, c);
+ casewriter_write (sfi->writer, c);
+ RETVAL = 1;
  finish:
  free (vv);
 OUTPUT: