Move PerlQt

1 files changed, 81 insertions, 0 deletions

diff --git a/PerlTQt/lib/Qt/isa.pm b/PerlTQt/lib/Qt/isa.pm
new file mode 100644
index 0000000..71e9391
--- /dev/null
+++ b/PerlTQt/lib/Qt/isa.pm
@@ -0,0 +1,81 @@
+package TQt::isa;
+use strict;
+
+sub import {
+    no strict 'refs';
+    my $class = shift;
+    my $caller = (caller)[0];
+
+    # Trick 'use' into believing the file for this class has been read
+    my $pm = $caller . ".pm";
+    $pm =~ s!::!/!g;
+    unless(exists $::INC{$pm}) {
+	$::INC{$pm} = $::INC{"TQt/isa.pm"};
+    }
+
+    for my $super (@_) {
+	push @{ $caller . '::ISA' }, $super;
+	push @{ ${$caller . '::META'}{'superClass'} }, $super; # if isa(TQObject)?
+    }
+
+    *{ $caller . '::className' } = sub {	# closure on $caller
+	return $caller;
+    };
+
+    ${ $caller. '::_INTERNAL_STATIC_'}{'SUPER'} = bless {}, "  $caller";
+    TQt::_internal::installsuper($caller) unless defined &{ $caller.'::SUPER' };   
+
+    *{ $caller . '::metaObject' } = sub {
+	TQt::_internal::getMetaObject($caller);
+    };
+
+    *{ $caller . '::import' } = sub {
+	my $name = shift;    # classname = function-name
+	my $incaller = (caller)[0];
+        $incaller = (caller(1))[0] if $incaller eq 'if'; # work-around bug in package 'if'  pre 0.02
+        (my $cname = $name) =~ s/.*::// and do
+        { 
+            *{ "$name" } = sub {
+                $name->new(@_);
+            } unless defined &{ "$name" };
+        };
+        my $p = defined $&? $&:'';
+        $p eq ($incaller=~/.*::/?($p?$&:''):'') and
+	    *{ "$incaller\::$cname" } = sub {
+	        $name->new(@_);
+	    };
+
+        if(defined @{ ${$caller.'::META'}{'superClass'} } &&
+           @{ ${$caller.'::META'}{'superClass'} } )
+        {
+            # attributes inheritance
+            for my $attribute( keys %{ ${$caller.'::META'}{'attributes'} } )
+            {
+                if(! defined  &{$incaller.'::'.$attribute })
+                {
+                    TQt::_internal::installattribute($incaller, $attribute);
+                    ${ ${$incaller .'::META'}{'attributes'} }{$attribute} = 1;
+                }
+            }
+        }
+    };
+
+    TQt::_internal::installautoload("  $caller");
+    TQt::_internal::installautoload(" $caller");
+    TQt::_internal::installautoload($caller);
+    {
+	package TQt::AutoLoad;
+	my $autosub = \&{ " $caller\::_UTOLOAD" };
+	*{ " $caller\::AUTOLOAD" } = sub { &$autosub };
+        $autosub = \&{ "  $caller\::_UTOLOAD" };
+	*{ "  $caller\::AUTOLOAD" } = sub { &$autosub };        
+	$autosub = \&{ "$caller\::_UTOLOAD" };
+	*{ "$caller\::AUTOLOAD" } = sub { &$autosub };
+    }
+    TQt::_internal::installthis($caller);
+
+    # operator overloading
+    *{ " $caller\::ISA" } = ["TQt::base::_overload"];
+}
+
+1;