← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/LiveSeq/Mutator.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/LiveSeq/Mutator.pm
1
 
# $Id: Mutator.pm,v 1.27 2003/06/04 08:36:40 heikki Exp $
 
1
# $Id: Mutator.pm,v 1.33.4.3 2006/10/02 23:10:21 sendu Exp $
2
2
#
3
3
# bioperl module for Bio::LiveSeq::Mutator
4
4
#
5
 
# Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
 
5
# Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
6
6
#
7
7
# Copyright Joseph Insana
8
8
#
43
43
Bioperl modules. Send your comments and suggestions preferably to the
44
44
Bioperl mailing lists  Your participation is much appreciated.
45
45
 
46
 
  bioperl-l@bioperl.org                         - General discussion
47
 
  http://bio.perl.org/MailList.html             - About the mailing lists
 
46
  bioperl-l@bioperl.org                  - General discussion
 
47
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
48
48
 
49
49
=head2 Reporting Bugs
50
50
 
51
51
report bugs to the Bioperl bug tracking system to help us keep track
52
 
 the bugs and their resolution.  Bug reports can be submitted via
53
 
 email or the web:
 
52
the bugs and their resolution.  Bug reports can be submitted via the
 
53
web:
54
54
 
55
 
  bioperl-bugs@bio.perl.org
56
 
  http://bugzilla.bioperl.org/
 
55
  http://bugzilla.open-bio.org/
57
56
 
58
57
=head1 AUTHOR - Heikki Lehvaslaiho & Joseph A.L. Insana
59
58
 
60
 
  Email:  heikki@ebi.ac.uk
 
59
  Email:  heikki-at-bioperl-dot-org
61
60
          insana@ebi.ac.uk, jinsana@gmx.net
62
61
 
63
 
  Address:
64
 
 
65
 
     EMBL Outstation, European Bioinformatics Institute
66
 
     Wellcome Trust Genome Campus, Hinxton
67
 
     Cambs. CB10 1SD, United Kingdom
68
 
 
69
62
=head1 APPENDIX
70
63
 
71
64
  The rest of the documentation details each of the object
76
69
# Let the code begin...
77
70
 
78
71
package Bio::LiveSeq::Mutator;
79
 
use vars qw(@ISA);
80
72
use strict;
81
73
 
82
 
use vars qw(@ISA);
83
74
use Bio::Variation::SeqDiff;
84
75
use Bio::Variation::DNAMutation;
85
76
use Bio::Variation::RNAChange;
90
81
#use integer;
91
82
# Object preamble - inheritance
92
83
 
93
 
use Bio::Root::Root;
94
84
 
95
 
@ISA = qw( Bio::Root::Root );
 
85
use base qw(Bio::Root::Root);
96
86
 
97
87
sub new {
98
88
    my($class,@args) = @_;
139
129
  if (defined $value) {
140
130
      if( ! $value->isa('Bio::LiveSeq::Gene') ) {
141
131
          $self->throw("Is not a Bio::LiveSeq::Gene object but a [$value]");
142
 
          return undef;
 
132
          return;
143
133
      }
144
134
      else {
145
135
          $self->{'gene'} = $value;
146
136
      }
147
137
  }
148
138
  unless (exists $self->{'gene'}) {
149
 
      return (undef);
 
139
      return;
150
140
  } else {
151
141
      return $self->{'gene'};
152
142
  }
203
193
    if( $value->isa('Bio::Liveseq::Mutation') ) {
204
194
        my $com = ref $value;
205
195
        $self->throw("Is not a Mutation object but a [$com]" );
206
 
        return undef;
 
196
        return;
207
197
    }
208
198
    if (! $value->pos) {
209
199
        $self->warn("No value for mutation position in the sequence!");
210
 
        return undef;
 
200
        return;
211
201
    }
212
202
    if (! $value->seq && ! $value->len) {
213
203
        $self->warn("Either mutated sequence or length of the deletion must be given!");
214
 
        return undef;
 
204
        return;
215
205
    }
216
206
    push(@{$self->{'mutations'}},$value);
217
207
}
256
246
  if (defined $value) {
257
247
      if( ! $value->isa('Bio::LiveSeq::Mutation') ) {
258
248
          $self->throw("Is not a Bio::LiveSeq::Mutation object but a [$value]");
259
 
          return undef;
 
249
          return;
260
250
      }
261
251
      else {
262
252
          $self->{'mutation'} = $value;
263
253
      }
264
254
  }
265
255
  unless (exists $self->{'mutation'}) {
266
 
      return (undef);
 
256
      return;
267
257
  } else {
268
258
      return $self->{'mutation'};
269
259
  }
290
280
  if (defined $value) {
291
281
      if( ! $value->isa('Bio::LiveSeq::DNA') and ! $value->isa('Bio::LiveSeq::Transcript') ) {
292
282
          $self->throw("Is not a Bio::LiveSeq::DNA/Transcript object but a [$value]");
293
 
          return undef;
 
283
          return;
294
284
      }
295
285
      else {
296
286
          $self->{'DNA'} = $value;
297
287
      }
298
288
  }
