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; |