perl: Can't print to filehandle in object? - perl

Question

I'm trying to debug a cgi script that reports no errors but the browser displays the generated text as opposed to rendering the page. I called cgi from a container object (of sorts) to see if I'm sending the header twice.
package debugcgi;
use CGI qw(:standard);
use CGI qw(:standard Vars);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
sub new {
my ($class,$glob) = #_;
open(lls,">process-cgi.txt");
return bless{'cgi'=>CGI->new($glob),'glob'=>\*lls,'headers'=>0},$class;
}
sub header {
my $self = shift;
my $tmp = shift->{'cgi'}->header(#_);
print $tmp;
my $t = $self->{'glob'};
print $t $tmp;
$self->{'headers'}++;
}
...
sub myclose {
my $self = shift;
my $t = $self->{'glob'};
my $tmp = $self->{'headers'};
print $t "\nnumber of headers: ";
print $t $tmp;
close $t;
}
1;
used as a simple replacement for the real cgi in the bad script:
use debugcgi;
...
#my $cgi = CGI->new(\*STDIN);
my $cgi = debugcgi->new(\*STDIN);
...
print $cgi->header(Referer => $cgi->url());
oh.
but nothing gets printed to the file except "number of headers: 0" and I still get a full HTML document to show up. What did I do wrong, how can I improve on this?

Answer 1

You have a problem here:
sub header {
my $self = shift;
my $tmp = shift->{'cgi'}->header(#_);
...
$self is your hash, which contains the cgi object. So, you need to do this:
sub header {
my $self = shift;
my $cgi = $self->{'cgi'};
my $header_str = $cgi->header(#_);
shift
Shifts the first value of the array off and returns it, shortening the array by 1 and moving everything down.
http://perldoc.perl.org/functions/shift.html
This is more like what modern perl code looks like:
DebugCGI.pm:
package DebugCGI;
use strict;
use warnings;
use 5.016;
use Data::Dumper;
use CGI;
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
sub new {
my ($class, $PARAMFILE) = #_;
my $fname = 'process-cgi.txt';
open my $OUTFILE, '>', $fname
or die "Couldn't read from $fname: $!";
my $obj_attributes = {
'cgi_obj' => CGI->new($PARAMFILE),
'outfile' => $OUTFILE,
'header_count' => 0,
};
return bless $obj_attributes, $class;
}
sub header {
my ($self, #headers) = #_;
my $cgi = $self->{'cgi_obj'};
my $header_str = $cgi->header(#headers);
print {$self->{outfile}} $header_str;
$self->{'header_count'}++;
return;
}
sub close {
my ($self) = #_;
my $count = $self->{'header_count'};
my $OUTFILE = $self->{'outfile'};
say {$OUTFILE} "number of headers: $count";
close $OUTFILE;
return;
}
1;
Test it out:
use strict;
use warnings;
use 5.016;
use Data::Dumper;
use DebugCGI;
my $fname = 'params.txt';
open my $PARAMFILE, '<', $fname
or die "Couldn't open $fname: $!";
my $debug_cgi = DebugCGI->new($PARAMFILE);
close $PARAMFILE;
$debug_cgi->header(
'-type' => 'text/html; charset=UTF-8',
);
$debug_cgi->header(
'-type' => 'text/plain: charset=UTF-8',
);
$debug_cgi->close;
params.txt:
x=3
y=4
Output:
$ cat process-cgi.txt
Content-Type: text/html; charset=UTF-8
Content-Type: text/plain: charset=UTF-8
number of headers: 2
Note the double newline that $cgi->header() adds after its output. A double newline is a signal to the browser, that the headers have ended, and that any subsequent text is to be considered the body of the response. Therefore, you can't print $cgi->header() twice because the second time the text won't be considered a header. If for some reason you want to print $cgi->header() twice, then you can strip off the trailing newlines with s/\s+\z//xms.