[Bio] / FigKernelPackages / Subsystem.pm Repository:
ViewVC logotype

View of /FigKernelPackages/Subsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.39 - (download) (as text) (annotate)
Sat Oct 16 20:42:28 2004 UTC (15 years, 5 months ago) by overbeek
Branch: MAIN
Changes since 1.38: +5 -2 lines
fixes to generalize chromosomal_clusters.cgi for UniProt

package Subsystem;

use Carp;
use FIG;

use FIGAttributes;
use base 'FIGAttributes';

use POSIX;
use DirHandle;
use Data::Dumper;
use File::Copy;
use File::Spec;
use IPC::Open2;

use strict;

=pod

=head1 Subsystem manipulation.

Any manipulation of subsystem data should happen through this interface.
This allows us to assure ourselves that the relational tables that 
mirror and index the subsystem data are kept up to date with the 
canonical version of the subsystem information in the flat-files
kept in $FIG_Config::data/Subsystems.

=head2 Objects.

We define the following perl objects:

Subsystem: represents a subsystem. It can be read from disk and
written to disk, and manipulated via its methods when in memory.

If we were completely on the OO side of the world, we would also
define the following set of objects. However, we are not, so they are
only objects in a conceptual sense. They are implemented using the
basic perl datatypes. 

Role: represents a single role. A role has a name and an abbreviation.

RoleSubset: represents a subset of available roles. A subset has a
name and a list of role names that comprise the subset.

=head2 Thoughts on locking

It is currently dangerous for multiple users to modify spreadsheets at once.
It will likely remain dangerous while the subsystem backend is fairly
stateless, as it is with the CGI mechanism.

We'd like to make this a little safer. One mechanism might be to allow
a user to open a subsystem for modification, and others for readonly access.
For this to work we have to be able to tell which users is allowed; current
implementation uses the curator of the subsystem for this purpose.

NB: This module does not currently attempt to handle locking or exclusion.
It is up to the caller (user application, CGI script, etc) to do so.
It does attempt to use locking internally where appropriate.

=head2 Data structures

We maintain the following data structures (all members of %$self).

=over 4

=item dir

Directory in which the subsystem is stored.

=item notes

The current notes contents for the subsystem

=item version

Current subsystem version.

=item exchangable

1 if subsystem is exchangable, 0 otherwise.

=item roles

List of role names.

=item role_index

hash that maps from role name to index

=item role_abbrs

list of role abbreviations

=item abbr

hash mapping from role abbreviation to role name

=item col_subsets

list of column subset names

=item col_subset_members

hash that maps from column subset name to subset members

=item col_active_subset

currently-active column subset

=item row_active_subset

currently-active row subset

=item genome

List  of genome IDs.

=item variant_code

List of variant codes.

=item genome_index

Hash mapping from genome ID to genome index.

=item spreadsheet

Spreadsheet data. Structured as a list of rows, each of  which
is a list of entries. An entry is a list of PEG numbers.

=item spreadsheet_inv

Inverted structure of spreadsheet - list of columns, each of which is a list
of rows.

=back

=head2  Methods

=over 4

=item index_cell

Create the subsystem_index entries for the given cell.
(NEW).

=item delete_role(name)

Delete the given role.

=item add_role(name, abbr)

Add a new role.

=item get_subset(name)

A deprecated form of get_subsetC

=item get_subsetC(name)

Returns a given subset. A subset is an object, implemented as a blessed array
of roles.

=item add_genome(genome_id, variant_code)

=item remove_genome(genome_id)

=back

=cut

=pod

=head1 Subsystem constructor

usage: $sub = Subsystem->new("subsystem name", $fig, $createFlag)

Load the subsystem. If it does not exist, and $createFlag is true, create
a new empty subsystem.

=cut

sub new
{
    my($class, $name, $fig, $create) = @_;

    my $ssa_dir = get_dir_from_name($name);
    #
    # For loading, the subsystem directory must already exist.
    #
    
    if (! -d $ssa_dir and not $create)
    {
	#	    warn "Subsystem $name does not exist\n";
	return undef;
    }
    my $self = {
	dir => $ssa_dir,
	name => $name,
	fig => $fig,
    };

    bless($self, $class);

    if ($create)
    {
	$self->create_subsystem();
    }
    else
    {
	$self->load();
    }

    return $self;
}

sub new_from_dir
{
    my($class, $dir, $fig) = @_;

    my $ssa_dir = $dir;
    my $name = $dir;
    $name =~ s,.*/,,;

    #
    # For loading, the subsystem directory must already exist.
    #
    
    my $self = {
	dir => $ssa_dir,
	name => $name,
	fig => $fig,
    };

    bless($self, $class);

    $self->load();

    return $self;
}

=pod

=head2 create_subsystem()

Create a new subsystem. This creates the subsystem directory in the
correct place ($FIG_Config::data/Subsystems), and populates it with
the correct initial data.

=cut

sub create_subsystem
{
    my($self) = @_;

    my $dir = $self->{dir};
    my $fig = $self->{fig};

    if (-d $dir)
    {
	warn "Not creating: Subsystem directory $dir already exists";
	return;
    }

    $fig->verify_dir($dir);

    #
    # Initialize empty data structures.
    #
    
    $self->{genome} = [];
    $self->{genome_index} = {};
    $self->{variant_code} = [];

    $self->{abbr} = {};
    $self->{role_index} = {};
    $self->{roles} = [];
    $self->{role_abbrs} = [];

    $self->{spreadsheet} = [];
    $self->{spreadsheet_inv} = [];

    $self->{col_subsets} = [];
    $self->{col_subset_members} = {};

    $self->{row_subsets} = [];
    $self->{row_subset_members} = {};
    $self->load_row_subsets();

    $self->{row_active_subset} = "All";
    $self->{col_active_subset} = "All";

    $self->{version} = 0;
    $self->{exchangable} = 0;

    $self->write_subsystem();
}

#
# Retrieve the diagrams associated with this subsystem.
#
# This is done via a lookup into FIG/Data/SubsystemDiagrams/<ssaname>/<diagram-name>.
#
# Returned is a list of names.
#

sub get_diagrams
{
    my($self) = @_;

    my $b = $self->{name};
    $b =~ s/ /_/g;
    my $dir = File::Spec->catfile($FIG_Config::data, 'SubsystemDiagrams', $b);

    my $dh = new DirHandle($dir);
    
    my @names = grep(/^[^.]/, $dh->read());

    return @names;
}

