getting perl wrapper up to speed

bruceravel · bruceravel · commit 9dd28a02330f · 2014-07-18T18:18:33.000-04:00
also some small improvments to xdireader.c + squenlched a compilation warning in xdifile
diff --git a/.gitignore b/.gitignore
@@ -39,6 +39,7 @@ perl/XDIFile.inl
 perl/pm_to_blib
 _Inline/*
 perl/t/baddata/coverage.txt
+perl/*.inl
 
 *.aux
 *.dvi
diff --git a/c/xdi_reader.c b/c/xdi_reader.c
@@ -34,11 +34,16 @@ int main(int argc, char **argv) {
   xdifile = malloc(sizeof(XDIFile));
   ret = XDI_readfile(argv[1], xdifile);
   if (ret < 0) {
-    printf("Error reading XDI file '%s':\n     %s\n",
-	   argv[1], XDI_errorstring(ret));
+    printf("Error reading XDI file '%s':\n     %s\t(error code = %ld)\n",
+	   argv[1], XDI_errorstring(ret), ret);
     return 1;
   }
 
+  if (ret > 0) {
+    printf("Warning reading XDI file '%s':\n     %s\t(error code = %ld)\n\n",
+	   argv[1], XDI_errorstring(ret), ret);
+  }
+
   printf("#------\n# XDI FILE Read %s VERSIONS: |%s|%s|\n" ,
 	 xdifile->filename, xdifile->xdi_version, xdifile->extra_version);
 
@@ -59,7 +64,7 @@ int main(int argc, char **argv) {
   tdat = (double *)calloc(xdifile->npts, sizeof(double));
   for (j = 0; j < xdifile->narrays; j++ ) {
     ret = XDI_get_array_name(xdifile,xdifile->array_labels[j], tdat);
-    printf(" %ld %9s: ", j, xdifile->array_labels[j], ret);
+    printf(" %ld %9s: ", j, xdifile->array_labels[j]);
     for (k=0; k < nout; k++) {  printf("%.8g, ", tdat[k]); }
     printf("\n");
     /* printf("..., %.8g, %.8g\n", tdat[xdifile->npts-2], tdat[xdifile->npts-1]);
diff --git a/c/xdifile.c b/c/xdifile.c
@@ -119,7 +119,7 @@ XDI_readfile(char *filename, XDIFile *xdifile) {
   COPY_STRING(xdifile->xdi_version, "");
   COPY_STRING(xdifile->extra_version, "");
   COPY_STRING(xdifile->element, "__");
-  COPY_STRING(xdifile->edge, "K");
+  COPY_STRING(xdifile->edge, "_");
   COPY_STRING(xdifile->comments, "");
   COPY_STRING(xdifile->error_line, "");
   COPY_STRING(xdifile->outer_label, "");
diff --git a/c/xdifile.h b/c/xdifile.h
@@ -94,7 +94,7 @@ static char *ValidElems[] =
 
 
 /* error codes   
-  < 1  data file is not valid
+  < 0  data file is not valid
   = 0  all OK.
   > 0  data file is valid but may be incomplete as XAFS data
 */
diff --git a/perl/lib/Xray/XDI.pm b/perl/lib/Xray/XDI.pm
@@ -5,13 +5,12 @@ use MooseX::NonMoose;
 extends 'Xray::XDIFile';
 with 'Xray::XDI::WriterPP';
 
