From 7da2b01528493bd9f84a706e71fafb9ae8797ab7 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Wed, 24 Dec 2008 12:00:14 +0900 Subject: [PATCH] Added functions to enable reading data files from perl Extended the perl module so that existing data files can be read using the perl bindings. --- perl-module/PSPP.xs | 301 +++++++++++++++++++++++++++++++++++----- perl-module/lib/PSPP.pm | 65 ++++++++- perl-module/t/Pspp.t | 289 +++++++++++++++++++++++++++++++++++++- perl-module/typemap | 1 + src/libpspp/message.c | 6 +- 5 files changed, 616 insertions(+), 46 deletions(-) diff --git a/perl-module/PSPP.xs b/perl-module/PSPP.xs index 7a3103e1..254b668c 100644 --- a/perl-module/PSPP.xs +++ b/perl-module/PSPP.xs @@ -1,5 +1,5 @@ /* PSPP - computes sample statistics. - Copyright (C) 2007 Free Software Foundation, Inc. + Copyright (C) 2007, 2008 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 @@ -34,7 +34,9 @@ #include #include #include +#include #include +#include #include #include #include @@ -46,7 +48,7 @@ typedef struct fmt_spec output_format ; /* A thin wrapper around sfm_writer */ struct sysfile_info { - bool opened; + bool opened; /* A pointer to the writer. The writer is owned by the struct */ struct casewriter *writer; @@ -56,6 +58,20 @@ struct sysfile_info }; +/* A thin wrapper around sfm_reader */ +struct sysreader_info +{ + struct sfm_read_info opts; + + /* A pointer to the reader. The reader is owned by the struct */ + struct casereader *reader; + + /* A pointer to the dictionary. */ + struct dictionary *dict; +}; + + + /* A message handler which writes messages to PSPP::errstr */ static void message_handler (const struct msg *m) @@ -79,22 +95,57 @@ sysfile_close (struct sysfile_info *sfi) } static void -scalar_to_value (union value *val, SV *scalar) +scalar_to_value (union value *val, SV *scalar, const struct variable *var) { - if ( looks_like_number (scalar)) + if ( var_is_numeric (var)) { - val->f = SvNV (scalar); + if ( SvNOK (scalar) || SvIOK (scalar) ) + val->f = SvNV (scalar); + else + val->f = SYSMIS; } else { STRLEN len; - char *p = SvPV (scalar, len); - memset (val->s, ' ', MAX_SHORT_STRING); + const char *p = SvPV (scalar, len); + memset (val->s, ' ', var_get_width (var)); memcpy (val->s, p, len); } } +static SV * +value_to_scalar (const union value *val, const struct variable *var) +{ + if ( var_is_numeric (var)) + { + if ( var_is_value_missing (var, val, MV_SYSTEM)) + return newSVpvn ("", 0); + + return newSVnv (val->f); + } + else + return newSVpvn (val->s, var_get_width (var)); +} + + +static void +var_set_input_format (struct variable *v, input_format ip_fmt) +{ + struct fmt_spec *if_copy = malloc (sizeof (*if_copy)); + memcpy (if_copy, &ip_fmt, sizeof (ip_fmt)); + var_attach_aux (v, if_copy, var_dtor_free); +} + +static union value * +make_value_from_scalar (SV *val, const struct variable *var) +{ + union value *uv = value_create (var_get_width (var)); + scalar_to_value (uv, val, var); + return uv; +} + + MODULE = PSPP BOOT: @@ -103,10 +154,46 @@ BOOT: fh_init (); +MODULE = PSPP PACKAGE = PSPP + +SV * +format_value (val, var) + SV *val + struct variable *var +CODE: + SV *ret; + const struct fmt_spec *fmt = var_get_print_format (var); + union value *uv = make_value_from_scalar (val, var); + char *s; + s = malloc (fmt->w); + memset (s, '\0', fmt->w); + data_out (uv, fmt, s); + free (uv); + ret = newSVpv (s, fmt->w); + free (s); + RETVAL = ret; + OUTPUT: +RETVAL + + +int +value_is_missing (val, var) + SV *val + struct variable *var +CODE: + union value *uv = make_value_from_scalar (val, var); + int ret = var_is_value_missing (var, uv, MV_ANY); + free (uv); + RETVAL = ret; + OUTPUT: +RETVAL + + + MODULE = PSPP PACKAGE = PSPP::Dict struct dictionary * -_dict_new() +pxs_dict_new() CODE: RETVAL = dict_create (); OUTPUT: @@ -120,6 +207,14 @@ CODE: dict_destroy (dict); +int +get_var_cnt (dict) + struct dictionary *dict +CODE: + RETVAL = dict_get_var_cnt (dict); +OUTPUT: +RETVAL + void set_label (dict, label) struct dictionary *dict @@ -158,11 +253,28 @@ CODE: dict_set_weight (dict, var); +struct variable * +pxs_get_variable (dict, idx) + struct dictionary *dict + SV *idx +INIT: + SV *errstr = get_sv("PSPP::errstr", TRUE); + sv_setpv (errstr, ""); + if ( SvIV (idx) >= dict_get_var_cnt (dict)) + { + sv_setpv (errstr, "The dictionary doesn't have that many variables."); + XSRETURN_UNDEF; + } +CODE: + RETVAL = dict_get_var (dict, SvIV (idx)); + OUTPUT: +RETVAL MODULE = PSPP PACKAGE = PSPP::Var + struct variable * -_dict_create_var (dict, name, ip_fmt) +pxs_dict_create_var (dict, name, ip_fmt) struct dictionary * dict char *name input_format ip_fmt @@ -176,7 +288,7 @@ INIT: } CODE: struct fmt_spec op_fmt; - struct fmt_spec *if_copy; + struct variable *v; op_fmt = fmt_for_output_from_input (&ip_fmt); v = dict_create_var (dict, name, @@ -187,9 +299,7 @@ CODE: XSRETURN_UNDEF; } var_set_both_formats (v, &op_fmt); - if_copy = malloc (sizeof (*if_copy)); - memcpy (if_copy, &ip_fmt, sizeof (ip_fmt)); - var_attach_aux (v, if_copy, var_dtor_free); + var_set_input_format (v, ip_fmt); RETVAL = v; OUTPUT: RETVAL @@ -207,7 +317,7 @@ INIT: croak ("No more than 3 missing values are permitted"); for (i = 0; i < items - 1; ++i) - scalar_to_value (&val[i], ST(i+1)); + scalar_to_value (&val[i], ST(i+1), var); CODE: struct missing_values mv; mv_init (&mv, var_get_width (var)); @@ -222,7 +332,7 @@ set_label (var, label) char *label CODE: var_set_label (var, label); - + void clear_value_labels (var) @@ -231,7 +341,7 @@ CODE: var_clear_value_labels (var); void -_set_write_format (var, fmt) +pxs_set_write_format (var, fmt) struct variable *var output_format fmt CODE: @@ -239,14 +349,14 @@ CODE: void -_set_print_format (var, fmt) +pxs_set_print_format (var, fmt) struct variable *var output_format fmt CODE: var_set_print_format (var, &fmt); void -_set_output_format (var, fmt) +pxs_set_output_format (var, fmt) struct variable *var output_format fmt CODE: @@ -291,13 +401,59 @@ CODE: +const char * +get_name (var) + struct variable * var +CODE: + RETVAL = var_get_name (var); + OUTPUT: +RETVAL + + +const char * +get_label (var) + struct variable * var +CODE: + RETVAL = var_get_label (var); + OUTPUT: +RETVAL + + +SV * +get_value_labels (var) + struct variable *var +CODE: + HV *labelhash = (HV *) sv_2mortal ((SV *) newHV()); + struct val_lab *vl; + struct val_labs_iterator *viter = NULL; + const struct val_labs *labels = var_get_value_labels (var); + + if ( labels ) + { + for (vl = val_labs_first (labels, &viter); + vl; + vl = val_labs_next (labels, &viter)) + { + SV *sv = value_to_scalar (&vl->value, var); + STRLEN len; + const char *s = SvPV (sv, len); + hv_store (labelhash, s, len, newSVpv (vl->label, 0), 0); + } + } + + RETVAL = newRV ((SV *) labelhash); + OUTPUT: +RETVAL + + + MODULE = PSPP PACKAGE = PSPP::Sysfile struct sysfile_info * -_create_sysfile (name, dict, opts_hr) - char * name - struct dictionary * dict +pxs_create_sysfile (name, dict, opts_hr) + char *name + struct dictionary *dict SV *opts_hr INIT: struct sfm_write_options opts; @@ -323,6 +479,7 @@ CODE: sfi->writer = sfm_open_writer (fh, dict, opts); sfi->dict = dict; sfi->opened = true; + RETVAL = sfi; OUTPUT: RETVAL @@ -360,6 +517,7 @@ CODE: const struct variable **vv; size_t nv; struct ccase c; + SV *sv; if ( av_len (av_case) >= dict_get_var_cnt (sfi->dict)) XSRETURN_UNDEF; @@ -368,20 +526,31 @@ CODE: dict_get_vars (sfi->dict, &vv, &nv, 1u << DC_ORDINARY | 1u << DC_SYSTEM); - SV *sv ; for (sv = av_shift (av_case); SvOK (sv); sv = av_shift (av_case)) { const struct variable *v = vv[i++]; - struct substring ss = ss_cstr (SvPV_nolen (sv)); - struct fmt_spec *ifmt = var_get_aux (v); - - if ( ! data_in (ss, LEGACY_NATIVE, ifmt->type, 0, 0, 0, case_data_rw (&c, v), - var_get_width (v)) ) - { - RETVAL = 0; - goto finish; - } + const struct fmt_spec *ifmt = var_get_aux (v); + + /* If an input format has been set, then use it. + Otherwise just convert the raw value. + */ + if ( ifmt ) + { + struct substring ss = ss_cstr (SvPV_nolen (sv)); + if ( ! data_in (ss, LEGACY_NATIVE, ifmt->type, 0, 0, 0, + case_data_rw (&c, v), + var_get_width (v)) ) + { + RETVAL = 0; + goto finish; + } + } + else + { + scalar_to_value (case_data_rw (&c, v), sv, v); + } } + /* The remaining variables must be sysmis or blank string */ while (i < dict_get_var_cnt (sfi->dict)) { @@ -394,7 +563,75 @@ CODE: } RETVAL = casewriter_write (sfi->writer, &c); finish: - case_destroy (&c); +// Case_destroy (&c); free (vv); OUTPUT: RETVAL + + + + +MODULE = PSPP PACKAGE = PSPP::Reader + +struct sysreader_info * +pxs_open_sysfile (name) + char * name +CODE: + struct casereader *reader; + struct sysreader_info *sri = NULL; + struct file_handle *fh = + fh_create_file (NULL, name, fh_default_properties () ); + + sri = xmalloc (sizeof (*sri)); + sri->reader = sfm_open_reader (fh, &sri->dict, &sri->opts); + + if ( NULL == sri->reader) + { + free (sri); + sri = NULL; + } + + RETVAL = sri; + OUTPUT: +RETVAL + + +struct dictionary * +pxs_get_dict (reader) + struct sysreader_info *reader; +CODE: + RETVAL = reader->dict; + OUTPUT: +RETVAL + + +SV * +get_next_case (sfr) + struct sysreader_info *sfr; +CODE: + struct ccase c; + + if (! casereader_read (sfr->reader, &c)) + { + RETVAL = 0; + } + else + { + int v; + AV *av_case = (AV *) sv_2mortal ((SV *) newAV()); + + for (v = 0; v < dict_get_var_cnt (sfr->dict); ++v ) + { + const struct variable *var = dict_get_var (sfr->dict, v); + const union value *val = case_data (&c, var); + + av_push (av_case, value_to_scalar (val, var)); + } + + case_destroy (&c); + RETVAL = newRV ((SV *) av_case); + } +OUTPUT: + RETVAL + + diff --git a/perl-module/lib/PSPP.pm b/perl-module/lib/PSPP.pm index 8a54094e..f4310eee 100644 --- a/perl-module/lib/PSPP.pm +++ b/perl-module/lib/PSPP.pm @@ -41,8 +41,9 @@ use POSIX ; use constant { SYSMIS => -(POSIX::DBL_MAX), PERL_EPOCH => 12219379200 # Number of seconds between + # 14th October 1582 + # and # 1st January 1970 - # and 14th October 1582 }; @@ -77,11 +78,33 @@ Sets the weighting variable to C. sub new { my $class = shift; - my $self = _dict_new (); + my $self = pxs_dict_new (); bless ($self, $class); return $self; } +=pod + +=head3 get_var + +Returns a variable from a dictionary + +=cut + +sub get_var +{ + my $dict = shift; + my $idx = shift; + my $var = pxs_get_variable ($dict, $idx); + + if ( ref $var ) + { + bless ($var, "PSPP::Var"); + } + return $var; +} + + package PSPP::Fmt; =pod @@ -161,7 +184,7 @@ sub new my $dict = shift; my $name = shift; my %format = @_; - my $self = _dict_create_var ($dict, $name, \%format); + my $self = pxs_dict_create_var ($dict, $name, \%format); if ( ref $self ) { bless ($self, $class); @@ -208,7 +231,7 @@ sub set_write_format { my $var = shift; my %format = @_; - _set_write_format ($var, \%format); + pxs_set_write_format ($var, \%format); } =pod @@ -224,7 +247,7 @@ sub set_print_format { my $var = shift; my %format = @_; - _set_print_format ($var, \%format); + pxs_set_print_format ($var, \%format); } =pod @@ -242,7 +265,7 @@ sub set_output_format { my $var = shift; my %format = @_; - _set_output_format ($var, \%format); + pxs_set_output_format ($var, \%format); } =pod @@ -347,7 +370,7 @@ sub new my $dict = shift; my $opts = shift; - my $self = _create_sysfile ($filename, $dict, $opts); + my $self = pxs_create_sysfile ($filename, $dict, $opts); if ( ref $self ) { @@ -368,6 +391,34 @@ The system file will be automatically closed when it goes out of scope. =cut +package PSPP::Reader; + +sub open +{ + my $class = shift; + my $filename = shift; + + my $self = pxs_open_sysfile ($filename); + + if ( ref $self ) + { + bless ($self, $class); + } + return $self; +} + + +sub get_dict +{ + my $reader = shift; + + my $dict = pxs_get_dict ($reader); + + bless ($dict, "PSPP::Dict"); + + return $dict; +} + 1; diff --git a/perl-module/t/Pspp.t b/perl-module/t/Pspp.t index 3388120a..ed824d12 100644 --- a/perl-module/t/Pspp.t +++ b/perl-module/t/Pspp.t @@ -6,18 +6,25 @@ # change 'tests => 1' to 'tests => last_test_to_print'; -use Test::More tests => 19; +use Test::More tests => 30; use Text::Diff; use File::Temp qw/ tempfile tempdir /; BEGIN { use_ok('PSPP') }; ######################### +sub compare +{ + my $file = shift; + my $pattern = shift; + return ! diff ("$file", \$pattern); +} + sub run_pspp_syntax { my $tempdir = shift; my $syntax = shift; - my $result = shift; + my $syntaxfile = "$tempdir/foo.sps"; open (FH, ">$syntaxfile"); @@ -25,6 +32,16 @@ sub run_pspp_syntax close (FH); system ("cd $tempdir; pspp -o raw-ascii $syntaxfile"); +} + +sub run_pspp_syntax_cmp +{ + my $tempdir = shift; + my $syntax = shift; + + my $result = shift; + + run_pspp_syntax ($tempdir, $syntax); my $diff = diff ("$tempdir/pspp.list", \$result); @@ -37,7 +54,7 @@ sub run_pspp_syntax } -# Insert your test code below, the Test::More module is use()ed here so read +# Insert your test code below, the Test::More module is used here so read # its man page ( perldoc Test::More ) for help writing this test script. { @@ -136,7 +153,7 @@ sub run_pspp_syntax } ok (-s "$tempfile", "existance2"); - ok (run_pspp_syntax ($tempdir, <close (); - ok (run_pspp_syntax ($tempdir, < 1 ); + + generate_sav_file ("$tempdir/in.sav", "$tempdir"); + + my $sf = PSPP::Reader->open ("$tempdir/in.sav"); + + my $dict = $sf->get_dict (); + + open (MYFILE, ">$tempdir/out.txt"); + for ($v = 0 ; $v < $dict->get_var_cnt() ; $v++) + { + my $var = $dict->get_var ($v); + my $name = $var->get_name (); + my $label = $var->get_label (); + + print MYFILE "Variable $v is \"$name\", label is \"$label\"\n"; + + my $vl = $var->get_value_labels (); + + print MYFILE "Value Labels:\n"; + print MYFILE "$_ => $vl->{$_}\n" for keys %$vl; + } + + while (my $c = $sf->get_next_case () ) + { + for ($v = 0; $v < $dict->get_var_cnt(); $v++) + { + print MYFILE "val$v: \"@$c[$v]\"\n"; + } + print MYFILE "\n"; + } + + close (MYFILE); + +ok (compare ("$tempdir/out.txt", < threes +1111 => ones +2222 => twos +Variable 1 is "longstring", label is "A Long String Variable" +Value Labels: +Variable 2 is "numeric", label is "A Numeric Variable" +Value Labels: +1 => Unity +3 => Thripality +2 => Duality +Variable 3 is "date", label is "A Date Variable" +Value Labels: +Variable 4 is "dollar", label is "A Dollar Variable" +Value Labels: +Variable 5 is "datetime", label is "A Datetime Variable" +Value Labels: +val0: "1111 " +val1: "One " +val2: "1" +val3: "13197686400" +val4: "1" +val5: "13197690060" + +val0: "2222 " +val1: "Two " +val2: "2" +val3: "13231987200" +val4: "2" +val5: "13231994520" + +val0: "3333 " +val1: "Three " +val2: "3" +val3: "13266028800" +val4: "3" +val5: "13266039780" + +val0: ". " +val1: ". " +val2: "" +val3: "" +val4: "" +val5: "" + +val0: "5555 " +val1: "Five " +val2: "5" +val3: "13334630400" +val4: "5" +val5: "13334648700" + +EOF + +} + + +# Check that we can stream one file into another +{ + my $tempdir = tempdir( CLEANUP => 1 ); + + generate_sav_file ("$tempdir/in.sav", "$tempdir"); + + my $input = PSPP::Reader->open ("$tempdir/in.sav"); + + my $dict = $input->get_dict (); + + my $output = PSPP::Sysfile->new ("$tempdir/out.sav", $dict); + + while (my $c = $input->get_next_case () ) + { + $output->append_case ($c); + } + + $output->close (); + + + #Check the two files are the same (except for metadata) + + run_pspp_syntax ($tempdir, < 1 ); + + run_pspp_syntax ($tempdir, <open ("$tempdir/dd.sav"); + + my $dict = $sf->get_dict (); + + my $c = $sf->get_next_case (); + + my $var = $dict->get_var (0); + my $val = @$c[0]; + my $formatted = PSPP::format_value ($val, $var); + my $str = gmtime ($val - PSPP::PERL_EPOCH); + print "Formatted string is \"$formatted\"\n"; + ok ( $formatted eq "11-SEP-2001 08:20", "format_value function"); + ok ( $str eq "Tue Sep 11 08:20:00 2001", "Perl representation of time"); +} + + +# Check that attempting to open a non-existent file results in an error +{ + my $tempdir = tempdir( CLEANUP => 1 ); + + unlink ("$tempdir/no-such-file.sav"); + + my $sf = PSPP::Reader->open ("$tempdir/no-such-file.sav"); + + ok ( !ref $sf, "Returns undef on opening failure"); + + ok ("$PSPP::errstr" eq "Error opening \"$tempdir/no-such-file.sav\" for reading as a system file: No such file or directory.", + "Error string on open failure"); +} + + +# Missing value tests. +{ + my $tempdir = tempdir( CLEANUP => 1 ); + + generate_sav_file ("$tempdir/in.sav", "$tempdir"); + + my $sf = PSPP::Reader->open ("$tempdir/in.sav"); + + my $dict = $sf->get_dict (); + + + my $c = $sf->get_next_case (); + + my $stringvar = $dict->get_var (0); + my $numericvar = $dict->get_var (2); + my $val = @$c[0]; + + ok ( !PSPP::value_is_missing ($val, $stringvar), "Missing Value Negative String"); + + $val = @$c[2]; + + ok ( !PSPP::value_is_missing ($val, $numericvar), "Missing Value Negative Num"); + + $c = $sf->get_next_case (); + $c = $sf->get_next_case (); + + $val = @$c[0]; + ok ( PSPP::value_is_missing ($val, $stringvar), "Missing Value Positive"); + + $c = $sf->get_next_case (); + $val = @$c[2]; + ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive SYS"); + + $c = $sf->get_next_case (); + $val = @$c[2]; + ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive Num"); +} diff --git a/perl-module/typemap b/perl-module/typemap index 157eab2a..cd45c339 100644 --- a/perl-module/typemap +++ b/perl-module/typemap @@ -2,6 +2,7 @@ TYPEMAP struct dictionary * T_PTRREF struct variable * T_PTRREF struct sysfile_info * T_PTRREF + struct sysreader_info * T_PTRREF input_format INPUT_FMT_SPEC output_format OUTPUT_FMT_SPEC diff --git a/src/libpspp/message.c b/src/libpspp/message.c index 695b7132..22710914 100644 --- a/src/libpspp/message.c +++ b/src/libpspp/message.c @@ -99,9 +99,11 @@ msg_destroy(struct msg *m) void msg_emit (struct msg *m) { - get_msg_location (s_stream, &m->where); + if ( s_stream ) + get_msg_location (s_stream, &m->where); + if (!messages_disabled) - msg_handler (m); + msg_handler (m); free (m->text); } -- 2.30.2