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.
libtqt-perl/PerlTQt/lib/TQt/isa.pm

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;