From: rettenbe Date: Thu, 12 Mar 2009 08:20:59 +0000 (+0000) Subject: add required perl modules X-Git-Url: https://git.tokkee.org/?a=commitdiff_plain;h=9278b765ed976044452b7000fcd23abdc5d5ad4c;p=gosa.git add required perl modules git-svn-id: https://oss.gonicus.de/repositories/gosa/trunk@13531 594d385d-05f5-0310-b6e9-bd551577e9d8 --- diff --git a/gosa-si/modules/ResourcePool.pm b/gosa-si/modules/ResourcePool.pm new file mode 100644 index 000000000..77a473d10 --- /dev/null +++ b/gosa-si/modules/ResourcePool.pm @@ -0,0 +1,251 @@ +#********************************************************************* +#*** ResourcePool +#*** Copyright (c) 2002-2005 by Markus Winand +#*** $Id: ResourcePool.pm,v 1.49.2.4 2005/01/05 19:42:49 mws Exp $ +#********************************************************************* + +###### +# TODO +# +# -> statistics function +# -> DEBUG option to find "lost" resources (store backtrace of get() call +# and dump on DESTROY) +# -> NOTIFYing features + +package ResourcePool; + +use strict; +use vars qw($VERSION @ISA); +use Tie::RefHash; +use ResourcePool::Singleton; +use ResourcePool::Command::Execute; + +BEGIN { + # make script using Time::HiRes, but not fail if it isn't there + eval "use Time::HiRes qw(sleep)"; +} + + +push @ISA, ("ResourcePool::Command::Execute", "ResourcePool::Singleton"); +$VERSION = "1.0104"; + +sub new($$@) { + my $proto = shift; + my $class = ref($proto) || $proto; + my $factory = shift->singleton(); + my $self = $class->SUPER::new($factory); # Singleton + + if (!exists($self->{Factory})) { + $self->{Factory} = $factory; + $self->{FreePool} = []; + tie %{ $self->{UsedPool} }, 'Tie::RefHash'; + $self->{FreePoolSize} = 0; + $self->{UsedPoolSize} = 0; + my %options = ( + Max => 5, + Min => 1, + MaxTry => 2, + MaxExecTry => 2, + PreCreate => 0, + SleepOnFail => [0] + ); + if (scalar(@_) == 1) { + %options = ((%options), %{$_[0]}); + } elsif (scalar(@_) > 1) { + %options = ((%options), @_); + } + + if ($options{MaxTry} <= 1) { + $options{MaxTry} = 2; + } + # prepare SleepOnFail parameter, extend if neccessary + if (ref($options{SleepOnFail})) { + push (@{$options{SleepOnFail}}, + ($options{SleepOnFail}->[-1]) x + ($options{MaxTry} - 1 - scalar(@{$options{SleepOnFail}}))); + } else { + # convinience if you want set SleepOnFail to a scalar + $options{SleepOnFail} + = [($options{SleepOnFail}) x ($options{MaxTry} - 1)]; + + } + # truncate list if it is too long + $#{$options{SleepOnFail}} = $options{MaxTry} - 2; + + $self->{Max} = $options{Max}; + $self->{Min} = $options{Min}; + $self->{MaxTry} = $options{MaxTry} - 1; + $self->{MaxExecTry} = $options{MaxExecTry} - 1; + $self->{PreCreate} = $options{PreCreate}; + $self->{SleepOnFail} = [reverse @{$options{SleepOnFail}}]; + + bless($self, $class); + for (my $i = $self->{PreCreate}; $i > 0; $i--) { + $self->inc_pool(); + } + } + + return $self; +} + +sub get($) { + my ($self) = @_; + my $rec = undef; + my $maxtry = $self->{MaxTry}; + my $rv = undef; + + do { + if (! $self->{FreePoolSize}) { + $self->inc_pool(); + } + if ($self->{FreePoolSize}) { + $rec = shift @{$self->{FreePool}}; + $self->{FreePoolSize}--; + + if (! $rec->precheck()) { + swarn("ResourcePool(%s): precheck failed\n", + $self->{Factory}->info()); + $rec->fail_close(); + undef $rec; + } + if ($rec) { + $rv = $rec->get_plain_resource(); + $self->{UsedPool}->{$rv} = $rec; + $self->{UsedPoolSize}++; + } + } + } while (! $rec && ($maxtry-- > 0) && ($self->sleepit($maxtry))); + return $rv; +} + +sub free($$) { + my ($self, $plain_rec) = @_; + + my $rec = $self->{UsedPool}->{$plain_rec}; + if ($rec) { + undef $self->{UsedPool}->{$plain_rec}; + $self->{UsedPoolSize}--; + if ($rec->postcheck()) { + push @{$self->{FreePool}}, $rec; + $self->{FreePoolSize}++; + } else { + $rec->fail_close(); + } + return 1; + } else { + return 0; + } +} + +sub fail($$) { + my ($self, $plain_rec) = @_; + + swarn("ResourcePool(%s): got failed resource from client\n", + $self->{Factory}->info()); + my $rec = $self->{UsedPool}->{$plain_rec}; + if (defined $rec) { + undef $self->{UsedPool}->{$plain_rec}; + $self->{UsedPoolSize}--; + $rec->fail_close(); + return 1; + } else { + return 0; + } +} + +sub downsize($) { + my ($self) = @_; + my $rec; + + swarn("ResourcePool(%s): Downsizing\n", $self->{Factory}->info()); + while ($rec = shift(@{$self->{FreePool}})) { + $rec->close(); + } + $self->{FreePoolSize} = 0; + swarn("ResourcePool: Downsized... still %s open (%s)\n", + $self->{UsedPoolSize}, $self->{FreePoolSize}); + +} + +sub postfork($) { + my ($self) = @_; + my $rec; + $self->{FreePool} = []; + $self->{UsedPool} = {}; + $self->{FreePoolSize} = 0; + $self->{UsedPoolSize} = 0; +} + +sub info($) { + my ($self) = @_; + return $self->{Factory}->info(); +} + +sub setMin($$) { + my ($self, $min) = @_; + $self->{Min} = $min; + return 1; +} + +sub setMax($$) { + my ($self, $max) = @_; + $self->{Max} = $max; + return 1; +} + +sub print_status($) { + my ($self) = @_; + printf("\t\t\t\t\tDB> FreePool: <%d>", $self->{FreePoolSize}); + printf(" UsedPool: <%d>\n", $self->{UsedPoolSize}); +} + +sub get_stat_used($) { + my ($self) = @_; + return $self->{UsedPoolSize}; +} + +sub get_stat_free($) { + my ($self) = @_; + return $self->{FreePoolSize}; +} + +#********************************************************************* +#*** Private Part +#********************************************************************* + +sub inc_pool($) { + my ($self) = @_; + my $rec; + my $PoolSize; + + $PoolSize=$self->{FreePoolSize} + $self->{UsedPoolSize}; + + if ( (! defined $self->{Max}) || ($PoolSize < $self->{Max})) { + $rec = $self->{Factory}->create_resource(); + + if (defined $rec) { + push @{$self->{FreePool}}, $rec; + $self->{FreePoolSize}++; + } + } +} + +sub sleepit($$) { + my ($self, $try) = @_; + swarn("ResourcePool> sleeping %s seconds...\n", $self->{SleepOnFail}->[$try]); + sleep($self->{SleepOnFail}->[$try]); + $self->downsize(); + return 1; +} + + +#********************************************************************* +#*** Functional Part +#********************************************************************* + +sub swarn($@) { + my $fmt = shift; + warn sprintf($fmt, @_); +} + +1; diff --git a/gosa-si/modules/ResourcePool_Factory_Net_LDAP.pm b/gosa-si/modules/ResourcePool_Factory_Net_LDAP.pm new file mode 100644 index 000000000..d5cc61153 --- /dev/null +++ b/gosa-si/modules/ResourcePool_Factory_Net_LDAP.pm @@ -0,0 +1,93 @@ +#********************************************************************* +#*** ResourcePool::Factory::Net::LDAP +#*** Copyright (c) 2002,2003 by Markus Winand +#*** $Id: LDAP.pm,v 1.5 2003/09/25 17:34:06 mws Exp $ +#********************************************************************* + +package ResourcePool::Factory::Net::LDAP; +use strict; +use vars qw($VERSION @ISA); +use ResourcePool::Factory; +use ResourcePool::Resource::Net::LDAP; +use Data::Dumper; + +push @ISA, "ResourcePool::Factory"; +$VERSION = "1.0002"; + +#### +# Some notes about the singleton behavior of this class. +# 1. the constructor does not return a singleton reference! +# 2. there is a seperate function called singelton() which will return a +# singleton reference +# this change was introduces with ResourcePool 0.9909 to allow more flexible +# factories (e.g. factories which do not require all parameters to their +# constructor) an example of such an factory is the Net::LDAP factory. + +sub new($@) { + my ($proto) = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + if (! exists($self->{host})) { + $self->{host} = shift; + if (defined $_[0] && ref($_[0]) ne "ARRAY") { + $self->{BindOptions} = []; + $self->{NewOptions} = [@_]; + } else { + # old syntax, compatiblity... + $self->{BindOptions} = defined $_[0]?shift: []; + $self->{NewOptions} = defined $_[0]?shift: []; + } + } + + bless($self, $class); + + return $self; +} + +sub bind($@) { + my $self = shift; + $self->{BindOptions} = [@_]; +} + +sub start_tls($@) { + my $self = shift; + $self->{start_tlsOptions} = [@_]; +} + +sub mk_singleton_key($) { + my $d = Data::Dumper->new([$_[0]]); + $d->Indent(0); + $d->Terse(1); + return $d->Dump(); +} + + +sub create_resource($) { + my ($self) = @_; + return ResourcePool::Resource::Net::LDAP->new($self + , $self->{host} + , $self->{BindOptions} + , $self->{NewOptions} + , $self->{start_tlsOptions} + ); +} + +sub info($) { + my ($self) = @_; + my $dn; + + if (scalar(@{$self->{BindOptions}}) % 2 == 0) { + # even numer -> old Net::LDAP->bind syntax + my %h = @{$self->{BindOptions}}; + $dn = $h{dn}; + } else { + # odd numer -> new Net::LDAP->bind syntax + $dn = $self->{BindOptions}->[0]; + } + # if dn is still undef -> anonymous bind + return (defined $dn? $dn . "@" : "" ) . $self->{host}; +} + + +1;