#
# Return a Subsystem::Diagram object for this diagram.
#
sub get_diagram
{
    my($self, $name) = @_;

    my $b = $self->{name};
    $b =~ s/ /_/g;
    my $dir = File::Spec->catfile($FIG_Config::data, 'SubsystemDiagrams', $b, $name);

    if (-d $dir)
    {
	return Subsystem::Diagram->new($self, $self->{fig}, $name, $dir);
    }
    else
    {
	return undef;
    }
}
    
#
# Synchronize the database index for this subsystem to the
# subsystem data.
#
# We assume the table already exists.
# 

sub db_sync
{
    my($self, $skip_delete) = @_;

    my $rdbH = $self->{fig}->db_handle();

    if (!$skip_delete)
    {
	$self->delete_indices();
    }

    #
    # We run thru all the cells, writing an entry in the database for the peg/subsystem/role.
    #

    my $sth = $rdbH->{_dbh}->prepare("INSERT INTO subsystem_index values(?, ?, ?)");

    for my $role ($self->get_roles())
    {
	my $ridx = $self->get_role_index($role);
	my $col = $self->get_col($ridx);
	for my $cell (@$col)
	{
	    if ($cell)
	    {
		for my $peg (@$cell)
		{
		    $sth->execute($peg, $self->{name}, $role);
		}
	    }
	}
    }
}

#
# Delete this subsystem's entries from the database index.
#
sub delete_indices
{
    my($self) = @_;

    my $rdbH = $self->{fig}->db_handle();

    $rdbH->SQL("DELETE FROM subsystem_index where subsystem = '$self->{name}'")
}

sub load
{
    my($self) = @_;

    #
    # Load the subsystem.
    #

    my $ssa;
    if  (!open($ssa,"<$self->{dir}/spreadsheet"))
    {
	warn "Spreadsheet does not exist in subsystem\n";
	return;
    }

    local $/ = "//\n";

    my $roles = <$ssa>;
    if ($roles)
    {
	$roles =~ s,$/$,,;
	#
	# Split on newline, filter for non-empty lines.
	#
	my @roles = split("\n", $roles);
	
	@roles = grep { $_ ne "" } @roles;
	
	$self->load_roles(@roles);
    }

    my $subsets = <$ssa>;
    if ($subsets)
    {
	$subsets =~ s,$/$,,;
	$self->load_subsets($subsets);
    }

    $/ = "\n";

    $self->load_row_subsets();
    $self->load_genomes($ssa);

    #
    # Now load the rest of the info.
    #

    $self->load_notes();
    $self->load_version();
    $self->load_exchangable();
    $self->load_curation();
}

sub load_notes
{
    my($self) = @_;

    $self->{notes} = &FIG::file_read(File::Spec->catfile($self->{dir}, "notes"));
}

sub load_curation
{
    my($self) = @_;

    my @l = &FIG::file_head(File::Spec->catfile($self->{dir}, "curation.log"), 1);

    $_ = $l[0];
    chomp;
    if (/^\d+\t(\S+)\s+started/)
    {
	$self->{curator} = $1;
    }
}

sub load_version
{
    my($self) = @_;

    my @l = &FIG::file_head(File::Spec->catfile($self->{dir}, "VERSION"), 1);
    my $l = $l[0];
    chomp $l;
    $self->{version} = $l;
}

sub load_exchangable
{
    my($self) = @_;

    my $file = File::Spec->catfile($self->{dir}, "EXCHANGABLE");

    if (-f $file)
    {
	my($l, @l);

	@l = &FIG::file_head($file, 1);
	$l = $l[0];
	chomp $l;
	$self->{exchangable} = $l;
    }
    else
    {
	$self->{exchangable} = 0;
    }
}


sub load_roles
{
    my($self, @roles) = @_;

    $self->{abbr} = {};
    $self->{role_index} = {};
    $self->{roles} = [];
    $self->{role_abbrs} = [];

    my $i = 0;
    for my $role (@roles)
    {
	my($abbr, $name) = split(/\t/, $role);
	# print "Role $i: abbr=$abbr name=$name\n";

	$self->{abbr}->{$abbr} = $name;
	$self->{role_index}->{$name} = $i;
	$self->{roles}->[$i] = $name;
	$self->{role_abbrs}->[$i] = $abbr;
	$i++;
    }
}
    
sub load_subsets
{
    my($self, $subsets) = @_;

    #
    # Column and row subsets.
    #
    my($subsetsC, $subsetsR) = split(/\n\n/, $subsets);

    #
    # Handle column subsets.
    #

    my @subsetsC = split(/\n/, $subsetsC);

    #
    # Determine active subset.
    #

    my $active_subsetC;
    if (@subsetsC > 0)
    {
	$active_subsetC = pop(@subsetsC);
    }
    else
    {
	$active_subsetC = 'All';
    }

    $self->{col_active_subset} = $active_subsetC;

    $self->{col_subsets} = [];
    $self->{col_subset_members} = {};
    
    for my $subset (@subsetsC)
    {
	my($name, @members) = split(/\s+/, $subset);

	#
	# File format has members 1-based.
	#

	@members = map { $_ - 1 } @members;

	push(@{$self->{col_subsets}}, $name);

	#
	# Map role members from name to index if necessary.
	#
	# Is it really necessary? ssa2 code was looking up in %pos for this.
	#
	@members = map {
	    if (my $new = $self->{role_index}->{$_})
	    {
		$new;
	    }
	    else
	    {
		$_;
	    }
	} @members;

	@{$self->{col_subset_members}->{$name}} = @members;
    }

    #
    # Now the row subsets.
    #

    chomp($subsetsR);

    if ($subsetsR =~ /(\S+.*\S+)/)
    {
	$self->{row_active_subset} = $1;
    }
    else
    {
	$self->{row_active_subset} = 'All';
    }
    $self->{row_subsets} = [];
}

