BioPerl

 view release on metacpan or  search on metacpan

Bio/MapIO/fpc.pm  view on Meta::CPAN

                }
                else {
                    $_markers{$name}{'framework'} = 0;
                }
            }
            elsif ($line =~ /^anchor$/) {
                $_markers{$name}{'anchor'} = 1;
            }
            elsif ($line =~ /^Remark\s+"(.+)"/)  {
                $_markers{$name}{'remark'} .= $1;
                $_markers{$name}{'remark'} .= "\n";
            }
        }
        $curMarker++;
        print "Adding Marker $curMarker...\n"
            if ($self->verbose() && $curMarker % 1000 == 0);
    }

    $map->_setMarkerRef(\%_markers);

    my $ctgname;
    my $grpabbr = $map->group_abbr();
    my $chr_remark;

    $_contigs{0}{'group'} = 0;

    while (defined($line = <$fh>)) {

        if ($line =~ /^Ctg(\d+)/) {
            $ctgname = $1;
            $_contigs{$ctgname}{'group'}      = 0;
            $_contigs{$ctgname}{'anchor'}     = 0;
            $_contigs{$ctgname}{'position'}   = 0;

            if ($line =~ /#\w*(.*)\w*$/) {
                $_contigs{$ctgname}{'remark'} = $1;
                if ($line =~ /#\s+Chr(\d+)\s+/) {
                    $_contigs{$ctgname}{'group'}  = $1;
                    $_contigs{$ctgname}{'anchor'} = 1;
                }
            }
        }
        elsif ($line =~ /^Chr_remark\s+"(-|\+|Chr(\d+))\s+(.+)"$/) {

            $_contigs{$ctgname}{'anchor'}     = 1;
            $_contigs{$ctgname}{'chr_remark'} = $3 if(defined($3));

            if (defined($2)) {
                $_contigs{$ctgname}{'group'}  = $2;
            }
            else {
                $_contigs{$ctgname}{'group'}  = "?";
            }
        }
        elsif ($line =~ /^User_remark\s+"(.+)"/) {
            $_contigs{$ctgname}{'usr_remark'} = $1;
        }
        elsif ($line =~ /^Trace_remark\s+"(.+)"/) {
            $_contigs{$ctgname}{'trace_remark'} = $1;
        }
        elsif ($grpabbr && $line =~ /^Chr_remark\s+"(\W|$grpabbr((\d+)|(\w+)|([.\w\d]+)))\s*(\{(.*)\}|\[(.*)\])?"\s+(Pos\s+((\d.)+|NaN))(NOEDIT)?/)
        {
            my $grpmatch = $2;
            my $pos = $10;
            if ($pos eq "NaN") {
                $pos = 0;
                print "Warning: Nan encountered for Contig position \n";
            }
            $_contigs{$ctgname}{'chr_remark'}   = $6;
            $_contigs{$ctgname}{'position'} = $pos;
            $_contigs{$ctgname}{'subgroup'} = 0;

            if (defined($grpmatch)) {
                $_contigs{$ctgname}{'anchor'} = 1;

                if ($grpmatch =~ /((\d+)((\D\d.\d+)|(.\d+)))|((\w+)(\.\d+))/) {

                    my ($group,$subgroup);
                    $group    = $2 if($grpabbr eq "Chr");
                    $subgroup = $3 if($grpabbr eq "Chr");

                    $group    = $7 if($grpabbr eq "Lg");
                    $subgroup = $8 if($grpabbr eq "Lg");

                    $subgroup = substr($subgroup,1) if ($subgroup =~ /^\./);
                    $_contigs{$ctgname}{'group'}     = $group;
                    $_contigs{$ctgname}{'subgroup'}  = $subgroup;

                }
                else {
                    $_contigs{$ctgname}{'group'} = $grpmatch;
                }
            }
            else {
                $_contigs{$ctgname}{'anchor'} = 1;
                $_contigs{$ctgname}{'group'}  = "?";
            }
        }
        $curContig++;
        print "Adding Contig $curContig...\n"
            if ($self->verbose() && $curContig % 100 == 0);
    }

    $map->_setContigRef(\%_contigs);
    $map->_calc_markerposition();
    $map->_calc_contigposition() if ($map->version() < 7.0);
    $map->_calc_contiggroup() if ($map->version() == 4.6);

    return $map;
}


=head2 write_map

 Title   : write_map
 Usage   : $mapio->write_map($map);
 Function: Write a map out
 Returns : none
 Args    : Bio::Map::MapI

=cut

sub write_map{
    my ($self,@args) = @_;
    $self->throw_not_implemented();



( run in 2.486 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )