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

Annotation of /Sprout/CustomAttributes.pm

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3