STDOUT::Capture - manipulate STDOUT

   1: package STDOUT::Capture;
   2: use strict;
   3: use Carp qw(confess);
   4: 
   5: # Read ze POD, ze POD! :)
   6: #
   7: # A complete tarball with some examples and a
   8: # HTML version of the POD can currently be found at:
   9: #
  10: # http://dogandpony.perlmonk.org
  11: # /downloads/perl/STDOUT-Capture-0.01.tar.gz
  12: #
  13: # Comments, suggestions, previous art etc.
  14: # is very welcome.
  15: 
  16: use vars qw($VERSION $stdout %callbacks);
  17: $VERSION     = 0.01;
  18: 
  19: sub TIEHANDLE
  20: {
  21:     bless {}, shift;
  22: }
  23: 
  24: # Capture all that is printed, and do callbacks etc.
  25: sub PRINT
  26: {
  27:     shift; # Throw away.
  28: 
  29:     my $input = join '', @_;
  30:     if(exists $callbacks{'on_print'})
  31:     {
  32:         $callbacks{'on_print'}->(\$input);
  33:     }
  34:     $stdout .= $input;
  35: }
  36: 
  37: sub BINMODE
  38: {
  39:     # Finish all such manipluation before tieing STDOUT:
  40:     confess "Too late for binmode. If you are using CGI.pm, "
  41:           . "try to use it before you use this module.";
  42: }
  43: 
  44: # Tie STDOUT, and set up any callbacks:
  45: sub import
  46: {
  47:     my $self = shift;
  48: 
  49:     %callbacks = @_;
  50:     tie *STDOUT, __PACKAGE__;
  51: }
  52: 
  53: # Lastly, flush the output we do have:
  54: END
  55: {
  56:     if(exists $callbacks{'on_finish'})
  57:     {
  58:         $callbacks{'on_finish'}->(\$stdout);
  59:     }
  60: 
  61:     untie *STDOUT;
  62:     print $stdout;
  63: }
  64: 
  65: =head1 NAME
  66: 
  67: STDOUT::Capture - Simple base package for capturing
  68: the output of STDOUT from your programs.
  69: 
  70: 
  71: =head1 SYNOPSIS
  72: 
  73:  # In MyCapture.pm:
  74: 
  75:  package MyCapture;
  76: 
  77:  use STDOUT::Capture on_finish => \&on_finish;
  78: 
  79:  sub on_finish
  80:  {
  81:      my $stdout_ref = shift;
  82: 
  83:      # Insert a stylesheet link last in the head section
  84:      $$stdout_ref =~
  85:          s{(</head>)}
  86:           {<link rel="stylesheet" type="text/css" href="/css/style.css" />\n$1}i;
  87:  }
  88:  1;
  89: 
  90:  # In your program:
  91: 
  92:  use CGI qw(:standard); # import CGI.pm first!
  93:  use MyCapture;         # import your callbacks, capture STDOUT
  94: 
  95:  print header;
  96:  print start_html(-title => 'Cool CGI program');
  97:  print h1('Welcome to my cool CGI!');
  98:  print p('This is just a test page.');
  99:  print end_html;
 100: 
 101: 
 102: See the examples/ directory of this distribution for other,
 103: and non-CGI related examples.
 104: 
 105: 
 106: =head1 DESCRIPTION
 107: 
 108: STDOUT::Capture is a base package for creating packages that can be
 109: used to manipulate the output of your programs.
 110: 
 111: Typical usage might be if you already have some CGI scripts that you
 112: want to use on your site, but do not want to code the layout into
 113: them. Examples of this could be if you want to be able to display
 114: the raw code for them easily (without the layout stuff), if you want
 115: to use the same program on several sites or if you just are lazy or
 116: want a quick and dirty solution.
 117: 
 118: You could also use it if you have a normal, non-CGI program that you
 119: want to display the output of, as CGI,  without recoding the program
 120: itself.
 121: 
 122: Other uses include mailing the output of your program somewhere, or
 123: look for certain patterns in a resuable way, and without having to
 124: set up "complex" commands in cron or the like.
 125: 
 126: STDOUT::Capture works by capturing all prints to STDOUT and providing
 127: callbacks for each one, or for all of it at once. You get a reference
 128: to the current (or all) text that is to be printed, and can manipulate
 129: it before it is finally sent out.
 130: 
 131: I started writing this because I considered redesigning a web site a
 132: little, and figured I could get away with a little CSS, and simple
 133: output for most things, and maybe use HTML::Template for the extras.
 134: But I didn't really want to go in and prod inside all my CGI programs
 135: to add this new look, even though it wasn't much, and figured that
 136: maybe I could write a wrapper instead.
 137: 
 138: That way, all my CGI:s have just one extra line of code, which is the
 139: use statement for my redesign module. So the scripts are still very
 140: movable, and clean, plus I need only change something in one place.
 141: 
 142: Had I used HTML::Template or some such in the beginning, I could have
 143: avoided this, but with this, I can even switch HTML::Template out and
 144: in, with almost no hassle at all. Depending on how much rework of the
 145: output one does, however, it may be too much overhead.
 146: 
 147: Then I realized this module could be used for all sorts of other things
 148: too, preferably when something is already in place and tough to change,
 149: so I renamed it STDOUT::Capture, from CGI::Capture which was the
 150: intended name.
 151: 
 152: 
 153: =head1 USAGE
 154: 
 155: Your package, that contains your callbacks, extends STDOUT::Capture.
 156: Depending on which callbacks you choose, you will get the chance to
 157: modify the output from prints on STDOUT before they are actually
 158: printed.
 159: 
 160: Current callbacks are B<on_print>, which is called on each print,
 161: and B<on_finish> that is called upon exit of the program, with
 162: all output. You set them up in your package that inherits from
 163: STDOUT::Capture as you call use, like so:
 164: 
 165:  use STDOUT::Capture on_finish => \&on_finish,
 166:                      on_print  => \&on_print;
 167: 
 168:  sub on_print
 169:  {
 170:      my $$stdout_ref = shift;
 171:      # Do stuff on the current print
 172:  }
 173: 
 174:  sub on_finish
 175:  {
 176:      my $$stdout_ref = shift;
 177:      # Do stuff on all output
 178:  }
 179: 
 180: Input to these subs is a scalar reference that holds the contents
 181: of either the current print (B<on_print>) or the total output upon
 182: finish of the program (B<on_finish>). You can prod, look at and
 183: manipulate the contents of this scalar as you wish.
 184: 
 185: The callbacks expect no return value, you only modify the scalar
 186: reference in place.
 187: 
 188: 
 189: =head2 Using STDOUT::Capture together with CGI.pm
 190: 
 191: CGI.pm wants to do some things to STDOUT upon initialize, in
 192: particular it wants to set binmode on certain platforms. So when
 193: you are using CGI.pm together with this, you should use CGI.pm
 194: I<before> your own derived class, like so:
 195: 
 196:  use CGI;
 197:  use MyCapture;
 198: 
 199:  # Rest of program...
 200: 
 201: This will let CGI set up all things it wants to to do STDOUT
 202: before we tie it down.
 203: 
 204: =head2 Using STDOUT::Capture together with CGI::Carp
 205: 
 206: CGI::Carp, when "fatalsToBrowser" is imported, will emit the
 207: warnings on STDOUT, so you can (and will) capture that just
 208: as any other output and display it nicely formatted.
 209: 
 210: There are some caveats though, since the output from
 211: fatalsToBrowser is pretty terse - for instance, in the normal
 212: case it is probably likely that you would like to seach for
 213: everything inside the body tags, but CGI::Carp does not emit
 214: any body tags. So you will have to compensate for that, if
 215: you wish this information to still be printed (maybe check
 216: for the event of no body tag present?).
 217: 
 218: 
 219: =head1 CAVEATS
 220: 
 221: STDOUT::Capture prevents autoflushing, since it captures all
 222: the output and flushes it all when it exits.
 223: 
 224: 
 225: =head1 AUTHOR
 226: 
 227:     Kristoffer Lundén
 228:     kung.stoffe@home.se
 229: 
 230: 
 231: =head1 COPYRIGHT
 232: 
 233: Copyright (c) 2002 Kristoffer Lundén. All rights reserved.
 234: This program is free software; you can redistribute
 235: it and/or modify it under the same terms as Perl itself.
 236: 
 237: The full text of the license can be found in the
 238: LICENSE file included with this module.
 239: 
 240: 
 241: =head1 SEE ALSO
 242: 
 243: L<perltie>, L<CGI.pm>, L<CGI::Carp>
 244: 
 245: 
 246: =cut
 247: 
 248: 1;

