From 931e6730f2a74917e8120760f9fea1f9037c623a Mon Sep 17 00:00:00 2001
From: Pascal Rigaux <pixel@mandriva.com>
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