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

Diff of /Sprout/AttrDBRefresh.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13, Mon Mar 12 19:17:43 2007 UTC revision 1.14, Fri Apr 27 22:17:06 2007 UTC
# Line 106  Line 106 
106    
107  If specified, the name of an attribute key. The key's descriptive data will be displayed.  If specified, the name of an attribute key. The key's descriptive data will be displayed.
108    
109    =item mapSubkey
110    
111    Subkey mapping rule. Consists of a key name, followed by a substitution command enclosed in
112    slashes. For example, to remove the word C<ZINC> from the beginning of C<docking_results>
113    subkeys, you would code
114    
115        -mapSubkey=docking_results/^ZINC//
116    
117  =back  =back
118    
119  =cut  =cut
# Line 119  Line 127 
127  use File::Path;  use File::Path;
128  use CustomAttributes;  use CustomAttributes;
129  use ERDBLoad;  use ERDBLoad;
130    use Stats;
131  use FIG;  use FIG;
132  use CGI;  use CGI;
133    
# Line 138  Line 147 
147                                                trimSpaces => ["", "if specified, the name of a backup file, which will be processed to remove excess spaces"],                                                trimSpaces => ["", "if specified, the name of a backup file, which will be processed to remove excess spaces"],
148                                                appendLoad => ["", "if specified, no data will be erased before loading from the load file"],                                                appendLoad => ["", "if specified, no data will be erased before loading from the load file"],
149                                                showKeyDef => ["", "if specified, the name of a key whose descriptive data is to be displayed"],                                                showKeyDef => ["", "if specified, the name of a key whose descriptive data is to be displayed"],
150                                                  mapSubkey => ["", "instructions for fixing subkey values"],
151                                             },                                             },
152                                             "",                                             "",
153                                             @ARGV);                                             @ARGV);
# Line 150  Line 160 
160      # Insure we don't use the new attribute system for accessing the old attributes.      # Insure we don't use the new attribute system for accessing the old attributes.
161      $FIG_Config::attrOld = 1;      $FIG_Config::attrOld = 1;
162      # Get the FIG object.      # Get the FIG object.
163        Trace("Connecting to legacy attribute database via FIG object.") if T(2);
164      my $fig = FIG->new();      my $fig = FIG->new();
165      # Get the attribute database.      # Get the attribute database.
166      Trace("Connecting to attribute database.") if T(2);      Trace("Connecting to local attribute database.") if T(2);
167      my $ca = CustomAttributes->new();      my $ca = CustomAttributes->new();
168      # Process according to the options selected.      # Process according to the options selected.
169      if ($options->{backup}) {      if ($options->{backup}) {
# Line 372  Line 383 
383              WritePage($options->{compare}, 'Attribute System Comparison', \@lines);              WritePage($options->{compare}, 'Attribute System Comparison', \@lines);
384          }          }
385      }      }
386        if ($options->{mapSubkey}) {
387            # Parse out the main key.
388            my $mapSubkey = $options->{mapSubkey};
389            if ($mapSubkey =~ m#([^/]+)(/.+)#) {
390                my ($keyName, $pattern) = ($1, $2);
391                Trace("Processing subkey mapping for $keyName with pattern s$pattern.") if T(2);
392                # Create a statistics object.
393                my $results = Stats->new();
394                # Get all the subkey values.
395                my %subkeys = map { $_ => 1 } $ca->GetFlat(['HasValueFor'], "HasValueFor(from-link) = ?", [$keyName],
396                                                           'HasValueFor(subkey)');
397                my $totalSubkeys = scalar keys %subkeys;
398                Trace("$totalSubkeys subkeys found.") if T(2);
399                # Loop through them, doing updates where necessary.
400                for my $subKey (keys %subkeys) {
401                    # Count this subkey.
402                    my $subkeyCount = $results->Add(subkeys => 1);
403                    # Apply the substitution.
404                    my $newSubKey = $subKey;
405                    eval("\$newSubKey =~ s$pattern");
406                    # If the evaluation resulted in an error, stop immediately.
407                    if ($@) {
408                        Confess("Error in substitution pattern: $@");
409                    } elsif ($newSubKey ne $subKey) {
410                        # Here the substitution worked and it changed the key value.
411                        # We need to update the database.
412                        $results->Add(updates => 1);
413                        my $count = $ca->UpdateField('HasValueFor(subkey)', $subKey, $newSubKey,
414                                                     "HasValueFor(from-link) = ?", [$keyName]);
415                        $results->Add(rowsChanged => $count);
416                    }
417                    # Trace our progress.
418                    if ($subkeyCount % 100 == 0) {
419                        Trace("$subkeyCount of $totalSubkeys processed.") if T(3);
420                    }
421                }
422                # Display the statistics.
423                Trace("Statistics from mapSubkey update:\n" . $results->Show()) if T(2);
424            } else {
425                # Here the incoming parameter was in the wrong format. Mostly this means there
426                # was nothing before the slash or no slash was found.
427                Confess("Invalid substitution syntax in mapSubkey option.");
428            }
429        }
430      Trace("Processing complete.") if T(2);      Trace("Processing complete.") if T(2);
431  };  };
432  if ($@) {  if ($@) {

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3