>Есть мдуль DBD::Oracle для работы с базой данных Oracle. В этом модуле
>нет опции настройки таймаута при работе с базой.
>
>Так же есть решение, описанное тут http://search.cpan.org/~lbaxter/Sys-SigAction/dbd-oracle-tim..., которое позволяет решить проблему. Но можно конечно и классами, но вот посмотри, правда тут много лишнего но ведь это тест:
--------------------------------------------------------------------------------------
#!/usr/bin/perl -w
use strict;
use Data::Dumper;
sub safetimeout {
my ($action_ref, $param_ref, $timeoutaction_ref, $timeout_param_ref, $timeout) = @_;
my $result_ref;
undef($@);
eval {
#print "set timeout action: $timeoutaction_ref with param:\n";
#print Dumper($timeout_param_ref)."\n";
local $SIG{ALRM} = sub { &$timeoutaction_ref(@$$timeout_param_ref); };
print "set timeout: $timeout sec .\n";
alarm($timeout); #implement N second time out
#print "call: $action_ref with param:\n";
#print Dumper($param_ref)."\n";
$result_ref = \&$action_ref( @$$param_ref);
#\&$action_ref( @$param_ref);
alarm(0);
};
alarm(0);
if ( $@ ) { print "execute timed out or error: $@\n" }
if(defined($result_ref) ) {
if(ref($result_ref) eq 'ARRAY') {
return @$result_ref;
} elsif (ref($result_ref) eq 'SCALAR'){
return $$result_ref;
} else {
return $result_ref;
}
} else {
print "undefined result!\n";
}
}
sub act_test1 {
my @arg_list = @_;
print "test1: start short operation\n";
print "get argument list\n";
print Dumper(@arg_list);
print "test1: end short operation\n";
return 'for test1_return';
}
sub timeout_test1 {
my @arg_list = @_;
print "TIMEOUT!!! operation test!!";
print "get argument list\n";
print Dumper(@arg_list)."\n";
return "ret from timeout";
}
sub test1 {
print "start test 1!\n";
print "call timeout safe procedure!\n";
my $ret = safetimeout(\&act_test1, \['param1', 'p2', 'p3'], \&timeout_test1, \["timeout param1"], 2);
print "return resultis:\n";
print Dumper($ret);
print "end test 1!\n";
}
sub act_test2 {
my @arg_list = @_;
print "test2: start long operation\n";
print "get argument list\n";
print Dumper(@arg_list);
my $time_sleep = $arg_list[0] || 1;
print "start sleeping: $time_sleep sec.\n";
sleep $time_sleep;
print "end sleeping\n";
print "test2: end operation\n";
return ['for test2_return', 1, 3, 'ret test2'];
}
sub test2 {
print "start test 2!\n";
print "call timeout safe procedure!\n";
my $ret = safetimeout(\&act_test2, \[5, 'p2', 'p3'], \&timeout_test1, \["timeout param1"], 2);
print "return resultis:\n";
print Dumper($ret);
print "end test 2!\n";
}
sub test2_1 {
print "start test 2_1!\n";
print "call timeout safe procedure!\n";
my @ret = safetimeout(\&act_test2, \[5, 'p2', 'p3'], \&timeout_test1, \["timeout param1"], 7);
print "return resultis:\n";
print Dumper(@ret);
print "end test 2_1!\n";
}
print "--------------------------------------------------\n";
&test1();
&test2();
&test2_1();
exit(0);
----------------------------------------------------------
все зависающие операции можно вызывать через оболочку:
safetimeout(), передав саму операцию, аргументы, можно еще и обработчик таймаутов, да и само время тайм аута.
поскольку здесь мы имеем дело с объектами, можно в параметре предать объект, а в фукции защищаемой функции вызвать необходимый метод, и передать туда необходимые аргументы,
всего таких фукций надо написать по числу защищаемых методов. но зато исходный код пострадает не сильно. хотя не знаю может быть можно как нибудь еще и имя метода передать, чтобы не писать кучу функций, надо подумать.
