perl: Can't print to filehandle in object?

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.