[Bio] / Sprout / CustomAttributes.pm Repository:
ViewVC logotype

Annotation of /Sprout/CustomAttributes.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package CustomAttributes;
4 :    
5 :     require Exporter;
6 :     use ERDB;
7 :     @ISA = qw(Exporter ERDB);
8 :     use strict;
9 :     use Tracer;
10 :     use FIG;
11 :     use ERDBLoad;
12 :    
13 :     =head1 Custom SEED Attribute Manager
14 :    
15 :     =head2 Introduction
16 :    
17 :     The Custom SEED Attributes Manager allows the user to upload and retrieve
18 :     custom data for SEED objects. It uses the B<ERDB> database system to
19 :     store the attributes, which are implemented as multi-valued fields
20 :     of ERDB entities.
21 :    
22 :     The full suite of ERDB retrieval capabilities is provided. In addition,
23 :     custom methods are provided specific to this application. To get all
24 :     the values of the attribute C<essential> in the B<Feature> entity, you
25 :     would code
26 :    
27 :     my @values = $attrDB->GetAttributes($fid, Feature => 'essential');
28 :    
29 : parrello 1.2 where I<$fid> contains the ID of the desired feature. Each attribute has
30 :     an alternate index to allow searching for attributes by value.
31 : parrello 1.1
32 :     New attributes are introduced by updating the database definition at
33 :     run-time. Attribute values are stored by uploading data from files.
34 :     A web interface is provided for both these activities.
35 :    
36 :     =head2 FIG_Config Parameters
37 :    
38 :     The following configuration parameters are used to manage custom attributes.
39 :    
40 :     =over 4
41 :    
42 :     =item attrDbms
43 :    
44 :     Type of database manager used: C<mysql> for MySQL or C<pg> for PostGres.
45 :    
46 :     =item attrDbName
47 :    
48 :     Name of the attribute database.
49 :    
50 :     =item attrHost
51 :    
52 :     Name of the host server for the database. If omitted, the current host
53 :     is used.
54 :    
55 :     =item attrUser
56 :    
57 :     User name for logging in to the database.
58 :    
59 :     =item attrPass
60 :    
61 :     Password for logging in to the database.
62 :    
63 :     =item attrPort
64 :    
65 :     TCP/IP port for accessing the database.
66 :    
67 :     =item attrSock
68 :    
69 :     Socket name used to access the database. If omitted, the default socket
70 :     will be used.
71 :    
72 :     =item attrDBD
73 :    
74 :     Fully-qualified file name for the database definition XML file. This file
75 :     functions as data to the attribute management process, so if the data is
76 :     moved, this file must go with it.
77 :    
78 :     =back
79 :    
80 :     =head2 Impliementation Note
81 :    
82 :     The L</Refresh> method reloads the entities in the database. If new
83 :     entity types are added, that method will need to be adjusted accordingly.
84 :    
85 :     =head2 Public Methods
86 :    
87 :     =head3 new
88 :    
89 :     C<< my $attrDB = CustomAttributes->new(); >>
90 :    
91 :     Construct a new CustomAttributes object. This object is only used to load
92 :     or access data. To add new attributes, use the static L</NewAttribute>
93 :     method.
94 :    
95 :     =cut
96 :    
97 :     sub new {
98 :     # Get the parameters.
99 :     my ($class) = @_;
100 :     # Connect to the database.
101 :     my $dbh = DBKernel->new($FIG_Config::attrDbms, $FIG_Config::attrDbName,
102 :     $FIG_Config::attrUser, $FIG_Config::attrPass,
103 :     $FIG_Config::attrPort, $FIG_Config::attrHost,
104 :     $FIG_Config::attrSock);
105 :     # Create the ERDB object.
106 :     my $xmlFileName = $FIG_Config::attrDBD;
107 :     my $retVal = ERDB::new($class, $dbh, $xmlFileName);
108 :     # Return the result.
109 :     return $retVal;
110 :     }
111 :    
112 :     =head3 GetAttributes
113 :    
114 :     C<< my @values = $attrDB->GetAttributes($id, $entityName => $attributeName); >>
115 :    
116 :     Return all the values of the specified attribute for the specified entity instance.
117 :     A list of vaues will be returned. If the entity instance does not exist or the
118 :     attribute has no values, an empty list will be returned. If the attribute name
119 :     does not exist, an SQL error will occur.
120 :    
121 :     A typical invocation would look like this:
122 :    
123 :     my @values = $sttrDB->GetAttributes($fid, Feature => 'essential');
124 :    
125 :     Here the user is asking for the values of the C<essential> attribute for the
126 :     B<Feature> with the specified ID. If the identified feature is not essential,
127 :     the list returned will be empty. If it is essential, then one or more values
128 :     will be returned that describe the essentiality.
129 :    
130 :     =over 4
131 :    
132 :     =item id
133 :    
134 :     ID of the desired entity instance. This identifies the specific object to
135 :     be interrogated for attribute values.
136 :    
137 :     =item entityName
138 :    
139 :     Name of the entity. This identifies the the type of the object to be
140 :     interrogated for attribute values.
141 :    
142 :     =item attributeName
143 :    
144 :     Name of the desired attribute.
145 :    
146 :     =item RETURN
147 :    
148 :     Returns zero or more strings, each representing a value of the named attribute
149 :     for the specified entity instance.
150 :    
151 :     =back
152 :    
153 :     =cut
154 :    
155 :     sub GetAttributes {
156 :     # Get the parameters.
157 :     my ($self, $id, $entityName, $attributeName) = @_;
158 :     # Get the data.
159 :     my @retVal = $self->GetEntityValues($entityName, $id, ["$entityName($attributeName)"]);
160 :     # Return the result.
161 :     return @retVal;
162 :     }
163 :    
164 :     =head3 StoreAttribute
165 :    
166 :     C<< my $attrDB = CustomAttributes::StoreAttribute($entityName, $attributeName, $type, $notes); >>
167 :    
168 :     Create or update an attribute for the database. This method will update the database definition
169 :     XML, but it will not create the table. It will connect to the database so that the caller
170 :     can upload the attribute values.
171 :    
172 :     =over 4
173 :    
174 :     =item entityName
175 :    
176 :     Name of the entity containing the attribute. The entity must exist.
177 :    
178 :     =item attributeName
179 :    
180 :     Name of the attribute. It must be a valid ERDB field name, consisting entirely of
181 :     letters, digits, and hyphens, with a letter at the beginning. If it does not
182 :     exist already, it will be created.
183 :    
184 :     =item type
185 :    
186 :     Data type of the attribute. This must be a valid ERDB data type name.
187 :    
188 :     =item notes
189 :    
190 :     Descriptive notes about the attribute. It is presumed to be raw text, not HTML.
191 :    
192 :     =item RETURN
193 :    
194 :     Returns a Custom Attribute Database object if successful. If unsuccessful, an
195 :     error will be thrown.
196 :    
197 :     =back
198 :    
199 :     =cut
200 :    
201 :     sub StoreAttribute {
202 :     # Get the parameters.
203 :     my ($entityName, $attributeName, $type, $notes) = @_;
204 :     # Get the data type hash.
205 :     my %types = ERDB::GetDataTypes();
206 :     # Validate the initial input values.
207 :     if (! ERDB::ValidateFieldName($attributeName)) {
208 :     Confess("Invalid attribute name \"$attributeName\" specified.");
209 :     } elsif (! $notes || length($notes) < 25) {
210 :     Confess("Missing or incomplete description for $attributeName.");
211 :     } elsif (! exists $types{$type}) {
212 :     Confess("Invalid data type \"$type\" for $attributeName.");
213 :     }
214 :     # Our next step is to read in the XML for the database defintion. We
215 :     # need to verify that the named entity exists.
216 :     my $metadata = ERDB::ReadMetaXML($FIG_Config::attrDBD);
217 :     my $entityHash = $metadata->{Entities};
218 :     if (! exists $entityHash->{$entityName}) {
219 :     Confess("Entity $entityName not found.");
220 :     } else {
221 : parrello 1.2 # Okay, we're ready to begin. Get the entity hash and the field hash.
222 :     my $entityData = $entityHash->{$entityName};
223 : parrello 1.1 my $fieldHash = ERDB::GetEntityFieldHash($metadata, $entityName);
224 :     # Compute the attribute's relation name.
225 :     my $relName = join("", $entityName, map { ucfirst $_ } split(/-/, $attributeName));
226 :     # Store the attribute's field data. Note the use of the "content" hash for
227 :     # the notes. This is how the XML writer knows Notes is a text tag instead of
228 :     # an attribute.
229 :     $fieldHash->{$attributeName} = { type => $type, relation => $relName,
230 :     Notes => { content => $notes } };
231 : parrello 1.2 # Insure we have an index for this attribute.
232 :     my $index = ERDB::FindIndexForEntity($metadata, $entityName, $attributeName);
233 :     if (! defined($index)) {
234 :     push @{$entityData->{Indexes}}, { IndexFields => [ { name => $attributeName, order => 'ascending' } ],
235 :     Notes => "Alternate index provided for access by $attributeName." };
236 :     }
237 : parrello 1.1 # Write the XML back out.
238 :     ERDB::WriteMetaXML($metadata, $FIG_Config::attrDBD);
239 :     }
240 :     # Open a database with the new XML.
241 :     my $retVal = CustomAttributes->new();
242 :     return $retVal;
243 :     }
244 :    
245 :     =head3 Refresh
246 :    
247 :     C<< $attrDB->Refresh(); >>
248 :    
249 :     Refresh the primary entity tables from the FIG data store. This method basically
250 :     drops and reloads the main tables of the custom attributes database.
251 :    
252 :     =cut
253 :    
254 :     sub Refresh {
255 :     # Get the parameters.
256 :     my ($self) = @_;
257 :     # Create load objects for the genomes and the features.
258 :     my $loadGenome = ERDBLoad->new($self, 'Genome', $FIG_Config::temp);
259 :     my $loadFeature = ERDBLoad->new($self, 'Feature', $FIG_Config::temp);
260 :     # Get a FIG object. We'll use this to create the data.
261 :     my $fig = FIG->new();
262 :     # Get the genome list.
263 :     my @genomes = $fig->genomes();
264 :     # Loop through the genomes.
265 :     for my $genomeID (@genomes) {
266 :     # Put this genome in the genome table.
267 :     $loadGenome->Put($genomeID);
268 :     Trace("Processing Genome $genomeID") if T(3);
269 :     # Put its features into the feature table. Note we have to use a hash to
270 :     # remove duplicates.
271 :     my %featureList = map { $_ => 1 } $fig->all_features($genomeID);
272 :     for my $fid (keys %featureList) {
273 :     $loadFeature->Put($fid);
274 :     }
275 :     }
276 :     # Get a variable for holding statistics objects.
277 :     my $stats;
278 :     # Finish the genome load.
279 :     Trace("Loading Genome relation.") if T(2);
280 :     $stats = $loadGenome->FinishAndLoad();
281 :     Trace("Genome table load statistics:\n" . $stats->Show()) if T(3);
282 :     # Finish the feature load.
283 :     Trace("Loading Feature relation.") if T(2);
284 :     $stats = $loadFeature->FinishAndLoad();
285 :     Trace("Feature table load statistics:\n" . $stats->Show()) if T(3);
286 :     }
287 :    
288 :     =head3 LoadAttribute
289 :    
290 :     C<< my $stats = $attrDB->LoadAttribute($entityName, $fieldName, $fh, $keyCol, $dataCol); >>
291 :    
292 :     Load the specified attribute from the specified file. The file should be a
293 :     tab-delimited file with internal tab and new-line characters escaped. This is
294 :     the typical TBL-style file used by most FIG applications. One of the columns
295 :     in the input file must contain the appropriate key value and the other the
296 :     corresponding attribute value.
297 :    
298 :     =over 4
299 :    
300 :     =item entityName
301 :    
302 :     Name of the entity containing the attribute.
303 :    
304 :     =item fieldName
305 :    
306 :     Name of the actual attribute.
307 :    
308 :     =item fh
309 :    
310 :     Open file handle for the input file.
311 :    
312 :     =item keyCol
313 :    
314 :     Index (0-based) of the column containing the key field. The key field should
315 :     contain the ID of an instance of the named entity.
316 :    
317 :     =item dataCol
318 :    
319 :     Index (0-based) of the column containing the data value field.
320 :    
321 :     =item RETURN
322 :    
323 :     Returns a statistics object for the load process.
324 :    
325 :     =back
326 :    
327 :     =cut
328 :    
329 :     sub LoadAttribute {
330 :     # Get the parameters.
331 :     my ($self, $entityName, $fieldName, $fh, $keyCol, $dataCol) = @_;
332 :     # Create the return variable.
333 :     my $retVal;
334 :     # Insure the entity exists.
335 :     my $found = grep { $_ eq $entityName } $self->GetEntityTypes();
336 :     if (! $found) {
337 :     Confess("Entity \"$entityName\" not found in database.");
338 :     } else {
339 :     # Get the field structure for the named entity.
340 :     my $fieldHash = $self->GetFieldTable($entityName);
341 :     # Verify that the attribute exists.
342 :     if (! exists $fieldHash->{$fieldName}) {
343 :     Confess("Attribute \"$fieldName\" does not exist in entity $entityName.");
344 :     } else {
345 :     # Create a loader for the specified attribute. We need the
346 :     # relation name first.
347 :     my $relName = $fieldHash->{$fieldName}->{relation};
348 :     my $loadAttribute = ERDBLoad->new($self, $relName, $FIG_Config::temp);
349 :     # Loop through the input file.
350 :     while (! eof $fh) {
351 :     # Get the next line of the file.
352 :     my @fields = Tracer::GetLine($fh);
353 :     $loadAttribute->Add("lineIn");
354 :     # Now we need to validate the line.
355 :     if ($#fields < $dataCol) {
356 :     $loadAttribute->Add("shortLine");
357 :     } elsif (! $self->Exists($entityName, $fields[$keyCol])) {
358 :     $loadAttribute->Add("badKey");
359 :     } else {
360 :     # It's valid,so send it to the loader.
361 :     $loadAttribute->Put($fields[$keyCol], $fields[$dataCol]);
362 :     $loadAttribute->Add("lineUsed");
363 :     }
364 :     }
365 :     # Finish the load.
366 :     $retVal = $loadAttribute->FinishAndLoad();
367 :     }
368 :     }
369 :     # Return the statistics.
370 :     return $retVal;
371 :     }
372 :    
373 :     =head3 DeleteAttribute
374 :    
375 :     C<< CustomAttributes::DeleteAttribute($entityName, $attributeName); >>
376 :    
377 :     Delete an attribute from the custom attributes database.
378 :    
379 :     =over 4
380 :    
381 :     =item entityName
382 :    
383 :     Name of the entity possessing the attribute.
384 :    
385 :     =item attributeName
386 :    
387 :     Name of the attribute to delete.
388 :    
389 :     =back
390 :    
391 :     =cut
392 :    
393 :     sub DeleteAttribute {
394 :     # Get the parameters.
395 :     my ($entityName, $attributeName) = @_;
396 :     # Read in the XML for the database defintion. We need to verify that
397 :     # the named entity exists and it has the named attribute.
398 :     my $metadata = ERDB::ReadMetaXML($FIG_Config::attrDBD);
399 :     my $entityHash = $metadata->{Entities};
400 :     if (! exists $entityHash->{$entityName}) {
401 :     Confess("Entity \"$entityName\" not found.");
402 :     } else {
403 :     # Get the field hash.
404 :     my $fieldHash = ERDB::GetEntityFieldHash($metadata, $entityName);
405 :     if (! exists $fieldHash->{$attributeName}) {
406 :     Confess("Attribute \"$attributeName\" not found in entity $entityName.");
407 :     } else {
408 :     # Get the attribute's relation name.
409 :     my $relName = $fieldHash->{$attributeName}->{relation};
410 : parrello 1.2 # Check for an index.
411 :     my $indexIdx = ERDB::FindIndexForEntity($metadata, $entityName, $attributeName);
412 :     if (defined($indexIdx)) {
413 :     Trace("Index for $attributeName found at position $indexIdx for $entityName.") if T(3);
414 :     delete $entityHash->{$entityName}->{Indexes}->[$indexIdx];
415 :     }
416 : parrello 1.1 # Delete the attribute from the field hash.
417 :     Trace("Deleting attribute $attributeName from $entityName.") if T(3);
418 :     delete $fieldHash->{$attributeName};
419 :     # Write the XML back out.
420 :     ERDB::WriteMetaXML($metadata, $FIG_Config::attrDBD);
421 :     # Insure the relation does not exist in the database. This requires connecting
422 :     # since we may have to do a table drop.
423 :     my $attrDB = CustomAttributes->new();
424 : parrello 1.2 Trace("Dropping table $relName.") if T(3);
425 : parrello 1.1 $attrDB->DropRelation($relName);
426 :     }
427 :     }
428 :     }
429 :    
430 :     =head3 ControlForm
431 :    
432 :     C<< my $formHtml = $attrDB->ControlForm($cgi, $name); >>
433 :    
434 :     Return a form that can be used to control the creation and modification of
435 :     attributes.
436 :    
437 :     =over 4
438 :    
439 :     =item cgi
440 :    
441 :     CGI query object used to create HTML.
442 :    
443 :     =item name
444 :    
445 :     Name to give to the form. This should be unique for the web page.
446 :    
447 :     =item RETURN
448 :    
449 :     Returns the HTML for a form that submits instructions to the C<Attributes.cgi> script
450 :     for loading, creating, or deleting an attribute.
451 :    
452 :     =back
453 :    
454 :     =cut
455 :    
456 :     sub ControlForm {
457 :     # Get the parameters.
458 :     my ($self, $cgi, $name) = @_;
459 :     # Declare the return list.
460 :     my @retVal = ();
461 :     # Start the form. We use multipart to support the upload control.
462 :     push @retVal, $cgi->start_multipart_form(-name => $name);
463 :     # We'll put the controls in a table. Nothing else ever seems to look nice.
464 :     push @retVal, $cgi->start_table({ border => 2, cellpadding => 2 });
465 :     # The first row is for selecting the field name.
466 :     push @retVal, $cgi->Tr($cgi->th("Select a Field"),
467 :     $cgi->td($self->FieldMenu($cgi, 10, 'fieldName', 1,
468 :     "document.$name.notes.value",
469 :     "document.$name.dataType.value")));
470 :     # Now we set up a dropdown for the data types. The values will be the
471 :     # data type names, and the labels will be the descriptions.
472 :     my %types = ERDB::GetDataTypes();
473 :     my %labelMap = map { $_ => $types{$_}->{notes} } keys %types;
474 :     my $typeMenu = $cgi->popup_menu(-name => 'dataType',
475 :     -values => [sort keys %types],
476 :     -labels => \%labelMap);
477 :     push @retVal, $cgi->Tr($cgi->th("Data type"),
478 :     $cgi->td($typeMenu));
479 :     # The next row is for the notes.
480 :     push @retVal, $cgi->Tr($cgi->th("Description"),
481 :     $cgi->td($cgi->textarea(-name => 'notes',
482 :     -rows => 6,
483 :     -columns => 80))
484 :     );
485 :     # Allow the user to specify a new field name. This is required if the
486 :     # user has selected one of the "(new)" markers.
487 :     push @retVal, $cgi->Tr($cgi->th("New Field Name"),
488 :     $cgi->td($cgi->textfield(-name => 'newName',
489 :     -size => 30)),
490 :     );
491 :     # If the user wants to upload new values for the field, then we have
492 :     # an upload file name and column indicators.
493 :     push @retVal, $cgi->Tr($cgi->th("Upload Values"),
494 :     $cgi->td($cgi->filefield(-name => 'newValueFile',
495 :     -size => 20) .
496 :     " Key&nbsp;" .
497 :     $cgi->textfield(-name => 'keyCol',
498 :     -size => 3,
499 :     -default => 0) .
500 :     " Value&nbsp;" .
501 :     $cgi->textfield(-name => 'valueCol',
502 :     -size => 3,
503 :     -default => 1)
504 :     ),
505 :     );
506 :     # Now the two buttons: UPDATE and DELETE.
507 :     push @retVal, $cgi->Tr($cgi->th("&nbsp;"),
508 :     $cgi->td({align => 'center'},
509 :     $cgi->submit(-name => 'Delete', -value => 'DELETE') . " " .
510 :     $cgi->submit(-name => 'Store', -value => 'STORE')
511 :     )
512 :     );
513 :     # Close the table and the form.
514 :     push @retVal, $cgi->end_table();
515 :     push @retVal, $cgi->end_form();
516 :     # Return the assembled HTML.
517 :     return join("\n", @retVal, "");
518 :     }
519 :    
520 :     =head3 FieldMenu
521 :    
522 :     C<< my $menuHtml = $attrDB->FieldMenu($cgi, $height, $name, $newFlag, $noteControl, $typeControl); >>
523 :    
524 :     Return the HTML for a menu to select an attribute field. The menu will
525 :     be a standard SELECT/OPTION thing which is called "popup menu" in the
526 :     CGI package, but actually looks like a list. The list will contain
527 :     one selectable row per field, grouped by entity.
528 :    
529 :     =over 4
530 :    
531 :     =item cgi
532 :    
533 :     CGI query object used to generate HTML.
534 :    
535 :     =item height
536 :    
537 :     Number of lines to display in the list.
538 :    
539 :     =item name
540 :    
541 :     Name to give to the menu. This is the name under which the value will
542 :     appear when the form is submitted.
543 :    
544 :     =item newFlag (optional)
545 :    
546 :     If TRUE, then extra rows will be provided to allow the user to select
547 :     a new attribute. In other words, the user can select an existing
548 :     attribute, or can choose a C<(new)> marker to indicate a field to
549 :     be created in the parent entity.
550 :    
551 :     =item noteControl (optional)
552 :    
553 :     If specified, the name of a variable for displaying the notes attached
554 :     to the field. This must be in Javascript form ready for assignment.
555 :     So, for example, if you have a variable called C<notes> that
556 :     represents a paragraph element, you should code C<notes.innerHTML>.
557 :     If it actually represents a form field you should code C<notes.value>.
558 :     If an C<innerHTML> coding is used, the text will be HTML-escaped before
559 :     it is copied in. Specifying this parameter generates Javascript for
560 :     displaying the field description when a field is selected.
561 :    
562 :     =item typeControl (optional)
563 :    
564 :     If specified, the name of a variable for displaying the field's
565 :     data type. Data types are a much more controlled vocabulary than
566 :     notes, so there is no worry about HTML translation. Instead, the
567 :     raw value is put into the specified variable. Otherwise, the same
568 :     rules apply to this value that apply to I<$noteControl>.
569 :    
570 :     =item RETURN
571 :    
572 :     Returns the HTML to create a form field that can be used to select an
573 :     attribute from the custom attributes system.
574 :    
575 :     =back
576 :    
577 :     =cut
578 :    
579 :     sub FieldMenu {
580 :     # Get the parameters.
581 :     my ($self, $cgi, $height, $name, $newFlag, $noteControl, $typeControl) = @_;
582 :     # These next two hashes make everything happen. "entities"
583 :     # maps each entity name to the list of values to be put into its
584 :     # option group. "labels" maps each entity name to a map from values
585 :     # to labels.
586 :     my @entityNames = sort ($self->GetEntityTypes());
587 :     my %entities = map { $_ => [] } @entityNames;
588 :     my %labels = map { $_ => { }} @entityNames;
589 :     # Loop through the entities, adding the existing attributes.
590 :     for my $entity (@entityNames) {
591 :     # Get this entity's field table.
592 :     my $fieldHash = $self->GetFieldTable($entity);
593 :     # Get its field list in our local hashes.
594 :     my $fieldList = $entities{$entity};
595 :     my $labelList = $labels{$entity};
596 :     # Add the NEW fields if we want them.
597 :     if ($newFlag) {
598 :     push @{$fieldList}, $entity;
599 :     $labelList->{$entity} = "(new)";
600 :     }
601 :     # Loop through the fields in the hash. We only keep the ones with a
602 :     # secondary relation name. (In other words, the name of the relation
603 :     # in which the field appears cannot be the same as the entity name.)
604 :     for my $fieldName (sort keys %{$fieldHash}) {
605 :     if ($fieldHash->{$fieldName}->{relation} ne $entity) {
606 :     my $value = "$entity/$fieldName";
607 :     push @{$fieldList}, $value;
608 :     $labelList->{$value} = $fieldName;
609 :     }
610 :     }
611 :     }
612 :     # Now we have a hash and a list for each entity, and they correspond
613 :     # exactly to what the $cgi->optgroup function expects.
614 :     # The last step is to create the name for the onChange function. This function
615 :     # may not do anything, but we need to know the name to generate the HTML
616 :     # for the menu.
617 :     my $changeName = "${name}_setNotes";
618 :     my $retVal = $cgi->popup_menu({name => $name,
619 :     size => $height,
620 :     onChange => "$changeName(this.value)",
621 :     values => [map { $cgi->optgroup(-name => $_,
622 :     -values => $entities{$_},
623 :     -labels => $labels{$_})
624 :     } @entityNames]}
625 :     );
626 :     # Create the change function.
627 :     $retVal .= "\n<script language=\"javascript\">\n";
628 :     $retVal .= " function $changeName(fieldValue) {\n";
629 :     # The function only has a body if we have a notes control to store the description.
630 :     if ($noteControl || $typeControl) {
631 :     # Check to see if we're storing HTML or text into the note control.
632 :     my $htmlMode = ($noteControl && $noteControl =~ /innerHTML$/);
633 :     # We use a CASE statement based on the newly-selected field value. The
634 :     # field description will be stored in the JavaScript variable "myText"
635 :     # and the data type in "myType". Note the default data type is a normal
636 :     # string, but the default notes is an empty string.
637 :     $retVal .= " var myText = \"\";\n";
638 :     $retVal .= " var myType = \"string\";\n";
639 :     $retVal .= " switch (fieldValue) {\n";
640 :     # Loop through the entities.
641 :     for my $entity (@entityNames) {
642 :     # Get the entity's field hash. This has the notes in it.
643 :     my $fieldHash = $self->GetFieldTable($entity);
644 :     # Loop through the values we might see for this entity's fields.
645 :     my $fields = $entities{$entity};
646 :     for my $value (@{$fields}) {
647 :     # Only proceed if we have an existing field.
648 :     if ($value =~ m!/(.+)$!) {
649 :     # Get the field's hash element.
650 :     my $element = $fieldHash->{$1};
651 :     # Generate this case.
652 :     $retVal .= " case \"$value\" :\n";
653 :     # Here we either want to update the note display, the
654 :     # type display, or both.
655 :     if ($noteControl) {
656 :     # Here we want the notes updated.
657 :     my $notes = $element->{Notes}->{content};
658 :     # Insure it's in the proper form.
659 :     if ($htmlMode) {
660 :     $notes = ERDB::HTMLNote($notes);
661 :     }
662 :     # Escape it for use as a string literal.
663 :     $notes =~ s/\n/\\n/g;
664 :     $notes =~ s/"/\\"/g;
665 :     $retVal .= " myText = \"$notes\";\n";
666 :     }
667 :     if ($typeControl) {
668 :     # Here we want the type updated.
669 :     my $type = $element->{type};
670 :     $retVal .= " myType = \"$type\";\n";
671 :     }
672 :     # Close this case.
673 :     $retVal .= " break;\n";
674 :     }
675 :     }
676 :     }
677 :     # Close the CASE statement and make the appropriate assignments.
678 :     $retVal .= " }\n";
679 :     if ($noteControl) {
680 :     $retVal .= " $noteControl = myText;\n";
681 :     }
682 :     if ($typeControl) {
683 :     $retVal .= " $typeControl = myType;\n";
684 :     }
685 :     }
686 :     # Terminate the change function.
687 :     $retVal .= " }\n";
688 :     $retVal .= "</script>\n";
689 :     # Return the result.
690 :     return $retVal;
691 :     }
692 :    
693 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3