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

Diff of /FigKernelPackages/FigGFF.pm

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

revision 1.1, Mon Mar 14 19:17:37 2005 UTC revision 1.2, Tue Mar 15 19:47:15 2005 UTC
# Line 52  Line 52 
52    
53  sub gff3_for_feature  sub gff3_for_feature
54  {  {
55      my($self, $fid, $user) = @_;      my($self, $fid, $user, $user_note) = @_;
56    
57      #      #
58      # Options we need to figure out somehow.      # Options we need to figure out somehow.
# Line 61  Line 61 
61    
62      my $escapespace = $options->{escapespace};      my $escapespace = $options->{escapespace};
63      my $outputfasta = $options->{outputfasta};      my $outputfasta = $options->{outputfasta};
64      my %outputtype = (cds => 1,  
65                        protein => 1,      my %outputtype;
66                        transcript => 1,      map { $outputtype{$_} = 1 } @{$options->{outputtype}};
                       gene => 1);  
67    
68      my $fastasequences = '';      my $fastasequences = '';
69      my $contig_data;      my $contig_data;
# Line 76  Line 75 
75      # Do this first to make sure that we really have a feature.      # Do this first to make sure that we really have a feature.
76      #      #
77      my @location = $fig->feature_location($fid);      my @location = $fig->feature_location($fid);
     print Dumper(\@location);  
78      if (@location == 0 or !defined($location[0]))      if (@location == 0 or !defined($location[0]))
79      {      {
80          warn "No location found for feature $fid\n";          warn "No location found for feature $fid\n";
# Line 100  Line 98 
98      #      #
99      my @alias;      my @alias;
100    
101        if ($options->{with_assignments})
102        {
103      my $func = $fig->function_of($fid, $user);      my $func = $fig->function_of($fid, $user);
104      if ($func)      if ($func)
105      {      {
106          push @$note, ("Note=\"" . uri_escape($func) . '"');          push @$note, ("Note=\"" . uri_escape($func) . '"');
107      }      }
108        }
109    
110        if ($options->{with_aliases})
111        {
112      # now find aliases      # now find aliases
113      foreach my $alias ($fig->feature_aliases($fid))      foreach my $alias ($fig->feature_aliases($fid))
114      {      {
# Line 142  Line 145 
145              push @alias, $alias;              push @alias, $alias;
146          }          }
147    }    }
148        }
149    
150      # now just join all the aliases and put them into @$note so we can add it to the array      # now just join all the aliases and put them into @$note so we can add it to the array
151      if (@alias)      if (@alias)
# Line 149  Line 153 
153          push @$note, "Alias=\"". join (",", @alias) . '"';          push @$note, "Alias=\"". join (",", @alias) . '"';
154      }      }
155    
156        #
157        # If we have user note passed in, add it.
158        #
159    
160        if ($user_note)
161        {
162            push @$note, $user_note;
163        }
164    
165      # the LAST thing I am going to add as a note is the FIG id so that I can grep it out easily      # the LAST thing I am going to add as a note is the FIG id so that I can grep it out easily
166      push @$note, "Dbxref=\"SEED:$fid\"";      push @$note, "Dbxref=\"SEED:$fid\"";
167    
# Line 268  Line 281 
281    
282                  push (@{$contig_data->{$contig_key}},                  push (@{$contig_data->{$contig_key}},
283                        (join "\t",                        (join "\t",
284                         ($contig, "The SEED", $type, $start, $stop, ".", $strand, ".", "Id=$id;$allnotes")));                         ($contig, "The SEED", $type, $start, $stop, ".", $strand, ".", "ID=$id;$allnotes")));
285              } # end the foreach my $type              } # end the foreach my $type
286          } # end the if type==peg          } # end the if type==peg
287          elsif ($type eq "rna")          elsif ($type eq "rna")
# Line 285  Line 298 
298                  $addseq =~ s/(.{$linelength})/$1\n/g; chomp($addseq);                  $addseq =~ s/(.{$linelength})/$1\n/g; chomp($addseq);
299                  $fastasequences .= ">$id\n$addseq\n";                  $fastasequences .= ">$id\n$addseq\n";
300              }              }
301              push (@{$contig_data->{$contig_key}}, (join "\t", ($contig, "The SEED", $type, $start, $stop, ".", $strand, ".", "Id=$id;$allnotes")));              push (@{$contig_data->{$contig_key}}, (join "\t", ($contig, "The SEED", $type, $start, $stop, ".", $strand, ".", "ID=$id;$allnotes")));
302          } # end the if type == rna          } # end the if type == rna
303          else          else
304          {          {
# Line 367  Line 380 
380          }          }
381          for my $list (@{$contigs{$contig}})          for my $list (@{$contigs{$contig}})
382          {          {
383              print $fh join "\n", @$list;              print $fh join("\n", @$list), "\n";
384          }          }
385      }      }
386    
# Line 410  Line 423 
423      close($fh) if $close_output;      close($fh) if $close_output;
424  }  }
425    
426    package GFFParser;
427    
428    use strict;
429    use URI::Escape;
430    use Carp;
431    use Data::Dumper;
432    
433    use base qw(Class::Accessor);
434    
435    __PACKAGE__->mk_accessors(qw(fig current_file));
436    
437    my $count;
438    
439    
440    #
441    # GFF file parser. Creates GFFFiles.
442    #
443    
444    sub new
445    {
446        my($class, $fig) = @_;
447    
448        my $self = {
449            fig => $fig,
450        };
451    
452        return bless($self, $class);
453    }
454    
455    sub parse
456    {
457        my($self, $file) = @_;
458    
459        my($fh, $close_handle);
460    
461        my $fobj = GFFFile->new($self->fig);
462        $self->current_file($fobj);
463    
464        if (ref($file) ? (ref($file) eq 'GLOB'
465                           || UNIVERSAL::isa($file, 'GLOB')
466                           || UNIVERSAL::isa($file, 'IO::Handle'))
467            : (ref(\$file) eq 'GLOB'))
468        {
469            $fh = $file;
470        }
471        else
472        {
473            open($fh, "<$file") or confess "Cannot open $file: $!";
474            $fobj->filename($file);
475            $close_handle = 1;
476        }
477    
478        #
479        # Start parsing by verifying this is a gff3 file.
480        #
481    
482        $_ = <$fh>;
483    
484        if (m,^\#gff-version\t(\S+),)
485        {
486            if ($1 != 3)
487            {
488                confess "Invalid GFF File: version is not 3";
489            }
490        }
491    
492        #
493        # Now parse.
494        #
495    
496        while (<$fh>)
497        {
498            chomp;
499            #
500            # Check first for the fasta directive so we can run off and parse that
501            # separately.
502            #
503    
504            if (/^>/)
505            {
506                $self->parse_fasta($fh, $_);
507                last;
508            }
509            elsif (/^\#\#FASTA/)
510            {
511                print "Got fasta directive\n";
512                $_ = <$fh>;
513                chomp;
514                $self->parse_fasta($fh, $_);
515                last;
516            }
517            elsif (/^\#\s/)
518            {
519                #
520                # comment.
521                #
522                next;
523            }
524            elsif (/^\#\#(\S+)(?:\t(.*))?/)
525            {
526                #
527                # GFF3 directive.
528                #
529    
530                $self->parse_gff3_directive($1, $2);
531    
532            }
533            elsif (/^\#(\S+)(?:\t(.*))?/)
534            {
535                #
536                # Directive.
537                #
538    
539                if ($1 eq "seed")
540                {
541                    $self->parse_seed_directive($2);
542                }
543                else
544                {
545                    $self->parse_local_directive($1, $2);
546                }
547    
548            }
549            elsif (/^([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)$/)
550            {
551                $self->parse_feature($1, $2, $3, $4, $5, $6, $7, $8, $9);
552            }
553            else
554            {
555                die "bad line: '$_'\n";
556            }
557        }
558    
559        return $fobj;
560    }
561    
562    sub parse_gff3_directive
563    {
564        my($self, $directive, $rest) = @_;
565    
566        print "Have gff3 directive '$directive' rest='$rest'\n";
567    }
568    
569    sub parse_seed_directive
570    {
571        my($self, $rest) = @_;
572    
573        my($verb, @rest) = split(/\t/, $rest);
574    
575        if ($verb eq "anno_start")
576        {
577            $self->current_file->anno_start($rest[0]);
578        }
579        elsif ($verb eq "anno_end")
580        {
581            $self->current_file->anno_start($rest[0]);
582        }
583        elsif ($verb eq "genome_md5")
584        {
585            $self->current_file->set_genome_checksum(@rest[0,1]);
586        }
587        elsif ($verb eq "contig_md5")
588        {
589            $self->current_file->set_contig_checksum(@rest[0,1,2]);
590        }
591    }
592    
593    sub parse_local_directive
594    {
595        my($self, $directive, $rest) = @_;
596    
597        print "Have local directive '$directive' rest='$rest'\n";
598    }
599    
600    sub parse_feature
601    {
602        my($self, $seqid, $source, $type, $start, $end, $score, $strand, $phase, $attributes) = @_;
603    
604        #print "data: seqid=$seqid source=$source type=$type start=$start end=$end\n";
605        #print "      score=$score strand=$strand phase=$phase\n";
606        #print "      $attributes\n";
607    
608        #
609        # Parse this feature, creating a GFFFeature object for it.
610        #
611    
612        my $feature = GFFFeature->new($self->fig);
613    
614        $feature->seqid($seqid);
615        $feature->source($source);
616        $feature->type($type);
617        $feature->start($start);
618        $feature->end($end);
619        $feature->score($score);
620        $feature->strand($strand);
621        $feature->phase($phase);
622    
623        my $athash = {};
624    
625        for my $attr (split(/;/, $attributes))
626        {
627            my($name, $value) = split(/=/, $attr);
628    
629            #
630            # Handle the GFF3-defined attributes
631            #
632    
633            my @values = split(/,/, $value);
634    
635            if (@values > 1)
636            {
637                my $vlist = [];
638                for my $value (@values)
639                {
640                    $value = uri_unescape($value);
641                    push(@$vlist, $value);
642                }
643                $value = $vlist;
644            }
645    
646            $athash->{$name} = $value;
647    
648            if ($GFFFeature::GFF_Tags{$name})
649            {
650                $feature->set($name, $value);
651            }
652    
653        }
654        $feature->attributes($athash);
655    
656        $self->current_file->add_feature($feature);
657    }
658    
659    #
660    # We come in here with the first line of the fasta already read
661    # in order to support the backward-compatiblity syntax that
662    # lets a file skip the ##FASTA directive if it wishes.
663    #
664    sub parse_fasta
665    {
666        my($self, $fh, $first_line) = @_;
667        my($cur, $cur_id);
668    
669        for ($_ = $first_line; $_;  $_ = <$fh>, chomp)
670        {
671            if (/^>\s*(\S+)/)
672            {
673                if ($cur)
674                {
675                    $self->handle_fasta_block($cur_id, $cur);
676                }
677    
678                $cur = '';
679                $cur_id = $1;
680            }
681            else
682            {
683                s/^\s*$//;
684                s/\s*$//;
685                if (/\s/)
686                {
687                    die "FASTA data had embedded space: $_\n";
688                }
689                $cur .= $_;
690            }
691        }
692        if ($cur)
693        {
694            $self->handle_fasta_block($cur_id, $cur);
695        }
696    }
697    
698    sub handle_fasta_block
699    {
700        my($self, $id, $data) = @_;
701    
702        my $len = length($data);
703        $self->current_file->set_fasta_data($id, $data);
704    }
705    
706    package GFFFeature;
707    
708    use strict;
709    use base qw(Class::Accessor);
710    
711    our @GFF_Tags = qw(ID Name  Alias Parent Target Gap Note Dbxref Ontology_term);
712    our %GFF_Tags;
713    
714    map { $GFF_Tags{$_} = 1 } @GFF_Tags;
715    
716    __PACKAGE__->mk_accessors(qw(fig seqid source type start end score strand phase attributes),
717                              @GFF_Tags);
718    
719    
720    sub new
721    {
722        my($class, $fig) = @_;
723    
724        my $self = {
725            fig => $fig,
726        };
727    
728        return bless($self, $class);
729    }
730    
731    package GFFFile;
732    
733    use strict;
734    use base qw(Class::Accessor);
735    
736    __PACKAGE__->mk_accessors(qw(fig filename features feature_index anno_start anno_end));
737    
738    #
739    # Package to hold the contents of a GFF file, and to hold the code
740    # for mapping its contents to the local SEED.
741    #
742    # Created by GFFParser->parse.
743    #
744    
745    sub new
746    {
747        my($class, $fig) = @_;
748    
749        my $self = {
750            fig => $fig,
751            features => [],
752            feature_index => {},
753        };
754        return bless($self, $class);
755    }
756    
757    sub add_feature
758    {
759        my($self, $feature) = @_;
760    
761        push(@{$self->features}, $feature);
762        $self->feature_index->{$feature->ID} = $feature;
763    }
764    
765    sub set_genome_checksum
766    {
767        my($self, $genome, $md5sum) = @_;
768        $self->{genome_checksum}->{$genome} = $md5sum;
769    }
770    
771    sub set_contig_checksum
772    {
773        my($self, $genome, $contig, $md5sum) = @_;
774        $self->{contig_checksum}->{$genome}->{$contig} = $md5sum;
775    }
776    
777    sub set_fasta_data
778    {
779        my($self, $id, $data) = @_;
780    
781        $self->{fasta_data}->{$id} = $data;
782    }
783    
784    
785  1;  1;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3