X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FO.pm;h=7012c36ef7f28d184e291b7b73089d09711bddb9;hb=8ad6cd6e30dd4147303864a0fc6d2311046cabef;hp=2ef91edbd92d71e7d582e8fefea4b89d45e089db;hpb=f8519be6fd9bf0423897a621d943e29ddc834d84;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/B/O.pm b/ext/B/O.pm
index 2ef91ed..7012c36 100644
--- a/ext/B/O.pm
+++ b/ext/B/O.pm
@@ -1,21 +1,60 @@
 package O;
+
+our $VERSION = '1.00';
+
 use B qw(minus_c save_BEGINs);
-use Carp;    
+use Carp;
 
 sub import {
-    my ($class, $backend, @options) = @_;
-    eval "use B::$backend ()";
-    if ($@) {
-	croak "use of backend $backend failed: $@";
-    }
-    my $compilesub = &{"B::${backend}::compile"}(@options);
-    if (ref($compilesub) eq "CODE") {
-	minus_c;
-	save_BEGINs;
-	eval 'CHECK { &$compilesub() }';
-    } else {
-	die $compilesub;
+    my ($class, @options) = @_;
+    my ($quiet, $veryquiet) = (0, 0);
+    if ($options[0] eq '-q' || $options[0] eq '-qq') {
+	$quiet = 1;
+	open (SAVEOUT, ">&STDOUT");
+	close STDOUT;
+	open (STDOUT, ">", \$O::BEGIN_output);
+	if ($options[0] eq '-qq') {
+	    $veryquiet = 1;
+	}
+	shift @options;
     }
+    my $backend = shift (@options);
+    eval q[
+	BEGIN {
+	    minus_c;
+	    save_BEGINs;
+	}
+
+	CHECK {
+	    if ($quiet) {
+		close STDOUT;
+		open (STDOUT, ">&SAVEOUT");
+		close SAVEOUT;
+	    }
+
+	    # Note: if you change the code after this 'use', please
+	    # change the fudge factors in B::Concise (grep for
+	    # "fragile kludge") so that its output still looks
+	    # nice. Thanks. --smcc
+	    use B::].$backend.q[ ();
+	    if ($@) {
+		croak "use of backend $backend failed: $@";
+	    }
+
+
+	    my $compilesub = &{"B::${backend}::compile"}(@options);
+	    if (ref($compilesub) ne "CODE") {
+		die $compilesub;
+	    }
+
+	    local $savebackslash = $\;
+	    local ($\,$",$,) = (undef,' ','');
+	    &$compilesub();
+
+	    close STDERR if $veryquiet;
+	}
+    ];
+    die $@ if $@;
 }
 
 1;
@@ -28,12 +67,25 @@ O - Generic interface to Perl Compiler backends
 
 =head1 SYNOPSIS
 
-	perl -MO=Backend[,OPTIONS] foo.pl
+	perl -MO=[-q,]Backend[,OPTIONS] foo.pl
 
 =head1 DESCRIPTION
 
 This is the module that is used as a frontend to the Perl Compiler.
 
+If you pass the C<-q> option to the module, then the STDOUT
+filehandle will be redirected into the variable C<$O::BEGIN_output>
+during compilation.  This has the effect that any output printed
+to STDOUT by BEGIN blocks or use'd modules will be stored in this
+variable rather than printed. It's useful with those backends which
+produce output themselves (C<Deparse>, C<Concise> etc), so that
+their output is not confused with that generated by the code
+being compiled.
+
+The C<-qq> option behaves like C<-q>, except that it also closes
+STDERR after deparsing has finished. This suppresses the "Syntax OK"
+message normally produced by perl.
+
 =head1 CONVENTIONS
 
 Most compiler backends use the following conventions: OPTIONS
@@ -79,6 +131,12 @@ After the user's program is loaded and parsed, that returned sub ref
 is invoked which can then go ahead and do the compilation, usually by
 making use of the C<B> module's functionality.
 
+=head1 BUGS
+
+The C<-q> and C<-qq> options don't work correctly if perl isn't
+compiled with PerlIO support : STDOUT will be closed instead of being
+redirected to C<$O::BEGIN_output>.
+
 =head1 AUTHOR
 
 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>