~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/Annotation/AnnotationFactory.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# $Id: AnnotationFactory.pm,v 1.6.4.1 2006/10/02 23:10:12 sendu Exp $
 
1
# $Id: AnnotationFactory.pm 15407 2009-01-20 05:18:29Z cjfields $
2
2
#
3
3
# BioPerl module for Bio::Annotation::AnnotationFactory
4
4
#
33
33
 
34
34
    use Bio::Annotation::AnnotationFactory;
35
35
    # 
36
 
    my $factory = new Bio::Annotation::AnnotationFactory(
 
36
    my $factory = Bio::Annotation::AnnotationFactory->new(
37
37
                    -type => 'Bio::Annotation::SimpleValue');
38
38
    my $ann = $factory->create_object(-value => 'peroxisome',
39
39
                                      -tagname => 'cellular component');
93
93
=head2 new
94
94
 
95
95
 Title   : new
96
 
 Usage   : my $obj = new Bio::Annotation::AnnotationFactory();
 
96
 Usage   : my $obj = Bio::Annotation::AnnotationFactory->new();
97
97
 Function: Builds a new Bio::Annotation::AnnotationFactory object 
98
98
 Returns : Bio::Annotation::AnnotationFactory
99
99
 Args    : -type => string, name of a L<Bio::AnnotationI> derived class.
141
141
       # we need to guess this
142
142
       $type = $self->_guess_type(@args);
143
143
       if(! $type) {
144
 
           $self->throw("No annotation type set and unable to guess.");
 
144
       $self->throw("No annotation type set and unable to guess.");
145
145
       }
146
146
       # load dynamically if it hasn't been loaded yet
147
147
       if(! $self->{'_loaded_types'}->{$type}) {
148
 
           eval {
149
 
               $self->_load_module($type);
150
 
               $self->{'_loaded_types'}->{$type} = 1;
151
 
           };
152
 
           if($@) {
153
 
               $self->throw("Bio::AnnotationI implementation $type ".
154
 
                            "failed to load: ".$@);
155
 
           }
 
148
       eval {
 
149
           $self->_load_module($type);
 
150
           $self->{'_loaded_types'}->{$type} = 1;
 
151
       };
 
152
       if($@) {
 
153
           $self->throw("Bio::AnnotationI implementation $type ".
 
154
                "failed to load: ".$@);
 
155
       }
156
156
       }
157
157
   }
158
158
   return $type->new(-verbose => $self->verbose, @args);
177
177
    my $self = shift;
178
178
 
179
179
    if(@_) {
180
 
        my $type = shift;
181
 
        if($type && (! $self->{'_loaded_types'}->{$type})) {
182
 
            eval {
183
 
                $self->_load_module($type);
184
 
            };
185
 
            if( $@ ) {
186
 
                $self->throw("Annotation class '$type' failed to load: ".
187
 
                             $@);
188
 
            }
189
 
            my $a = bless {},$type;
190
 
            if( ! $a->isa('Bio::AnnotationI') ) {
191
 
                $self->throw("'$type' does not implement Bio::AnnotationI. ".
192
 
                             "Too bad.");
193
 
            }
194
 
            $self->{'_loaded_types'}->{$type} = 1;
195
 
        }
196
 
        return $self->{'type'} = $type;
 
180
    my $type = shift;
 
181
    if($type && (! $self->{'_loaded_types'}->{$type})) {
 
182
        eval {
 
183
        $self->_load_module($type);
 
184
        };
 
185
        if( $@ ) {
 
186
        $self->throw("Annotation class '$type' failed to load: ".
 
187
                 $@);
 
188
        }
 
189
        my $a = bless {},$type;
 
190
        if( ! $a->isa('Bio::AnnotationI') ) {
 
191
        $self->throw("'$type' does not implement Bio::AnnotationI. ".
 
192
                 "Too bad.");
 
193
        }
 
194
        $self->{'_loaded_types'}->{$type} = 1;
 
195
    }
 
196
    return $self->{'type'} = $type;
197
197
    }
198
198
    return $self->{'type'};
199
199
}
218
218
    my $type;
219
219
 
220
220
    # we can only guess from a certain number of arguments
221
 
    my ($val,$db,$text,$name,$authors, $start) =
222
 
        $self->_rearrange([qw(VALUE
223
 
                              DATABASE
224
 
                              TEXT
225
 
                              NAME
226
 
                              AUTHORS
227
 
                              START
228
 
                              )], @args);
229
 
  SWITCH: {
230
 
      $val        && do { $type = "SimpleValue"; last SWITCH; };
231
 
      $authors    && do { $type = "Reference"; last SWITCH; };
232
 
      $db         && do { $type = "DBLink"; last SWITCH; };
233
 
      $text       && do { $type = "Comment"; last SWITCH; };
234
 
      $name       && do { $type = "OntologyTerm"; last SWITCH; };
235
 
      $start      && do { $type = "Target"; last SWITCH; };
236
 
      # what else could we look for?
237
 
  }
 
221
    my ($val, $db, $text, $name, $authors, $start, $tree, $node) =
 
222
    $self->_rearrange([qw(VALUE
 
223
                  DATABASE
 
224
                  TEXT
 
225
                  NAME
 
226
                  AUTHORS
 
227
                  START
 
228
                  TREE_OBJ
 
229
                  NODE
 
230
                  )], @args);
 
231
    SWITCH: {
 
232
        $val        && do { $type = ref($val) ? "TagTree" : "SimpleValue"; last SWITCH; };
 
233
        $authors    && do { $type = "Reference"; last SWITCH; };
 
234
        $db         && do { $type = "DBLink"; last SWITCH; };
 
235
        $text       && do { $type = "Comment"; last SWITCH; };
 
236
        $name       && do { $type = "OntologyTerm"; last SWITCH; };
 
237
        $start      && do { $type = "Target"; last SWITCH; };
 
238
        $tree       && do { $type = "Tree"; last SWITCH; };
 
239
        $node       && do { $type = "TagTree"; last SWITCH; };
 
240
        # what else could we look for?
 
241
    }
238
242
    $type = "Bio::Annotation::".$type;
239
243
 
240
244
    return $type;