source: branches/stable/PERL_SCRIPTS/GENOME/GI.pm

Last change on this file was 7971, checked in by westram, 9 years ago
  • perl script to collect information from gene-field and store it into organism-field
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.2 KB
Line 
1#  ==================================================================== #
2#                                                                       #
3#    File      : GI.pm                                                  #
4#    Purpose   : Genome import library                                  #
5#                                                                       #
6#                                                                       #
7#  Coded by Ralf Westram (coder@reallysoft.de) in December 2003         #
8#  Copyright Department of Microbiology (Technical University Munich)   #
9#                                                                       #
10#  Visit our web site at: http://www.arb-home.de/                       #
11#                                                                       #
12#                                                                       #
13#  ==================================================================== #
14
15package GI;
16
17use strict;
18use warnings;
19use ARB;
20
21my $gb_main;
22my $columns;
23
24sub connectDB() {
25  print "Connecting to running ARB database\n";
26  $gb_main = ARB::open(":","r");
27  if (! $gb_main ) {
28    my $error = ARB::await_error();
29    print $error."\n";
30    exit 0;
31  }
32  ARB::begin_transaction($gb_main);
33}
34
35sub disconnectDB() {
36  ARB::commit_transaction($gb_main);
37  ARB::close($gb_main);
38}
39
40sub findCurrentGenome() {
41  my $organism = BIO::read_string($gb_main, 'tmp/focus/organism_name'); # aka AWAR_ORGANISM_NAME
42  if ($organism eq '') {
43    error("You have to select the target organism in ARB!");
44  }
45
46  my $gb_orga = BIO::find_organism($gb_main,$organism);
47  if (!$gb_orga) { error("'$organism' is not a organism"); }
48
49  return ($gb_orga,$organism);
50}
51
52sub with_marked_genes($\&) {
53  my ($gb_orga,$fun_r) = @_;
54  my $gb_gene = BIO::first_marked_gene($gb_orga);
55  while ($gb_gene) {
56    &$fun_r($gb_gene);
57    $gb_gene = BIO::next_marked_gene($gb_gene);
58  }
59}
60sub with_all_genes($\&) {
61  my ($gb_orga,$fun_r) = @_;
62  my $gb_gene = BIO::first_gene($gb_orga);
63  while ($gb_gene) {
64    &$fun_r($gb_gene);
65    $gb_gene = BIO::next_gene($gb_gene);
66  }
67}
68
69sub with_marked_genomes(\&) {
70  my ($fun_r) = @_;
71  my $gb_orga = BIO::first_marked_organism($gb_main);
72  while ($gb_orga) {
73    &$fun_r($gb_orga);
74    $gb_orga = BIO::next_marked_organism($gb_orga);
75  }
76}
77sub with_all_genomes(\&) {
78  my ($fun_r) = @_;
79  my $gb_orga = BIO::first_organism($gb_main);
80  while ($gb_orga) {
81    &$fun_r($gb_orga);
82    $gb_orga = BIO::next_organism($gb_orga);
83  }
84}
85
86sub unmark_gene($) {
87  my ($gb_gene) = @_;
88  ARB::write_flag($gb_gene, 0); # unmark
89}
90sub unmarkGenesOfGenome($) {
91  my ($gb_genome) = @_;
92  with_marked_genes($gb_genome, &unmark_gene);
93}
94
95sub findORF($$$$$) {
96  my ($gb_gene_data,$genome_name,$orf,$create,$verbose) = @_;
97  my $error;
98  my $gb_orf;
99  my $gb_locus_tag = ARB::find_string($gb_gene_data, "locus_tag", $orf, 1, "grandchild");
100  if (!$gb_locus_tag) {
101    if ($create==0) {
102      $error = "no gene with locus_tag '$orf' found for organism '$genome_name'";
103    }
104    else {
105      my $gb_genome = ARB::get_father($gb_gene_data);
106      $gb_orf = BIO::create_nonexisting_gene($gb_genome, $orf);
107      if (!$gb_orf) {
108        my $reason = ARB::await_error();
109        $error = "cannot create gene '$orf' ($reason)";
110      }
111      else {
112        my $gb_locus_tag = ARB::search($gb_orf, "locus_tag", "STRING");
113        if (!$gb_locus_tag) {
114          my $reason = ARB::await_error();
115          $error = "cannot create field 'locus_tag' ($reason)";
116        }
117        else {
118          $error = ARB::write_string($gb_locus_tag, $orf);
119          if ($error) {
120            $error = "Couldn't write to 'locus_tag' ($error)";
121          }
122        }
123      }
124      if (!$error and $verbose==1) { print "Created new gene '$orf'\n"; }
125    }
126  }
127  else {
128    $gb_orf = ARB::get_father($gb_locus_tag);
129  }
130
131  if (!$gb_orf) { if (!$error) { die "Internal error"; }}
132  return ($gb_orf,$error);
133}
134
135sub write_entry($$$$$$) {
136  my ($gb_container, $field_name, $field_type, $field_content, $overwrite, $verbose) = @_;
137  my $gb_field = ARB::search($gb_container, $field_name, "NONE");
138  my $error;
139  if (!$gb_field) {
140    $gb_field = ARB::search($gb_container, $field_name, $field_type);
141    if (!$gb_field) {
142      my $reason = ARB::await_error();
143      $error = "Can't create '$field_name' ($reason)";
144    }
145  }
146  else {
147    if ($overwrite==0) {
148      $error = "Field '$field_name' already exists";
149    }
150  }
151
152  if (!$error) {
153    if (!$gb_field) { die "internal error"; }
154    $error = ARB::write_as_string($gb_field, $field_content);
155    if ($error) { $error = "Cannot write to '$field_name' ($error)"; }
156  }
157
158  return $error;
159}
160
161# --------------------------------------------------------------------------------
162
163sub show_csv_info() {
164    print "  CSV may be saved with Excel and StarCalc. It simply is a\n".
165          "  comma separated list with strings quoted in \"\". The first line\n".
166          "  contains the column titles.\n";
167}
168
169sub message($) {
170  my ($msg) = @_;
171  BIO::message($gb_main, $msg);
172  print "$msg\n";
173}
174
175sub error($) {
176  my ($msg) = @_;
177  $msg = "Error: ".$msg;
178  ARB::commit_transaction($gb_main); # this undoes all changes made by this script
179#   ARB::abort_transaction($gb_main); # this undoes all changes made by this script
180
181  ARB::begin_transaction($gb_main);
182  BIO::message($gb_main, $msg);
183  BIO::message($gb_main, "Script aborted!");
184  ARB::commit_transaction($gb_main);
185  die $msg."\n";
186}
187
188# --------------------------------------------------------------------------------
189
190sub define_tokenizer_columns($) {
191  ($columns) = @_;
192}
193
194sub tokenize_columns($$) {
195  my ($line,$errline) = @_;
196  chomp $line;
197  $line .= ',';
198
199  my @array = ();
200
201  while (not $line =~ /^[ ]*$/ig) {
202    if ($line =~ /^[ ]*\"([^\"]*)\"[ ]*,/ig) {
203      my $content = $1;
204      $line = $';
205      $content =~ s/^[ ]*//ig;
206      $content =~ s/[ ]*$//ig;
207      push @array, $content;
208    }
209    elsif ($line =~ /[ ]*([0-9]+)[ ]*,/ig) {
210      push @array, $1;
211      $line = $';
212    }
213    else {
214      error("cannot parse line $errline (at '$line')");
215    }
216  }
217
218  my $cols = @array;
219  if ($cols != $columns) {
220    error("expected $columns columns (found $cols) in line $errline");
221  }
222
223  return @array;
224}
225
226# --------------------------------------------------------------------------------
227
2281; # result of module initialization
229
Note: See TracBrowser for help on using the repository browser.