163
163
verbosity -1 => no warning
164
164
verbosity 1 => warning with stack trace
165
165
verbosity 2 => converts warnings into throw
167
Args : string (the warning message)
173
172
my ($self,$string) = @_;
175
174
my $verbose = $self->verbose;
177
if( $verbose >= 2 ) {
178
$self->throw($string);
179
} elsif( $verbose <= -1 ) {
181
} elsif( $verbose == 1 ) {
182
my $out = "\n-------------------- WARNING ---------------------\n".
183
"MSG: ".$string."\n";
184
$out .= $self->stack_trace_dump;
176
my $header = "\n--------------------- WARNING ---------------------\nMSG: ";
177
my $footer = "---------------------------------------------------\n";
180
$self->throw($string);
182
elsif ($verbose <= -1) {
185
elsif ($verbose == 1) {
186
CORE::warn $header, $string, "\n", $self->stack_trace_dump, $footer;
190
my $out = "\n-------------------- WARNING ---------------------\n".
191
"MSG: ".$string."\n".
192
"---------------------------------------------------\n";
190
CORE::warn $header, $string, "\n", $footer;
196
193
=head2 deprecated
198
195
Title : deprecated
199
196
Usage : $obj->deprecated("Method X is deprecated");
200
Function: Prints a message about deprecation
201
unless verbose is < 0 (which means be quiet)
197
$obj->deprecated("Method X is deprecated", 1.007);
198
$obj->deprecated(-message => "Method X is deprecated");
199
$obj->deprecated(-message => "Method X is deprecated",
201
Function: Prints a message about deprecation unless verbose is < 0
202
(which means be quiet)
203
204
Args : Message string to print to STDERR
205
Version of BioPerl where use of the method results in an exception
206
Notes : The method can be called two ways, either by positional arguments:
208
$obj->deprecated('This module is deprecated', 1.006);
210
or by named arguments:
213
-message => 'use of the method foo() is deprecated, use bar() instead',
216
The version is optional but highly suggested. For proper comparisons
217
one must use a version in lines with the current versioning scheme
218
for Perl and BioPerl, (i.e. where 1.006000 indicates v1.6.0, 5.010000
208
my ($self,$msg) = @_;
209
if( $self->verbose >= 0 ) {
210
print STDERR $msg, "\n", $self->stack_trace_dump;
225
my ($msg, $version) = $self->_rearrange([qw(MESSAGE VERSION)], @_);
226
# delegate to either warn or throw based on whether a version is given
228
$self->throw('Version must be numerical, such as 1.006000 for v1.6.0, not '.
229
$version) unless $version =~ /^\d+\.\d+$/;
230
if ($Bio::Root::Version::VERSION >= $version) {
234
# passing this on to warn() should deal properly with verbosity issues
214
238
=head2 stack_trace_dump
361
385
return @param{@$order};
388
=head2 _set_from_args
390
Usage : $object->_set_from_args(\%args, -methods => \@methods)
391
Purpose : Takes a hash of user-supplied args whose keys match method names,
392
: and calls the method supplying it the corresponding value.
393
Example : $self->_set_from_args(\%args, -methods => [qw(sequence id desc)]);
394
: Where %args = (-sequence => $s,
395
: -description => $d,
398
: the above _set_from_args calls the following methods:
399
: $self->sequence($s);
401
: ( $self->description($i) is not called because 'description' wasn't
402
: one of the given methods )
403
Argument : \%args | \@args : a hash ref or associative array ref of arguments
404
: where keys are any-case strings corresponding to
405
: method names but optionally prefixed with
406
: hyphens, and values are the values the method
407
: should be supplied. If keys contain internal
408
: hyphens (eg. to separate multi-word args) they
409
: are converted to underscores, since method names
410
: cannot contain dashes.
411
: -methods => [] : (optional) only call methods with names in this
412
: array ref. Can instead supply a hash ref where
413
: keys are method names (of real existing methods
414
: unless -create is in effect) and values are array
415
: refs of synonyms to allow access to the method
416
: using synonyms. If there is only one synonym it
417
: can be supplied as a string instead of a single-
419
: -force => bool : (optional, default 0) call methods that don't
420
: seem to exist, ie. let AUTOLOAD handle them
421
: -create => bool : (optional, default 0) when a method doesn't
422
: exist, create it as a simple getter/setter
423
: (combined with -methods it would create all the
424
: supplied methods that didn't exist, even if not
425
: mentioned in the supplied %args)
426
: -code => '' | {}: (optional) when creating methods use the supplied
427
: code (a string which will be evaulated as a sub).
428
: The default code is a simple get/setter.
429
: Alternatively you can supply a hash ref where
430
: the keys are method names and the values are
431
: code strings. The variable '$method' will be
432
: available at evaluation time, so can be used in
433
: your code strings. Beware that the strict pragma
435
: -case_sensitive => bool : require case sensitivity on the part of
436
: user (ie. a() and A() are two different
437
: methods and the user must be careful
440
: The \%args argument will usually be the args received during new()
441
: from the user. The user is allowed to get the case wrong, include
442
: 0 or more than one hyphens as a prefix, and to include hyphens as
443
: multi-word arg separators: '--an-arg' => 1, -an_arg => 1 and
444
: An_Arg => 1 are all equivalent, calling an_arg(1). However, in
445
: documentation users should only be told to use the standard form
446
: -an_arg to avoid confusion. A possible exception to this is a
447
: wrapper module where '--an-arg' is what the user is used to
448
: supplying to the program being wrapped.
450
: Another issue with wrapper modules is that there may be an
451
: argument that has meaning both to Bioperl and to the program, eg.
452
: -verbose. The recommended way of dealing with this is to leave
453
: -verbose to set the Bioperl verbosity whilst requesting users use
454
: an invented -program_verbose (or similar) to set the program
455
: verbosity. This can be resolved back with
456
: Bio::Tools::Run::WrapperBase's _setparams() method and code along
458
: my %methods = map { $_ => $_ } @LIST_OF_ALL_ALLOWED_PROGRAM_ARGS
459
: delete $methods{'verbose'};
460
: $methods{'program_verbose'} = 'verbose';
461
: my $param_string = $self->_setparams(-methods => \%methods);
462
: system("$exe $param_string");
467
my ($self, $args, @own_args) = @_;
468
$self->throw("a hash/array ref of arguments must be supplied") unless ref($args);
470
my ($methods, $force, $create, $code, $case);
472
($methods, $force, $create, $code, $case) =
473
$self->_rearrange([qw(METHODS
477
CASE_SENSITIVE)], @own_args);
479
my $default_code = 'my $self = shift;
480
if (@_) { $self->{\'_\'.$method} = shift }
481
return $self->{\'_\'.$method};';
483
my %method_names = ();
487
if (ref($methods) eq 'HASH') {
488
@names = keys %{$methods};
492
@names = @{$methods};
493
%syns = map { $_ => $_ } @names;
495
%method_names = map { $case ? $_ : lc($_) => $_ } @names;
499
my %orig_args = ref($args) eq 'HASH' ? %{$args} : @{$args};
501
while (my ($method, $value) = each %orig_args) {
504
$args{$method} = $value;
507
# create non-existing methods on request
510
%syns = map { $_ => $case ? $_ : lc($_) } keys %args;
513
foreach my $method (keys %syns) {
514
$self->can($method) && next;
516
my $string = $code || $default_code;
517
if (ref($code) && ref($code) eq 'HASH') {
518
$string = $code->{$method} || $default_code;
521
my $sub = eval "sub { $string }";
522
$self->throw("Compilation error for $method : $@") if $@;
525
*{ref($self).'::'.$method} = $sub;
529
# create synonyms of existing methods
530
while (my ($method, $syn_ref) = each %syns) {
531
my $method_ref = $self->can($method) || next;
533
foreach my $syn (@{ ref($syn_ref) ? $syn_ref : [$syn_ref] }) {
534
next if $syn eq $method;
535
$method_names{$case ? $syn : lc($syn)} = $syn;
536
next if $self->can($syn);
538
*{ref($self).'::'.$syn} = $method_ref;
542
# set values for methods
543
while (my ($method, $value) = each %args) {
544
$method = $method_names{$case ? $method : lc($method)} || ($methods ? next : $method);
545
$self->can($method) || next unless $force;
546
$self->$method($value);
365
550
#----------------'
366
551
sub _rearrange_old {
added
removed
Bio/Root/RootI.pm
