source: branches/profile/PERL_SCRIPTS/lib/ali_dnapro.pm

Last change on this file was 12799, checked in by westram, 5 years ago
  • describe some enhanced macro techniques:
    • howto use selected alignment, tree, species, position (instead of hardcoding these values)
  • added a perl-module (ali_dnapro) to support macros with custom dna and corresponding protein alignment
  • some changes to global catch introduced in [12798]
File size: 1.8 KB
Line 
1package ali_dnapro;
2
3# meant to be used from inside macros
4# see ../../HELP_SOURCE/oldhelp/macro.hlp@ali_dnapro
5
6use strict;
7use warnings;
8
9use lib "$ENV{'ARBHOME'}/lib/";
10use ARB;
11
12BEGIN {
13  use Exporter ();
14  our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS);
15  $VERSION     = 1.00;
16  @ISA         = qw(Exporter);
17  @EXPORT      = qw(
18                    &get_dnapro_alignments
19                   );
20  %EXPORT_TAGS = qw();
21  @EXPORT_OK   = qw();
22}
23
24sub caps($) {
25  my ($reg) = @_;
26  if ($reg =~ /\|/) {
27    return join('|', map {
28      die if /\|/;
29      caps($_);
30    } split(/\|/,$reg));
31  }
32  return uc(substr($reg,0,1)).substr($reg,1);
33}
34
35sub mod_name($$$) {
36  my ($name,$old,$new) = @_;
37  if ($name =~ /$old/) { return $`.$new.$'; }
38  $old = caps($old);
39  $new = caps($new);
40  if ($name =~ /$old/) { return $`.$new.$'; }
41  $old = uc($old);
42  $new = uc($new);
43  if ($name =~ /$old/) { return $`.$new.$'; }
44  return undef;
45}
46
47sub cant_decide($) {
48  my ($ali_selected) = @_;
49  die "can't decide whether '$ali_selected' is a protein or a DNA alignment.\nPlease select an alignment with 'pro' OR 'dna' in name.";
50}
51
52sub get_dnapro_alignments($) {
53  my ($gb_main) = @_;
54
55  my $ali_selected = BIO::remote_read_awar($gb_main,'ARB_NT','presets/use');
56  if ((not defined $ali_selected) or ($ali_selected =~ /\?/)) {
57    die "Please select a valid alignment";
58  }
59
60  my $ali_dna = mod_name($ali_selected,'protein|prot|pro', 'dna');
61  my $ali_pro = mod_name($ali_selected,'dna', 'pro');
62
63  if (defined $ali_pro) {
64    if (defined $ali_dna) { cant_decide($ali_selected); }
65    $ali_dna = $ali_selected;
66  }
67  else {
68    if (not defined $ali_dna) { cant_decide($ali_selected); }
69    $ali_pro = $ali_selected;
70  }
71
72  return ($ali_dna,$ali_pro);
73}
74
75# ----------------------------------------
76# cleanup (if needed)
77END { }
78
791; # module initialization is ok
Note: See TracBrowser for help on using the repository browser.