[Bio] / Sprout / AttributeTest.pl Repository:
ViewVC logotype

Annotation of /Sprout/AttributeTest.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     =head1 Attribute Test Script
4 :    
5 :     This method will run a short test of the attribute system. It will use a
6 :     dummy attribute called C<Frog> that will be created and deleted by this
7 :     test process.
8 :    
9 :     The currently-supported command-line options are as follows.
10 :    
11 :     =over 4
12 :    
13 :     =item user
14 :    
15 :     Name suffix to be used for log files. If omitted, the PID is used.
16 :    
17 :     =item trace
18 :    
19 :     Numeric trace level. A higher trace level causes more messages to appear. The
20 :     default trace level is 2. Tracing will be directly to the standard output
21 :     as well as to a C<trace>I<User>C<.log> file in the FIG temporary directory,
22 :     where I<User> is the value of the B<user> option above.
23 :    
24 :     =item sql
25 :    
26 :     If specified, turns on tracing of SQL activity.
27 :    
28 :     =item background
29 :    
30 :     Save the standard and error output to files. The files will be created
31 :     in the FIG temporary directory and will be named C<err>I<User>C<.log> and
32 :     C<out>I<User>C<.log>, respectively, where I<User> is the value of the
33 :     B<user> option above.
34 :    
35 :     =item h
36 :    
37 :     Display this command's parameters and options.
38 :    
39 :     =item phone
40 :    
41 :     Phone number to message when the script is complete.
42 :    
43 :     =back
44 :    
45 :     =cut
46 :    
47 :     use strict;
48 :     use Tracer;
49 :     use DocUtils;
50 :     use TestUtils;
51 :     use Cwd;
52 :     use File::Copy;
53 :     use File::Path;
54 :     use FIG;
55 :     use CustomAttributes;
56 :    
57 :     # Get the command-line options and parameters.
58 :     my ($options, @parameters) = StandardSetup([qw(CustomAttributes) ],
59 :     {
60 :     phone => ["", "phone number (international format) to call when load finishes"],
61 :     },
62 :     "",
63 :     @ARGV);
64 :     # Set a variable to contain return type information.
65 :     my $rtype;
66 :     # Insure we catch errors.
67 :     eval {
68 :     # Get a FIG object.
69 :     my $fig = FIG->new();
70 :     # Get the CustomAttributes object.
71 :     my $ca = $fig->{_ca};
72 :     # Insure the attribute server is local.
73 :     if (ref $ca ne 'CustomAttributes') {
74 :     Confess("This test must be run on a local attribute server.");
75 :     } else {
76 :     # Build a hash of the data we want to put into the attribute load file.
77 :     my %loadHash = (0 => "# This is a comment.",
78 :     'Family:aclame|cluster103' => ['egg', 'beaters'],
79 :     'Feature:fig|100226.1.peg.3361' => ['tadpole'],
80 :     'Genome:83333.1' => ['adult'],
81 :     1 => '',
82 :     'Subsystem:4-Hydroxyphenylacetic_acid_catabolic_pathway' => ['wiggle'],
83 :     'Role:1,4-alpha-glucan phosphorylase (EC 2.4.1.1)' => ['swim'],
84 :     'Genome:100226.1' => ['hip','hop']
85 :     );
86 :     # Create the load file.
87 :     my $loadFileName = "$FIG_Config::temp/FrogLoader$$.tbl";
88 :     Trace("Creating load file $loadFileName.") if T(2);
89 :     my $oh = Open(undef, ">$loadFileName");
90 :     # Loop through the hash of load values.
91 :     for my $key (keys %loadHash) {
92 :     my $value = $loadHash{$key};
93 :     # If the value is an array, we have an attribute value line.
94 :     if (ref $value eq 'ARRAY') {
95 :     # Format the ID.
96 :     $key =~ /([^:]+):(.+)/;
97 :     my $idValue = FIG::form_oid($1, $2);
98 :     # Format the value.
99 :     my $valueValue = join($ca->{splitter}, @{$value});
100 :     # Write the line.
101 :     Tracer::PutLine($oh, [$idValue, $valueValue]);
102 :     } else {
103 :     # Here we have a comment line.
104 :     Tracer::PutLine($oh, [$value]);
105 :     # Delete this line from the hash so we don't expect it when
106 :     # we test "get_attributes".
107 :     delete $loadHash{$key};
108 :     }
109 :     }
110 :     # Close the load file.
111 :     close $oh;
112 :     # Create the attribute.
113 :     my @groups = qw(Feature Genome);
114 :     Trace("Creating Frog attribute.") if T(2);
115 :     $ca->StoreAttributeKey('Frog', 'string',
116 :     "This attribute is a special one used to test the attribute system. It was created by the AttributeTest script.",
117 :     \@groups);
118 :     # Verify that it is in the correct groups.
119 :     my @allGroups = $ca->GetGroups();
120 :     for my $group (@allGroups) {
121 :     Trace("Checking group $group.") if T(3);
122 :     # Get the current group's attributes in a hash.
123 :     my %keys = $ca->GetAttributeData(group => $group);
124 :     # Find out if we should be in this group.
125 :     my $inGroup = grep { $_ eq $group } @groups;
126 :     if (! exists $keys{Frog} && $inGroup) {
127 :     Confess("Frog not found in $group group.");
128 :     } elsif (exists $keys{Frog} && ! $inGroup) {
129 :     Confess("Frog found in $group group.");
130 :     }
131 :     }
132 :     # Load the attribute.
133 :     Trace("Loading Frog data.") if T(3);
134 :     my $ih = Open(undef, "<$loadFileName");
135 :     my $stats = $ca->LoadAttributeKey('Frog', $ih, 0, 1);
136 :     # Now we need to test the data against what's in the hash. First we get the data.
137 :     my @attributes = $fig->get_attributes(undef, 'Frog');
138 :     # Loop through the attributes, checking against the hash. As we find an attribute,
139 :     # we delete it from the hash. When we're done, the hash should be empty.
140 :     for my $attributeRow (@attributes) {
141 :     # Get the ID from this row.
142 :     my @rowData = ();
143 :     push @rowData, @{$attributeRow};
144 :     my $idValue = shift @rowData;
145 :     # Parse it into an ID and type, then combine them to get the hash key.
146 :     my ($type, $id) = FIG::parse_oid($idValue);
147 :     my $hashKey = "$type:$id";
148 :     # Check the hash.
149 :     if (! exists $loadHash{$hashKey}) {
150 :     Confess("Object $type($id) not found in load hash.");
151 :     } else {
152 :     # Insure this is a Frog attribute.
153 :     my $key = shift @rowData;
154 :     if ($key ne 'Frog') {
155 :     Confess("Attribute key is $key, but it should be Frog.");
156 :     } else {
157 :     # Get the values for this key.
158 :     my $valueList = $loadHash{$hashKey};
159 :     my @valueData = ();
160 :     push @valueData, @{$valueList};
161 :     # Compare them against the actual values.
162 :     if (length(@valueData) != length(@rowData)) {
163 :     Confess("Row for $hashKey does not match length of row retrieved from get_attributes.");
164 :     } else {
165 :     for (my $i = 0; $i <= $#valueData; $i++) {
166 :     if ($rowData[$i] ne $valueData[$i]) {
167 :     Confess("Value at position $i in row for $hashKey has mismatched data.");
168 :     }
169 :     }
170 :     # Remove this key from the hash.
171 :     Trace("$hashKey processed in retrieval check.") if T(3);
172 :     delete $loadHash{$hashKey};
173 :     }
174 :     }
175 :     }
176 :     }
177 :     # Verify that the load hash is empty.
178 :     if (scalar(keys %loadHash)) {
179 :     my @keys = sort keys %loadHash;
180 :     Trace("Attribute object IDs not found: " . join(" ", @keys)) if T(0);
181 :     Confess("Not all expected attribute values were found.");
182 :     } else {
183 :     # Now we do an insert and a delete.
184 :     Trace("Insert/delete test.") if T(2);
185 :     # Create an attribute row.
186 :     my @testArray = ('Reaction:R00001', 'Frog', 'simplicity');
187 :     # Insert it into the database.
188 :     $fig->add_attribute(@testArray);
189 :     # Verify that it's there.
190 :     my @tuple = $fig->get_attributes(@testArray);
191 :     if (! @tuple) {
192 :     Confess("Insert failed.");
193 :     } else {
194 :     # Delete it.
195 :     $fig->delete_attribute(@testArray);
196 :     # Verify that it's gone.
197 :     my @nonTuple = $fig->get_attributes(@testArray);
198 :     if (@nonTuple) {
199 :     Confess("Delete failed.");
200 :     } else {
201 :     # Delete the key.
202 :     $ca->DeleteAttributeKey('Frog');
203 :     # Verify that it has no values.
204 :     my @values = $fig->get_attributes(undef, 'Frog');
205 :     if (@values) {
206 :     Confess("Not all Frog attributes were deleted.");
207 :     } else {
208 :     # Insure there is no Frog attribute.
209 :     my %keys = $ca->GetAttributeData(name => 'Frog');
210 :     if (exists $keys{Frog}) {
211 :     Confess("Frog attribute was not deleted.");
212 :     }
213 :     }
214 :     }
215 :     }
216 :     }
217 :    
218 :     }
219 :     Trace("Test complete.") if T(2);
220 :     };
221 :    
222 :     if ($@) {
223 :     Trace("Script failed with error: $@") if T(0);
224 :     $rtype = "error";
225 :     } else {
226 :     Trace("Script complete.") if T(2);
227 :     $rtype = "no error";
228 :     }
229 :     if ($options->{phone}) {
230 :     my $msgID = Tracer::SendSMS($options->{phone}, "Attribute Test Script terminated with $rtype.");
231 :     if ($msgID) {
232 :     Trace("Phone message sent with ID $msgID.") if T(2);
233 :     } else {
234 :     Trace("Phone message not sent.") if T(2);
235 :     }
236 :     }
237 :    
238 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3