← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/Root/RootI.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/Root/RootI.pm
1
 
# $Id: RootI.pm,v 1.66 2003/08/10 16:27:32 jason Exp $
 
1
# $Id: RootI.pm,v 1.69.4.4 2006/10/02 23:10:23 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::Root::RootI
4
4
#
40
40
  # Using throw_not_implemented() within a RootI-based interface module:
41
41
 
42
42
  package Foo;
43
 
  @ISA = qw( Bio::Root::RootI );
 
43
  use base qw(Bio::Root::RootI);
44
44
 
45
45
  sub foo {
46
46
      my $self = shift;
54
54
they are on. The methods provide the ability to throw exceptions with nice
55
55
stack traces.
56
56
 
57
 
This is what should be inherited by all bioperl compliant interfaces, even
 
57
This is what should be inherited by all Bioperl compliant interfaces, even
58
58
if they are exotic XS/CORBA/Other perl systems.
59
59
 
60
60
=head2 Using throw_not_implemented()
77
77
 
78
78
So, if an implementer of C<FooI> forgets to implement C<foo()>
79
79
and a user of the implementation calls C<foo()>, a
80
 
B<Bio::Exception::NotImplemented> exception will result.
 
80
L<Bio::Exception::NotImplemented> exception will result.
81
81
 
82
82
Unfortunately, failure to implement a method can only be determined at
83
83
run time (i.e., you can't verify that an implementation is complete by
84
84
running C<perl -wc> on it). So it should be standard practice for a test
85
85
of an implementation to check each method and verify that it doesn't
86
 
throw a B<Bio::Exception::NotImplemented>.
 
86
throw a L<Bio::Exception::NotImplemented>.
87
87
 
88
88
=head1 CONTACT
89
89
 
101
101
 
102
102
package Bio::Root::RootI;
103
103
 
104
 
use vars qw($DEBUG $ID $Revision $VERBOSITY);
 
104
use vars qw($DEBUG $ID $VERBOSITY);
105
105
use strict;
106
106
use Carp 'confess','carp';
107
107
 
109
109
 
110
110
BEGIN { 
111
111
    $ID        = 'Bio::Root::RootI';
112
 
    $Revision  = '$Id: RootI.pm,v 1.66 2003/08/10 16:27:32 jason Exp $ ';
113
112
    $DEBUG     = 0;
114
113
    $VERBOSITY = 0;
115
114
}
173
172
sub warn{
174
173
    my ($self,$string) = @_;
175
174
    
176
 
    my $verbose;
177
 
    if( $self->can('verbose') ) {
178
 
        $verbose = $self->verbose;
179
 
    } else {
180
 
        $verbose = 0;
181
 
    }
 
175
    my $verbose = $self->verbose;
182
176
 
183
177
    if( $verbose >= 2 ) {
184
178
        $self->throw($string);
288
282
 Purpose   : Rearranges named parameters to requested order.
289
283
 Example   : $self->_rearrange([qw(SEQUENCE ID DESC)],@param);
290
284
           : Where @param = (-sequence => $s,
291
 
           :                    -desc     => $d,
292
 
           :                    -id       => $i);
 
285
               :                 -desc     => $d,
 
286
               :                 -id       => $i);
293
287
 Returns   : @params - an array of parameters in the requested order.
294
288
           : The above example would return ($s, $i, $d).
295
289
           : Unspecified parameters will return undef. For example, if
302
296
           :          or as an associative array with hyphenated tags
303
297
           :          (in which case the function sorts the values 
304
298
           :          according to @{$order} and returns that new array.)
305
 
           :          The tags can be upper, lower, or mixed case
 
299
               :              The tags can be upper, lower, or mixed case
306
300
           :          but they must start with a hyphen (at least the
307
301
           :          first one should be hyphenated.)
308
302
 Source    : This function was taken from CGI.pm, written by Dr. Lincoln
324
318
           : indicate that named parameters are being used.
325
319
           : Therefore, the ('me', 'blue') list will be returned as-is.
326
320
           :
327
 
           : Note that Perl will confuse unquoted, hyphenated tags as 
 
321
               : Note that Perl will confuse unquoted, hyphenated tags as 
328
322
           : function calls if there is a function of the same name 
329
323
           : in the current namespace:
330
324
           :    -name => 'foo' is interpreted as -&name => 'foo'
331
 
           :
 
325
               :
332
326
           : For ultimate safety, put single quotes around the tag:
333
 
           :    ('-name'=>'me', '-color' =>'blue');
 
327
               : ('-name'=>'me', '-color' =>'blue');
334
328
           : This can be a bit cumbersome and I find not as readable
335
329
           : as using all uppercase, which is also fairly safe:
336
 
           :    (-NAME=>'me', -COLOR =>'blue');
337
 
           :
 
330
               : (-NAME=>'me', -COLOR =>'blue');
 
331
               :
338
332
           : Personal note (SAC): I have found all uppercase tags to
339
333
           : be more managable: it involves less single-quoting,
340
334
           : the key names stand out better, and there are no method naming 
343
337
           : and lots of uppercase can be hard to read.
344
338
           :
345
339
           : Regardless of the style, it greatly helps to line
346
 
           : the parameters up vertically for long/complex lists.
 
340
               : the parameters up vertically for long/complex lists.
 
341
           :
 
342
           : Note that if @param is a single string that happens to start with
 
343
           : a dash, it will be treated as a hash key and probably fail to
 
344
           : match anything in the array_ref, so not be returned as normally
 
345
           : happens when @param is a simple list and not an associative array.
347
346
 
348
347
=cut
349
348
 
511
510
 
512
511
sub throw_not_implemented {
513
512
    my $self = shift;
514
 
    my $package = ref $self;
515
 
    my $iface = caller(0);
516
 
    my @call = caller(1);
517
 
    my $meth = $call[3];
518
 
 
519
 
    my $message = "Abstract method \"$meth\" is not implemented by package $package.\n" .
520
 
                   "This is not your fault - author of $package should be blamed!\n";
521
 
 
522
 
    # Checking if Error.pm is available in case the object isn't decended from
523
 
    # Bio::Root::Root, which knows how to check for Error.pm.
524
 
 
525
 
    # EB - this wasn't working and I couldn't figure out!
526
 
    # SC - OK, since most RootI objects will be Root.pm-based,
527
 
    #      and Root.pm can deal with Error.pm. 
528
 
    #      Still, I'd like to know why it wasn't working...
 
513
 
 
514
    # Bio::Root::Root::throw() knows how to check for Error.pm and will
 
515
    # throw an Error-derived object of the specified class (Bio::Root::NotImplemented),
 
516
    # which is defined in Bio::Root::Exception.
 
517
    # If Error.pm is not available, the name of the class is just included in the
 
518
    # error message.
 
519
 
 
520
    my $message = $self->_not_implemented_msg;
529
521
 
530
522
    if( $self->can('throw') ) {
531
 
         $self->throw( -text  => $message,
532
 
                       -class => 'Bio::Root::NotImplemented');
533
 
    }
534
 
    else {
535
 
        confess $message ;
 
523
            $self->throw(-text=>$message,
 
524
                         -class=>'Bio::Root::NotImplemented');
 
525
    } else {
 
526
            confess $message ;
536
527
    }
537
528
}
538
529
 
561
552
 
562
553
sub warn_not_implemented {
563
554
    my $self = shift;
564
 
    my $package = ref $self;
565
 
    my $iface = caller(0);
566
 
    my @call = caller(1);
567
 
    my $meth = $call[3];
568
 
 
569
 
    my $message = "Abstract method \"$meth\" is not implemented by package $package.\n" .
570
 
                   "This is not your fault - author of $package should be blamed!\n";
571
 
 
 
555
    my $message = $self->_not_implemented_msg;
572
556
    if( $self->can('warn') ) {
573
557
        $self->warn( $message );
574
 
    }
575
 
    else {
576
 
        carp $message ;
 
558
    }else {
 
559
            carp $message ;
577
560
    }
578
561
}
579
562
 
 
563
# Unify 'not implemented' message. -Juguang
 
564
sub _not_implemented_msg {
 
565
    my $self = shift;
 
566
    my $package = ref $self;
 
567
    my $meth = (caller(2))[3];
 
568
    my $msg =<<EOD_NOT_IMP;
 
569
Abstract method \"$meth\" is not implemented by package $package.
 
570
This is not your fault - author of $package should be blamed!
 
571
EOD_NOT_IMP
 
572
    return $msg;
 
573
}
580
574
 
581
575
1;