← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/bioperl/intrepid

« back to all changes in this revision

Viewing changes to Bio/Tools/Analysis/SimpleAnalysisBase.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Tools/Analysis/SimpleAnalysisBase.pm
 
1
# $Id: SimpleAnalysisBase.pm,v 1.5 2003/09/23 13:50:37 radams Exp $
 
2
#
 
3
# BioPerl module for Bio::Tools::Analysis::SimpleAnalysisBase
 
4
#
 
5
# Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
 
6
#
 
7
# Copyright Richard Adams
 
8
#
 
9
# You may distribute this module under the same terms as perl itself
 
10
 
 
11
# POD documentation - main docs before the code
 
12
 
 
13
=head1 NAME
 
14
 
 
15
Bio::Tools::Analysis::SimpleAnalysisBase - abstact superclass for
 
16
SimpleAnalysis implementations
 
17
 
 
18
=head1 SYNOPSIS
 
19
 
 
20
  # no to be run directly
 
21
 
 
22
=head1 DESCRIPTION
 
23
 
 
24
This class is a generic implementation of SimpleAnalysisI and should
 
25
be used as a base class for specific implementations.
 
26
 
 
27
SimpleAnalysis implementing modules just need to provide a specific _run()
 
28
result() and _init() methods, plus any get/set methods for parameter
 
29
to the analysis program.
 
30
 
 
31
=head1 SEE ALSO
 
32
 
 
33
L<Bio::SimpleAnalysisI>, 
 
34
L<Bio::WebAgent>
 
35
 
 
36
=head1 FEEDBACK
 
37
 
 
38
=head2 Mailing Lists
 
39
 
 
40
User feedback is an integral part of the evolution of this and other
 
41
Bioperl modules. Send your comments and suggestions preferably to one
 
42
of the Bioperl mailing lists.  Your participation is much appreciated.
 
43
 
 
44
  bioperl-l@bioperl.org                       - General discussion
 
45
  http://bio.perl.org/MailList.html           - About the mailing lists
 
46
 
 
47
=head2 Reporting Bugs
 
48
 
 
49
Report bugs to the Bioperl bug tracking system to help us keep track
 
50
the bugs and their resolution.  Bug reports can be submitted via email
 
51
or the web:
 
52
 
 
53
  bioperl-bugs@bio.perl.org
 
54
  http://bugzilla.bioperl.org/
 
55
 
 
56
=head1 AUTHORS
 
57
 
 
58
Richard Adams, Richard.Adams@ed.ac.uk, 
 
59
Heikki Lehvaslaiho, heikki@ebi.ac.uk
 
60
 
 
61
=head1 APPENDIX
 
62
 
 
63
The rest of the documentation details each of the object
 
64
methods. Internal methods are usually preceded with a _
 
65
 
 
66
=cut
 
67
 
 
68
 
 
69
# Let the code begin...
 
70
 
 
71
 
 
72
package Bio::Tools::Analysis::SimpleAnalysisBase;
 
73
 
 
74
use vars qw(@ISA);
 
75
use strict;
 
76
use Data::Dumper;
 
77
use Bio::SimpleAnalysisI;
 
78
use Bio::WebAgent;
 
79
 
 
80
my $FLOAT = '[+-]?\d*\.\d*';
 
81
 
 
82
my %STATUS =  map { $_ => 1 } qw(CREATED COMPLETED TERMINATED_BY_ERROR);
 
83
 
 
84
@ISA = qw(Bio::WebAgent Bio::SimpleAnalysisI );
 
85
 
 
86
=head2 new
 
87
 
 
88
 Usage   : $job->new(...)
 
89
 Returns : a new analysis object, 
 
