[Bio] / FigKernelScripts / EmergencySubsystemFix.pl Repository:
ViewVC logotype

Annotation of /FigKernelScripts/EmergencySubsystemFix.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 Emergency Subsystem Fix
4 :    
5 :     This script will look for empty subsystem roles and examine the Sapling
6 :     to determine the role's correct name.
7 :    
8 :     It is designed to fix a problem created by a bad input file for the
9 :     role-change script.
10 :    
11 :     The single positional parameter is the name of the subsystem directory.
12 :    
13 :     =cut
14 :    
15 :     use strict;
16 :     use Sapling;
17 :     use FIG_Config;
18 :     use Tracer;
19 :     use File::Copy;
20 :    
21 :     my ($options, @parameters) = StandardSetup([], {
22 :     dbname => [$FIG_Config::saplingDB, "name of the Sapling database to use"],
23 :     dbhost => ["", "host containing the Sapling database"],
24 :     dbport => ["", "port for connecting to the Sapling database"],
25 :     trace => ["3-", "tracing level"],
26 :     }, "<subsysDirectory>",
27 :     @ARGV);
28 :     # Get the Sapling database.
29 :     my $sap = Sapling->new(dbName => $options->{dbname}, dbhost => $options->{dbhost},
30 :     port => $options->{dbport});
31 :     # Get the subsystem directory.
32 :     my $subsysDir = $parameters[0];
33 :     # Insure it exists.
34 :     if (! -d $subsysDir) {
35 :     die "Subsystem directory $subsysDir not found.";
36 :     } else {
37 :     # Get all the subsystems.
38 :     my @subs = grep { -d "$subsysDir/$_" } OpenDir($subsysDir, 1);
39 :     Trace(scalar(@subs) . " subsystem directories found in $subsysDir.") if T(2);
40 :     # This will be a list of the updated subsystems.
41 :     my @updated;
42 :     # Loop through them.
43 :     for my $sub (@subs) {
44 :     Trace("Processing $sub.") if T(3);
45 :     # Compute the subsystem's Sapling ID.
46 :     my $subID = $sap->SubsystemID($sub);
47 :     # We'll fill this hash with a map of abbreviations to true roles.
48 :     my %roles;
49 :     # We'll put the original list of abbreviations in here.
50 :     my @abbrList;
51 :     # Finally, this will be set to the number of fixes that need to
52 :     # be made.
53 :     my $fixCount;
54 :     # Now we want to loop through the roles in the spreadsheet.
55 :     if (open my $ih, "<$subsysDir/$sub/spreadsheet") {
56 :     my ($abbr, $role) = Tracer::GetLine($ih);
57 :     while ($abbr && $abbr ne '//') {
58 :     # Add this abbreviation to the list.
59 :     push @abbrList, $abbr;
60 :     # Is this a good role?
61 :     if ($role) {
62 :     # Yes, store it in the hash.
63 :     $roles{$abbr} = $role;
64 :     } else {
65 :     # Here we have a bad role. Look for it in the Sapling.
66 :     my ($realRole) = $sap->GetFlat("Includes",
67 :     'Includes(from-link) = ? AND Includes(abbreviation) = ?',
68 :     [$subID,$abbr], 'to-link');
69 :     if ($realRole) {
70 :     # We found the new role. Mark it in the hash.
71 :     $roles{$abbr} = $realRole;
72 :     Trace("$abbr should be set to $realRole.") if T(3);
73 :     $fixCount++;
74 :     } else {
75 :     # No new role. It's really blank.
76 :     $roles{$abbr} = $role;
77 :     }
78 :     }
79 :     # Get the next role.
80 :     ($abbr, $role) = Tracer::GetLine($ih);
81 :     }
82 :     # Do we need to make a fix?
83 :     if ($fixCount) {
84 :     # Yes. Finish reading the spreadsheet file.
85 :     my @residual = ("//\n");
86 :     while (! eof $ih) {
87 :     my $line = <$ih>;
88 :     push @residual, $line;
89 :     }
90 :     # Close the spreadsheet and open a new one for output.
91 :     close $ih;
92 :     open my $oh, ">$subsysDir/$sub/spreadsheet.new";
93 :     # Loop through the abbreviations, printing the roles.
94 :     for $abbr (@abbrList) {
95 :     Tracer::PutLine($oh, [$abbr, $roles{$abbr}]);
96 :     }
97 :     # Output the rest of the spreadsheet.
98 :     for my $line (@residual) {
99 :     print $oh $line;
100 :     }
101 :     # Close the new file.
102 :     close $oh;
103 :     # Copy it over the old spreadsheet.
104 :     move("$subsysDir/$sub/spreadsheet.new",
105 :     "$subsysDir/$sub/spreadsheet");
106 :     # Save the subsystem name.
107 :     push @updated, $sub;
108 :     }
109 :     } else {
110 :     Trace("No spreadsheet found for $sub.") if T(1);
111 :     }
112 :     # All done. Index the updated subsystems.
113 :     Trace(scalar(@updated) . " subsystems updated.") if T(2);
114 :     my $indexCmd = join(" ", "index_subsystems", @updated);
115 :     Trace("Executing indexing command.") if T(2);
116 :     my @indexLines = `$indexCmd`;
117 :     for my $indexLine (@indexLines) {
118 :     chomp $indexLine;
119 :     Trace($indexLine) if T(3);
120 :     }
121 :     }
122 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3