File Coverage

blib/lib/CGI/PrintWrapper.pm

Criterion	Covered	Total	%
statement	39	41	95.1
branch	8	14	57.1
condition	1	3	33.3
subroutine	10	10	100.0
pod	3	3	100.0
total	61	71	85.9

package CGI::PrintWrapper;

# This is a lightweight wrapper for CGI so that you can call its
# methods, but have the results printed to the request object (passing
# through the Template object, of course).

use strict;

use Carp ( );
use CGI ( );
use CGI::Pretty;


$CGI::PrintWrapper::VERSION = (substr q$Revision: 1.8 $, 10) - 1;
my $rcs = '$Id: PrintWrapper.pm,v 1.8 1999/12/30 13:38:06 binkley Exp $';


sub new ($$;@) {
  my ($this, $h, @cgi_args) = @_;
  @cgi_args = ('') unless @cgi_args;

  $h or Carp::croak ('No print handle');
  $h->can ('print') or Carp::croak ("'$h' is not a print handle");

  my $class = ref ($this) || $this;
  # Need to create an empty CGI object to avoid CGI trying to read in
  # the parameters -- we are using CGI for printing forms, not for
  # processing scripts:
  my $cgi;
  eval { $cgi = CGI->new (@cgi_args); };
  $@ and Carp::croak ("Couldn't create CGI object because $@");

  bless [$h, $cgi], $class;
}

sub io ($;$) {
  if (scalar @_ == 1) {
    $_[0]->[0];
  } else {
    $_[0]->[0] = $_[1];
  }
}

# Modify CGI without printing:
sub cgi ($;$) {
  if (scalar @_ == 1) {
    $_[0]->[1];
  } else {
    $_[0]->[1] = $_[1];
  }
}

sub AUTOLOAD {
  no strict qw(refs);

  my $sub = $CGI::PrintWrapper::AUTOLOAD;
  $sub =~ s/.*:://; # strip package
  # We don't particularly want to print this:  :-)
  return if $sub eq 'DESTROY';

  # Fixup our call to invoke the same-named CGI function, but to print
  # the resulting string to our handle.  Update our symbol table so
  # that future calls can bypass AUTOLOAD entirely.  Be careful to
  # capture the handle ($$self) inside the sub--not outside--so that
  # calls from other instances don't reuse a previous handle (correct
  # scoping):
  *{$CGI::PrintWrapper::AUTOLOAD} = sub {
    my $self = shift;
    my $cgi_sub = "CGI::$sub";

    $self->[0]->print ($self->[1]->$cgi_sub (@_));

    return $self;
  };

  goto &$CGI::PrintWrapper::AUTOLOAD;
}

1;


__END__