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

Diff of /FigKernelPackages/P2P.pm

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

revision 1.26, Tue Jan 11 14:06:18 2005 UTC revision 1.27, Tue Jan 11 20:15:59 2005 UTC
# Line 80  Line 80 
80      open($html_fh, ">$html_file") or die "Cannot open htmlfile $html_file: $!\n";      open($html_fh, ">$html_file") or die "Cannot open htmlfile $html_file: $!\n";
81      $html_fh->autoflush(1);      $html_fh->autoflush(1);
82    
83      if (ref($assignment_policy) eq "CODE")      if (!defined($assignment_policy))
84        {
85            $allow_assignment = sub { 1;};
86        }
87        elsif (ref($assignment_policy) eq "CODE")
88      {      {
89          $allow_assignment = $assignment_policy;          $allow_assignment = $assignment_policy;
90      }      }
# Line 764  Line 768 
768                      # the feature is on, we want to look at either minloc or maxloc.                      # the feature is on, we want to look at either minloc or maxloc.
769                      #                      #
770    
771                      my $whichloc = $strand eq '-' ? "minloc" : "maxloc";                      my($start_loc, $end_loc);
772    
773                      my $res = $dbh->SQL(qq!SELECT id from features                      if ($strand eq '-')
774                                             WHERE $whichloc = $end and genome = '$my_genome' and                      {
775                            $start_loc = 'maxloc';
776                            $end_loc = 'minloc';
777                        }
778                        else
779                        {
780                            $start_loc = 'minloc';
781                            $end_loc = 'maxloc';
782                        }
783    
784                        my $res = $dbh->SQL(qq!SELECT id, $start_loc from features
785                                               WHERE $end_loc = $end and genome = '$my_genome' and
786                                             contig = '$local_contig'                                             contig = '$local_contig'
787                                          !);                                          !);
788    
789                      if ($res and @$res > 0)                      if ($res and @$res > 0)
790                      {                      {
791                          my(@ids) = map { $_->[0] } @$res;                          my $id;
792                          my $id = $ids[0];                          if (@$res == 1)
793                            {
794                                #
795                                # Found a unique mapping.
796                                #
797                                $id = $res->[0]->[0];
798                            }
799                            else
800                            {
801                                #
802                                # Multiple mappings found. See if one matches the
803                                # start location. If it doesn't, pick the one that
804                                # is closest in length.
805                                #
806    
807                                my @lens;
808    
809                                for my $res_ent (@$res)
810                                {
811                                    my($rid, $rloc) = @$res_ent;
812    
813                                    push(@lens, [$rid, abs($rloc - $end - ($start - $end))]);
814                                    warn "Matching $rid $rloc to $start\n";
815                                    if ($rloc == $start)
816                                    {
817                                        $id = $rid;
818                                        warn "Matched $rid\n";
819                                        last;
820                                    }
821                                }
822    
823                                if (!$id)
824                                {
825                                    my @slens = sort { $a->[1] <=> $b->[1]} @lens;
826                                    my $len;
827                                    ($id, $len) = @{$slens[0]};
828                                    warn "No unique match found, picking closest match $id (len=$len)\n";
829                                }
830                            }
831    
832                          $peg_mapping->{$peg} = $id;                          $peg_mapping->{$peg} = $id;
833                          $peg_cache->{$peg} = $id;                          $peg_cache->{$peg} = $id;
834                          print "Mapped $peg to $id via contigs\n";                          print "Mapped $peg to $id via contigs\n";
                         if (@$res > 1)  
                         {  
                             warn "Multiple mappings found for $peg: @ids\n";  
                             print $log_fh "Multiple mappings found for $peg: @ids\n";  
                         }  
835                      }                      }
836                      else                      else
837                      {                      {
# Line 996  Line 1045 
1045    
1046      $credentials = [] unless ref($credentials);      $credentials = [] unless ref($credentials);
1047    
1048      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url, timeout => 3600,      my $proxy = SOAP::Lite->uri($ns_p2p)->proxy($url, timeout => 3600);
1049                                                  credentials => $credentials);  
1050        for my $cred (@$credentials)
1051        {
1052            $proxy->transport->credentials(@$cred);
1053        }
1054    
1055      my $self = {      my $self = {
1056          fig => $fig,          fig => $fig,

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3