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

View of /FigKernelScripts/EmergencySubsystemFix.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (as text) (annotate)
Tue Aug 9 20:51:30 2011 UTC (8 years, 3 months ago) by parrello
Branch: MAIN
CVS Tags: rast_rel_2014_0912, rast_rel_2014_0729, mgrast_release_3_1_2, rast_rel_2011_0928, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_10262011, HEAD
Changes since 1.1: +4 -2 lines
Bug fix in index_subsystems call.

#!/usr/bin/perl -w

=head1 Emergency Subsystem Fix

This script will look for empty subsystem roles and examine the Sapling
to determine the role's correct name.

It is designed to fix a problem created by a bad input file for the
role-change script.

The single positional parameter is the name of the subsystem directory.

=cut

    use strict;
    use Sapling;
    use FIG_Config;
    use Tracer;
    use File::Copy;

my ($options, @parameters) = StandardSetup([], {
                                                dbname => [$FIG_Config::saplingDB, "name of the Sapling database to use"],
                                                dbhost => ["", "host containing the Sapling database"],
                                                dbport => ["", "port for connecting to the Sapling database"],
                                                trace => ["3-", "tracing level"],
                                               }, "<subsysDirectory>",
                                       @ARGV);
# Get the Sapling database.
my $sap = Sapling->new(dbName => $options->{dbname}, dbhost => $options->{dbhost},
                       port => $options->{dbport});
# Get the subsystem directory.
my $subsysDir = $parameters[0];
# Insure it exists.
if (! -d $subsysDir) {
    die "Subsystem directory $subsysDir not found.";
} else {
    # Get all the subsystems.
    my @subs = grep { -d "$subsysDir/$_" } OpenDir($subsysDir, 1);
    Trace(scalar(@subs) . " subsystem directories found in $subsysDir.") if T(2);
    # This will be a list of the updated subsystems.
    my @updated;
    # Loop through them.
    for my $sub (@subs) {
        Trace("Processing $sub.") if T(3);
        # Compute the subsystem's Sapling ID.
        my $subID = $sap->SubsystemID($sub);
        # We'll fill this hash with a map of abbreviations to true roles.
        my %roles;
        # We'll put the original list of abbreviations in here.
        my @abbrList;
        # Finally, this will be set to the number of fixes that need to
        # be made.
        my $fixCount;
        # Now we want to loop through the roles in the spreadsheet.
        if (open my $ih, "<$subsysDir/$sub/spreadsheet") {
            my ($abbr, $role) = Tracer::GetLine($ih);
            while ($abbr && $abbr ne '//') {
                # Add this abbreviation to the list.
                push @abbrList, $abbr;
                # Is this a good role?
                if ($role) {
                    # Yes, store it in the hash.
                    $roles{$abbr} = $role;
                } else {
                    # Here we have a bad role. Look for it in the Sapling.
                    my ($realRole) = $sap->GetFlat("Includes", 
                        'Includes(from-link) = ? AND Includes(abbreviation) = ?', 
                        [$subID,$abbr], 'to-link');
                    if ($realRole) {
                        # We found the new role. Mark it in the hash.
                        $roles{$abbr} = $realRole;
                        Trace("$abbr should be set to $realRole.") if T(3);
                        $fixCount++;
                    } else {
                        # No new role. It's really blank.
                        $roles{$abbr} = $role;
                    }
                }
                # Get the next role.
                ($abbr, $role) = Tracer::GetLine($ih);
            }
            # Do we need to make a fix?
            if ($fixCount) {
                # Yes. Finish reading the spreadsheet file.
                my @residual = ("//\n");
                while (! eof $ih) {
                    my $line = <$ih>;
                    push @residual, $line;
                }
                # Close the spreadsheet and open a new one for output.
                close $ih;
                open my $oh, ">$subsysDir/$sub/spreadsheet.new";
                # Loop through the abbreviations, printing the roles.
                for $abbr (@abbrList) {
                    Tracer::PutLine($oh, [$abbr, $roles{$abbr}]);
                }
                # Output the rest of the spreadsheet.
                for my $line (@residual) {
                    print $oh $line;
                }
                # Close the new file.
                close $oh;
                # Copy it over the old spreadsheet.
                move("$subsysDir/$sub/spreadsheet.new",
                     "$subsysDir/$sub/spreadsheet");
                # Save the subsystem name.
                push @updated, $sub;
            }
        } else {
            Trace("No spreadsheet found for $sub.") if T(1);
        }
    }
    # All done. Index the updated subsystems.
    Trace(scalar(@updated) . " subsystems updated.") if T(2);
    if (@updated) {
        my $indexCmd = join(" ", "index_subsystems", @updated);
        Trace("Executing indexing command.") if T(2);
        my @indexLines = `$indexCmd`;
        for my $indexLine (@indexLines) {
            chomp $indexLine;
            Trace($indexLine) if T(3);
        }
    }
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3