view release on metacpan or  search on metacpan

Bio/AlignIO/arp.pm  view on Meta::CPAN

                push @{$self->{state}->{Annotation}->{$cur_type}}, $cur_data;
        }
        elsif ($data =~ m{^\s*\}\s*$}xms) {
            $self->throw("Unmatched bracket in ARP file:\n$data") if
                !exists($self->{state}->{in_curly_block});
            if ($self->{state}->{current_block} eq 'Samples') {;
                my $ac = $self->_process_annotation($aln);
                delete $self->{state}->{SampleAnnotation};
            } else {
                # process other data at a later point
            }
            delete $self->{state}->{blockdata};
            $self->{state}->{in_curly_block} = 0;
            last SCAN;
        }
        else {
            # all other data should be in a curly block and have a block title
            $self->throw("Data found outside of proper block:\n$data") if
                !exists($self->{state}->{current_block}) && !$self->{state}->{in_curly_block};
            # bypass commented stuff (but we may want to process it at a later
            # point, so turn back here)
            next if $data =~ m{^\s*\#}xms;
            if ($self->{state}->{current_block} eq 'Samples') {
                chomp $data;
                # we have two possible ways to deal with sample number, either
                # clone the LocatableSeq (in which case we need to deal with ID
                # duplication), or store as annotation data. I chose the latter
                # route using a Bio::Annotation::TagTree. YMMV - cjfields 10-15-08
                my ($ls, $samples) = $self->_process_sequence($data);
                my $id = $ls->id;
                push @{ $self->{state}->{SampleAnnotation}->{Samples} }, [$id => $samples];
                $aln->add_seq($ls);
            } else {
                # add elsif's for further processing
                #$self->debug('Unmatched data in block '.
                #             $self->{state}->{current_block}.
                #             ":\n$data\n");
                $self->{state}->{blockdata} .= $data;
            }
        }
    }
    # alignments only returned if they contain sequences
    return $aln if $aln->num_sequences;
    return;
}

=head2 write_aln

 Title   : write_aln
 Usage   : $stream->write_aln(@aln)
 Function: writes the $aln object into the stream in xmfa format
 Returns : 1 for success and 0 for error
 Args    : L<Bio::Align::AlignI> object

See L<Bio::Align::AlignI>

=cut

sub write_aln {
    my ($self,@aln) = @_;
    $self->throw_not_implemented;
}

################ PRIVATE SUBS ################ 

sub _process_sequence {
    my ($self, $raw) = @_;
    return unless defined $raw;
    $raw =~ s{(?:^\s+|\s+$)}{}g;
    my ($id, $samples, $seq) = split(' ', $raw);
    my $ls = Bio::LocatableSeq->new('-seq'        => $seq,
                                    '-start'      => 1,
                                    '-display_id' => $id,
				    '-alphabet'   => $self->alphabet);
    return($ls, $samples);
}

sub _process_annotation {
    my ($self, $aln) = @_;
    my $coll = Bio::Annotation::Collection->new();
    my $factory = Bio::Annotation::AnnotationFactory->new(-type => 'Bio::Annotation::SimpleValue');
    for my $anntype (qw(SampleAnnotation Annotation)) {
        for my $key (keys %{ $self->{state}->{$anntype} }) {
            if ($key eq 'Title') {
                $aln->description($self->{state}->{$anntype}->{$key}[0]);
            } elsif ($key eq 'Samples') {
                $factory->type('Bio::Annotation::TagTree');
                $coll->add_Annotation($key, $factory->create_object(
                    -value => [$key => $self->{state}->{$anntype}->{$key}]));
                $factory->type('Bio::Annotation::SimpleValue');
            } elsif ($key eq 'SampleName') {
                $aln->id($self->{state}->{$anntype}->{$key}[0]);
            } else {
                $self->throw('Expecting an array reference') unless
                    ref $self->{state}->{$anntype}->{$key} eq 'ARRAY';
                for my $a (@{ $self->{state}->{$anntype}->{$key} }) {
                    $coll->add_Annotation($key, $factory->create_object(
                        -value => $a) );
                }
            }
        }
    }
    #$self->debug("Collection:".Dumper($coll)."\n");
    $aln->annotation($coll);
}

1;