Comment on STDOUT::Capture - manipulate STDOUT Download Code

Replies are listed 'Best First'.
Re: STDOUT::Capture - manipulate STDOUT by Anonymous Monk on Jun 09, 2002 at 19:49 UTC
You might want to first look at Tie::Handle::Scalar as a starting point. Also available are: IO::Stringy and IO::String which can also be used to capture output. None of these are limited to STDOUT.	[reply]
Re(2): STDOUT::Capture - manipulate STDOUT by Dog and Pony (Priest) on Jun 09, 2002 at 21:55 UTC
Thank you for the tips! I actually took the time to install these modules, and try to do the same job with them before answering, so I would know a little what I am talking about. First off, I want to limit myself to STDOUT, in this case, because I want the impact on the original script to be as small as possible - ie, I'd like it to just be an extra use line that I can insert into each script. But anyways, here is how it all worked out for me: I could, after some tinkering, accomplish the same thing with Tie::Handle::Scalar, as I do now. I'll just throw up the code right away: `use Tie::Handle::Scalar; tie STDOUT, 'Tie::Handle::Scalar'; END { my $output; while(<STDOUT>) { $output .= $_; } &on_finish(\$output); untie STDOUT; print $output; } sub on_finish { my $stdout_ref = shift; # Insert a stylesheet link last in the head section $$stdout_ref =~ s{(</head>)}{<link rel="stylesheet" type="text/css +" href="/css/style.css" />\n$1}i; }` [download] I put this in a module, and used it instead of the original example file - the sub routine is the exact same, so I could compare results. The above code does work, and comparatively, it uses about one third of the code in my module to do the same thing. But I do have some issues with it - you be the judge if I am just defending my code, or if I have any substance in these "complaints". :) I don't want to insert this whole chunk into my scripts, CGI or not, even though I could have it stored somewhere and just copy/paste it in, and =pod it out I guess. So I'd still wrap it into a wrapper module, which means that it gets the extra overhead of loading this other module (petty, probably) that does a lot I don't need, and that I need this module too, to be installed. It is not a standard module. Neither is mine, but that'd make it two. It uses a file to read and write from, which could result in some IO going back and forth, and it generally seems if not bad, so overkill for my needs. Of course, if my memory approach causes swapping (don't think so though, really), then it is about the same. On win2k, it also didn't remove the files it created, it did on linux though. The NT family is like that sometimes - it could be a problem though. Not big things, I guess, but it does a lot I don't need, in probably too general ways, plus I'd want that wrapper anyways. It could have saved me some POD writing though, if I wanted a one-time solution. It would most certainly work. IO::String and IO::Stringy I am less certain about. I couldn't get either to do this at all. Possibly because I don't understand the terse docs, but I tried most possible combinations of what was there at least. It is possible that it isn't meant to do this exact thing too, and equally possible I am doing it wrong. Most things still apply though, it would take an extra wrapper to get it where I want, etc. Well, I guess my petty "defence" is that I wanted something that did something, that something only, and did it good while being easy to use. If I succeeded is another matter entirely. I did lots of searches for something that could do this, and I still missed those modules, that is almost unbelievable. Especially since I searched the Tie::* modules pretty good. Guess I didn't look closely enough at exactly what modules did. Again, thanks for pointing these out to me. I'd still stick with what I wrote, now that it is written, but I might have reconsidered had I found this. Not that it matters, writing code is what is fun after all. :) You have moved into a dark place. It is pitch black. You are likely to be eaten by a grue.	[reply] [d/l]
Re: Re(2): STDOUT::Capture - manipulate STDOUT by Anonymous Monk on Jun 10, 2002 at 01:53 UTC
My thoughts were to just make MyCapture a subclass of Tie::Handle::Scalar that registers callbacks. Here's an example MyCapture.pm that is similar to your STDOUT::Capture module. You could go ahead and provide a wrapper module that hardcodes the desired callbacks as you do, or hardcode them directly in this subclass. ## -- MyCapture.pm -- ## package MyCapture; use Tie::Handle::Scalar; our @ISA = qw/Tie::Handle::Scalar/; my %callbacks; sub import { my $self = shift; %callbacks = @_; } sub PRINT { my $self = shift; my $input = join '', @_; if(exists $callbacks{on_print}){ $callbacks{on_print}->(\$input); } $self->SUPER::PRINT($input); } sub DESTROY { my $self = shift; if(exists $callbacks{on_finish}){ $callbacks{on_finish}->($self->{data}); } print ${$self->{data}}; } 1; __END__ ## -- test.pl -- ## #!/usr/bin/perl -w use strict; use CGI qw(:standard); use MyCapture on_finish => \&on_finish, on_print => sub{${$_[0]} =~ s/\bcgi\b/CGI/g}; sub on_finish { my $input = shift; $$input =~ s{(</head>)} {<link rel="stylesheet" type="text/css" href="/css/style.css" />\n +$1}i; } tie STDOUT, 'MyCapture'; print header; print start_html(-title => 'Cool cgi program'); print h1('Welcome to my cool cgi!'); print p('This is just a test page.'); print end_html; untie STDOUT; __END__ [download]	[reply] [d/l]
Re(4): STDOUT::Capture - manipulate STDOUT by Dog and Pony (Priest) on Jun 10, 2002 at 07:04 UTC
Re: STDOUT::Capture - manipulate STDOUT by aufflick (Deacon) on Apr 07, 2006 at 02:43 UTC
You have a minor problem in PRINT which will only be an issue if someone tries to print an object that automagically stringifies. You can fix this by replacing `my $input = join '', @_;` [download] with `my $intput = join '', map { "$_" } @_;` [download]	[reply] [d/l] [select]