You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
82 lines
2.4 KiB
82 lines
2.4 KiB
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;
|