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 (file)
index 0000000..77a473d
--- /dev/null
+++ b/gosa-si/modules/ResourcePool.pm
@@ -0,0 +1,251 @@
+#*********************************************************************
+#*** ResourcePool
+#*** Copyright (c) 2002-2005 by Markus Winand <mws@fatalmind.com>
+#*** $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 (file)
index 0000000..d5cc611
--- /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 <mws@fatalmind.com>
+#*** $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;