Mercurial > repos > cpt > cpt_psm_plotter

comparison cpt_psm_plotter/lib/CPT/Bio/DataSource/Chado.pm @ 0:54c7a3ea81e2 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author cpt
date Tue, 05 Jul 2022 05:40:36 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:54c7a3ea81e2
1 package CPT::Bio::DataSource::Chado;
2 no warnings;
3 use Moose;
4 with 'CPT::Bio::DataSource';
5
6 has 'host' => ( is => 'rw', isa => 'Str' );
7 has 'pass' => ( is => 'rw', isa => 'Str' );
8 has 'user' => ( is => 'rw', isa => 'Str' );
9 has 'name' => ( is => 'rw', isa => 'Str' );
10 has 'port' => ( is => 'rw', isa => 'Str' );
11
12 has 'landmark' => ( is => 'rw', isa => 'Str' );
13 has 'organism' => ( is => 'rw', isa => 'Str' );
14
15
16 sub getSeqIO {
17 my ($self) = @_;
18 require CPT::Chado::GMOD_Conf;
19
20 my $db = Bio::DB::Das::Chado->new(
21 -dsn => sprintf( 'dbi:Pg:dbname=%s;host=%s;port=%s', $self->name(), $self->host(), $self->port() ),
22 -user => $self->user(),
23 -pass => $self->pass(),
24 -organism => $self->organism(),
25 -inferCDS => 1,
26
27 );
28
29 # Get a list of "segments". Essentially (seqlen IS NOT NULL)
30 my @segments = $db->segment( -name => $self->{'landmark'} );
31
32 # TODO: Need to have a fallback method
33 # Should only produce ONE since we specify landmark exactly
34 foreach my $segment (@segments) {
35 my $stream = $segment->get_feature_stream();
36 use Bio::Seq;
37 my $seq_obj = Bio::Seq->new(
38 -seq => $segment->seq->seq(),
39 -display_id => $segment->id()
40 );
41 use Bio::SeqFeature::Generic;
42 while ( my $feat = $stream->next_seq ) {
43
44 # In an IDEAL world we'd just do $seq_obj->add_SeqFeature($feat);
45 #
46 # HOWEVER.
47 #
48 # ------------- EXCEPTION: Bio::Root::NotImplemented -------------
49 # MSG: Abstract method "Bio::DB::Das::Chado::Segment::Feature::attach_seq" is not implemented by package Bio::DB::Das::Chado::Segment::Feature.
50 # This is not your fault - author of Bio::DB::Das::Chado::Segment::Feature should be blamed!
51 # STACK: Error::throw
52 # STACK: Bio::Root::Root::throw /usr/local/share/perl/5.14.2/Bio/Root/Root.pm:472
53 # STACK: Bio::Root::RootI::throw_not_implemented /usr/local/share/perl/5.14.2/Bio/Root/RootI.pm:748
54 # STACK: Bio::DB::Das::Chado::Segment::Feature::attach_seq /usr/local/share/perl/5.14.2/Bio/DB/Das/Chado/Segment/Feature.pm:374
55 # STACK: Bio::Seq::add_SeqFeature /usr/local/share/perl/5.14.2/Bio/Seq.pm:1148
56 # STACK: chado_export.pl:59
57 # ----------------------------------------------------------------
58
59 # BUT WE CAN'T. >_> rageface.tiff
60
61 my %keys;
62 foreach my $tag ( $feat->get_all_tags() ) {
63 my @values = $feat->get_tag_values($tag);
64 if ( $tag eq 'Note' ) {
65 $tag = 'note';
66 }
67 if ( $tag eq 'Dbxref' ) {
68 $tag = 'db_xref';
69
70 #@values = map { if($_ ne 'GFF_source:Genbank'){ $_ } } @values;
71 @values = grep !/GFF_source:Genbank/, @values;
72 }
73 $keys{$tag} = \@values;
74 }
75
76 #print $feat->gff_string(),"\n";
77 my $new_feat = new Bio::SeqFeature::Generic(
78 -start => $feat->start(),
79 -end => $feat->end(),
80 -strand => $feat->strand(),
81 -primary_tag => $feat->primary_tag(),
82 -tag => \%keys,
83 );
84 $seq_obj->add_SeqFeature($new_feat);
85 }
86
87 return $seq_obj;
88 }
89
90 }
91
92 no Moose;
93 1;
94
95 __END__
96
97 =pod
98
99 =encoding UTF-8
100
101 =head1 NAME
102
103 CPT::Bio::DataSource::Chado
104
105 =head1 VERSION
106
107 version 1.99.4
108
109 =head2 getSeqIO
110
111 supposed to get a seqIO object from a chado DB. not fully implemented
112
113 =head1 AUTHOR
114
115 Eric Rasche <rasche.eric@yandex.ru>
116
117 =head1 COPYRIGHT AND LICENSE
118
119 This software is Copyright (c) 2014 by Eric Rasche.
120
121 This is free software, licensed under:
122
123 The GNU General Public License, Version 3, June 2007
124
125 =cut