diff options
Diffstat (limited to 'perl-install/share/po/b_dump_strings.pm')
| -rw-r--r-- | perl-install/share/po/b_dump_strings.pm | 113 | 
1 files changed, 0 insertions, 113 deletions
| diff --git a/perl-install/share/po/b_dump_strings.pm b/perl-install/share/po/b_dump_strings.pm deleted file mode 100644 index 791eb97aa..000000000 --- a/perl-install/share/po/b_dump_strings.pm +++ /dev/null @@ -1,113 +0,0 @@ -package b_dump_strings; - -use B qw(minus_c save_BEGINs peekop class walkoptree walkoptree_exec -         main_start main_root cstring sv_undef); - -BEGIN { open OUT, ">$ENV{OUTFILE}" } - -sub B::CV::debug { -    my ($sv) = @_; -    B::walkoptree_exec($sv->START, "debug"); -} - -sub B::OP::debug { -    my ($op) = @_; -#    print "OP ", class($op), " ", $op->name, "\n"; -    eval { -	if ($op->name eq 'entersub') { -	    $op2 = $op->first->first or return; - -	    if ($op2->name eq 'pushmark') { -		my $s = $op2->sibling->sv->PV; -		my $l; -		for ($l = $op2->sibling; ${$l->sibling}; $l = $l->sibling) {} - -		$s =~ s/"/\\"/g; -		if ($l->first->sv->NAME eq '_') { -		    print OUT qq($::pkg N("$s")\n); -		} -	    } -	} -    }; -} -sub B::RV::debug { -    my ($op) = @_; -    $op->RV->debug; -} -sub B::SVOP::debug { -    my ($op) = @_; -    $op->sv->debug; -} -sub B::PV::debug { -    my ($sv) = @_; -#    print "STRING ", $sv->PV, "\n"; -} -sub B::IV::debug { -    my ($sv) = @_; -#    printf "IV\t%d\n", $sv->IV; -} -sub B::NV::debug { -    my ($sv) = @_; -#    printf "NV\t%s\n", $sv->NV; -} -sub B::PVIV::debug { -    my ($sv) = @_; -#    printf "IV\t%d\n", $sv->IV; -} -sub B::PVNV::debug { -    my ($sv) = @_; -#    printf "NV\t%s\n", $sv->NV; -} -sub B::AV::debug { -    my ($av) = @_; -#    print "ARRAY\n"; -} -sub B::GV::debug { -    my ($gv) = @_; -#    printf "GV %s::%s\n", $gv->STASH->NAME, $gv->SAFENAME; -} -sub B::NULL::debug {  -#    print "NUL\n"; -} -sub B::SPECIAL::debug {} - -sub B::SV::debug { die "SV"; } -sub B::BM::debug {  -    die "BM";  -} -sub B::PVLV::debug { die "PVLV"; } - -sub B::GV::pgv { -    my ($gv) = @_; -#    print $gv->NAME, "\n"; -    $gv->SV->debug; -    $gv->HV->debug; -    $gv->AV->debug; -    $gv->CV->debug; -} - - - - -sub search { - -foreach my $pkg (grep { /^[a-z]/ && !/^(diagnostics|strict|attributes|main)/ } grep { /\w+::$/ } keys %main::) { -    $::pkg = $pkg; -    foreach (keys %{$main::{$pkg}}) { -	print STDERR "$pkg $_ XXXXX\n"; -	local *f = *{$main::{$pkg}{$_}}; -	B::svref_2object(\*f)->pgv; -    } -} -print STDERR "DONE\n"; -} - -CHECK { search() } -INIT { exit 0 } - -#use lib qw(. /home/pixel/gi/perl-install); -##use commands; -#require '/tmp/t.pl'; -#search(); - -1; | 
