1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
#!/usr/bin/perl -w
use strict;
use Xray::Xtal;
use Ifeffit;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
my $elem_regex = '([bcfhiknopsuvwy]|a[cglmrstu]|b[aehikr]|c[adeflmorsu]|dy|e[rsu]|f[emr]|g[ade]|h[aefgos]|i[nr]|kr|l[airu]|m[dgnot]|n[abdeiop]|os|p[abdmortu]|r[abefhnu]|s[bcegimnr]|t[abcehilm]|xe|yb|z[nr])';
my $num_regex = '-?(\d+\.?\d*|\.\d+)';
## if the display is messed up, comment the next line and uncomment
## the following line
my ($red, $green, $reset) = ("[31;1m", "[32;1m", "[33m[0m");
## my ($red, $green, $reset) = ("", "", "");
print "usage: testinp <file(s)>\n" unless @ARGV;
foreach my $a (@ARGV) {
## now test if this is an athena project file
my $is_proj = test_athena($a);
my $passfail = ($is_proj) ?
$green.'athena '.$reset :
$red.'not athena'.$reset;
printf "%s\n\t%s is_project=%s\n",
$a, $passfail, $is_proj;
## now test if this is an athena project file
my ($is_zipfile, $horae) = test_artemis($a);
$passfail = ($is_zipfile and $horae) ?
$green.'artemis '.$reset :
$red.'not artemis'.$reset;
printf "\t%s is_zipfile=%s horae=%s\n",
$passfail, $is_zipfile, $horae;
## test if this is a atoms.inp file
my ($space_test, $atoms_test) = test_atoms($a);
$passfail = ($atoms_test && $space_test) ?
$green.'atoms '.$reset : $red.'not atoms'.$reset;
printf "\t%s atoms_test=%d space_test=%s\n",
$passfail, $atoms_test, $space_test;
## now test if this is a feff.inp file
my ($abs_test, $scat_test) = test_feff($a);
$passfail = ($abs_test && $scat_test) ?
$green.'feff '.$reset : $red.'not feff'.$reset;
printf "\t%s abs_test =%s\n\t scat_test=%s\n",
$passfail, $abs_test, $scat_test;
## now test if this is a data file
my $col_string = ($is_zipfile) ? " " : test_data($a);
$passfail = ($col_string =~ /^(\s*|--undefined--)$/) ?
$red.'not data'.$reset :
$green.'data '.$reset ;
printf "\t%s col_string=%s\n",
$passfail, $col_string;
}
## an atoms.inp file is identified by having a valid space group
## symbol and by having an atoms list with at least one valid line of
## atoms
sub test_atoms {
my $a = $_[0];
open A, $a or die "could not open $a: $!";
my ($space_test, $atoms_test, $toss) = (0,0,0);
my $switch = 0;
A: while (<A>) {
next if /^\s*$/; # skip blanks
next if /^\s*[!\#%*]/; # skip comment lines
$switch = 1, next if (/^\s*ato/);
if ($switch) {
my @line = split(" ", $_);
($atoms_test=1), last A if ( (lc($line[0]) =~ /^$elem_regex$/) and
($line[1] =~ /^$num_regex$/) and
($line[2] =~ /^$num_regex$/) and
($line[3] =~ /^$num_regex$/));
} else {
my @line = split(" ", $_);
LINE: foreach my $word (@line) {
last LINE if (lc($word) eq 'title');
if (lc($word) =~ /space/) {
my $lline = lc($_);
my $space = substr($_, index($lline,"space")+6);
$space =~ s/^[\s=,]+//;
$space = substr($space, 0, 10); # next 10 characters
$space =~ s/[!\#%*].*$//; # trim off comments
($space_test, $toss) = Xray::Xtal::Cell::canonicalize_symbol($space);
};
};
};
};
close A;
return ($space_test, $atoms_test);
};
## a feff.inp file is identified by having a potentials list and at
## least two valid potentials line, the absorber and one other.
sub test_feff {
my $a = $_[0];
open A, $a or die "could not open $a: $!";
my $switch = 0;
my ($abs_test, $scat_test) = (0,0);
A: while (<A>) {
chomp;
next if /^\s*$/; # skip blanks
next if /^\s*[!\#%*]/; # skip comment lines
$switch = 1, next if (/^\s*pot/i);
if ($switch) {
last A if (/^\s*[a-zA-Z]/);
my @line = split(" ", $_);
($abs_test=$_), next A if (($line[0] =~ /^0$/) and
($line[1] =~ /^\d+$/) and
(lc($line[2]) =~ /^$elem_regex$/));
($scat_test=$_), next A if (($line[0] =~ /^\d+$/) and
($line[1] =~ /^\d+$/) and
(lc($line[2]) =~ /^$elem_regex$/));
};
}
close A;
return ($abs_test, $scat_test);
};
## a data file is data if ifeffit recognizes it as such and returns a
## column_label string
sub test_data {
my $a = $_[0];
ifeffit("read_data(file=$a, group=a)\n");
return Ifeffit::get_string('$column_label');
};
## an athena project file is so marked in the first line
sub test_athena {
my $file = $_[0];
open F, $file or die "could not open $file as a record\n";
my $first = <F>;
close F;
return ($first =~ /Athena (record|project) file/) ? $1 : 0;
};
## an artemis project file is a valid zip file with a file called
## HORAE in it.
sub test_artemis {
my $file = $_[0];
Archive::Zip::setErrorHandler( \&is_zip_error_handler );
my $zip = Archive::Zip->new();
my $is_zipstyle = ($zip->read($file) == AZ_OK);
my $horae = ($is_zipstyle) ? $zip->membersMatching( '^HORAE$' ) : 0;
undef $zip;
Archive::Zip::setErrorHandler( undef );
return ($is_zipstyle, $horae);
};
sub is_zip_error_handler { 1; };
|
