view release on metacpan or  search on metacpan

Bio/SeqIO/agave.pm  view on Meta::CPAN

             - reference to a data structure to store the <fragment_order> data.
  Returns  : Nothing.
  Note     : Method(s) that call(s) this method : _process_contig
             Method(s) that this method calls   :
             _helper_store_attribute_list , _process_fragment_orientation

=cut

sub _process_fragment_order {


    my ($self, $line, $data_structure) = @_;
    # Because I'm passing a reference to a data structure, I don't need to return it
    # after values have been added.

    while ($$line =~ /<fragment_order\s?(.*?)\s?>/) {

        my $fragment_order;
        $self->_helper_store_attribute_list($1, \$fragment_order);
        # Store the attribute(s) for <fragment_order> into the
        # $fragment_order data structure.
        $$line = $self->_readline;

        # One or more <fragment_orientation>
        $self->_process_fragment_orientation($line, \$fragment_order);
        # Don't forget: $line is a reference to a scalar.

        push @{$$data_structure->{'fragment_order'}}, $fragment_order;
        # Store the data between <fragment_order></fragment_order>
        # in $$data_structure.

    }

    return;

}
# ==================================================================================

=head2 _process_fragment_orientation

  Title    : _process_fragment_orientation
  Usage    : $self->_process_fragment_orientation
  Function : Parses the data between the <fragment_orientation> and
             </fragment_orientation> tags.
  Args     : 2 scalars:
             - reference to a scalar holding the value of the line to be parsed.
             - reference to a data structure to store the <fragment_orientation> data.
  Returns  : Nothing.
  Note     : Method(s) that call(s) this method : _process_fragment_order

Method(s) that this method calls : _helper_store_attribute_list ,
_process_bio_sequence

=cut

sub _process_fragment_orientation {


    my ($self, $line, $data_structure) = @_;

    # counter to determine the number of iterations within this while loop.
    my $count = 0;

    # One or more <fragment_orientation>
    while ($$line =~ /<fragment_orientation\s?(.*?)\s?>/) {

        my $fragment_orientation;
        $self->_helper_store_attribute_list($1, \$fragment_orientation);
        $$line = $self->_readline;

        # One <bio_sequence>
        $$line =~ /<bio_sequence\s?(.*?)\s?>/;
        # Process the data between <bio_sequence></bio_sequence>
        my $bio_sequence = $self->_process_bio_sequence($line, $1);
        $fragment_orientation->{'bio_sequence'} = $bio_sequence;

        push @{$$data_structure->{'fragment_orientation'}}, $fragment_orientation;

        ++$count;
    }


    $self->throw("Error: Missing <fragment_orientation> tag.  Got this: $$line\n\n")
        if $count == 0;

    return;

}
# ==================================================================================

=head2 _process_bio_sequence

  Title    : _process_bio_sequence
  Usage    : $self->_process_bio_sequence
  Function : Parses the data between the <bio_sequence></bio_sequence> tags.
  Args     : 2 scalars:
             - reference to a scalar holding the value of the line to be parsed.
             - scalar holding the value of the attributes for <bio_sequence>
  Returns  : data structure holding the values between <bio_sequence></bio_sequence>
  Note     : Method(s) that call(s) this method : _process_fragment_orientation

Method(s) that this method calls : _helper_store_attribute_list ,
_one_tag , _question_mark_tag , _star_tag , _process_alt_ids ,
_process_xrefs , _process_sequence_map

=cut

sub _process_bio_sequence {

    my ($self, $line, $attribute_line) = @_;

    my $bio_sequence;

    $self->_helper_store_attribute_list($attribute_line, \$bio_sequence);
    $$line = $self->_readline;


    # One <db_id>.
    $self->_one_tag($line, \$bio_sequence, 'db_id');

Bio/SeqIO/agave.pm  view on Meta::CPAN

    my $sequence_map;

    # Zero or more <sequence_map>
    while ($$line =~ /<sequence_map\s?(.*?)\s?>/) {

        $self->_helper_store_attribute_list($1, \$sequence_map) if defined $1;
        $$line = $self->_readline;

        # Zero or one <note>
        $self->_question_mark_tag($line, \$sequence_map, 'note');

        # NOT IMPLEMENTED!!!
        #if ($$line =~ /<computations\?(.*?)\s?>/){
        #       # $self->_process_computations();
        #}


        # Zero or one <annotations>
        if ($$line =~ /<annotations\s?(.*?)\s?>/) {
            my $annotations = $self->_process_annotations($line);
            $sequence_map->{'annotations'} = $annotations;
        }


    }                           # closes the while loop


    # Match closing tag:
    if ($$line =~ /<\/sequence_map>/) {
        return $sequence_map;
    } else {
        $self->throw("Error:  Missing </sequence_map> tag.  Got this: $$line\n\n");
    }


}
# ==================================================================================

=head2 _process_annotations

  Title    : _process_annotations
  Usage    : $self->_process_annotations
  Function : Parse the data between the <annotations></annotations> tags.
  Args     : Reference to scalar holding the line to be parsed.
  Returns  : Data structure that holds the values that were parsed.
  Note     : Method(s) that call(s) this method : _process_sequence_map
             Method(s) that this method calls   : _process_seq_feature

=cut

sub _process_annotations {

    my ($self, $line) = @_;
    # ( seq_feature | gene | comp_result )+

    my $annotations;

    $$line = $self->_readline;

    my $count = 0;              # counter to keep track of number of iterations in the loop.

    # One or more of these:
    while ($$line =~ /<(seq_feature|gene|comp_result)\s?(.*?)\s?>/) {

        if ($$line =~ /<seq_feature\s?(.*?)\s?>/) {

            my $seq_feature = $self->_process_seq_feature($line, $1);
            push @{$annotations->{'seq_feature'}}, $seq_feature;

        } elsif ($$line =~ /<gene\s?(.*?)\s?>/) {

            # gene

        } elsif ($$line =~ /<comp_result\s?(.*?)\s?>/) {

            # comp_result

        }

        ++$count;

    }                           # closes the while loop.

    $self->throw("Error:  Missing <seq_feature> tag.  Got: $$line\n\n") if $count == 0;

    # Match closing tag:
    if ($$line =~ /<\/annotations/) {

        $$line = $self->_readline; # get the next line to be _processed by the next sub.
        return $annotations;

    } else {
        $self->throw("Error:  Missing </annotations> tag.  Got this: $$line\n\n");
    }


}
# ==================================================================================

=head2 _process_seq_feature

  Title    : _process_seq_feature
  Usage    : $self->_process_seq_feature
  Function : Parses the data between the <seq_feature></seq_feature> tag.
  Args     : 2 scalars:
             - Reference to scalar holding the line to be parsed.
             - Scalar holding the attributes for <seq_feature>.
  Returns  : Data structure holding the values parsed.
  Note     : Method(s) that call(s) this method: _process_annotations

Method(s) that this method calls: _helper_store_attribute_list ,
_process_classification , _question_mark_tag , _one_tag ,
_process_evidence , _process_qualifier , _process_seq_feature ,
_process_related_annot

=cut

sub _process_seq_feature {

    my ($self, $line, $attribute_line) = @_;