blob: 71e93912d7df8c89f867d65f415df0aca52e377c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
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;
|