sub load_genomes
{
    my($self, $fh) = @_;
    my(%seen);

    $self->{spreadsheet} = [];
    $self->{spreadsheet_inv} = [];
    $self->{genome} = [];
    $self->{genome_index} = {};
    $self->{variant_code} = [];

    my $nr = @{$self->{roles}};

    my $i = 0;
    while (<$fh>)
    {
	chomp;

	my($genome, $variant_code, @row) = split(/\t/, $_, $nr + 2);

	next if $seen{$genome};
	$seen{$genome}++;
	
	my $j = 0;

	$self->{genome}->[$i] = $genome;
	$self->{genome_index}->{$genome} = $i;
	$self->{variant_code}->[$i] = $variant_code;

	my $thislen = @row;

#	if ($thislen != $nr)
#	{
#	    warn "Genome $genome has wrong column count ($thislen != $nr)\n";
#	    warn "<$_> $genome $variant_code '", join(":", @row), "'\n";
#	}

	for my $j (0..$nr - 1)
	{
	    my $entry = $row[$j];
	    my $e2 = [map("fig|$genome.peg.$_", split(/,/, $entry))];
	    $self->{spreadsheet}->[$i]->[$j] = $e2;
	    $self->{spreadsheet_inv}->[$j]->[$i] = $e2;
	    $j++;
	}
	$i++;
	
    }
}

=pod

=head2 write_subsystem()

Write the subsystem to the disk.  Updates on-disk data with notes,
etc. Perform backups when necessary.

=cut

sub write_subsystem
{
    my($self) = @_;

    my $dir = $self->{dir};
    my $fig = $self->{fig};

    #
    # We first move the existing spreadsheet and notes files (if present)
    # to spreadsheet~ and notes~, and current state.
    #

    my $ss_file = "$dir/spreadsheet";
    my $ss_bak = "$dir/spreadsheet~";
    my $notes_file = "$dir/notes";
    my $notes_bak = "$dir/notes~";

    if (-f $ss_file)
    {
	rename($ss_file, $ss_bak);
    }

    if (-f $notes_file)
    {
	rename($notes_file, $notes_bak);
    }

    #
    # Eval this whole chunk, so that if we get any fatal errors, we can
    # roll back to the old saved data.
    #
    
    eval {
	my $fh;
	open($fh, ">$ss_file") or die "Cannot open $ss_file for writing: $!\n";
	$self->write_spreadsheet($fh);
	close($fh);
	chmod(0777,$ss_file);

	open($fh, ">$notes_file") or die "Cannot open $notes_file for writing: $!\n";
	print $fh "$self->{notes}\n";
	close($fh);
	chmod(0777,$notes_file);

	$self->update_curation_log();

	#
	# Write out the piddly stuff.
	#

	open($fh, ">$dir/EXCHANGABLE") or die "Cannot write $dir/EXCHANGABLE: $!\n";
	print $fh "$self->{exchangable}\n";
	close($fh);
	chmod(0777,"EXCHANGABLE");

	#
	# Process backup files. This is the smae process that determines when the
	# version number should be bumped, so write the version file afterward.
	#

	$self->update_backups();

	if ($self->{version} < 100) { $self->{version} += 100 }
	open($fh, ">$dir/VERSION") or die "Cannot write $dir/VERSION: $!\n";
	print $fh "$self->{version}\n";
	close($fh);
	chmod(0777,"VERSION");
    };

    if ($@ ne "")
    {
	warn "Spreadsheet write failed, reverting to backup. Error was\n$@\n";
    }
    
}

sub update_curation_log
{
    my($self) = @_;

    my $fh;
    my $file = "$self->{dir}/curation.log";

    my $now = time;
    my $user = $self->{fig}->get_user();

    if (-f $file)
    {
	open($fh, ">>$file") or die "Cannot open $file for writing: $!\n";
    }
    else
    {
	open($fh, ">$file") or die "Cannot open $file for writing: $!\n";
	print $fh "$now\t$user\tstarted\n";
    }
    print $fh "$now\t$user\tupdated\n";
    close($fh);
}

sub update_backups
{
    my($self) = @_;

    my $dir = $self->{dir};
    my $fig = $self->{fig};

    my $ss_file = "$dir/spreadsheet";
    my $ss_bak = "$dir/spreadsheet~";
    my $notes_file = "$dir/notes";
    my $notes_bak = "$dir/notes~";

    my $ss_diff = abs((-s $ss_file) - (-s $ss_bak));
    my $notes_diff = abs((-s $notes_file) - (-s $notes_bak));

    if (($ss_diff > 10) or ($notes_diff > 10))
    {
	$self->make_backup();
    }
}

sub make_backup
{
    my($self) = @_;

    my $dir = $self->{dir};
    my $bak = "$dir/Backup";

    $self->{fig}->verify_dir($bak);

    my $ts = time;

    rename("$dir/spreadsheet~", "$bak/spreadsheet.$ts");
    rename("$dir/notes~", "$bak/notes.$ts");
    $self->{version}++;
}



=pod

=head1 write_spreadsheet($fh)

Write the spreadsheet for this subsystem to filehandle $fh.

=cut

sub write_spreadsheet
{
    my($self, $fh) = @_;

    $self->_write_roles($fh);
    print $fh "//\n";

    $self->_write_subsets($fh);
    print $fh "//\n";

    $self->_write_spreadsheet($fh);
}

sub _write_roles
{
    my($self, $fh) = @_;

    my(@roles, @abbrs);

    @roles = $self->get_roles();
    @abbrs = $self->get_abbrs();

    while (@roles)
    {
	my $role = shift(@roles);
	my $abbr = shift(@abbrs);

	print $fh "$abbr\t$role\n";
    }
}

sub _write_subsets
{
    my($self, $fh) = @_;

    for my $sub ($self->get_subset_namesC())
    {
	next if ($sub eq "All");
	my @members= $self->get_subsetC($sub);

	#
	# member list on disk is 1-based
	#

	@members = map { $_ + 1 } @members;
	print $fh join("\t", $sub, @members), "\n";
    }
    my $active_row_subset = $self->{row_active_subset};
    my $active_col_subset = $self->{col_active_subset};

    print $fh "$active_col_subset\n";

    #
    # separator
    #

    print $fh "\n";
    
    #
    # genome subsets.
    #

    print $fh "$active_row_subset\n";
}

sub _write_spreadsheet
{
    my($self, $fh) = @_;

    my(@genomes);

    @genomes= $self->get_genomes();

    for (my $i = 0; $i < @genomes; $i++)
    {
	my $genome = $genomes[$i];
	my $vc = $self->get_variant_code($i);

	my $row = $self->get_row($i);

	if ($vc eq "")
	{
	    $vc = "0";
	}
	print $fh "$genome\t$vc";

	for my $entry (@$row)
	{
	    my(@p);
	    
	    for my $peg (@$entry)
	    {
		if ($peg =~ /fig\|$genome\.peg\.(\d+)$/)
		{
		    push(@p, $1);
		}
		else
		{
		    warn "Bad peg $peg in cell for $genome";
		}
	    }
	    print $fh "\t", join(",", @p);
	}
	print $fh "\n";
    }
}