90
 Args    : none (but an implementation may choose
 
91
           to add arguments representing parameters for the analysis
 
92
           program. Each key value of must have a method implemented
 
93
           for it in a subclass. A seq () method is provided here as
 
94
           this will probably be needed by all sequence analysis programs
 
95
 
 
96
=cut
 
97
 
 
98
sub new {
 
99
    my $class = shift;
 
100
 
 
101
    my $self = $class->SUPER::new(); #WebAGent new
 
102
    $self->_init;      #this line has to be before the attributes are filled in
 
103
    while ( @_ ) {
 
104
        my $key = lc shift;
 
105
        $key =~ s/^-//;
 
106
        $self->$key(shift);
 
107
    }
 
108
    return $self;
 
109
}
 
110
 
 
111
=head2 seq
 
112
 
 
113
 Usage   : $job->seq()
 
114
 Returns : a Bio::PrimarySeqI implementing sequence object, or void
 
115
 Args    : None, or a Bio::PrimarySeqI implementing object 
 
116
 
 
117
=cut
 
118
 
 
119
sub seq {
 
120
    my ($self,$value) = @_;
 
121
    if ( defined $value) {
 
122
        $self->throw("I need a Bio::PrimarySeqI, not  [". $value. "]")
 
123
            unless $value->isa('Bio::PrimarySeqI');
 
124
                $self->throw(" I need a PrimarySeq object, not a BioSeq object ")
 
125
                        if $value->isa('Bio::SeqI');
 
126
 
 
127
        my $mol_type = $self->analysis_spec->{'type'};
 
128
        $self->throw("I need a [" . $mol_type . "]  seq, not a  [". $value->alphabet. "]")
 
129
            unless $value->alphabet =~/$mol_type/i;
 
130
        $self->{'_seq'} = $value;
 
131
        return $self;
 
132
    }
 
133
    return $self->{'_seq'} ;
 
134
}
 
135
 
 
136
=head2  analysis_name
 
137
 
 
138
    Useage   :  $analysis->analysis_name();
 
139
    Returns  :  The analysis name
 
140
    Arguments:  none
 
141
 
 
142
=cut
 
143
 
 
144
sub analysis_name {
 
145
    my $self = shift;
 
146
    return $self->{'_ANALYSIS_NAME'};
 
147
}
 
148
 
 
149
=head2  analysis_spec
 
150
 
 
151
    Useage   :  $analysis->analysis_spec();
 
152
    Returns  :  a hash reference to  a hash of analysis parameters. See
 
153
                Bio::SimpleAnalysisI for a list of recommended key values.
 
154
    Arguments:  none
 
155
 
 
156
=cut
 
157
 
 
158
sub analysis_spec {
 
159
    my $self = shift;
 
160
    return $self->{'_ANALYSIS_SPEC'};
 
161
}
 
162
 
 
163
=head2 clear
 
164
 
 
165
    Usage     :$analysis->clear();
 
166
    Returns   :true value on success
 
167
    Arguments :none
 
168
    Purpose   :to remove raw results from a previous analysis so that
 
169
               an analysis can be repeated with different parameters.
 
170
 
 
171
=cut
 
172
 
 
173
sub clear {
 
174
        my $self= shift;
 
175
        if (defined($self->{'_result'})) {
 
176
                delete $self->{'_result'};
 
177
                }
 
178
        if (defined ($self->{'_parsed'})) {
 
179
                delete $self->{'_parsed'};
 
180
                }
 
181
        return 1;
 
182
}
 
183
                 
 
184
 
 
185
 
 
186
=head2  input_spec
 
187
 
 
188
    Useage   :  $analysis->input_spec();
 
189
    Returns  :  a  reference to  an array of  hashes of analysis parameters. See
 
190
                Bio::SimpleAnalysisI for a list of recommended key values.
 
191
    Arguments:  none
 
192
 
 
193
=cut
 
194
 
 
195
sub input_spec {
 
196
    my $self = shift;
 
197
    return $self->{'_INPUT_SPEC'};
 
198
}
 
199
 
 
200
=head2  result_spec
 
201
 
 
202
    Useage   :  $analysis->result_spec();
 
203
    Returns  :  a  reference to  a   hashes of resultformats. See
 
204
                Bio::SimpleAnalysisI for a list of recommended key values. The key
 
205
                values can be used as parameters to the result() method, the values
 
206
                provide descriptions.
 
207
    Arguments:  none
 
208
 
 
209
=cut
 
210
 
 
211
sub result_spec {
 
212
    my $self = shift;
 
213
    return $self->{'_RESULT_SPEC'};
 
214
}
 
215
 
 
216
sub run {
 
217
    my ($self, $args) = @_;
 
218
    $self->_process_arguments ($args) if $args;
 
219
 
 
220
    # check input
 
221
    $self->throw("Need a sequence object as an input") unless $self->seq;
 
222
    $self->debug(Data::Dumper->Dump([$self],[$self]));
 
223
 
 
224
    # internal run()
 
225
    $self->_run;
 
226
    return $self;
 
227
}
 
228
 
 
229
sub wait_for {
 
230
    my ($self, $args) = @_;
 
231
    $self->run($args);
 
232
}
 
233
 
 
234
sub status {
 
235
    my ($self,$value) = @_;
 
236
 
 
237
    if( defined $value) {
 
238
        no strict 'refs';
 
239
        my $class = ref($self);
 
240
        $self->throw("Not a valid status value [$value]\n".
 
241
                     "Valid values are ". join(", ", keys %STATUS ))
 
242
            unless defined $STATUS{$value};
 
243
        $self->{'_status'} = $value;
 
244
        use strict;
 
245
    }
 
246
    return $self->{'_status'} || 'CREATED' ;
 
247
}
 
248
 
 
249
sub _process_arguments {
 
250
    my ($self, $args) = @_;
 
251
 
 
252
    my %spec;
 
253
    map {$spec{ $_->{'name'} } = $_ } @{$self->input_spec};
 
254
 
 
255
    $self->debug(Data::Dumper->Dump([\%spec, $args],[\%spec, $args]));
 
256
    foreach my $key (keys %$args) {
 
257
        my $value = $args->{$key};
 
258
 
 
259
        $self->throw("Unknown argument [$key]")
 
260
            unless $spec{$key};
 
261
        $self->$key($value);
 
262
    }
 
263
 
 
264
    foreach my $key (keys %spec) {
 
265
        $self->throw("Mandatory argument [$key] is not set")
 
266
            if $spec{$key}{'mandatory'} eq 'true' and not defined $self->$key;
 
267
    }
 
268
}
 
269
 
 
270
 
 
271
sub _run { shift->throw_not_implemented();}
 
272
        
 
273
 
 
274