Added method to get the custom variable attributes

diff --git a/perl-module/PSPP.xs b/perl-module/PSPP.xs
index c479c75b09e1e67f85a208aa03fc6aa08e27257e..e0943d6e6513b052b6ff97417d7b82f09fdc9ca1 100644 (file)
--- a/perl-module/PSPP.xs
+++ b/perl-module/PSPP.xs
@@ -31,7 +31,9 @@
 #include <gl/xalloc.h>
 #include <data/dictionary.h>
 #include <data/case.h>
 #include <gl/xalloc.h>
 #include <data/dictionary.h>
 #include <data/case.h>

+#include <data/casereader.h>

 #include <data/variable.h>
 #include <data/variable.h>

+#include <data/attributes.h>

 #include <data/file-handle-def.h>
 #include <data/sys-file-writer.h>
 #include <data/sys-file-reader.h>
 #include <data/file-handle-def.h>
 #include <data/sys-file-writer.h>
 #include <data/sys-file-reader.h>


@@ -180,7 +182,7 @@ CODE:
  RETVAL = ret;
  OUTPUT:
 RETVAL
  RETVAL = ret;
  OUTPUT:
 RETVAL

- 
+

 
 int
 value_is_missing (val, var)
 
 int
 value_is_missing (val, var)


@@ -423,6 +425,43 @@ CODE:
  XSRETURN_IV (1);
 
 
  XSRETURN_IV (1);
 
 

+SV *
+get_attributes (var)
+ struct variable *var
+CODE:
+ HV *attrhash = (HV *) sv_2mortal ((SV *) newHV());
+
+ struct attrset *as = var_get_attributes (var);
+
+ if ( as )
+   {
+     struct attrset_iterator iter;
+     struct attribute *attr;
+
+     for (attr = attrset_first (as, &iter);
+         attr;
+         attr = attrset_next (as, &iter))
+       {
+        int i;
+        const char *name = attribute_get_name (attr);
+
+        AV *values = newAV ();
+
+        for (i = 0 ; i < attribute_get_n_values (attr); ++i )
+          {
+            const char *value = attribute_get_value (attr, i);
+            av_push (values, newSVpv (value, 0));
+          }
+
+        hv_store (attrhash, name, strlen (name),
+                  newRV_noinc ((SV*) values), 0);
+       }
+   }
+
+ RETVAL = newRV ((SV *) attrhash);
+ OUTPUT:
+RETVAL
+

 
 const char *
 get_name (var)
 
 const char *
 get_name (var)

diff --git a/perl-module/lib/PSPP.pm b/perl-module/lib/PSPP.pm
index 6fbae803a9b250cf3d0aa8aaccaebaaace00aba5..2ea613dee31b8ae987779ec7e2865f2a1cf73e98 100644 (file)
--- a/perl-module/lib/PSPP.pm
+++ b/perl-module/lib/PSPP.pm
@@ -355,6 +355,12 @@ sub set_value_labels
 Sets the missing values for the variable.  
 No more than three missing values may be specified.
 
 Sets the missing values for the variable.  
 No more than three missing values may be specified.
 

+=head3 get_attributes()
+
+Returns a reference to a hash of the custom variable attributes.
+Each value of the hash is a reference to an array containing the 
+attribute values.
+

 =head3 get_name ()
 
 Returns the name of the variable.
 =head3 get_name ()
 
 Returns the name of the variable.

diff --git a/perl-module/t/Pspp.t b/perl-module/t/Pspp.t
index ff0e4d1e0dac22d277a28f95d606398bbb637485..6e8510f883d6675c90386e2a8cc5c88109dce53e 100644 (file)
--- a/perl-module/t/Pspp.t
+++ b/perl-module/t/Pspp.t
@@ -6,7 +6,7 @@
 
 # change 'tests => 1' to 'tests => last_test_to_print';
 
 
 # change 'tests => 1' to 'tests => last_test_to_print';
 

-use Test::More tests => 31;
+use Test::More tests => 32;

 use Text::Diff;
 use File::Temp qw/ tempfile tempdir /;
 BEGIN { use_ok('PSPP') };
 use Text::Diff;
 use File::Temp qw/ tempfile tempdir /;
 BEGIN { use_ok('PSPP') };


@@ -314,6 +314,12 @@ add value labels
   /string '1111' 'ones' '2222' 'twos' '3333' 'threes'
   /numeric 1 'Unity' 2 'Duality' 3 'Thripality'.
 
   /string '1111' 'ones' '2222' 'twos' '3333' 'threes'
   /numeric 1 'Unity' 2 'Duality' 3 'Thripality'.
 

+variable attribute
+    variables = numeric
+    attribute=colour[1]('blue') colour[2]('pink') colour[3]('violet')
+    attribute=size('large') nationality('foreign').
+
+

 save outfile='$filename'.
 SYNTAX
 
 save outfile='$filename'.
 SYNTAX
 


@@ -570,3 +576,37 @@ SYNTAX
  $val = @$c[2];
  ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive Num");
 }
  $val = @$c[2];
  ok ( PSPP::value_is_missing ($val, $numericvar), "Missing Value Positive Num");
 }

+
+
+#Test reading of custom attributes
+{
+    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 $var = $dict->get_var_by_name ("numeric");
+
+    my $attr = $var->get_attributes ();
+
+    open (MYFILE, ">$tempdir/out.txt");
+
+    foreach $k (keys %$attr)
+    {
+       my $ll = $attr->{$k};
+       print MYFILE "$k =>";
+       print MYFILE map "$_\n", join ', ', @$ll;
+    }
+
+    close (MYFILE);
+
+    ok (compare ("$tempdir/out.txt", <<EOF), "Custom Attributes");
+colour =>blue, pink, violet
+nationality =>foreign
+size =>large
+EOF
+
+}