diff Lib/IMPL/Config/Class.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Config/Class.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,52 @@
+package IMPL::Config::Class;
+use strict;
+use warnings;
+
+use base qw(IMPL::Config);
+use IMPL::Exception;
+use IMPL::Class::Property;
+
+BEGIN {
+    public property Type => prop_all;
+    public property Parameters => prop_all;
+    public property IsSingleton => prop_all;
+    private property _Instance => prop_all;
+}
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+    my $this = shift;
+    
+    die new IMPL::Exception("A Type parameter is required") unless $this->Type;
+    
+}
+
+sub _is_class {
+    no strict 'refs';
+    scalar keys %{"$_[0]::"} ? 1 : 0;
+}
+
+sub instance {
+    my $this = shift;
+    
+    my $type = $this->Type;
+    
+    if ($this->IsSingleton) {
+        if ($this->_Instance) {
+            return $this->_Instance;
+        } else {
+            my %args = (%{$this->Parameters || {}},@_);
+            eval "require $type" unless _is_class($type);
+            my $inst = $type->new(%args);
+            $this->_Instance($inst);
+            return $inst;
+        }
+    } else {
+        my %args = (%{$this->Parameters || {}},@_);
+        eval "require $type" unless _is_class($type);
+        return $type->new(%args);
+    }
+}
+
+1;