Skip to content

Commit 5a99ab8

Browse files
bruceravelbruceravel
committed
perl wrapper up to date with validation branch of library
1 parent fe52ad2 commit 5a99ab8

19 files changed

+221
-91
lines changed

‎c/xdifile.c‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -342,10 +342,10 @@ XDI_readfile(char *filename, XDIFile *xdifile) {
342342

343343
/* MONO D-SPACING */
344344
} else if (strcasecmp(mkey, TOK_DSPACE) == 0) {
345-
if (0 != xdi_strtod(mval, &dval)) {
345+
if (0 == xdi_strtod(mval, &dval)) {
346346
xdifile->dspacing = dval;
347347
} else {
348-
xdifile->dspacing = -1;
348+
xdifile->dspacing = -1.0;
349349
};
350350

351351
/* OUTER ARRAY NAME */

‎perl/example/xdi_reader.pl‎

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
#!/usr/bin/perl
2+
3+
## This is a replica in perl of the xdi_reader.c test program
4+
## the only difference is the order in which the metadata is printed to the screen
5+
##
6+
## to run this *before* installing Xray::XDI, try
7+
## perl -Iblib/lib -Iblib/arch example/xdi_reader.pl ../baddata/bad_32.xdi
8+
9+
use strict;
10+
use warnings;
11+
use Xray::XDI;
12+
13+
my $xdi = Xray::XDI->new(file=>$ARGV[0]||"");
14+
print "Syntax: xdi_reader.pl filename\n", exit if not defined($xdi->xdifile);
15+
printf "Error reading XDI file '%s':\n\t%s\t(error code = %d)\n", $ARGV[0], $xdi->errormessage, $xdi->errorcode, exit if $xdi->errorcode < 0;
16+
printf "Warning reading XDI file '%s':\n\t%s\t(warning code = %d)\n\n", $ARGV[0], $xdi->errormessage, $xdi->errorcode if $xdi->errorcode > 0;
17+
18+
19+
print "#------\n";
20+
printf "# XDI FILE Read %s: |%s|%s|\n", $xdi->filename, $xdi->xdi_version, $xdi->extra_version;
21+
printf "# Elem/Edge: %s|%s|\n", $xdi->element, $xdi->edge;
22+
23+
24+
25+
print "# User comments:\n";
26+
print $xdi->comments, $/;
27+
28+
29+
30+
printf "# Metadata(%d entries):\n--\n", $xdi->nmetadata;
31+
foreach my $fam (sort keys %{$xdi->metadata}) {
32+
foreach my $key (sort keys %{$xdi->metadata->{$fam}}) {
33+
my $value = $xdi->metadata->{$fam}->{$key};
34+
printf " %s / %s => %s\n", $fam, $key, $value;
35+
my $i = $xdi->validate($fam, $key, $value);
36+
if ($i) {
37+
printf "-- Warning for %s.%s: %s\t(warning code = %d)\n\t%s\n",
38+
$fam, $key, $value, $i, $xdi->errormessage;
39+
};
40+
};
41+
};
42+
print $/;
43+
44+
45+
46+
my $i = $xdi->required;
47+
printf "# check for required metadata -- (requirement code %d):\n%s\n", $i, $xdi->errormessage;
48+
49+
$i = $xdi->recommended;
50+
printf "# check for recommended metadata -- (recommendation code %d):\n%s\n", $i, $xdi->errormessage;
51+
52+
53+
54+
printf "# Arrays Index, Name, Values: (%s points total):\n", $xdi->npts;
55+
$i = 0;
56+
foreach my $lab (@{$xdi->array_labels}) {
57+
my @x = $xdi->get_array($lab);
58+
printf "%d %9s: %s, %s, %s, %s, ... %s, %s\n", $i, $lab, @x[0..3], @x[-2,-1];
59+
++$i;
60+
};

‎perl/lib/Xray/XDI.pm‎

Lines changed: 57 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ has 'ok' => (is => 'rw', isa => 'Bool', traits => [qw(NoClone)],
2929
has 'warning' => (is => 'rw', isa => 'Bool', traits => [qw(NoClone)], default => 0);
3030
has 'errorcode' => (is => 'rw', isa => 'Int', traits => [qw(NoClone)], default => 0);
3131
has 'error' => (is => 'rw', isa => 'Str', traits => [qw(NoClone)], default => q{});
32+
has 'errormessage' => (is => 'rw', isa => 'Str', traits => [qw(NoClone)], default => q{});
3233

3334
has 'filename' => (is => 'rw', isa => 'Str', traits => [qw(NoClone)], default => q{});
3435
has 'xdi_libversion' => (is => 'rw', isa => 'Str', traits => [qw(Clone)], default => q{});
@@ -81,55 +82,64 @@ sub DEMOLISH {
8182

8283
sub _build_object {
8384
my ($self) = @_;
84-
$self->error(q{});
85+
$self->errormessage(q{});
8586
$self->ok(1);
8687
$self->warning(0);
88+
if (not $self->file) {
89+
$self->errorcode(1);
90+
$self->errormessage('No file specified');
91+
$self->ok(0);
92+
return undef;
93+
};
8794
if (not -e $self->file) {
8895
$self->errorcode(1);
89-
$self->error('The file '.$self->file.' does not exist as XDI');
96+
$self->errormessage('The file '.$self->file.' does not exist');
9097
$self->ok(0);
9198
return undef;
9299
};
93100
if (not -r $self->file) {
94101
$self->errorcode(1);
95-
$self->error('The file '.$self->file.' cannot be read as XDI');
102+
$self->errormessage('The file '.$self->file.' cannot be read');
96103
$self->ok(0);
97104
return undef;
98105
};
99106
if (-d $self->file) {
100107
$self->errorcode(1);
101-
$self->error($self->file.' is a folder (i.e. not an XDI file)');
108+
$self->errormessage($self->file.' is a folder (i.e. not an XDI file)');
102109
$self->ok(0);
103110
return undef;
104111
};
105112
my $errcode = 0;
106113
my $obj = Xray::XDIFile->new($self->file, $errcode);
107114
$self->errorcode($errcode);
115+
$self->errormessage($obj->_error_message);
116+
117+
return $obj if ($errcode < 0);
108118

109119
#print $self->file, $/;
110120
#$self->trace;
111121
#print '>>>>>', $errcode, $/;
112122

113123
##### see xdifile.h for error codes
114124
##### see xdifile.c (line 23 and following) for error messages
115-
if ($errcode < 0) {
116-
my @errors = ();
117-
foreach my $i (0 .. 10) {
118-
push @errors, $obj->_errorstring(-1*2**$i) if (abs($errcode) & 2**$i);
119-
};
120-
$self->error(join(", ", @errors));
121-
$self->ok(0);
122-
return $obj;
123-
};
124-
if ($errcode > 0) {
125-
my @errors = ();
126-
foreach my $i (0 .. 4) {
127-
push @errors, $obj->_errorstring(2**$i) if ($errcode & 2**$i);
128-
};
129-
$self->error(join(", ", @errors));
130-
$self->ok(1);
131-
$self->warning(1);
132-
};
125+
# if ($errcode < 0) {
126+
# my @errors = ();
127+
# foreach my $i (0 .. 10) {
128+
# push @errors, $obj->_errorstring(-1*2**$i) if (abs($errcode) & 2**$i);
129+
# };
130+
# $self->error(join(", ", @errors));
131+
# $self->ok(0);
132+
# return $obj;
133+
# };
134+
# if ($errcode > 0) {
135+
# my @errors = ();
136+
# foreach my $i (0 .. 4) {
137+
# push @errors, $obj->_errorstring(2**$i) if ($errcode & 2**$i);
138+
# };
139+
# $self->error(join(", ", @errors));
140+
# $self->ok(1);
141+
# $self->warning(1);
142+
# };
133143

134144
if (not defined $obj->_filename) {
135145
$self->error('unknown problem reading '.$self->file.' as an XDI file');
@@ -290,6 +300,31 @@ sub token {
290300
return $self->xdifile->_token($tok);
291301
};
292302

303+
## methods for validation
304+
305+
sub required {
306+
my ($self) = @_;
307+
my $i = $self->xdifile->_required_metadata;
308+
$self->errorcode($i);
309+
$self->errormessage($self->xdifile->_error_message);
310+
return $i;
311+
};
312+
sub recommended {
313+
my ($self) = @_;
314+
my $i = $self->xdifile->_recommended_metadata;
315+
$self->errorcode($i);
316+
$self->errormessage($self->xdifile->_error_message);
317+
return $i;
318+
};
319+
320+
sub validate {
321+
my ($self, $family, $name, $value) = @_;
322+
my $i = $self->xdifile->_validate_item($family, $name, $value);
323+
$self->errorcode($i);
324+
$self->errormessage($self->xdifile->_error_message);
325+
return $i;
326+
};
327+
293328

294329
sub serialize {
295330
my ($self) = @_;

‎perl/lib/Xray/XDIFile.pm‎

Lines changed: 25 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -148,13 +148,31 @@ SV* new(char* class, char* file, SV* errcode) {
148148
return obj_ref;
149149
}
150150
151+
int _validate_item(SV* obj, char* family, char *name, char *value) {
152+
int ret;
153+
ret = XDI_validate_item((INT2PTR(XDIFile*, SvIV(SvRV(obj)))), family, name, value);
154+
return ret;
155+
}
156+
157+
int _required_metadata(SV* obj) {
158+
int ret;
159+
ret = XDI_required_metadata((INT2PTR(XDIFile*, SvIV(SvRV(obj)))));
160+
return ret;
161+
}
162+
163+
int _recommended_metadata(SV* obj) {
164+
int ret;
165+
ret = XDI_recommended_metadata((INT2PTR(XDIFile*, SvIV(SvRV(obj)))));
166+
return ret;
167+
}
168+
151169
void _cleanup(SV* obj, long err) {
152170
XDI_cleanup((INT2PTR(XDIFile*, SvIV(SvRV(obj)))), err);
153171
}
154172
155-
char* _errorstring(SV* obj, int code) {
156-
return XDI_errorstring(code);
157-
}
173+
/* char* _errorstring(SV* obj, int code) { */
174+
/* return XDI_errorstring(code); */
175+
/* } */
158176
159177
void _valid_edges(SV* obj) {
160178
long i;
@@ -242,6 +260,10 @@ char* _comments(SV* obj) {
242260
return (INT2PTR(XDIFile*, SvIV(SvRV(obj))))->comments;
243261
}
244262
263+
char* _error_message(SV* obj) {
264+
return (INT2PTR(XDIFile*, SvIV(SvRV(obj))))->error_message;
265+
}
266+
245267
long _nmetadata(SV* obj) {
246268
return (INT2PTR(XDIFile*, SvIV(SvRV(obj))))->nmetadata;
247269
}

‎perl/t/00_base.t‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ ok($xdifile->_extra_version =~ m{GSE}, 'extra_version');
4747

4848
ok(ucfirst($xdifile->_element) eq 'Co', 'element');
4949
ok(ucfirst($xdifile->_edge) eq 'K', 'edge');
50+
print $xdifile->_dspacing, $/;
5051
ok(abs($xdifile->_dspacing - 3.13555) < $epsi, 'dspacing');
5152
ok($xdifile->_comments =~ m{room temperature}, 'comments');
5253
ok($xdifile->_nmetadata == 19, 'nmetadata');

‎perl/t/03_nofile.t‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,9 +14,9 @@ BEGIN { use_ok('Xray::XDI') };
1414
my $here = dirname($0);
1515
my $file = File::Spec->catfile($here, '..', '..', 'data', 'co_metal_rt.xdiX');
1616
my $xdi = Xray::XDI->new(file=>$file);
17-
ok($xdi->error =~ m{does not exist}, 'file not exist');
17+
ok($xdi->errormessage =~ m{does not exist}, 'file not exist');
1818

1919
$file = File::Spec->catfile($here, '..', '..', 'data');
2020
$xdi = Xray::XDI->new(file=>$file);
21-
ok($xdi->error =~ m{is a folder}, 'is a folder');
21+
ok($xdi->errormessage =~ m{is a folder}, 'is a folder');
2222

‎perl/t/baddata/01_no_xdi_line.t‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,8 @@ my $xdi = Xray::XDI->new(file=>$file);
1919
#my $xdi = Xray::XDI->new;
2020
#$xdi->file($file);
2121

22-
ok((not $xdi->ok), 'bad_01.xdi flagged as failing to import');
23-
ok(($xdi->error =~ m{not an XDI}), 'correctly identified problem');
22+
ok(($xdi->errorcode<0), 'bad_01.xdi flagged as failing to import');
23+
ok(($xdi->errormessage =~ m{not an XDI}), 'correctly identified problem');
2424

2525
open(my $COV, '>', 'coverage.txt');
2626
print $COV 1, $/;

‎perl/t/baddata/02_no_edge.t‎

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -17,15 +17,17 @@ my $here = dirname($0);
1717
my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_02.xdi');
1818
my $xdi = Xray::XDI->new(file=>$file);
1919

20-
ok(($xdi->warning and $xdi->ok), 'bad_02.xdi flagged with a warning');
21-
ok(($xdi->error =~ m{no element\.edge}), 'correctly identified missing edge symbol');
20+
$xdi->required;
21+
ok(($xdi->errorcode>0), 'bad_02.xdi flagged with a warning');
22+
ok(($xdi->errormessage =~ m{Element.edge missing}), 'correctly identified missing edge symbol');
2223

2324

2425
$file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_04.xdi');
2526
$xdi = Xray::XDI->new(file=>$file);
2627

27-
ok(($xdi->warning and $xdi->ok), 'bad_04.xdi flagged with a warning');
28-
ok(($xdi->error =~ m{no element\.edge}), 'correctly identified invalid edge symbol');
28+
$xdi->required;
29+
ok(($xdi->errorcode>0), 'bad_04.xdi flagged with a warning');
30+
ok(($xdi->errormessage =~ m{Element.edge missing}), 'correctly identified invalid edge symbol');
2931

3032
open(my $COV, '>>', 'coverage.txt');
3133
print $COV 2, $/;

‎perl/t/baddata/03_no_symbol.t‎

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -17,14 +17,16 @@ my $here = dirname($0);
1717
my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_03.xdi');
1818
my $xdi = Xray::XDI->new(file=>$file);
1919

20-
ok(($xdi->warning and $xdi->ok), 'bad_03.xdi flagged with a warning');
21-
ok(($xdi->error =~ m{no element.symbol}), 'correctly identified missing element symbol');
20+
$xdi->required;
21+
ok(($xdi->errorcode>0), 'bad_03.xdi flagged with a warning');
22+
ok(($xdi->errormessage =~ m{Element.symbol missing}), 'correctly identified missing element symbol');
2223

2324
$file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_05.xdi');
2425
$xdi = Xray::XDI->new(file=>$file);
2526

26-
ok(($xdi->warning and $xdi->ok), 'bad_05.xdi flagged with a warning');
27-
ok(($xdi->error =~ m{no element.symbol}), 'correctly identified invalid element symbol');
27+
$xdi->required;
28+
ok(($xdi->errorcode>0), 'bad_05.xdi flagged with a warning');
29+
ok(($xdi->errormessage =~ m{Element.symbol missing}), 'correctly identified invalid element symbol');
2830

2931

3032
open(my $COV, '>>', 'coverage.txt');

‎perl/t/baddata/06_no_minus_signs.t‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,8 @@ my $here = dirname($0);
1717
my $file = File::Spec->catfile($here, '..', '..', '..', 'baddata', 'bad_06.xdi');
1818
my $xdi = Xray::XDI->new(file=>$file);
1919

20-
ok(($xdi->warning and $xdi->ok), 'bad_06.xdi flagged with warning');
21-
ok(($xdi->error =~ m{no line of minus signs}), 'correctly identified lack of minus signs ');
20+
ok(($xdi->errorcode>0), 'bad_06.xdi flagged with warning');
21+
ok(($xdi->errormessage =~ m{no line of minus signs}), 'correctly identified lack of minus signs ');
2222

2323

2424
open(my $COV, '>>', 'coverage.txt');

0 commit comments

Comments
 (0)