=pod

=head1 get_genomes

=cut

sub get_genomes
{
    my($self) = @_;

    my $glist = $self->{genome};

    return @$glist;
}

=pod

=head1 get_variant_codes

=cut

sub get_variant_codes
{
    my($self) = @_;

    my $glist = $self->{variant_code};

    return @$glist;
}

sub get_variant_code
{
    my($self, $gidx) = @_;
    return $self->{variant_code}->[$gidx];
}

sub set_variant_code
{
    my($self, $gidx, $val) = @_;
    $self->{variant_code}->[$gidx] = $val;
    return;
}


sub get_variant_code_for_genome
{
    my($self, $genome) = @_;

    my $index = $self->{genome_index}->{$genome};
    return $self->{variant_code}->[$index];
}

sub get_roles
{
    my($self) = @_;

    my $rlist = $self->{roles};

    return @$rlist;
}

sub get_abbrs
{
    my($self) = @_;

    my $rlist = $self->{role_abbrs};

    return @$rlist;
}

sub roles_with_abbreviations
{
    my($self) = @_;

    my @ret;

    for my $i (0..@{$self->{roles}} - 1)
    {
	push(@ret, [$self->{role_abbrs}->[$i], $self->{roles}->[$i]]);
    }
    return @ret;
}


sub get_row :scalar
{
    my($self, $row) = @_;

    return $self->{spreadsheet}->[$row];
}

sub get_col :scalar
{
    my($self, $col) = @_;

    return $self->{spreadsheet_inv}->[$col];
}

sub get_cell :scalar
{
    my($self, $row, $col) = @_;

    my $cell = $self->{spreadsheet}->[$row]->[$col];
    if (! defined($cell))
    {
	$cell = $self->{spreadsheet}->[$row]->[$col] = [];
    }
    return $cell;
}

sub get_genome_index :scalar
{
    my($self, $genome) = @_;

    return $self->{genome_index}->{$genome};
}

sub get_genome :scalar
{
    my($self, $gidx) = @_;

    return $self->{genome}->[$gidx];
}

sub get_role_index :scalar
{
    my($self, $role) = @_;

    return $self->{role_index}->{$role};
}

sub get_role :scalar
{
    my($self, $ridx) = @_;

    return $self->{roles}->[$ridx];
}

sub get_role_abbr :scalar
{
    my($self, $ridx) = @_;

    return $self->{role_abbrs}->[$ridx];
}

sub get_role_from_abbr :scalar
{
    my($self, $abbr) = @_;

    return $self->{abbr}->{$abbr};
}

=pod

=head1 set_pegs_in_cell($genome, $role, $peg_list)

Set the cell for the given genome and role to $peg_list.

=cut

