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

Diff of /FigKernelPackages/FIGV.pm

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

revision 1.43, Tue Sep 18 15:53:18 2007 UTC revision 1.44, Thu Oct 11 18:30:52 2007 UTC
# Line 1906  Line 1906 
1906  }  }
1907    
1908  sub get_attributes {  sub get_attributes {
1909      my($self,$peg) = @_;      my($self, $id, $attr) = @_;
1910    
1911      my $fig     = $self->{_fig};      my $fig     = $self->{_fig};
1912      my $newG    = $self->{_genome};      my $newG    = $self->{_genome};
1913      my $newGdir = $self->{_orgdir};      my $newGdir = $self->{_orgdir};
1914    
1915      if (($peg =~ /^fig\|(\d+\.\d+)\.peg\.\d+$/) && ($1 eq $newG))      if ((($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+$/) and ($1 eq $newG)) or
1916            (($id =~ /^(\d+\.\d+)/  and $1 eq $newG)))
1917      {      {
1918          &load_attr($self);          &load_attr($self);
1919          if (my $x = $self->{_attr}->{$peg})  
1920            my $t = $self->{_attr_id_tie};
1921            if (!$t)
1922          {          {
1923              return @$x;              #
1924                # Tied index not present, bail back to simple attributes.
1925                #
1926    
1927                my $l = $self->{_attr_id}->{$id};
1928                return $l ? @$l : ();
1929          }          }
1930          else  
1931            my @v = $t->get_dup($id);
1932    
1933            my @out;
1934            for my $v (@v)
1935          {          {
1936              return ();              my @a = split(/$;/, $v);
1937    
1938                if (!defined($attr) or $attr eq $a[1])
1939                {
1940                    push(@out, [@a]);
1941                }
1942          }          }
1943            return @out;
1944      }      }
1945      else      else
1946      {      {
1947          return $fig->get_attributes($peg);          my @f = $fig->get_attributes($id, $attr);
1948            if (!defined($id) and defined(my $t = $self->{_attr_key_tie}))
1949            {
1950                #
1951                # lookup locally for $attr matches and merge with other output.
1952                #
1953    
1954                my @mine = $t->get_dup($attr);
1955                @mine = map { [split(/$;/, $_)] } @mine;
1956    
1957                return (@mine, @f);
1958            }
1959            else
1960            {
1961                return @f;
1962            }
1963      }      }
1964  }  }
1965    
1966  sub load_attr {  sub load_attr {
1967      my($self) = @_;      my($self) = @_;
1968    
1969      if ($self->{_attr}) { return };      if ($self->{_attr_id}) { return };
1970    
1971      my $newGdir = $self->{_orgdir};      my $newGdir = $self->{_orgdir};
1972      my $attr     = {};  
1973        my $id = {};
1974        my $key = {};
1975    
1976        $self->{_attr_id_tie} = tie %$id, 'DB_File', "$newGdir/attr_id.btree", O_RDONLY, 0, $DB_BTREE;
1977        $self->{_attr_key_tie} = tie %$key, 'DB_File', "$newGdir/attr_key.btree", O_RDONLY, 0, $DB_BTREE;
1978    
1979        $self->{_attr_id} = $id;
1980        $self->{_attr_key} = $key;
1981    
1982        #
1983        # If the tie didn't work for ids, at least load up the evidence codes.
1984        #
1985    
1986        if (!$self->{_attr_id_tie})
1987        {
1988      foreach my $x (`cat $newGdir/evidence.codes`)      foreach my $x (`cat $newGdir/evidence.codes`)
1989      {      {
1990          if ($x =~ /^(\S+)\t(\S+)/)          if ($x =~ /^(\S+)\t(\S+)/)
1991          {          {
1992              push(@{$attr->{$1}},[$1,"evidence_code",$2,""]);                  push(@{$id->{$1}},[$1,"evidence_code",$2,""]);
1993                }
1994          }          }
1995      }      }
1996      $self->{_attr} = $attr;  
1997  }  }
1998    
1999  sub load_ann {  sub load_ann {

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.44

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3