-use feature "switch";
-use List::MoreUtils qw(uniq);
+use List::MoreUtils qw(any uniq);
 
 our $VERSION = '0.01';
 
 has 'file' => (is => 'rw', isa => 'Str', default => q{},
-	      trigger => sub{$_[0]->_build_object; });
+	       trigger => sub{$_[0]->_build_object});
 
 has 'xdifile' => (
 		  is        => 'ro',
@@ -22,6 +21,7 @@ has 'xdifile' => (
 		 );
 # no need to fiddle with inline_constructor here
 has 'ok'             => (is => 'rw', isa => 'Bool', default => 0);
+has 'warning'        => (is => 'rw', isa => 'Bool', default => 0);
 has 'errorcode'      => (is => 'rw', isa => 'Int',  default => 0);
 has 'error'          => (is => 'rw', isa => 'Str',  default => q{});
 
@@ -71,6 +71,7 @@ sub _build_object {
   my ($self) = @_;
   $self->error(q{});
   $self->ok(1);
+  $self->warning(0);
   if (not -e $self->file) {
     $self->error('The file '.$self->file.' does not exist as XDI');
     $self->ok(0);
@@ -90,23 +91,31 @@ sub _build_object {
   my $obj = Xray::XDIFile->new($self->file, $errcode);
   $self->errorcode($errcode);
 
+  #print $self->file, $/;
+  #$self->trace;
+  #print '>>>>>', $errcode, $/;
+
   ##### see xdifile.h for error codes
-  given ($errcode) {
-    when ([-10,-30,-31,-32,-41,-42,-43,-80,-81,-82,-100]) {
-      $self->error($obj->_errorstring($errcode));
-      $self->ok(0);
-      return $obj;
-    };
-    when ($_ != 0) {
-      $self->error('not an XDI file, unknown error');
-      $self->ok(0);
-      return $obj;
+  ##### see xdifile.c (line 23 and following) for error messages
+  if ($errcode < 0) {
+    my @errors = ();
+    foreach my $i (0 .. 10) {
+      push @errors, $obj->_errorstring(-1*2**$i) if (abs($errcode) & 2**$i);
     };
-    default {
-      $self->error(q{});
-      $self->ok(1);
+    $self->error(join(", ", @errors));
+    $self->ok(0);
+    return $obj;
+  };
+  if ($errcode > 0) {
+    my @errors = ();
+    foreach my $i (0 .. 4) {
+      push @errors, $obj->_errorstring(2**$i) if ($errcode & 2**$i);
     };
+    $self->error(join(", ", @errors));
+    $self->ok(1);
+    $self->warning(1);
   };
+
   if (not defined $obj->_filename) {
     $self->error('unknown problem reading '.$self->file.' as an XDI file');
     $self->ok(0);
@@ -152,7 +161,24 @@ sub _build_object {
   return $obj;
 };
 
-
+use Term::ANSIColor qw(:constants);
+sub trace {
+  my ($self) = @_;
+  my $max_depth = 30;
+  my $i = 0;
+  my ($green, $red, $yellow, $end) = (BOLD.GREEN, BOLD.RED, BOLD.YELLOW, RESET);
+  local $|=1;
+  print($/.BOLD."--- Begin stack trace ---$end\n");
+  while ( (my @call_details = (caller($i++))) && ($i<$max_depth) ) {
+    my $from = $call_details[1];
+    my $line  = $call_details[2];
+    my $color = RESET.YELLOW;
+    (my $func = $call_details[3]) =~ s{(?<=::)(\w+)\z}{$color$1};
+    print("$green$from$end line $red$line$end in function $yellow$func$end\n");
+  }
+  print(BOLD."--- End stack trace ---$end\n");
+  return $self;
+};
 
 
 
diff --git a/perl/lib/Xray/XDIFile.pm b/perl/lib/Xray/XDIFile.pm
@@ -174,6 +174,12 @@ char* _token(SV* obj, char* tok) {
     return TOK_COLUMN;
   } else if (strncmp(tok, "dspacing", 2) == 0) {
     return TOK_DSPACE;
+  } else if (strncmp(tok, "timestamp", 2) == 0) {
+    return TOK_TIMESTAMP;
+  } else if (strncmp(tok, "outervalue", 6) == 0) {
+    return TOK_OUTER_VAL;
+  } else if (strncmp(tok, "outername", 6) == 0) {
+    return TOK_OUTER_NAME;
   } else {
     return "";
   }
diff --git a/perl/t/00_base.t b/perl/t/00_base.t
@@ -2,7 +2,7 @@
 
 ## test the Inline C code in the Xray::XDIFile module
 
-use Test::More tests => 45;
+use Test::More tests => 46;
 
 use strict;
 use warnings;
@@ -20,27 +20,28 @@ my $xdifile = Xray::XDIFile->new($file, $errcode);
 ok($errcode == 0,                              'error code = 0');
 ok($xdifile =~ m{Xray::XDIFile},               'created Xray::XDIFile object');
 
-ok( $xdifile->_token('comment') eq '#',               'token: comment');
-ok( $xdifile->_token('delimiter') eq ':',             'token: delimiter');
-ok( $xdifile->_token('dot') eq '.',                   'token: dot');
-ok( $xdifile->_token('startcomment') eq '///',        'token: startcomment');
-ok( $xdifile->_token('endcomment') eq '---',          'token: endcomment');
-ok( $xdifile->_token('energycolumn') eq 'energy',     'token: energycolumn');
-ok( $xdifile->_token('anglecolumn') eq 'angle',       'token: anglecolumn');
-ok( $xdifile->_token('version') eq 'XDI/',            'token: version');
-ok( $xdifile->_token('edge') eq 'element.edge',       'token: edge');
-ok( $xdifile->_token('element') eq 'element.symbol',  'token: element');
-ok( $xdifile->_token('column') eq 'column.',          'token: column');
-ok( $xdifile->_token('dspacing') eq 'mono.d_spacing', 'token: dspacing');
-ok( $xdifile->_token('glorb') eq '',                  'token: not a token');
+ok( $xdifile->_token('comment') eq '#',                 'token: comment');
+ok( $xdifile->_token('delimiter') eq ':',               'token: delimiter');
+ok( $xdifile->_token('dot') eq '.',                     'token: dot');
+ok( $xdifile->_token('startcomment') eq '///',          'token: startcomment');
+ok( $xdifile->_token('endcomment') eq '---',            'token: endcomment');
+ok( $xdifile->_token('energycolumn') eq 'energy',       'token: energycolumn');
+ok( $xdifile->_token('anglecolumn') eq 'angle',         'token: anglecolumn');
+ok( $xdifile->_token('version') eq 'XDI/',              'token: version');
+ok( $xdifile->_token('edge') eq 'element.edge',         'token: edge');
+ok( $xdifile->_token('element') eq 'element.symbol',    'token: element');
+ok( $xdifile->_token('column') eq 'column.',            'token: column');
+ok( $xdifile->_token('dspacing') eq 'mono.d_spacing',   'token: dspacing');
+ok( $xdifile->_token('timestamp') eq 'scan.start_time', 'token: starttime');
+ok( $xdifile->_token('glorb') eq '',                    'token: "glorb" is not a token');
 
 my @edges = $xdifile->_valid_edges;
 ok($#edges == 26, 'edge symbols');
 my @elements = $xdifile->_valid_elements;
 ok($#elements == 117, 'element symbols');
 
 ok($xdifile->_filename =~ m{co_metal_rt.xdi},  'filename');
-ok($xdifile->_xdi_libversion eq '1.0.0',       'xdi_libversion');
+ok($xdifile->_xdi_libversion eq '1.1.0',       'xdi_libversion');
 ok($xdifile->_xdi_version >= 1.0,              'xdi_version');
 ok($xdifile->_extra_version =~ m{GSE},         'extra_version');
 
@@ -62,7 +63,7 @@ ok($families[6] eq 'Mono',   'specific family');
 ok($keywords[6] eq 'name',   'specific keyword');
 ok($values[6]   eq 'Si 111', 'specific value');
 
-ok($xdifile->_npts    == 418, 'npts');
+ok($xdifile->_npts    == 417, 'npts');
 ok($xdifile->_narrays ==   3, 'narrays');
 ok($xdifile->_narrays ==  $xdifile->_narray_labels, 'narray_labels');
 
diff --git a/perl/t/01_moose_nonmoose.t b/perl/t/01_moose_nonmoose.t
@@ -2,7 +2,7 @@
 
 ## test the construction of the Moose attribute structure in Xray::XDI;
 
-use Test::More tests => 45;
+use Test::More tests => 46;
 
 use strict;
 use warnings;
@@ -16,23 +16,24 @@ BEGIN { use_ok('Xray::XDI') };
 my $here = dirname($0);
 my $file = File::Spec->catfile($here, '..', '..', 'data', 'co_metal_rt.xdi');
 my $xdi  = Xray::XDI->new(file=>$file);
-ok($xdi =~ m{Xray::XDI},                         'created Xray::XDI object');
-ok($xdi->ok,                                     'ok flag is true');
-ok($xdi->error eq '',                            'error text is empty');
-
-ok( $xdi->token('comment') eq '#',               'token: comment');
-ok( $xdi->token('delimiter') eq ':',             'token: delimiter');
-ok( $xdi->token('dot') eq '.',                   'token: dot');
-ok( $xdi->token('startcomment') eq '///',        'token: startcomment');
-ok( $xdi->token('endcomment') eq '---',          'token: endcomment');
-ok( $xdi->token('energycolumn') eq 'energy',     'token: energycolumn');
-ok( $xdi->token('anglecolumn') eq 'angle',       'token: anglecolumn');
-ok( $xdi->token('version') eq 'XDI/',            'token: version');
-ok( $xdi->token('edge') eq 'element.edge',       'token: edge');
-ok( $xdi->token('element') eq 'element.symbol',  'token: element');
-ok( $xdi->token('column') eq 'column.',          'token: column');
-ok( $xdi->token('dspacing') eq 'mono.d_spacing', 'token: dspacing');
-ok( $xdi->token('glorb') eq '',                  'token: not a token');
+ok($xdi =~ m{Xray::XDI},                           'created Xray::XDI object');
+ok($xdi->ok,                                       'ok flag is true');
+ok($xdi->error eq '',                              'error text is empty');
+
+ok( $xdi->token('comment') eq '#',                 'token: comment');
+ok( $xdi->token('delimiter') eq ':',               'token: delimiter');
+ok( $xdi->token('dot') eq '.',                     'token: dot');
+ok( $xdi->token('startcomment') eq '///',          'token: startcomment');
+ok( $xdi->token('endcomment') eq '---',            'token: endcomment');
+ok( $xdi->token('energycolumn') eq 'energy',       'token: energycolumn');
+ok( $xdi->token('anglecolumn') eq 'angle',         'token: anglecolumn');
+ok( $xdi->token('version') eq 'XDI/',              'token: version');
+ok( $xdi->token('edge') eq 'element.edge',         'token: edge');
+ok( $xdi->token('element') eq 'element.symbol',    'token: element');
+ok( $xdi->token('column') eq 'column.',            'token: column');
+ok( $xdi->token('dspacing') eq 'mono.d_spacing',   'token: dspacing');
+ok( $xdi->token('timestamp') eq 'scan.start_time', 'token: timestamp');
+ok( $xdi->token('glorb') eq '',                    'token: "glorb" is not a token');
 
 my @edges = $xdi->valid_edges;
 ok($#edges == 26,                                'edge symbols');
@@ -41,7 +42,7 @@ ok($#elements == 117,                            'element symbols');
 
 
 ok($xdi->filename =~ m{co_metal_rt.xdi},  'filename');
-ok($xdi->xdi_libversion eq '1.0.0',       'xdi_libversion');
+ok($xdi->xdi_libversion eq '1.1.0',       'xdi_libversion');
 ok($xdi->xdi_version >= 1.0,              'xdi_version');
 ok($xdi->extra_version =~ m{GSE},         'extra_version');
 
@@ -66,7 +67,7 @@ ok($count == $xdi->nmetadata,                                     'correct numbe
 ok($xdi->metadata->{Mono}->{name} eq 'Si 111',                     'fetching Mono.name');
 ok($xdi->metadata->{Facility}->{xray_source} eq 'APS undulator A', 'fetching Facility.xray_source');
 
-ok($xdi->npts    == 418, 'npts');
+ok($xdi->npts    == 417, 'npts');
 ok($xdi->narrays ==   3, 'narrays');
 ok($xdi->narrays == $xdi->narray_labels, 'narray_labels');
 
diff --git a/perl/t/baddata/01_no_xdi_line.t b/perl/t/baddata/01_no_xdi_line.t
@@ -16,6 +16,8 @@ BEGIN { use_ok('Xray::XDI') };
 my $here = dirname($0);
 my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_01.xdi');
 my $xdi  = Xray::XDI->new(file=>$file);
+#my $xdi  = Xray::XDI->new;
+#$xdi->file($file);
 
 ok((not $xdi->ok), 'bad_01.xdi flagged as failing to import');
 ok(($xdi->error =~ m{not an XDI}), 'correctly identified problem');
diff --git a/perl/t/baddata/02_no_edge.t b/perl/t/baddata/02_no_edge.t
@@ -17,14 +17,14 @@ my $here = dirname($0);
 my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_02.xdi');
 my $xdi  = Xray::XDI->new(file=>$file);
 
-ok((not $xdi->ok), 'bad_02.xdi flagged as failing to import');
+ok(($xdi->warning and $xdi->ok), 'bad_02.xdi flagged with a warning');
 ok(($xdi->error =~ m{no element\.edge}), 'correctly identified missing edge symbol');
 
 
 $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_04.xdi');
 $xdi  = Xray::XDI->new(file=>$file);
 
-ok((not $xdi->ok), 'bad_04.xdi flagged as failing to import');
+ok(($xdi->warning and $xdi->ok), 'bad_04.xdi flagged with a warning');
 ok(($xdi->error =~ m{no element\.edge}), 'correctly identified invalid edge symbol');
 
 open(my $COV, '>>', 'coverage.txt');
diff --git a/perl/t/baddata/03_no_symbol.t b/perl/t/baddata/03_no_symbol.t
@@ -17,13 +17,13 @@ my $here = dirname($0);
 my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_03.xdi');
 my $xdi  = Xray::XDI->new(file=>$file);
 
-ok((not $xdi->ok), 'bad_03.xdi flagged as failing to import');
+ok(($xdi->warning and $xdi->ok), 'bad_03.xdi flagged with a warning');
 ok(($xdi->error =~ m{no element.symbol}), 'correctly identified missing element symbol');
 
 $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_05.xdi');
 $xdi  = Xray::XDI->new(file=>$file);
 
-ok((not $xdi->ok), 'bad_05.xdi flagged as failing to import');
+ok(($xdi->warning and $xdi->ok), 'bad_05.xdi flagged with a warning');
 ok(($xdi->error =~ m{no element.symbol}), 'correctly identified invalid element symbol');
 
 
diff --git a/perl/t/baddata/06_no_minus_signs.t b/perl/t/baddata/06_no_minus_signs.t
@@ -17,8 +17,8 @@ my $here = dirname($0);
 my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_06.xdi');
 my $xdi  = Xray::XDI->new(file=>$file);
 
-ok((not $xdi->ok), 'bad_06.xdi flagged as failing to import');
-ok(($xdi->error =~ m{no line of minus signs}), 'correctly identified problem');
+ok(($xdi->warning and $xdi->ok), 'bad_06.xdi flagged with warning');
+ok(($xdi->error =~ m{no line of minus signs}), 'correctly identified lack of minus signs ');
 
 
 open(my $COV, '>>', 'coverage.txt');
diff --git a/perl/t/baddata/11_bad_comment_char.t b/perl/t/baddata/11_bad_comment_char.t
@@ -17,6 +17,8 @@ my $here = dirname($0);
 my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_11.xdi');
 my $xdi  = Xray::XDI->new(file=>$file);
 
+print $xdi->error, $/;
+
 ok((not $xdi->ok), 'bad_11.xdi flagged as failing to import');
 ok(($xdi->error =~ m{contains unrecognized header lines}), 'correctly identified bad comment character');
 
diff --git a/perl/t/baddata/99_coverage.t b/perl/t/baddata/99_coverage.t
@@ -24,11 +24,6 @@ my $text;
 my @list = sort {$a <=> $b} split(" ", $text);
 my @all = (1 .. 29);
 
-TODO: {
-  local $TODO = "not all bad data tests are finished";
-
-  ok($#list eq $#all, sprintf('tested %d of %d bad files (%s)',
-			      $#list+1, $#all+1, join(",", @list)));
-};
-
+ok($#list eq $#all, sprintf('tested %d of %d bad files (%s)',
+			    $#list+1, $#all+1, join(",", @list)));
 unlink 'coverage.txt';