sub set_pegs_in_cell
{
    my($self, $genome, $role, $peg_list) = @_;
    my($row, $col);

    #
    # If row isn't numeric, look it up in the genomes list.
    #
    
    if ($genome !~ /^\d+$/)
    {
	$row = $self->{genome_index}->{$genome};
    }
    else
    {
	$row = $genome
    }
	
    if (! defined($row))
    {
	print &Dumper($self->{genome_index});
	confess "Cannot find row for $genome\n";
	return undef;
    }

    #
    # If col isn't numeric, look it up in the roles and role abbreviations.
    #
    
    if ($role !~ /^\d+$/)
    {
	#
	# See if it's an abbr
	#

	my $a = $self->{abbr}->{$role};
	$role = $a if $a;

	$col = $self->{role_index}->{$role};
    }
    else
    {
	$col = $role;
    }
	
    if (! defined($col))
    {
	print &Dumper($self->{role_index});
	confess "Cannot find col for $role\n";
	return undef;
    }
    my $cell = $self->get_cell($row, $col);

    if (defined($cell))
    {
	my $peg;
	my $rdbH = $self->{fig}->db_handle();
	if (@$cell > 0)
	{
	    foreach $peg (@$cell)
	    {
		$rdbH->SQL("DELETE FROM subsystem_index where ( subsystem = '$self->{name}' ) AND
                                                              ( role = '$role' ) AND
                                                              ( protein = '$peg' )" );
	    }
	}
	@$cell = @$peg_list;
	foreach $peg (@$cell)
	{
	    $rdbH->SQL("INSERT INTO subsystem_index (protein,subsystem,role) VALUES ('$peg','$self->{name}','$role' )");
	}
    }
    else
    {
	warn "set_pegs_in_cell: Could not find cell!";
    }
}

sub get_pegs_from_cell
{
    my($self, $rowstr, $colstr) = @_;
    my($row, $col);

    #
    # If row isn't numeric, look it up in the genomes list.
    #
    
    if ($rowstr !~ /^\d+$/)
    {
	$row = $self->{genome_index}->{$rowstr};
    }
    else
    {
	$row = $rowstr;
    }
	
    if (! defined($row))
    {
	print &Dumper($self->{genome_index});
	confess "Cannot find row for $rowstr\n";
	return undef;
    }

    #
    # If col isn't numeric, look it up in the roles and role abbreviations.
    #
    
    if ($colstr !~ /^\d+$/)
    {
	#
	# See if it's an abbr
	#

	my $a = $self->{abbr}->{$colstr};
	$colstr = $a if $a;

	$col = $self->{role_index}->{$colstr};
    }
    else
    {
	$col = $colstr;
    }

    if (! defined($col))
    {
	warn "Cannot find col for $colstr\n";
	return undef;
    }
    my $cell = $self->get_cell($row, $col);

    if ($cell)
    {
	return @$cell;
    }
    else
    {
	return undef;
    }
}

#
# Subset support
#

sub get_active_subsetC
{
    my($self) = @_;

    return $self->{col_active_subset};
}

sub get_active_subsetR
{
    my($self) = @_;

    return $self->{row_active_subset};
}

sub set_active_subsetC
{
    my($self, $subset) = @_;

    $self->{col_active_subset} = $subset;
}


sub set_active_subsetR
{
    my($self, $subset) = @_;

    $self->{row_active_subset} = $subset;
}


sub get_subset_names
{
    my($self) = @_;

    return $self->get_subset_namesC;
}

sub get_subset_namesC
{
    my($self) = @_;

    return ("All",@{$self->{col_subsets}});
}

sub get_subset_namesR
{
    my($self) = @_;

    return ("All",@{$self->{row_subsets}});
}

sub get_subsetC_roles
{
    my($self, $subname) = @_;
    return map { $self->get_role($_) } $self->get_subsetC($subname);
}

sub get_subsetC
{
    my($self, $subname) = @_;
    if ($subname eq "All") { return map { $self->get_role_index($_) } $self->get_roles }

    defined($self->{col_subset_members}->{$subname}) || confess "BAD";
    return @{$self->{col_subset_members}->{$subname}};
}

sub get_subset
{
    my($self, $subname) = @_;
    return $self->get_subsetC($subname);
}

sub get_subsetR
{
    my($self, $subname) = @_;
    my($pair,$id,$members,$genome);

    if ($subname eq "All") { return $self->get_genomes }
    my %genomes = map { $_ => 1 } $self->get_genomes;

    return grep { $genomes{$_} } @{$self->{row_subset_members}->{$subname}};
}

sub load_row_subsets {
    my($self) = @_;
    my($id,$members,$pair);

    my $taxonomic_groups = $self->{fig}->taxonomic_groups_of_complete(10);
    foreach $pair (@$taxonomic_groups)
    {
	($id,$members) = @$pair;
	if ($id ne "All")
	{
	    push(@{$self->{row_subsets}},$id);
	}
	$self->{row_subset_members}->{$id} = $members;
    }
}


=pod

=head2 set_subsetC($name, $members)

Create a subset with the given name and members.

$members is a list of role names.

=cut

sub set_subsetC
{
    my($self, $subname, $list) = @_;

    my $nl = [map { $self->get_role_index($_) } @$list];
    
    $self->_set_subset($subname, $nl);
}

sub set_subset
{
    my($self, $subname, $list) = @_;

    $self->set_subsetsC($subname,$list);
}

=pod

=head2 _set_subset($name, $members)

Create a subset with the given name and members.

Internal version  - here, members is a list of role indices.

=cut

sub _set_subset
{
    my($self, $subname, $list) = @_;
    $self->{col_subset_members}->{$subname} = $list;
    my($i,$x);
    $x = $self->{col_subsets};
    for ($i=0; ($i < @$x) && ($x->[$i] ne $subname); $i++) {}
    if ($i == @$x)
    {
	push(@$x,$subname);
    }
}
	       
sub delete_subsetC
{
    my($self, $subname) = @_;
    my($i,$x);

    $x = $self->{col_subsets};
    for ($i=0; ($i < @$x) && ($x->[$i] ne $subname); $i++) {}
    if ($i < @$x)
    {
	splice(@$x,$i,1);
    }
    delete $self->{col_subset_members}->{$subname};
}
	       
#
# Role manipulation.
#


=pod

=head1 set_roles($role_list)

Set the list of roles. C<$role_list> is a list of tuples C<[$role_name, $abbreviation]>.

If a role already exists, it is used. If it does not exist, it is created empty.

=cut

sub set_roles
{
    my($self, $roles) = @_;

    #
    # We do this by first creating a new spreadsheet.
    #
    # It is easiest to do this by manipulating the inverted spreadsheet
    # (role-major), and then creating the non-inverted spreadsheet from it.
    #

    my $oldss = $self->{spreadsheet};
    my $oldssinv = $self->{spreadsheet_inv};

    my $ss = [];
    my $ssinv = [];

    my $g = $self->{genome};
    my $ng = @$g;

    my $old_roles = $self->{role_index};

    my @role_index_conversion;


    $self->{abbr} = {};
    $self->{role_index} = {};
    $self->{roles} = [];
    $self->{role_abbrs} = [];


    for (my $idx = 0; $idx < @$roles; $idx++)
    {
	my $role = $roles->[$idx]->[0];
	my $abbr = $roles->[$idx]->[1];

	my $old_idx = $old_roles->{$role};

	if (defined($old_idx))
	{
#	    print "Found old idx $old_idx for $role $idx\n";
#	    print $oldssinv->[$old_idx];
	    $ssinv->[$idx] = $oldssinv->[$old_idx];

	    $role_index_conversion[$old_idx] = $idx;
	}
	else
	{
#	    print "Did not find old role for $role $idx\n";
#	    print Dumper($old_roles);
	    my $l = [];
	    for (my $j = 0; $j < $ng; $j++)
	    {
		$l->[$j] = [];
	    }
	    
	    $ssinv->[$idx] = $l;
	}

	#
	# While we're here, update the new role and abbrev indexes
	#
	$self->{role_index}->{$role} = $idx;
	$self->{abbr}->{$abbr} = $role;
	$self->{roles}->[$idx] = $role;
	$self->{role_abbrs}->[$idx] = $abbr;
    }

    #
    # Now create the uninverted spreadsheet.
    #

    for (my $gidx = 0; $gidx < $ng; $gidx++)
    {
	my $row = [];
	$ss->[$gidx] = $row;
	for (my $ridx = 0; $ridx < @$roles; $ridx++)
	{
	    $row->[$ridx] = $ssinv->[$ridx]->[$gidx];
	}
    }

    $self->{spreadsheet} = $ss;
    $self->{spreadsheet_inv} = $ssinv;

    #
    # Fix up the subsets.
    #


    for my $subset (grep { $_ ne "All" } $self->get_subset_names())
    {
	my $n = [];
	for my $idx ($self->get_subset($subset))
	{
	    my $new = $role_index_conversion[$idx];
	    if (defined($new))
	    {
		push(@$n, $new);
	    }
	}
	$self->_set_subset($subset, $n);
    }

}

=pod

=head1 C<add_role($role, $abbr)>

Add the given role to the spreadsheet.

This causes a new column to be added, with empty values in each cell.

We do nothing if the role is already present.

Return the index of the new role.

=cut

sub add_role
{
    my($self, $role, $abbr) = @_;

    if (defined($self->get_role_index($role)))
    {
	warn "Role $role already present\n";
	return undef;
    }

    #
    # Add to the roles list. It goes at the end.
    #

    my $idx = @{$self->{roles}};
    $self->{roles}->[$idx] = $role;
    $self->{role_abbrs}->[$idx] = $abbr;
    $self->{role_index}->{$role} = $idx;
    $self->{abbr}->{$abbr} = $role;

    #
    # Update the spreadsheet.
    # On the standard one, we have to go through all the rows adding
    # a columnt to each.
    #
    # On the inverted one, we add a column with [] in each entry.
    #

    my $ng = @{$self->{genome}};
    my $newcol = [];

    for (my $i = 0; $i < $ng; $i++)
    {
	my $cell = [];
	# print "nr: Adding cell $cell for gidx=$i ridx=$idx\n";
	$self->{spreadsheet}->[$i]->[$idx] = $cell;
	$newcol->[$i] = $cell;
    }

    $self->{spreadsheet_inv}->[$idx] = $newcol;

    return $idx;
}

=pod

=head1 remove_role($role)

Remove the role from the spreadsheet.

We do nothing if the role is not present.

=cut

sub remove_role
{
    my($self, $role) = @_;

    my $idx = $self->get_role_index($role);
    if (!defined($idx))
    {
	warn "Role $role not present\n";
	return undef;
    }

    #
    # Remove from the roles list. 
    #

    my $abbr = $self->{role_abbrs}->[$idx];
	
    splice(@{$self->{roles}}, $idx, 1);
    splice(@{$self->{role_abbrs}}, $idx, 1);
    delete $self->{role_index}->{$role};
    delete $self->{abbr}->{$abbr};

    #
    # Update the spreadsheet.
    # On the standard one, we have to go through all the rows removing
    # the column from each.
    #
    # On the inverted one, we just remove the column.
    #

    my $ng = @{$self->{genome}};
    my $newcol = [];

    for (my $i = 0; $i < $ng; $i++)
    {
	splice(@{$self->{spreadsheet}->[$i]}, $idx, 1);
    }

    splice(@{$self->{spreadsheet_inv}}, $idx, 1);

    #
    # We need to rewrite the subsets. if $idx was present in one, it is
    # removed. Any index >$idx is decremented.
    #

    for my $subset ($self->get_subset_names())
    {
	my @n;

	for my $sidx ($self->get_subset($subset))
	{
	    if ($sidx < $idx)
	    {
		push(@n, $sidx);
	    }
	    elsif ($sidx > $idx)
	    {
		push(@n, $sidx - 1);
	    }
	}

	$self->_set_subset($subset, [@n]);
    }
}

=pod

=head1 C<add_genome($genome, $abbr)>

Add the given genome to the spreadsheet.

This causes a new row to be added, with empty values in each cell.

We do nothing if the genome is already present.

Return the index of the new genome.

=cut

sub add_genome
{
    my($self, $genome) = @_;

    my $idx = $self->get_genome_index($genome);
    if (defined($idx))
    {
	warn "Genome $genome already present\n";
	return $idx;
    }

    #
    # Add to the genomes list. It goes at the end.
    #

    my $idx = @{$self->{genome}};
    $self->{variant_code}->[$idx] = 0;
    $self->{genome}->[$idx] = $genome;
    $self->{genome_index}->{$genome} = $idx;

    #
    # Update the spreadsheet.
    # On the inverted one, we have to go through all the columns adding
    # a row to each.
    #
    # On the regular one, we add a row with [] in each entry.
    #

    my $nr = @{$self->{roles}};
    my $newrow = [];

    for my $i (0.. $nr - 1)
    {
	my $cell = [];
	# print "ng: Adding cell $cell for gidx=$idx ridx=$i\n";
	$self->{spreadsheet_inv}->[$i]->[$idx] = $cell;
	$newrow->[$i] = $cell;
    }

    $self->{spreadsheet}->[$idx] = $newrow;

    return $idx;
}

=pod

=head1 remove_genome($genome)

Remove the genome from the spreadsheet.

We do nothing if the genome is not present.

=cut

sub remove_genome
{
    my($self, $genome) = @_;

    my $idx = $self->get_genome_index($genome);
    if (!defined($idx))
    {
	warn "Genome $genome not present\n";
	return undef;
    }

    #
    # Remove from the genomes list. 
    #

    splice(@{$self->{genome}}, $idx, 1);
    splice(@{$self->{variant_code}}, $idx, 1);

    delete $self->{genome_index}->{$genome};

    #
    # Update the spreadsheet.
    # On the inverted one, we have to go through all the columns removing
    # the row from each.
    #
    # On the standard one, we just remove the row.
    #

    my $nr = @{$self->{roles}};

    for my $i (0 .. $nr - 1)
    {
	splice(@{$self->{spreadsheet_inv}->[$i]}, $idx, 1);
    }

    splice(@{$self->{spreadsheet}}, $idx, 1);

}

sub get_name :scalar
{
    my($self) = @_;
    return $self->{name};
}
    

sub get_version :scalar
{
    my($self) = @_;
    return $self->{version};
}

sub get_notes :scalar
{
    my($self) = @_;

    return $self->{notes};
}

sub set_notes
{
    my($self, $notes) = @_;

    $self->{notes} = $notes;
}

sub get_curator :scalar
{
    my($self) = @_;
    return $self->{curator};
}
    
#
# Subsystem copying logic
#

=pod

=head2 add_to_subsystem($subsystem_name, $columns, $notes_flag)

Merge the given columns from $subsystem_name into this subsystem. Append the
notes from the subsystem if $notes_flag is true.

=cut

sub add_to_subsystem
{
    my($self, $subsystem_name, $cols, $add_notes) = @_;

    my $ss = $self->{fig}->get_subsystem($subsystem_name);

    if (!$ss)
    {
	warn "Cannot open subsystem '$subsystem_name' to copy from";
	return;
    }

    #
    # Merge the data from the other subsystem.
    #
    # First we assure ourselves that we have the appropriate roles. While
    # we do this, build the list of row indices (in this subsystem) that
    # map to the roles we are adding.
    #

    #
    # local_roles[$his_role] = $my_role (map from other role idx to local role idx)
    #
    
    my @local_roles;

    #
    # his_roles = list of role indices corresponding to the remote roles.
    #
    if ($cols->[0] eq "all")
    {
	$cols = [$ss->get_roles];
    }

    my @his_roles;
    
    for my $his_role (@$cols)
    {
	my $idx = $self->get_role_index($his_role);
	my $his_idx = $ss->get_role_index($his_role);

	if (!defined($his_idx))
	{
	    confess "Cannot map his role $his_role\n";
	}
	push(@his_roles, $his_idx);

	if (!defined($idx))
	{
	    my $his_abbr = $ss->get_role_abbr($his_idx);

	    $idx = $self->add_role($his_role, $his_abbr);
#	    print "Adding missing role $his_role idx=$idx\n";
	}
	else
	{
#	    print "Found existing role $his_role idx=$idx\n";
	}
	    

	$local_roles[$his_idx] = $idx;
    }

    #
    # Similar scan to ensure that we have rows for the genomes
    # that are in the other subsystem.
    #

    my @local_genomes;

    my @his_genomes = $ss->get_genomes();

    for my $his_idx (0..@his_genomes - 1)
    {
	my $genome = $his_genomes[$his_idx];

	
	my $my_idx = $self->get_genome_index($genome);

	if (!defined($my_idx))
	{
	    #
	    # Not there, need to add.
	    #

	    $my_idx = $self->add_genome($genome);
#	    print "Adding missing genome $genome idx=$my_idx\n";
	}
	else
	{
#	    print "Found existing genome $genome idx=$my_idx\n";
	}
	
	$local_genomes[$his_idx] = $my_idx;
    }

    
    #
    # Now that we have our local roles set up to receive the data,
    # process the incoming roles one at a time.
    #


    for my $his_role (@his_roles)
    {
	my $my_col = $self->get_col($local_roles[$his_role]);
	my $his_col = $ss->get_col($his_role);

	#
	# $his_col is the information for $his_role, indexed by
	# genome in @his_genomes.
	#
	# $my_col is hte information for my copy of $his_role,
	# indexed by genome in MY genome list.
	#

	my $my_role = $local_roles[$his_role];

#	print "merging: $self->{roles}->[$my_role] $ss->{roles}->[$his_role] his_role=$his_role my_role=$my_role\n";

	for my $his_gidx (0 .. @his_genomes - 1)
	{
	    my $hisent = $his_col->[$his_gidx];

	    my $my_gidx = $local_genomes[$his_gidx];
	    

	    my $myent = $my_col->[$my_gidx];

#	    print "  his_gidx=$his_gidx my_gidx=$my_gidx hisent=@$hisent myent=@$myent\n";

	    my %new;
	    map { $new{$_}++ } @$hisent;
	    map { $new{$_}++ } @$myent;

	    @$myent = keys(%new);

#	    print "  new entry: @$myent\n";
	}
    }

    #
    # Fix up the variant codes.
    #

    for my $his_gidx (0 .. @his_genomes - 1)
    {
	my $his_code = $ss->get_variant_code($his_gidx);
	my $my_gidx = $local_genomes[$his_gidx];

	if (!$self->get_variant_code($my_gidx))
	{
	    $self->{variant_code}->[$my_gidx] = $his_code;
	}
    }

    #
    # If we are to add notes, append the other subsystem's notes text.
    #

    if ($add_notes)
    {
	my $his_notes = $ss->get_notes();

	$self->{notes} .= "\nNotes copied from $ss->{name}:\n$his_notes\n";
    }
}

sub dump
{
    my($self) = @_;

    for my $k (keys(%$self))
    {
	next if $k eq "spreadsheet" or $k eq "spreadsheet_inv";
	print "Key \"$k\": ", Dumper($self->{$k});
    }
}
    
#
# Increment the subsystem's version number.
#
sub incr_version {
    my($self) = @_;

    my $dir = $self->{dir};
    my $vfile = "$dir/VERSION";
    my($ver);

    if (open(my $fh,"<$vfile"))
    {
        if (defined($ver = <$fh>) && ($ver =~ /^(\S+)/))
        {
            $ver = $1;
        }
        else
        {
            $ver = 0;
        }
        close($fh);
    }
    else
    {
        $ver = 0;
    }

    $ver++;

    open(my $fh, ">$vfile") || die "could not open $vfile";
    print $fh "$ver\n";
    close($fh);

    chmod(0777, $vfile);

    $self->load_version();
}

sub get_dir_from_name
{
    my($name) = @_;

    my $b = $name;
    $b =~ s/ /_/g;
    my $dir = File::Spec->catfile($FIG_Config::data, 'Subsystems', $b);
    return $dir;
}

#
# Code for dealing with Bill McCune's prolog code for extending subsystems.
#
# The code here is a reconstruction of Bill's "go" script in perl with
# data pulled from the local SEED configuration.
#

sub extend_with_billogix
{
    my($self, $muser) = @_;
    my($isMaster, $user);
    
    my $now = time();

    if ($muser =~ /master:(.*)/)
    {
	$isMaster = 1;
	$user = $1;
    }
    else
    {
	$isMaster = 0;
	$user = $muser;
    }

    #
    # Find the executable.
    #

    my $exe = "$FIG_Config::bin/billogix";

    if (! -x $exe)
    {
	warn "Cannot find billogix exe at $exe\n";
	return;
    }
    
    my $ss_name = $self->{name};

    $ss_name =~ s/\s+/_/g;
    
    my $ss_dir = "$self->{dir}/";
    my $assign_dir = "$FIG_Config::data/Assignments/$user/";
    &FIG::verify_dir($assign_dir);

    my $when= strftime("%m-%d-%y:%H:%M:%S", localtime($now));
    my $job_id = "${when}:sss:$ss_name";

    my $seed = &FIG::cgi_url() . "/";
    my $export_part = "ssa.cgi?user=$muser&request=delete_or_export_ssa&export=";

    #
    # Have the prereq stuff, now start up the app.
    #

    $ENV{LOCALSZ} = "80000";
    $ENV{GLOBALSZ} = "80000";
    $ENV{TRAILSZ} = "30000";

    my $arch = &FIG::get_current_arch();

    $ENV{BILLOGIX} = "$FIG_Config::fig_disk/dist/releases/current/$arch/lib/Billogix";

    #
    # Need to ensure pl2wam is in our path
    #

    $ENV{PATH} = "${FIG_Config::ext_bin}:$ENV{PATH}";

    #
    # We're going to divide the run into $n_chunks chunks.
    #

    my $n_chunks = 10;

    my($log);
    open($log, ">$ss_dir/$job_id.log");

    for (my $this_chunk = 1; $this_chunk <= $n_chunks; $this_chunk++)
    {
	my $app_input = <<EOINP;
['\$BILLOGIX/top'].
loadup.
asserta(part($this_chunk, $n_chunks)).
asserta(url_default_seed('$seed')).
asserta(url_export_part('$export_part')).
asserta(ss_directory('$ss_dir')).
asserta(assign_directory('$assign_dir')).
asserta(job_id('$job_id')).
extend_test3('$ss_name').
EOINP

        print STDERR <<EOF;
Starting app

chunk $this_chunk of $n_chunks
ss_name = $ss_name
ss_dir = $ss_dir
user = $user
assign_dir = $assign_dir
exe = $exe
libdir = $ENV{BILLOGIX}
path = $ENV{PATH}

App input
$app_input
EOF
# feh, put in a block to reset perlmode indentation.
        {
	    my($app_read, $app_write);
	    
	    #
	    # Start the actual application with stdin and stdout redirected
	    # to pipes.
	    #
	    # We write $app_input to the stdin pipe, and close it.
	    # Then loop reading stdout, logging that output.
	    #
	    my $pid = open2($app_read, $app_write, $exe);
	    
	    if (!$pid)
	    {
		warn "open2 $exe failed: $!\n";
		print $log "open2 $exe failed: $!\n";
		return;
	    }
	    
	    print $app_write $app_input;
	    close($app_write);
	    
	    #
	    # Set autoflush on the logfile.
	    #
	    
	    my $old = select($log);
	    $| = 1;
	    select(STDERR);
	    $| = 1;
	    select($old);
	    
	    warn "Starting $exe with pid $pid\n";
	    print $log "Starting $exe with pid $pid\n";
	    
	    while (<$app_read>)
	    {
		print STDERR $_;
		print $log $_;
	    }
	    
	    print STDERR "App done\n";
	    print $log "App done\n";
	    
	    close($app_read);
	
	    my $ret = waitpid($pid, 0);
	    my $stat = $?;
	    print STDERR "Return status is $?\n";
	    print $log "Return status is $?\n";

	    #
	    # This chunk has finished. We should see a file
	    # rows.$this_chunk.$n_chunks.
	    #
	}
    }
    #
    # At this point, the extension is finished (we've run the
    # $n_chunks parts of the extension job).
    #

    #
    # We read in all the individual rows files, writing the single
    # concatenation of rows.
    #

    my $ssaD = $self->{dir};
    
    my $rows_file = "$ssaD/rows";

    my $rowFH;
    if (!open($rowFH, ">$rows_file"))
    {
	my $err = "Cannot open rows file $ssaD/rows for writing: $!\n";
	print STDERR $err;
	print $log $err;
	return;
    }

    for (my $this_chunk = 1; $this_chunk <= $n_chunks; $this_chunk++)
    {
	my $chunkFH;
	my $cfile = "$ssaD/rows.$this_chunk.$n_chunks";
	if (!open($chunkFH, "<$cfile"))
	{
	    my $err =  "Cannot open rows file $cfile for reading: $!\n";
	    print STDERR $err;
	    print $log $err;
	    return;
	}
	while (<$chunkFH>)
	{
	    print $rowFH $_;
	}
	close($chunkFH);
    }
    close($rowFH);

    #
    # Concatenate the assignments into the assignment directory.
    #

    my $assignments_file = "$assign_dir$job_id";
    my $assignFH;

    if (!open($assignFH, ">$assignments_file"))
    {
	my $err = "Cannot open assignments file $assignments_file for writing: $!\n";
	print STDERR $err;
	print $log $err;
	return;
    }

    for (my $this_chunk = 1; $this_chunk <= $n_chunks; $this_chunk++)
    {
	my $aFH;
	my $afile = "$ssaD/assignments.$this_chunk.$n_chunks";
	if (!open($aFH, "<$afile"))
	{
	    my $err = "Cannot open assignments file $afile for reading: $!\n";
	    print STDERR $err;
	    print $log $err;
	    return;
	}
	while (<$aFH>)
	{
	    print $assignFH $_;
	}
	close($aFH);
    }
    close($assignFH);

    
    
    #
    # Back up the spreadsheet, and append the rows file to it.
    #

    &FIG::verify_dir("$ssaD/Backup");
    my $ts = time;
    rename("$ssaD/spreadsheet~","$ssaD/Backup/spreadsheet.$ts");
    copy("$ssaD/spreadsheet","$ssaD/spreadsheet~");
    rename("$ssaD/notes~","$ssaD/Backup/notes.$ts");

    #
    # Append the new rows to the spreadsheet.
    #

    my($ssafh, $rowsfh);
    open($ssafh, ">>$ssaD/spreadsheet") or die "Cannot open $ssaD/spreadsheet for append: $!\n";
    open($rowsfh, "<$ssaD/rows") or die "Cannot open $ssaD/rows for reading: $!\n";
    
    while (<$rowsfh>)
    {
	print $ssafh $_;
    }
    close($ssafh);
    close($rowsfh);

    $self->incr_version();
}


sub set_current_extend_pid
{
    my($self, $pid) = @_;

    if (open(my $fh, ">$self->{dir}/EXTEND_PID"))
    {
	print $fh "$pid\n";
    }
    else
    {
	warn "Cannot open $self->{dir}/EXTEND_PID: $!\n";
    }
}

sub get_current_extend_pid
{
    my($self) = @_;

    if (open(my $fh, "<$self->{dir}/EXTEND_PID"))
    {
	my $pid = <$fh>;
	close($fh);
	if ($pid)
	{
	    chomp $pid;
	    
	    return $pid;
	}
    }
    return undef;
}
    
package Subsystem::Diagram;

sub new
{
    my($class, $sub, $fig, $name, $dir) = @_;

    if (!-d $dir)
    {
	return undef;
    }

    my $self = {
	fig => $fig,
	subsystem => $sub,
	name => $name,
	dir =>$ dir,
    };
    bless $self, $class;

    $self->load();

    return $self;
}

#
# Parse the diagram into internal data structure.
#

sub load
{
    my($self) = @_;

    $self->load_area();
}

sub load_area
{
    my($self) = @_;
    my $fh;

    if (!open($fh, "<$self->{dir}/area_table"))
    {
	warn "Could not load $self->{dir}/area_table: $!\n";
	return;
    }

    $self->{areas} = [];

    my $area_list = $self->{areas};
    
    while (<$fh>)
    {
	chomp;
	s/#.*$//;
	s/^\s+//;
	s/\s+$//;
	next if $_ eq '';
	my ($area, $tag, $value) = split(/\s+/, $_, 3);
	# print "area=$area tag=$tag value=$value\n";

	push(@$area_list, [$area, $tag, $value]);

	#
	# Do a little checking.
	#

	if ($tag eq "role")
	{
	    my $idx = $self->{subsystem}->get_role_index($value);
	    if (!defined($idx))
	    {
		warn "Role not found for \"$value\" in subsystem $self->{subsystem}->{name}\n";
	    }
	}
    }
    close($fh);
}

sub get_areas
{
    my($self) = @_;

    return @{$self->{areas}};
}

1;



MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3