Mercurial > repos > cpt > cpt_psm_prep

comparison lib/CPT/Bio/DataSource/Chado.pm @ 1:d724f34e671d draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author cpt
date Mon, 05 Jun 2023 02:50:07 +0000
parents
children
comparison
equal deleted inserted replaced
0:e4de0a0e90c8 1:d724f34e671d
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