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.
83 lines
2.3 KiB
83 lines
2.3 KiB
13 years ago
|
#!/usr/bin/perl
|
||
|
|
||
13 years ago
|
# Note: this program is part of PerlTQt and makes use of its internal functions.
|
||
13 years ago
|
# You should not rely on those in your own programs.
|
||
|
|
||
|
use Getopt::Std;
|
||
|
use strict 'vars';
|
||
|
|
||
|
our (%o, @x, $h);
|
||
|
getopts('r:hvimp', \%o);
|
||
|
|
||
13 years ago
|
package TQt::_internal;
|
||
|
use TQt;
|
||
13 years ago
|
|
||
13 years ago
|
exists $o{'v'} and do{ print "PerlTQt-$TQt::VERSION using TQt-".&TQt::version."\n" and exit 0 };
|
||
13 years ago
|
exists $o{'h'} and do{ print $h and exit 0 };
|
||
13 years ago
|
exists $o{'m'} and do{ # interactive mode for driving the TQt Designer Plugin
|
||
13 years ago
|
select(STDOUT); $| = 1; # unbuffered
|
||
|
while(<STDIN>)
|
||
|
{
|
||
|
chomp;
|
||
13 years ago
|
s/^Q(?=[A-Z])/TQt::/;
|
||
13 years ago
|
my $i = find_pclassid( $_ );
|
||
|
print "__START__\n";
|
||
|
if ($i)
|
||
|
{
|
||
|
my $a = findAllMethods( $i );
|
||
|
my $t = dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] );
|
||
|
getAllParents($i, \my @sup);
|
||
|
for my $s(@sup)
|
||
|
{
|
||
|
$a = findAllMethods( $s );
|
||
|
$t.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] );
|
||
|
}
|
||
|
$t =~ s/\t//gs;
|
||
|
print $t;
|
||
|
}
|
||
|
print "__END__\n";
|
||
|
}
|
||
|
};
|
||
13 years ago
|
(my $c = $ARGV[0]) =~ s/^Q(?=[A-Z])/TQt::/;
|
||
13 years ago
|
my $i = $c ? find_pclassid( $c ) : 1;
|
||
|
my $r = exists $o{'r'} ? (exists $o{'i'} ? qr|$o{'r'}|i : qr|$o{'r'}|) : 0;
|
||
|
my $d = "";
|
||
|
|
||
|
while ($i)
|
||
|
{
|
||
|
my $a=findAllMethods($i);
|
||
|
last unless keys %$a;
|
||
|
@x=map {@{ $$a{$_} }} sort keys %$a;
|
||
|
$d = dumpCandidates(\@x);
|
||
|
if($c and $i and exists $o{'p'})
|
||
|
{
|
||
|
getAllParents($i, \my @sup);
|
||
|
for my $s(@sup)
|
||
|
{
|
||
|
$a = findAllMethods( $s );
|
||
|
$d.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] );
|
||
|
}
|
||
|
}
|
||
|
if($r)
|
||
|
{
|
||
|
map { print "$_\n" if $_=~$r } split("\n", $d);
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
print $d
|
||
|
}
|
||
|
$c and last;
|
||
|
$i++
|
||
|
}
|
||
|
|
||
|
BEGIN {
|
||
13 years ago
|
$h = "pqtapi - a PerlTQt introspection tool\t(c) Germain Garand 2003 <germain\@ebooksfrance.org>\n\n".
|
||
13 years ago
|
"usage: pqtapi [-r <re>] [<class>]\n\n".
|
||
|
"options:\n".
|
||
|
"\t-r <re> : find all functions matching regular expression/keyword <re>\n".
|
||
|
"\t-i : together with -r, performs a case insensitive search\n".
|
||
|
"\t-p : display also inherited methods for <class>.\n".
|
||
13 years ago
|
"\t-v : print PerlTQt and TQt versions\n".
|
||
13 years ago
|
"\t-h : print this help message\n";
|
||
|
}
|