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

Diff of /FigKernelPackages/FIG.pm

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

revision 1.183, Wed Nov 10 22:10:22 2004 UTC revision 1.184, Fri Dec 3 18:55:20 2004 UTC
# Line 1231  Line 1231 
1231          &verify_dir($1);          &verify_dir($1);
1232      }      }
1233      mkdir($dir,0777) || die "could not make $dir: $!";      mkdir($dir,0777) || die "could not make $dir: $!";
1234      chmod 02777,$dir;      # chmod 02777,$dir;
1235  }  }
1236    
1237  =pod  =pod
# Line 6903  Line 6903 
6903      }      }
6904  }  }
6905    
6906    =head1 subsystem_roles
6907    
6908    Return a list of all roles present in locally-installed subsystems.
6909    The return is a hash keyed on role name with each value a list
6910    of subsystem names.
6911    
6912    =cut
6913    
6914    sub subsystem_roles
6915    {
6916        my($self) = @_;
6917    
6918        my $rdbH = $self->db_handle;
6919    
6920        my $q = "SELECT distinct subsystem, role FROM subsystem_index";
6921    
6922        my $ret = {};
6923    
6924        if (my $relational_db_response = $rdbH->SQL($q))
6925        {
6926            foreach my $pair (@$relational_db_response)
6927            {
6928                my($subname, $role) = @$pair;
6929                push(@{$ret->{$role}}, $subname);
6930            }
6931        }
6932    
6933        return $ret;
6934    }
6935    
6936  #  #
6937  # Return just the list of subsystems the peg appears in.  # Return just the list of subsystems the peg appears in.
6938  #  #
# Line 6951  Line 6981 
6981  ################################# PEG Translation  ####################################  ################################# PEG Translation  ####################################
6982    
6983  sub translate_pegs {  sub translate_pegs {
6984      my($self,$pegs,$seq_of) = @_;      my($self,$pegs,$seq_of, $cb) = @_;
6985      my($seq,$aliases,$pegT,%to,%sought,@keys,$peg,$alias);      my($seq,$aliases,$pegT,%to,%sought,@keys,$peg,$alias);
6986    
6987        $cb = sub {} unless ref($cb) eq "CODE";
6988    
6989      my $tran_peg = {};      my $tran_peg = {};
6990    
6991        my $n = scalar keys (%$pegs);
6992        my $idx = 0;
6993    
6994      foreach $peg (keys(%$pegs))      foreach $peg (keys(%$pegs))
6995      {      {
6996            $idx++;
6997            &$cb("$idx of $n") if $idx % 100 == 0;
6998          #          #
6999          # First, see if the peg of the same name locally has the same          # First, see if the peg of the same name locally has the same
7000          # last 10 chars.          # last 10 chars.

Legend:
Removed from v.1.183  
changed lines
  Added in v.1.184

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3