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

View of /FigKernelScripts/svr_column_of_subsystem.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Tue Jan 19 00:06:56 2010 UTC (10 years, 1 month ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, mgrast_dev_08022011, rast_rel_2014_0912, myrast_rel40, mgrast_dev_05262011, mgrast_dev_04082011, rast_rel_2010_0928, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_06072011, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, rast_rel_2011_0119, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, mgrast_dev_04012011, rast_rel_2010_0827, myrast_33, rast_rel_2011_0928, mgrast_dev_04052011, mgrast_dev_02222011, mgrast_dev_10262011, HEAD
server script to pull a subsystem colum

#! /usr/bin/perl -w
#
#  This is a SAS component
#
use strict;
use SAPserver;
use Data::Dumper;

my $usage = <<End_of_Usage;

Usage:  svr_column_of_subsystem [options] subsystem role1 ... > fids

Options:

  -u  #  Unique entries only

End_of_Usage

my $unique = 0;
while ( @ARGV && $ARGV[0] =~ s/^-// )
{
    $_ = shift @ARGV;
    if ( s/u//g ) { $unique = 1 }
    if ( /./   )
    {
        print STDERR "Bad flag '$_'.\n", $usage;
        exit;
    }
}

my $ssID  = shift @ARGV;
defined $ssID or print STDERR "Missing subsystem name.\n", $usage and exit;
my @roles = @ARGV;
@roles or print STDERR "Missing role(s).\n", $usage and exit;

my $sap = SAPserver->new();
my $roleH  = $sap->pegs_implementing_roles( -subsystem =>  $ssID,
                                            -roles     => \@roles
                                            );

# $roleH = { $role1 => [$fid1a, $fid1b, ...],
#            $role2 => [$fid2a, $fid2b, ...],
#            ... };

# Collect fids with role by genome, so that unique entries can be found.

my %fids_in_genome_with_role;
my $role;
my $gid;
foreach $role ( keys %$roleH )
{
    my %fids_by_genome;
    my @fids = @{ $roleH->{ $role } };
    foreach ( @fids )
    {
        ( $gid ) = /^fig\|(\d+\.\d+)\.[^.]+\.\d+$/;
        push @{$fids_by_genome{ $gid }}, $_ if $gid;
    }
    $fids_in_genome_with_role{ $role } = \%fids_by_genome;
}

#  Collect the nonredundant list of fids

my %fids;
foreach $role ( @roles )
{
    my %fids_with_role_by_genome = %{$fids_in_genome_with_role{ $role }};
    foreach $gid ( keys %fids_with_role_by_genome )
    {
        my $fids = $fids_with_role_by_genome{ $gid };
        next if $unique && @$fids != 1;
        foreach ( @$fids ) { $fids{ $_ } = 1 }
    }
}

foreach ( keys %fids ) { print "$_\n" }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3