299
289
  unless (exists $self->{'DNA'}) {
300
 
      return (undef);
 
290
      return;
301
291
  } else {
302
292
      return $self->{'DNA'};
303
293
  }
326
316
  if (defined $value) {
327
317
      if( ! $value->isa('Bio::LiveSeq::Transcript') ) {
328
318
          $self->throw("Is not a Bio::LiveSeq::RNA/Transcript object but a [$value]");
329
 
          return undef;
 
319
          return;
330
320
      }
331
321
      else {
332
322
          $self->{'RNA'} = $value;
333
323
      }
334
324
  }
335
325
  unless (exists $self->{'RNA'}) {
336
 
      return (undef);
 
326
      return;
337
327
  } else {
338
328
      return $self->{'RNA'};
339
329
  }
363
353
  if (defined $value) {
364
354
      if( ! $value->isa('Bio::Variation::DNAMutation') ) {
365
355
          $self->throw("Is not a Bio::Variation::DNAMutation object but a [$value]");
366
 
          return undef;
 
356
          return;
367
357
      }
368
358
      else {
369
359
          $self->{'dnamut'} = $value;
370
360
      }
371
361
  }
372
362
  unless (exists $self->{'dnamut'}) {
373
 
      return (undef);
 
363
      return;
374
364
  } else {
375
365
      return $self->{'dnamut'};
376
366
  }
400
390
  if (defined $value) {
401
391
      if( ! $value->isa('Bio::Variation::RNAChange') ) {
402
392
          $self->throw("Is not a Bio::Variation::RNAChange object but a [$value]");
403
 
          return undef;
 
393
          return;
404
394
      }
405
395
      else {
406
396
          $self->{'rnachange'} = $value;
407
397
      }
408
398
  }
409
399
  unless (exists $self->{'rnachange'}) {
410
 
      return (undef);
 
400
      return;
411
401
  } else {
412
402
      return $self->{'rnachange'};
413
403
  }
437
427
  if (defined $value) {
438
428
      if( ! $value->isa('Bio::Variation::AAChange') ) {
439
429
          $self->throw("Is not a Bio::Variation::AAChange object but a [$value]");
440
 
          return undef;
 
430
          return;
441
431
      }
442
432
      else {
443
433
          $self->{'aachange'} = $value;
444
434
      }
445
435
  }
446
436
  unless (exists $self->{'aachange'}) {
447
 
      return (undef);
 
437
      return;
448
438
  } else {
449
439
      return $self->{'aachange'};
450
440
  }
475
465
      $self->{'exons'} = $value;
476
466
  }
477
467
  unless (exists $self->{'exons'}) {
478
 
      return (undef);
 
468
      return;
479
469
  } else {
480
470
      return $self->{'exons'};
481
471
  }
710
700
    #
711
701
    # Recording the state: SeqDiff object creation  ?? transcript no.??
712
702
    #
713
 
    my $seqDiff = Bio::Variation::SeqDiff->new();
 
703
    my $seqDiff = Bio::Variation::SeqDiff->new(-verbose => $self->verbose);
714
704
    $seqDiff->alphabet($self->gene->get_DNA->alphabet);
715
705
    $seqDiff->numbering($self->numbering);
716
706
    my ($DNAobj, $RNAobj);
1074
1064
                         last;
1075
1065
                     } 
1076
1066
                     #proximity test for exon mutations
 
1067
                     #proximity test for exon mutations
1077
1068
                     elsif ( ( $strand == 1 and 
1078
 
                               $exons[$i]->start <= $self->mutation->prelabel and 
1079
 
                               $exons[$i]->end >= $self->mutation->postlabel) or 
1080
 
                             ( $strand == -1 and 
1081
 
                               $exons[$i]->start >= $self->mutation->prelabel and 
1082
 
                               $exons[$i]->end <= $self->mutation->postlabel) ) {
 
1069
                               $exons[$i]->start < $self->mutation->prelabel and 
 
1070
                               $exons[$i]->end > $self->mutation->prelabel) or 
 
1071
                             ( $strand == 1 and 
 
1072
                               $exons[$i]->start < $self->mutation->postlabel and 
 
1073
                               $exons[$i]->end > $self->mutation->postlabel) or 
 
1074
                             ( $strand == -1 and 
 
1075
                               $exons[$i]->start > $self->mutation->prelabel and 
 
1076
                               $exons[$i]->end < $self->mutation->prelabel) or
 
1077
                             ( $strand == -1 and 
 
1078
                               $exons[$i]->start > $self->mutation->postlabel and 
 
1079
                               $exons[$i]->end < $self->mutation->postlabel) ) {
1083
1080
                         $rnaAffected = 1;
1084
1081
 
1085
1082
                         my $afterdist = $self->mutation->prelabel - $exons[$i]->start;