diff --git a/Changes b/Changes index 71772ce..333ef0b 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,12 @@ Changelog for ResourcePool +V0.9906 - 2002-07-10 + + * wrapped DBI calls into eval{} blocks to make RaiseError aware. + * It's possible to pass the options for ResourcePool and LoadBalancer + using a Hash reference. + * added tests + V0.9905 - 2002-07-05 * A rollback() is performed on DBI sessions with AutoCommit disabled diff --git a/MANIFEST b/MANIFEST index 7079171..b3f17fa 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,8 +2,9 @@ MANIFEST Changes README Makefile.PL -lib/ResourcePool/Singleton.pm lib/ResourcePool.pm +lib/ResourcePool.pod +lib/ResourcePool/Singleton.pm lib/ResourcePool/LoadBalancer.pm lib/ResourcePool/Resource/Net/LDAP.pm lib/ResourcePool/Resource/DBI.pm @@ -14,3 +15,7 @@ lib/ResourcePool/Resource.pm t/01Singleton.t t/02FactorySingleton.t t/03ResourcePoolSingleton.t +t/04LBSingleton.t +t/10PoolOptions.t +t/30DBI.t +t/40LDAP.t diff --git a/Makefile.PL b/Makefile.PL index 90cd025..ea26148 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,7 +1,7 @@ #********************************************************************* #*** Makefile.PL #*** Copyright (c) 2002 by Markus Winand -#*** $Id: Makefile.PL,v 1.4 2002/07/05 16:00:48 mws Exp $ +#*** $Id: Makefile.PL,v 1.9 2002/07/10 17:06:42 mws Exp $ #********************************************************************* use ExtUtils::MakeMaker; @@ -11,7 +11,7 @@ use ExtUtils::MakeMaker; my %opts; $opts{NAME} = 'ResourcePool', -$opts{VERSION} = '0.9905'; +$opts{VERSION} = '0.9906'; if ($ExtUtils::MakeMaker::VERSION >= 5.43) { $opts{ABSTRACT} = 'A connection caching and pooling class.'; diff --git a/README b/README index 4289b02..8c1356c 100644 --- a/README +++ b/README @@ -6,9 +6,8 @@ See COPYRIGHT section in the ResourcePool(3pm) manpage. Recent Changes -------------- - When using DBI connections without AutoCommit, ResourcePool - performs a rollback on the session if it's returned to the - pool. + * wrapped DBI calls into eval{} blocks to make RaiseError aware. + * added tests Installation ------------ diff --git a/lib/ResourcePool.pm b/lib/ResourcePool.pm index c5a4283..85ff552 100644 --- a/lib/ResourcePool.pm +++ b/lib/ResourcePool.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool #*** Copyright (c) 2002 by Markus Winand -#*** $Id: ResourcePool.pm,v 1.29 2002/07/05 15:14:02 mws Exp $ +#*** $Id: ResourcePool.pm,v 1.32 2002/07/06 15:40:35 mws Exp $ #********************************************************************* ###### @@ -25,7 +25,7 @@ BEGIN { push @ISA, "ResourcePool::Singleton"; -$VERSION = "0.9905"; +$VERSION = "0.9906"; sub new($$@) { my $proto = shift; @@ -44,9 +44,13 @@ sub new($$@) { Min => 1, MaxTry => 2, PreCreate => 0, - SleepOnFail => [0], - @_, #override defaults with actual parameters + SleepOnFail => [0] ); + if (scalar(@_) == 1) { + %options = ((%options), %{$_[0]}); + } elsif (scalar(@_) > 1) { + %options = ((%options), @_); + } # prepare SleepOnFail parameter, extend if neccessary if (ref($options{SleepOnFail})) { push (@{$options{SleepOnFail}}, @@ -253,365 +257,3 @@ sub swarn($@) { } 1; - -__END__ - -=head1 NAME - -ResourcePool - A connection caching and pooling class. - -=head1 SYNOPSIS - - use ResourcePool; - use ResourcePool::Factory; - - my $factory = ResourcePool::Factory->new(); - my $pool = ResourcePool->new($factory, @Options); - - my $resource = $pool->get(); # get a resource out of the pool - [...] # do something with $resource - $pool->free($resource); # give it back to the pool - - $pool->fail($resource); # give back a failed resource - -=head1 DESCRIPTION - -The ResourcePool is a generic connection caching and pooling management -facility. It might be used in an Apache/mod_perl environment to support -connection caching like Apache::DBI for non-DBI resources (e.g. Net::LDAP). -It's also useful in a stand alone perl application to handle connection pools. - -The key benefit of ResourcePool is the generic design which makes it easily -extendable to new resource types. - -The ResourcePool has a simple check mechanism to detect and close -broken connections (e.g. if the database server was restarted) -and opens new connections if possible. - -The ResourcePool itself handles always exactly equivalent connections (e.g. -connections to the same server whith the same username and password) and is -therefore not able to do a loadbalancing. The ResourcePool::LoadBalancer class -is able to do a simple load balancing across different servers and increases -the overall availibility by detecting dead servers. - -=head2 Snew($factory, [@Options])> - -Creates a new ResourcePool. It uses a previous created ResourcePool if -possible. So if you call the new method with the same arguments twice, -the second call returns the same reference as the first did. -This is even true if you call the new method while handling different -Apache/mod_perl requests (as long as they are in the same Apache process). -(This is implemented using the Singleton class included in this distribution) - -=over 4 - -=item $factory - -A Factory is required to create new resources on demand. The Factory is the -place where you configure the resources you plan to use (e.g. Database server, -username and password). Since the Factory is specific to the actual resource you -want to use, there are different factories for the different resource type under the -ResourcePool::Factory tree. (see L) - -=back - -=head2 OPTIONS - -=over 4 - -=item B - -Specifies the maximum concurrent resources managed by this pool. -If the limit is reached the get() method will return undef. - -Default: 5 - -=item B - -Specifies how many dead Resources the get() method checks before -it returns undef. -Normally the get() method doesn't return dead resources (e.g. broken -connections). In the case there is a broken connection in the pool, the -get() method throws it away and takes the next resource out of the pool. -The get() method tries not more then B resources before it returns undef. - -Default: 2 - -=item B - -Normally the ResourcePool creates new resources only on demand, with this -option you can specify how many resources are created when the ResourcePool -gets constructed. - -Default: 0 - -=item B - -You can tell the ResourcePool to sleep a while when a dead resource was found. -Normally the get() method tries up to B times to get an valid resource -for you without any delay between the tries. This is usually not what you want -if you database is not available for a short time. Using this option you -can specify a list of timeouts which should be slept between two tries to get -an valid resource. If you have specified - - MaxTry => 5 - SleepOnFail => [0, 1, 2, 4] - -ResourcePool would do the following if it isn't able to get an valid resource: - - try to get resource -> failed - sleep 0 - try to get resource -> failed - sleep 1 - try to get resource -> failed - sleep 2 - try to get resource -> failed - sleep 4 - try to get resource -> failed - return undef - -So this call to get() would have taken about 7 seconds. - -Using an exponential time scheme like this one, is usually the most efficient. -However it is highly recommeded to leave the first value always "0" since -this is required to allow the ResourcePool to try to establish a new connection -without delay. - -The number of sleeps can not be more than MaxTry - 1, -if you specify more values the list is truncated. -If you specify less values the list is extended using the last value for the extended elements. e.g. [0,1] in the above example would have been extended to [0, 1, 1, 1] - -If you have Time::HiRes installed on your system, you can specify a fractal number of seconds. - -If you use ResourcePool::LoadBalancer you should use LoadBalancer's SleepOnFail option instead of this one. - -Please see also L for more information about timeouts. - -Default: [0] - -=back - -=head2 S<$pool-Eget> - -Returns a resource. This resource has to be given back via the free() or fail() -method. -The get() method calls the precheck() method of the according Resource -(see ResourcePool::Resource) to determine if a resource is valid. -The get() method may return undef if there is no valid resource available. -(e.g. because the B or the B values are reached) - -=head2 S<$pool-Efree($resource)> - -Marks a resource as free. This resource will be re-used by get() calls. -The free() method calls the postcheck() method of the Resource to dertermine if -the resource is valid. -Return value is 1 on success or 0 if the resource doesn't belong to that pool. - -=head2 S<$pool-Efail($resource)> - -Marks a resource as bad. The ResourcePool will throw this resource away and -NOT return it to the pool of available connections. -Return value is 1 on success or 0 if the resource doesn't belong to that pool. - -=head1 EXAMPLE - -This section includes a typical configuration for a persistent Net::LDAP pool. - - use ResourcePool; - use ResourcePool::Factory::Net::LDAP; - - my $factory = ResourcePool::Factory::Net::LDAP->new("ldaphost", - [ dni => 'cn=Manager,dc=fatalmind,dc=com', - password => 'secret', [version => 2]]); - - my $pool = ResourcePool->new($factory, MaxTry => 5, - SleepOnFail => [0,1,2,4]); - - if ($something) { - my $ldaph = $pool->get(); - - # do something useful with $ldaph - - $pool->free($ldaph); - } - - # some code nothing to do with ldap - - if ($somethingdifferent) { - my $ldaph = $pool->get(); - - # do something different with $ldaph - - $pool->free($ldaph); - } - - -So, lets sum up some characteristics of this example: - -=over 4 - -=item There is only one connection - -Even if $something AND $somethingdifferent are true, -there is only one connection to the ldaphost -opend during the run of this script. - -=item Connections are created on demand - -If neighter $something nor $somethingdifferent are true, there is -NO connection to ldaphost opend for this script. -This is very nice for script which MIGHT need a connection, and MIGHT -need this connection on some different places. You can save a lot of - - if (! defined $ldaph) { - # your connection code goes here - } - -stuff. - -It much more convinient to pass a single argument (e.g. $pool) to a function -than passing all the credentials. - -If you want to make sure that there is always a connection opend, you can use - - PreCreate => 1 - -=item Connections are persistent in Apache/mod_perl environment - -If you would use a script like the one above in an Apache/mod_perl -environment, the created pool would be persistent across different -script invocations within one Apache process. - -So, the connection establishment overhead would only occure once for -each Apache process. This is very much like Apache::DBI, but -much more generic. - -=item Covers serveroutages - -As long as the ldaphost doesn't crash while you are actually using -it (between get() and free()) the ResourcePool would transperently -cover any ldaphost outages which take less then 7 seconds. - -You can easily change the time how long ResourcePool tries to create -a connection with the B and B options. If you would have -used - - MaxTry => 1000000 - -in the example above, the get() method could have blocked for about 46 days -until giving up (after the first 3 tries it would have tried every 4 seconds -to establish a connection). - -If you have a connection problem with the resource while using it, it's the -best practice to give it back to the pool using the fail() method. In that -case the ResourcePool just throws it away. After that you can try again to -get() a new resource. - -=back - -=head1 TIMEOUTS - -Time to say some more words about timeouts which take place in the get() -method. As you have seen above you can configure this timeouts with -the B option, but thats only the half truth. As the name -of the option says, thats only the time which is actually slept if a try -to obtain a vailid resource failes. But there is also the time which is -needed to try to obtain a vailid resource. And this time might vary in -a very wide range. - -Imagine a situation where you have a newly created -ResourcePool for a database (without PreCreate) -and call the get() method for the first -time. Obviously the ResourcePool has to establish a new connection to the -database. But what happens if the database is down? Then the time which -is needed to recognize that the database is down does also block the get() -call. Thats usually not a problem if the Operating System of the database -server is up and only the database application is down. In that case the -Operating System rejects the connection activly and the connection -establishment will fail very fast. But it's very different if the Operating -System is also not available (hardware down, network down,...), -in that case it might take several seconds -(or even minutes!!) before the connection establishment fails, because -it has to wait for internal timeouts (which are not affected by ResourcePool). -Another example is if your DNS server is down, it might also take a long time -before the establishment fails. The usual DNS resolver tries more then one -minute before it gives up. - -Therefore you have to keep in mind that the timeouts configured via -B are only minimal values. If you configure a B -value of one second between the attempts, than you have a guarantee the -there is at least a sleep of one second between the attempts. - -If you want to limit the overall timeouts you have two choices. 1. Use the -timeout functionality of the underlaying modules. This is not always safe -since the modules might use some functions which do not implement a -configureable timeout or does just not use it. 2. Implement your own timeout -using alarm(). Thats also not safe, since there is no gurantee that a blocking -systemcall gets interrupted when a signal is received. But to my knowledge thats -still the more reliable variant. - -The best way of handling this timeouts is to avoid them. For a High -Availibility configuration it is important do fail very fast to be -effective. But thats easy to say... - -=head1 LIMITATIONS - -=over 4 - -=item Not transparent - -Since the main goal of the ResourcePool implementation is to be -generic for any resource types you can think of, it is not possible -to implement features which need knowledge of the used resource types. - -For this reason ResourcePool leaves you allone as soon as you have obtained -a resource until you give it back to the pool (between get() and free() or -fail()). - -ResourcePool does not magically modify DBI or Net::LDAP to do a transparent -reconnect if one connection failes while you are using it. The smartness -of ResourcePool lies in the get() method, therefore you must keep the -resources as short as possible outside of the pool and obtain a resource -via get() if you need one. - -But you have also to be careful to do too many get()/free() calls since this -might also cause a overhead because of the precheck() and postcheck() methods. - -=item Pools are not shared across different processes - -The use of fork() and ResourcePool is only safe if there are no open -resources (connections) when you are doing the fork. - -Even if it sounds very invitingly to create a ResourcePool with some -PreCreated connections and afterwards doing the fork, its just not save. -Thats for several reasons: 1. There is no locking between the different -processes (the same resource could be used more then once simultaneously). -2. There is no guarantee the the underlaying implementations do not keep -some state-information localy (this could case protocol errors). -3. I't impossible to share newly -opend connection with the other processes. - -If you try to pass some open resources through fork() you are alone! -You will have some funny effects which will cost you a lot of time -tracking down until you finally give up. And please, do not even think -of asking for help as long as you do pass open resources through -fork. - -=back - -=head1 SEE ALSO - -L, -L, -L, -L, -L - -=head1 AUTHOR - - Copyright (C) 2002 by Markus Winand - - This program is free software; you can redistribute it and/or - modify it under the same terms as Perl itself. - - diff --git a/lib/ResourcePool.pod b/lib/ResourcePool.pod new file mode 100644 index 0000000..a3ce62f --- /dev/null +++ b/lib/ResourcePool.pod @@ -0,0 +1,260 @@ +=head1 NAME + +ResourcePool - A connection caching and pooling class. + +=head1 SYNOPSIS + + use ResourcePool; + use ResourcePool::Factory; + + my $factory = ResourcePool::Factory->new(); + my $pool = ResourcePool->new($factory, @Options); + + my $resource = $pool->get(); # get a resource out of the pool + #[...] # do something with $resource + $pool->free($resource); # give it back to the pool + + $pool->fail($resource); # give back a failed resource + +=head1 DESCRIPTION + +The ResourcePool is a generic connection caching and pooling management facility. It might be used in an Apache/mod_perl environment to support connection caching like Apache::DBI for non-DBI resources (e.g. Net::LDAP). It's also useful in a stand alone perl application to handle connection pools. + +The key benefit of ResourcePool is the generic design which makes it easily extensible to new resource types. + +The ResourcePool has a simple check mechanism to detect and close broken connections (e.g. if the database server was restarted) and opens new connections if possible. + +The ResourcePool itself handles always exactly equivalent connections (e.g. connections to the same server with the same user-name and password) and is therefore not able to do a load balancing. The L is able to do a simple load balancing across different servers and increases the overall availability by detecting dead servers. + +=head2 Snew($factory, [@Options])> + +Creates a new ResourcePool. It uses a previous created ResourcePool if possible. So if you call the new method with the same arguments twice, the second call returns the same object as the first did. This is even true if you call the new method while handling different Apache/mod_perl requests (as long as they are in the same Apache process). (This is implemented using the Singleton class included in this distribution) + +=over 4 + +=item $factory + +A Factory is required to create new resources on demand. The Factory is the place where you configure the resources you plan to use (e.g. Database server, user-name and password). Since the Factory is specific to the actual resource you want to use, there are different factories for the different resource types (see L) + +=item [@Options] + +=over 4 + +=item B + +Specifies the maximum concurrent resources managed by this pool. If the limit is reached the get() method will return undef. + +Default: 5 + +=item B + +Specifies how many dead Resources the get() method checks before it returns undef. Normally the get() method doesn't return dead resources (e.g. broken connections). In the case there is a broken connection in the pool, the get() method throws it away and takes the next resource out of the pool. The get() method tries not more then MaxTry resources before it returns undef + +Default: 2 + +=item B + +Normally the ResourcePool creates new resources only on demand, with this option you can specify how many resources are created in advance when the ResourcePool gets constructed. + +Default: 0 + +=item B + +You can tell the ResourcePool to sleep a while when a dead resource was found. Normally the get() method tries up to MaxTry times to get an valid resource for you without any delay between the tries. This is usually not what you want if you database is not available for a short time. Using this option you can specify a list of timeouts which should be slept between two attempts to get an valid resource. + +If you have specified + + MaxTry => 5 + SleepOnFail => [0, 1, 2, 4] + +ResourcePool would do the following if it isn't able to get an valid resource: + + * try to get a resource: fails + * sleep 0 seconds + * try to get a resource: fails + * sleep 1 second + * try to get a resource: fails + * sleep 2 seconds + * try to get a resource: fails + * sleep 4 seconds + * try to get a resource: fails + * give up and return undef + +So this call to get() would have taken about 7 seconds. + +Using an exponential time scheme like this one, is usually the most efficient. However it is highly recommended to leave the first value always "0" since this is required to allow the ResourcePool to try to establish a new connection without delay. + +The number of sleeps can not be more than MaxTry - 1, if you specify more values the list is truncated. If you specify less values the list is extended using the last value for the extended elements. e.g. [0, 1] in the above example would have been extended to [0, 1, 1, 1] + +If you have L installed on your system, you can specify a fractal number of seconds. + +If you use L you should use LoadBalancer's SleepOnFail option instead of this one. + +Please see also L for more information about timeouts. + +Default: [0] + +=back + +=back + +=head2 S<$pool-Eget> + +Returns a resource. This resource has to be given back via the free() or fail() method. The get() method calls the precheck() method of the according Resource (see L) to determine if a resource is valid. The get() method may return undef if there is no valid resource available. (e.g. because the Max or the MaxTry values are reached) + +=head2 S<$pool-Efree($resource)> + +Marks a resource as free. This resource will be re-used by get() calls. The free() method calls the postcheck() method of the Resource to determine if the resource is valid. Return value is 1 on success or 0 if the resource doesn't belong to that pool. + +=head2 S<$pool-Efail($resource)> + +Marks a resource as bad. The ResourcePool will throw this resource away and NOT return it to the pool of available connections. Return value is 1 on success or 0 if the resource doesn't belong to that pool. + +=head1 EXAMPLE + +This section includes a typical configuration for a persistent L pool. + + use ResourcePool; + use ResourcePool::Factory::Net::LDAP; + + my $factory = ResourcePool::Factory::Net::LDAP->new("ldaphost", + [ dni => 'cn=Manager,dc=fatalmind,dc=com', + password => 'secret', + [version => 2] + ] + ); + + my $pool = ResourcePool->new($factory, + MaxTry => 5, + SleepOnFail => [0,1,2,4] + ); + + if ($something) { + my $ldaph = $pool->get(); + + # do something useful with $ldaph + + $pool->free($ldaph); + } + + # some code nothing to do with ldap + + if ($somethingdifferent) { + my $ldaph = $pool->get(); + + # do something different with $ldaph + + $pool->free($ldaph); + } + +So, lets sum up some characteristics of this example: + +=over 4 + +=item There is only one connection + +Even if $something AND $somethingdifferent are true, there is only one connection to the ldaphost opened during the run of this script. + +=item Connections are created on demand + +If neither $something nor $somethingdifferent are true, there is NO connection to ldaphost opened for this script. This is very nice for script which MIGHT need a connection, and MIGHT need this connection on some different places. You can save a lot of + + if (! defined $ldaph) { + # your connection code goes here + } + +stuff. + +It much more convenient to pass a single argument (e.g. $pool) to a function than passing all the credentials. + +If you want to make sure that there is always a connection opened, you can use + + PreCreate => 1 + +=back + + + +=over 4 + +=item Connections are persistent in Apache/mod_perl environment + +If you would use a script like the one above in an Apache/mod_perl environment, the created pool would be persistent across different script invocations within one Apache process. + +So, the connection establishment overhead would only occur once for each Apache process. This is very much like Apache::DBI, but much more generic. + +=back + + + +=over 4 + +=item Covers server outages + +As long as the ldaphost doesn't crash while you are actually using it (between get() and free()) the ResourcePool would transparently cover any ldaphost outages which take less then 7 seconds. + +You can easily change the time how long ResourcePool tries to create a connection with the MaxTry and SleepOnFail options. If you would have used + + MaxTry => 1000000 + +in the example above, the get() method could have blocked for about 46 days until giving up (after the first 3 tries it would have tried every 4 seconds to establish a connection). + +If you have a connection problem with the resource while using it, it's the best practice to give it back to the pool using the fail() method. In that case the ResourcePool just throws it away. After that you can try again to get() a new resource. + +=back + + +=head1 TIMEOUTS + +Time to say some more words about timeouts which take place in the get() method. As you have seen above you can configure this timeouts with the SleepOnFail option, but thats only the half truth. As the name of the option says, thats only the time which is actually slept if a try to obtain a valid resource fails. But there is also the time which is needed to try to obtain a valid resource. And this time might vary in a very wide range. + +imagine a situation where you have a newly created ResourcePool for a database (without PreCreate) and call the get() method for the first time. Obviously the ResourcePool has to establish a new connection to the database. But what happens if the database is down? Then the time which is needed to recognize that the database is down does also block the get() call. Thats usually not a problem if the Operating System of the database server is up and only the database application is down. In that case the Operating System rejects the connection actively and the connection establishment will fail very fast. But it's very different if the Operating System is also not available (hardware down, network down,...), in that case it might take several seconds (or even minutes!!) before the connection establishment fails, because it has to wait for internal timeouts (which are not affected by ResourcePool). Another example is if your DNS server is down, it might also take a long time before the establishment fails. The usual DNS resolver tries more then one minute before it gives up. + +Therefore you have to keep in mind that the timeouts configured via SleepOnFail are only minimal values. If you configure a SleepOnFail value of one second between the attempts, than you have a guarantee the there is at least a sleep of one second between the attempts. + +If you want to limit the overall timeouts you have two choices. 1. Use the timeout functionality of the underlaying modules. This is not always safe since the modules might use some functions which do not implement a configurable timeout or does just not use it. 2. Implement your own timeout using alarm(). Thats also not safe, since there is no guarantee that a blocking system call gets interrupted when a signal is received. But to my knowledge thats still the more reliable variant. + +The best way of handling this timeouts is to avoid them. For a High Availability configuration it is important do fail very fast to be effective. But thats easy to say... + + +=head1 LIMITATIONS + + +=over 4 + +=item Not transparent + +Since the main goal of the ResourcePool implementation is to be generic for any resource types you can think of, it is not possible to implement features which need knowledge of the used resource types. + +For this reason ResourcePool leaves you alone as soon as you have obtained a resource until you give it back to the pool (between get() and free() or fail()). + +ResourcePool does not magically modify DBI or Net::LDAP to do a transparent reconnect if one connection fails while you are using it. The smartness of ResourcePool lies in the get() method, therefore you must keep the resources as short as possible outside of the pool and obtain a resource via get() if you need one. + +But you have also to be careful to do too many get()/free() calls since this might also cause a overhead because of the precheck() and postcheck() methods. + +=item Pools are not shared across different processes + +The use of fork() and ResourcePool is only safe if there are no open resources (connections) when you are doing the fork. + +Even if it sounds very invitingly to create a ResourcePool with some PreCreated connections and afterwards doing the fork, its just not save. Thats for several reasons: 1. There is no locking between the different processes (the same resource could be used more then once simultaneously). 2. There is no guarantee the the underlaying implementations do not keep some state-information locally (this could cause protocol errors). 3. It's impossible to share newly opened connection with the other processes. + +If you try to pass some open resources through fork() you are alone! You will have some funny effects which will cost you a lot of time tracking down until you finally give up. And please, do not even think of asking for help as long as you do pass open resources through fork. + +=back + +=head1 SEE ALSO + +L, +L, +L, +L, +L + +=head1 AUTHOR + + Copyright (C) 2002 by Markus Winand + + This program is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + \ No newline at end of file diff --git a/lib/ResourcePool/Factory.pm b/lib/ResourcePool/Factory.pm index 9251ccb..8f33ae6 100644 --- a/lib/ResourcePool/Factory.pm +++ b/lib/ResourcePool/Factory.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::Factory #*** Copyright (c) 2002 by Markus Winand -#*** $Id: Factory.pm,v 1.13 2002/06/23 21:15:02 mws Exp $ +#*** $Id: Factory.pm,v 1.16 2002/07/10 17:27:44 mws Exp $ #********************************************************************* package ResourcePool::Factory; @@ -12,25 +12,27 @@ use ResourcePool::Singleton; use ResourcePool::Resource; push @ISA, "ResourcePool::Singleton"; -$VERSION = "0.9905"; +$VERSION = "0.9906"; sub new($$) { - my $proto = shift; - my $class = ref($proto) || $proto; + my $proto = shift; + my $class = ref($proto) || $proto; my $key = shift; - my $self; + my $self; $self = $class->SUPER::new("ResourcePool::Factory::". $key);#Singleton if (! exists($self->{Used})) { - $self->{Used} = 1; + $self->{Used} = 0; } - bless($self, $class); + bless($self, $class); - return $self; + return $self; } -sub create_resource() { +sub create_resource($) { + my ($self) = @_; + ++$self->{Used}; return ResourcePool::Resource->new(); } @@ -39,6 +41,11 @@ sub info($) { return $self; } +sub _my_very_private_and_secret_test_hook($) { + my ($self) = @_; + return $self->{Used}; +} + 1; __END__ @@ -89,8 +96,10 @@ purposes. =head1 SEE ALSO -ResourcePool(3pm), ResourcePool::Resource(3pm), ResourcePool::Factory::DBI(3pm), -ResourcePool::Factory::Net::LDAP(3pm) +L, +L, +L, +L =head1 AUTHOR diff --git a/lib/ResourcePool/Factory/DBI.pm b/lib/ResourcePool/Factory/DBI.pm index 8dc9f2a..f2598e4 100644 --- a/lib/ResourcePool/Factory/DBI.pm +++ b/lib/ResourcePool/Factory/DBI.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::Factory::DBI #*** Copyright (c) 2002 by Markus Winand -#*** $Id: DBI.pm,v 1.13 2002/07/01 21:49:53 mws Exp $ +#*** $Id: DBI.pm,v 1.15 2002/07/10 17:27:44 mws Exp $ #********************************************************************* package ResourcePool::Factory::DBI; @@ -12,7 +12,7 @@ use ResourcePool::Resource::DBI; use ResourcePool::Factory; use Data::Dumper; -$VERSION = "0.9905"; +$VERSION = "0.9906"; push @ISA, "ResourcePool::Factory"; sub new($$$$$) { @@ -78,7 +78,10 @@ Takes the same arguments as the connect method of the DBI perl module. =head1 SEE ALSO -DBI(3pm), ResourcePool(3pm), ResourcePool::Factory(3pm), ResourcePool::Factory::Net::LDAP(3pm) +L, +L, +L, +L =head1 AUTHOR diff --git a/lib/ResourcePool/Factory/Net/LDAP.pm b/lib/ResourcePool/Factory/Net/LDAP.pm index 4469221..6ab41ab 100644 --- a/lib/ResourcePool/Factory/Net/LDAP.pm +++ b/lib/ResourcePool/Factory/Net/LDAP.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::Factory::Net::LDAP #*** Copyright (c) 2002 by Markus Winand -#*** $Id: LDAP.pm,v 1.12 2002/07/01 21:49:53 mws Exp $ +#*** $Id: LDAP.pm,v 1.14 2002/07/10 17:27:44 mws Exp $ #********************************************************************* package ResourcePool::Factory::Net::LDAP; @@ -12,7 +12,7 @@ use ResourcePool::Resource::Net::LDAP; use Data::Dumper; push @ISA, "ResourcePool::Factory"; -$VERSION = "0.9905"; +$VERSION = "0.9906"; sub new($$@) { my ($proto) = shift; @@ -129,7 +129,10 @@ $factory->create_resource() method wich is invoked from the ResourcePool. =head1 SEE ALSO -Net::LDAP(3pm), ResourcePool(3pm), ResourcePool::Factory(3pm), ResourcePool::Factory::DBI(3pm) +L, +L, +L, +L =head1 AUTHOR diff --git a/lib/ResourcePool/LoadBalancer.pm b/lib/ResourcePool/LoadBalancer.pm index d8de548..30e5a62 100644 --- a/lib/ResourcePool/LoadBalancer.pm +++ b/lib/ResourcePool/LoadBalancer.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::LoadBalancer #*** Copyright (c) 2002 by Markus Winand -#*** $Id: LoadBalancer.pm,v 1.16 2002/07/05 15:14:03 mws Exp $ +#*** $Id: LoadBalancer.pm,v 1.19 2002/07/10 17:27:44 mws Exp $ #********************************************************************* ###### @@ -17,7 +17,7 @@ use vars qw($VERSION @ISA); use ResourcePool::Singleton; push @ISA, "ResourcePool::Singleton"; -$VERSION = "0.9905"; +$VERSION = "0.9906"; sub new($$@) { my $proto = shift; @@ -38,9 +38,15 @@ sub new($$@) { Policy => "LeastUsage", MaxTry => 6, # RoundRobin, LeastUsage, FallBack - SleepOnFail => [0,1,2,4,8], - @_, + SleepOnFail => [0,1,2,4,8] ); + + if (scalar(@_) == 1) { + %options = ((%options), %{$_[0]}); + } elsif (scalar(@_) > 1) { + %options = ((%options), @_); + } + $options{Policy} = uc($options{Policy}); if ($options{Policy} ne "LEASTUSAGE" && $options{Policy} ne "ROUNDROBIN" && @@ -402,7 +408,7 @@ ResourcePool::LoadBalancer - A LoadBalancer across ResourcePools =head1 DESCRIPTION The LoadBalancer is a generic way to spread requests to different ResourcePools -to increase performance and/or availibility. +to increase performance and/or availability. Beside the construction the interface of a LoadBalancer is the same as the interface of a ResourcePool. This makes it very simple to change a program @@ -625,7 +631,7 @@ In the example above the sleeps sum up to 60 seconds. =head1 SEEL ALSO -ResourcePool(3pm) +L =head1 AUTHOR diff --git a/lib/ResourcePool/Resource.pm b/lib/ResourcePool/Resource.pm index 53a56da..7c81268 100644 --- a/lib/ResourcePool/Resource.pm +++ b/lib/ResourcePool/Resource.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::Resource #*** Copyright (c) 2002 by Markus Winand -#*** $Id: Resource.pm,v 1.12 2002/07/03 19:25:36 mws Exp $ +#*** $Id: Resource.pm,v 1.15 2002/07/10 17:27:44 mws Exp $ #********************************************************************* package ResourcePool::Resource; @@ -9,13 +9,14 @@ package ResourcePool::Resource; use strict; use vars qw($VERSION); -$VERSION = "0.9905"; +$VERSION = "0.9906"; -sub new($) { +sub new($@) { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; - $self->{PlainResource} = {}; + $self->{PlainResource} = {shift => $self}; + $self->{VALID} = 1; bless($self, $class); @@ -35,12 +36,12 @@ sub fail_close($) { sub precheck($) { my ($self) = @_; - return 1; + return $self->{VALID}; } sub postcheck($) { my ($self) = @_; - return 1; + return $self->{VALID}; } sub get_plain_resource($) { @@ -48,12 +49,17 @@ sub get_plain_resource($) { return $self->{PlainResource}; } +sub _my_very_private_and_secret_test_hook($$) { + my ($self, $valid) = $_; + $self->{VALID} = $valid; +} + 1; __END__ =head1 NAME - + ResourcePool::Resource - A wrapper class for a resource =head1 SYNOPSIS @@ -109,8 +115,9 @@ The default implementation always returns true. =head1 SEE ALSO -ResourcePool(3pm), -ResourcePool::Resource::DBI(3pm), ResourcePool::Resource::Net::LDAP(3pm) +L, +L, +L =head1 AUTHOR diff --git a/lib/ResourcePool/Resource/DBI.pm b/lib/ResourcePool/Resource/DBI.pm index 69130ee..2a250a8 100644 --- a/lib/ResourcePool/Resource/DBI.pm +++ b/lib/ResourcePool/Resource/DBI.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::Resource::DBI #*** Copyright (c) 2002 by Markus Winand -#*** $Id: DBI.pm,v 1.12 2002/07/03 19:25:36 mws Exp $ +#*** $Id: DBI.pm,v 1.15 2002/07/10 17:27:44 mws Exp $ #********************************************************************* package ResourcePool::Resource::DBI; @@ -11,7 +11,7 @@ use strict; use DBI; use ResourcePool::Resource; -$VERSION = "0.9905"; +$VERSION = "0.9906"; push @ISA, "ResourcePool::Resource"; sub new($$$$$) { @@ -23,7 +23,9 @@ sub new($$$$$) { my $auth = shift; my $attr = shift; - $self->{dbh} = DBI->connect($ds, $user, $auth, $attr); + eval { + $self->{dbh} = DBI->connect($ds, $user, $auth, $attr); + }; if (! defined $self->{dbh}) { warn "ResourcePool::Resource::DBI: Connect to '$ds' failed: $DBI::errstr\n"; return undef; @@ -35,7 +37,9 @@ sub new($$$$$) { sub close($) { my ($self) = @_; - $self->{dbh}->disconnect(); + eval { + $self->{dbh}->disconnect(); + }; } sub precheck($) { @@ -43,7 +47,9 @@ sub precheck($) { my $rc = $self->{dbh}->ping(); if (!$rc) { - $self->close(); + eval { + $self->close(); + }; } return $rc; } @@ -52,7 +58,9 @@ sub postcheck($) { my ($self) = @_; if (! $self->{dbh}->{AutoCommit}) { - $self->{dbh}->rollback(); + eval { + $self->{dbh}->rollback(); + }; } return 1; } @@ -110,7 +118,8 @@ Always returns true, but does a rollback() on the session =head1 SEE ALSO -ResourcePool(3pm), ResourcePool::Resource(3pm) +L, +L =head1 AUTHOR diff --git a/lib/ResourcePool/Resource/Net/LDAP.pm b/lib/ResourcePool/Resource/Net/LDAP.pm index eb4f053..f449c71 100644 --- a/lib/ResourcePool/Resource/Net/LDAP.pm +++ b/lib/ResourcePool/Resource/Net/LDAP.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::Resource::Net::LDAP #*** Copyright (c) 2002 by Markus Winand -#*** $Id: LDAP.pm,v 1.10 2002/07/03 19:25:36 mws Exp $ +#*** $Id: LDAP.pm,v 1.12 2002/07/10 17:27:44 mws Exp $ #********************************************************************* package ResourcePool::Resource::Net::LDAP; @@ -13,7 +13,7 @@ use Net::LDAP::Constant qw(:all); use ResourcePool::Resource; use Data::Dumper; -$VERSION = "0.9905"; +$VERSION = "0.9906"; push @ISA, "ResourcePool::Resource"; sub new($$$@) { @@ -150,7 +150,8 @@ Does not implement any postcheck(). =head1 SEE ALSO -ResourcePool(3pm), ResourcePool::Resource(3pm) +L, +L =head1 AUTHOR diff --git a/lib/ResourcePool/Singleton.pm b/lib/ResourcePool/Singleton.pm index 1c1f97e..61fcd7e 100644 --- a/lib/ResourcePool/Singleton.pm +++ b/lib/ResourcePool/Singleton.pm @@ -1,7 +1,7 @@ #********************************************************************* #*** ResourcePool::Singleton.pm #*** Copyright (c) 2002 by Markus Winand -#*** $Id: Singleton.pm,v 1.2 2002/06/23 21:15:02 mws Exp $ +#*** $Id: Singleton.pm,v 1.3 2002/07/06 09:36:29 mws Exp $ #********************************************************************* package ResourcePool::Singleton; @@ -9,7 +9,7 @@ package ResourcePool::Singleton; use strict; use vars qw($VERSION); -$VERSION = "0.9905"; +$VERSION = "0.9906"; BEGIN { my $key_hash = {}; diff --git a/t/02FactorySingleton.t b/t/02FactorySingleton.t index b706102..10f87d3 100644 --- a/t/02FactorySingleton.t +++ b/t/02FactorySingleton.t @@ -2,7 +2,7 @@ #********************************************************************* #*** t/02DBIFactorySingleton.t #*** Copyright (c) 2002 by Markus Winand -#*** $Id: 02FactorySingleton.t,v 1.6 2002/07/05 20:28:00 mws Exp $ +#*** $Id: 02FactorySingleton.t,v 1.7 2002/07/08 20:07:43 mws Exp $ #********************************************************************* use strict; use Test; @@ -15,64 +15,64 @@ BEGIN{ BEGIN { plan tests => 7; }; if (exists $INC{"DBI.pm"}) { -my $f1 = new ResourcePool::Factory::DBI->new("DataSource1", "user", "pass"); -my $f2 = new ResourcePool::Factory::DBI->new("DataSource1", "user", "pass"); -my $f3 = new ResourcePool::Factory::DBI->new("DataSource2", "user", "pass"); -my $f4 = new ResourcePool::Factory::DBI->new("DataSource2", "user", "pass"); -my $f5 = new ResourcePool::Factory::DBI->new("DataSource1", "user", "pass"); +my $f1 = ResourcePool::Factory::DBI->new("DataSource1", "user", "pass"); +my $f2 = ResourcePool::Factory::DBI->new("DataSource1", "user", "pass"); +my $f3 = ResourcePool::Factory::DBI->new("DataSource2", "user", "pass"); +my $f4 = ResourcePool::Factory::DBI->new("DataSource2", "user", "pass"); +my $f5 = ResourcePool::Factory::DBI->new("DataSource1", "user", "pass"); ok (($f1 == $f2) && ($f1 == $f5) && ($f3 == $f4) && ($f1 != $f3)); } else { skip "skip DBI not found",0; } if (exists $INC{"DBI.pm"}) { -my $f1 = new ResourcePool::Factory::DBI->new("DataSource", "user1", "pass"); -my $f2 = new ResourcePool::Factory::DBI->new("DataSource", "user1", "pass"); -my $f3 = new ResourcePool::Factory::DBI->new("DataSource", "user2", "pass"); -my $f4 = new ResourcePool::Factory::DBI->new("DataSource", "user2", "pass"); -my $f5 = new ResourcePool::Factory::DBI->new("DataSource", "user1", "pass"); +my $f1 = ResourcePool::Factory::DBI->new("DataSource", "user1", "pass"); +my $f2 = ResourcePool::Factory::DBI->new("DataSource", "user1", "pass"); +my $f3 = ResourcePool::Factory::DBI->new("DataSource", "user2", "pass"); +my $f4 = ResourcePool::Factory::DBI->new("DataSource", "user2", "pass"); +my $f5 = ResourcePool::Factory::DBI->new("DataSource", "user1", "pass"); ok(($f1 == $f2) && ($f1 == $f5) && ($f3 == $f4) && ($f1 != $f3)); } else { skip "skip DBI not found",0; } if (exists $INC{"DBI.pm"}) { -my $f1 = new ResourcePool::Factory::DBI->new("DataSource", "user", "pass"); -my $f2 = new ResourcePool::Factory::DBI->new("DataSource", "user", "pass"); -my $f3 = new ResourcePool::Factory::DBI->new("DataSource", "user", "pass", {AutoCommit => 1}); -my $f4 = new ResourcePool::Factory::DBI->new("DataSource", "user", "pass", {AutoCommit => 1}); -my $f5 = new ResourcePool::Factory::DBI->new("DataSource", "user", "pass"); +my $f1 = ResourcePool::Factory::DBI->new("DataSource", "user", "pass"); +my $f2 = ResourcePool::Factory::DBI->new("DataSource", "user", "pass"); +my $f3 = ResourcePool::Factory::DBI->new("DataSource", "user", "pass", {AutoCommit => 1}); +my $f4 = ResourcePool::Factory::DBI->new("DataSource", "user", "pass", {AutoCommit => 1}); +my $f5 = ResourcePool::Factory::DBI->new("DataSource", "user", "pass"); ok(($f1 == $f2) && ($f1 == $f5) && ($f3 == $f4) && ($f1 != $f3)); } else { skip "skip DBI not found",0; } if (exists $INC{"Net/LDAP.pm"}) { -my $f1 = new ResourcePool::Factory::Net::LDAP->new("hostname1"); -my $f2 = new ResourcePool::Factory::Net::LDAP->new("hostname1"); -my $f3 = new ResourcePool::Factory::Net::LDAP->new("hostname2"); -my $f4 = new ResourcePool::Factory::Net::LDAP->new("hostname2"); -my $f5 = new ResourcePool::Factory::Net::LDAP->new("hostname1"); +my $f1 = ResourcePool::Factory::Net::LDAP->new("hostname1"); +my $f2 = ResourcePool::Factory::Net::LDAP->new("hostname1"); +my $f3 = ResourcePool::Factory::Net::LDAP->new("hostname2"); +my $f4 = ResourcePool::Factory::Net::LDAP->new("hostname2"); +my $f5 = ResourcePool::Factory::Net::LDAP->new("hostname1"); ok(($f1 == $f2) && ($f1 == $f5) && ($f3 == $f4) && ($f1 != $f3)); } else { skip "skip Net::LDAP not found", 0; } if (exists $INC{"Net/LDAP.pm"}) { -my $f1 = new ResourcePool::Factory::Net::LDAP->new("hostname"); -my $f2 = new ResourcePool::Factory::Net::LDAP->new("hostname"); -my $f3 = new ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass']); -my $f4 = new ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass']); -my $f5 = new ResourcePool::Factory::Net::LDAP->new("hostname"); +my $f1 = ResourcePool::Factory::Net::LDAP->new("hostname"); +my $f2 = ResourcePool::Factory::Net::LDAP->new("hostname"); +my $f3 = ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass']); +my $f4 = ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass']); +my $f5 = ResourcePool::Factory::Net::LDAP->new("hostname"); ok(($f1 == $f2) && ($f1 == $f5) && ($f3 == $f4) && ($f1 != $f3)); } else { skip "skip Net::LDAP not found", 0; } if (exists $INC{"Net/LDAP.pm"}) { -my $f1 = new ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass1']); -my $f2 = new ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass1']); -my $f3 = new ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass2']); -my $f4 = new ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass2']); -my $f5 = new ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass1']); +my $f1 = ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass1']); +my $f2 = ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass1']); +my $f3 = ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass2']); +my $f4 = ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass2']); +my $f5 = ResourcePool::Factory::Net::LDAP->new("hostname", [dn => 'dn', password => 'pass1']); ok(($f1 == $f2) && ($f1 == $f5) && ($f3 == $f4) && ($f1 != $f3)); } else { skip "skip Net::LDAP not found", 1; } if (exists $INC{"Net/LDAP.pm"}) { -my $f1 = new ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 10000]); -my $f2 = new ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 10000]); -my $f3 = new ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 20000]); -my $f4 = new ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 20000]); -my $f5 = new ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 10000]); +my $f1 = ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 10000]); +my $f2 = ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 10000]); +my $f3 = ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 20000]); +my $f4 = ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 20000]); +my $f5 = ResourcePool::Factory::Net::LDAP->new("hostname", [], [port => 10000]); ok(($f1 == $f2) && ($f1 == $f5) && ($f3 == $f4) && ($f1 != $f3)); } else { skip "skip Net::LDAP not found",0; } diff --git a/t/04LBSingleton.t b/t/04LBSingleton.t new file mode 100644 index 0000000..b0609e2 --- /dev/null +++ b/t/04LBSingleton.t @@ -0,0 +1,21 @@ +#! /usr/bin/perl -w +#********************************************************************* +#*** t/04LBSingleton.t +#*** Copyright (c) 2002 by Markus Winand +#*** $Id: 04LBSingleton.t,v 1.1 2002/07/08 20:30:28 mws Exp $ +#********************************************************************* +use strict; +use Test; + +use ResourcePool; +use ResourcePool::LoadBalancer; + +BEGIN { plan tests => 1; }; + +my $p1 = ResourcePool::LoadBalancer->new("lb1"); +my $p2 = ResourcePool::LoadBalancer->new("lb1"); +my $p3 = ResourcePool::LoadBalancer->new("lb2"); +my $p4 = ResourcePool::LoadBalancer->new("lb2"); +my $p5 = ResourcePool::LoadBalancer->new("lb1"); + +ok(($p1 == $p2) && ($p1 == $p5) && ($p3 == $p4) && ($p1 != $p3)); diff --git a/t/10PoolOptions.t b/t/10PoolOptions.t new file mode 100644 index 0000000..66ce206 --- /dev/null +++ b/t/10PoolOptions.t @@ -0,0 +1,131 @@ +#! /usr/bin/perl -w +#********************************************************************* +#*** t/10PoolOptions.t +#*** Copyright (c) 2002 by Markus Winand +#*** $Id: 10PoolOptions.t,v 1.3 2002/07/10 16:06:33 mws Exp $ +#********************************************************************* +use strict; + +use Test; +use ResourcePool; +use ResourcePool::Factory; + +BEGIN { + eval "use Time::HiRes qw(time)"; +} + +sub timeinframe($$) { + my ($is, $should) = @_; + my ($low, $high); + + if (exists $INC{"Time/HiRes.pm"}) { + ($low, $high) = (($should - 0.2), ($should + 0.2)); + } else { + ($low, $high) = (($should - 1), ($should + 1)); + } + if ( ($low <= $is) && ($is <= $high)) { + return 1; + } else { + printf(STDERR "Time test faild: (expected %ss, got %ss)\n", $should, $is); + return 0; + } +} + +BEGIN { plan tests => 25; }; + +# there shall be silence +$SIG{'__WARN__'} = sub {}; + + +my $f1 = ResourcePool::Factory->new('f1'); +my $f2 = ResourcePool::Factory->new('f2'); +my $f3 = ResourcePool::Factory->new('f3'); +my $f4 = ResourcePool::Factory->new('f4'); +my $f5 = ResourcePool::Factory->new('f5'); +ok ((defined $f1) && (defined $f2) && (defined $f3) && (defined $f4) && (defined $f5)); + +my $p1 = ResourcePool->new($f1, PreCreate => 3); +my $p2 = ResourcePool->new($f2, Max => 1, SleepOnFail => [1]); +my $p3 = ResourcePool->new($f3, {Max => 1, PreCreate => 1}); +my $p4 = ResourcePool->new($f4, {Max => 1, MaxTry => 4, SleepOnFail => [0,1,2]}); +my $p5 = ResourcePool->new($f5, {Max => 1, MaxTry => 3, SleepOnFail => [0,1,2], PreCreate => 10}); +ok ((defined $p1) && (defined $p2) && (defined $p3) && (defined $p4) && (defined $p5)); + +{ +# test Max Option/default +ok ($f1->_my_very_private_and_secret_test_hook() == 3); +my $start = time(); +my $r1 = $p1->get(); +my $r2 = $p1->get(); +my $r3 = $p1->get(); +my $r4 = $p1->get(); +my $r5 = $p1->get(); +ok ((defined $r1) && (defined $r2) && (defined $r3) && (defined $r4) && (defined $r5)); +ok ($f1->_my_very_private_and_secret_test_hook() == 5); + +my $r6 = $p1->get(); +my $stop = time(); +ok(!(defined $r6)); +ok timeinframe (($stop - $start) , 0); +} + +{ +# test Max Option 1 +ok ($f2->_my_very_private_and_secret_test_hook() == 0); +my $r1 = $p2->get(); +ok ((defined $r1)); +ok ($f2->_my_very_private_and_secret_test_hook() == 1); + +my $start = time(); +my $r2 = $p2->get(); +my $stop = time(); +ok(!(defined $r2)); + +ok timeinframe (($stop - $start) , 1); +ok ($f2->_my_very_private_and_secret_test_hook() == 1); +} + +{ +# test Max Option 1 +ok ($f3->_my_very_private_and_secret_test_hook() == 1); +my $start = time(); +my $r1 = $p3->get(); +ok ((defined $r1)); + +my $r2 = $p3->get(); +ok(!(defined $r2)); + +$p3->free($r1); +$r2 = $p3->get(); +my $stop = time(); +ok((defined $r2)); +ok timeinframe(($stop - $start) , 0); +} + +{ +# test Max Option 1 +my $start = time(); +my $r1 = $p4->get(); +ok ((defined $r1)); + +my $r2 = $p4->get(); +ok(!(defined $r2)); +my $stop = time(); + +ok timeinframe(($stop - $start) , 3); +} + +{ +# test Max Option 1 +ok ($f5->_my_very_private_and_secret_test_hook() == 1); +my $start = time(); +my $r1 = $p5->get(); +ok ((defined $r1)); + +my $r2 = $p5->get(); +ok(!(defined $r2)); +my $stop = time(); + +ok timeinframe($stop - $start, 1); +} + diff --git a/t/30DBI.t b/t/30DBI.t new file mode 100644 index 0000000..2815dd4 --- /dev/null +++ b/t/30DBI.t @@ -0,0 +1,34 @@ +#! /usr/bin/perl -w +#********************************************************************* +#*** t/30DBI.t +#*** Copyright (c) 2002 by Markus Winand +#*** $Id: 30DBI.t,v 1.4 2002/07/09 07:35:32 mws Exp $ +#********************************************************************* +use strict; + +use Test; + +BEGIN { + use ResourcePool; + eval "use DBI; use ResourcePool::Factory::DBI;"; + plan tests => 2; +} + +if (!exists $INC{"DBI.pm"}) { + skip("skip DBI not found", 0); + skip("skip DBI not found", 0); + exit(0); +} + +# there shall be silence +$SIG{'__WARN__'} = sub {}; + +my $f1 = ResourcePool::Factory::DBI->new("DataSource1", "user", "pass"); +my $pr1 = $f1->create_resource(); +ok(! defined $pr1); + +my $f2 = ResourcePool::Factory::DBI->new("DataSource2", "user", "pass", {RaiseError => 1}); +my $pr2 = $f2->create_resource(); +ok(! defined $pr2); + + diff --git a/t/40LDAP.t b/t/40LDAP.t new file mode 100644 index 0000000..2329dfd --- /dev/null +++ b/t/40LDAP.t @@ -0,0 +1,26 @@ +#! /usr/bin/perl -w +#********************************************************************* +#*** t/30LDAP.t +#*** Copyright (c) 2002 by Markus Winand +#*** $Id: 40LDAP.t,v 1.4 2002/07/09 07:35:32 mws Exp $ +#********************************************************************* +use strict; + +use Test; +BEGIN { + use ResourcePool; + eval "use Net::LDAP; use ResourcePool::Factory::Net::LDAP;"; + plan tests => 1; +} + +if (!exists $INC{"Net/LDAP.pm"}) { + skip("skip Net::LDAP not found", 0); + exit(0); +} + +# there shall be silence +$SIG{'__WARN__'} = sub {}; + +my $f1 = ResourcePool::Factory::Net::LDAP->new("hostname1"); +my $pr1 = $f1->create_resource(); +ok(! defined $pr1);