From 931e6730f2a74917e8120760f9fea1f9037c623a Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Mon, 2 Jul 2001 14:01:16 +0000 Subject: high level i18n messages getting. only partial stuff. Used only for verification --- perl-install/share/po/b_dump_strings.pm | 113 ++++++++++++++++++++++++++++++++ 1 file changed, 113 insertions(+) create mode 100644 perl-install/share/po/b_dump_strings.pm (limited to 'perl-install/share') diff --git a/perl-install/share/po/b_dump_strings.pm b/perl-install/share/po/b_dump_strings.pm new file mode 100644 index 000000000..f29275ecd --- /dev/null +++ b/perl-install/share/po/b_dump_strings.pm @@ -0,0 +1,113 @@ +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 _("$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; -- cgit v1.2.1