Stamp_Guy has asked for the wisdom of the Perl Monks concerning the following question:

I've been using this module for templates that is really straight forward. However, I'm running into trouble because I want to output the results to a file rather than to the STDOUT. I tried using a select statement to redirect STDOUT to a file, then reselecting it, but after it is reselected, I can't print anything. I'm sure it isn't my select code, because I tried it without the module here and it worked fine. Here is the code of the module. If anyone can explain this, I'd appreciate it! 
# Bilstone html template parser
#
#        May 2000
#        Version 1.21    production
#        author    Ian Steel    (ian@bilstone.co.uk)
#
#        For latest releases, documentation, faqs, etc see the homepag
+e at
#            http://freeweb.ftech.net/bilstone/htmltmpl.html
#
#        History:
#
#            april 1999 - First cut
#            September 1999 - added strict.
#            May 2000 - Speed Improvement.
#

package HTMLTMPL;

use strict;
use vars qw($aUTOLOaD);
use Carp;

no strict 'refs';

sub new()
{
    my $class = shift;
    my %baseHtml = ();
    bless \%baseHtml, $class;
    return \%baseHtml
}

sub src()
{
    if ($#_ != 1)
    {
        bailout("Error! template function requires a single parameter\
+n");
    }

    my $self = shift;
    my $src = shift;

    $self->{'_C__REPEaT__'} = 0;    # Not a repeating block as this is
+ the
                                    # main html page.

    my $allToks = [];

    # Parse the html into an array.
    #
    open(HTML, "<$src") || bailout("Cannot open html template file!<br
+>$src");

    parseSegment($self, '_e_o_f_', $allToks);

    $self->{'_C__TOKLIST__'} = $allToks;    # array of all tokens.

    close HTML;
}

# Reads html from handle.
# adds segments to array within the given hash parameter.
#
sub parseSegment()
{
    my ($segHash, $endOfSeg, $allToks) = @_;

    my @segments = ();
    my $repeating = $segHash->{'_C__REPEaT__'};
    my $aline = <HTML>;

    while (!($aline =~ /$endOfSeg/))
    {
        if ($aline =~ /__.+__/)
        {
            if ($aline =~ /^__x_.+__/)
            {
                chomp $aline;

                # The start of a repeating block
                # Create a hash which is named after the repeating blo
+ck.
                # Pass a reference to the hash into parseSegment (us) 
+so that
                #    the block of repeating html is picked up and asso
+ciated
                #    with this hash.
                #
                my $tokId = $aline;
                $tokId =~ s/__x_(.+)__/$1/;
                %$aline = ();
                %$aline->{'_C__ID__'} = $tokId;
                %$aline->{'_C__REPEaT__'} = 1;
                parseSegment(\%$aline, $aline, $allToks);
                push @segments, $aline;

                $aline = <HTML> || last;
                next;
            }

            # This line contains a token.
            # Break up line to get out tokens, and store in array.
            #
            while ($aline =~ /^(.*?)(__.+?__)/)
            {
                my $padding = $1;
                my $token = $2;
                my $tokId = $2;
                $tokId =~ s/__(.+)__/$1/;

                # For a repeating block, each token will have to hold 
+an array
                # of values. For non-repeating, just a scalar.
                #
                $segHash->{$token} = ($repeating ? [] : '');

                push @segments, $padding;
                push @segments, $token;

                push @$allToks, ($repeating ?     
                            $segHash->{'_C__ID__'} . ":" . $tokId : $t
+okId);
                $aline =~ s/^.*?__.+?__//o;
            }

            # Don't forget remainder of line
            #
            push @segments, $aline;
        }
        else
        {
            # No token in this line of html, so just add to array of h
+tml.
            #
            push @segments, $aline;
        }

        $aline = <HTML> || last;
    }
    if (($aline ne "$endOfSeg\n") && ($endOfSeg ne '_e_o_f_'))
    {
        bailout("Mismatch of end of block token ('$endOfSeg')!");
    }

    $segHash->{'_C__HTML__'} = [ @segments ];
}

sub aUTOLOaD
{
    my $token = $aUTOLOaD;
    my ($self, $value, $block) = @_;

    if (defined $block)
    {
        # Self needs to refer to the repeating block now rather than t
+his
        #    object because the user wants to store a repeating block 
+value.
        #
        my $tmp = '__' . $block . '__';
        $self = \%$tmp;
    }

    $token =~ s/.*:://;
    my $tok = '__' . $token . '__';

    if (exists $self->{$tok})
    {
        if (defined $block)
        {
            # within a block so add to array rather than storing raw v
+alue.
            #
            my $tmp = $self->{$tok};
            push @$tmp, $value;
        }
        else
        {
            $self->{$tok} = $value;
        }
    }
    else
    {
        bailout("Invalid token '$token'.<br>Maybe it needs qualifying 
+within a " .
                "block?");
    }
}

sub output()
{
    my $self = shift;
    my $hdr;

    foreach $hdr (@_)
    {
        print "$hdr\n";
    }

    print "\n";

    print mergeData($self);
}

sub htmlString()
{
    my $self = shift;
    return mergeData($self);
}

sub mergeData()
{
    my ($leg) = @_;

    my $segs = $leg->{'_C__HTML__'};
    my $repeating = $leg->{'_C__REPEaT__'};
    my $entries = 1;

    my $htmlGen;                            # Generated html to be out
+put.

    if ($repeating)
    {
        # determine number of times we need to repeat putting out this
        #    segment.
        #
        my $key;
        foreach $key (keys %$leg)
        {
            next if ($key =~ /^_C__/);    # ignore control entries.

            my $tmp = $leg->{$key};
            $entries = $#$tmp;
            $entries++;
            last;
        }
    }

    my $ix;
    for ($ix=0; $ix < $entries; $ix++)
    {
        # Walk the array of html segments.
        #
        my $seg;
        foreach $seg (@$segs)
        {
            if ($seg =~ /__.*__/)            # Is it a token?
            {
                if ($seg =~ /^__x_.+__/)        # Repeating?
                {
                    chomp($seg);
                    # This is a repeating block rather than an individ
+ual token,
                    # so process it seperately.
                    #
                    $htmlGen .= mergeData(\%$seg);
                }
                else
                {
                    if ($repeating)
                    {
                        # Output next value from array for this token.
                        #
                        my $temp = $leg->{$seg};
                        # print @$temp[$ix];
                        $htmlGen .= @$temp[$ix];
                    }
                    else
                    {
                        # Output token value.
                        #
                        # print $leg->{$seg};
                        $htmlGen .= $leg->{$seg};
                    }
                }
            }
            else
            {
                # Straight html
                #
                # print $seg;
                $htmlGen .= $seg;
            }
        }
    }

    return $htmlGen;
}

#    Returns a ref to an array. Each element of the array contains the
+ name of a
#    token within the template. Tokens within repeating blocks are pre
+fixed
#    with 'block_name:'.
#
sub listallTokens()
{
    my $self = shift;

    return $self->{'_C__TOKLIST__'};
}

sub dumpall()
{
    print << "EOHTML";
Content-type: text/html

<html><head><title>Dump of tokens and values</title></head>
<body bgcolor=beige>
<h3 align=center>Dump of tokens and values</h3>
<p>
<table border=1 align=center>
<tr align=center><th bgcolor=lightblue>Token</th><th colspan=2 bgcolor
+=lightblue>Value</th></tr>
EOHTML
    dumpit(@_);

    print "</table></body></html>";
}

sub dumpit()
{
    my ($self, $block) = @_;

    if (defined $block)
    {
        $self = \%$block if (defined $block);
    }

    my $repeating = $self->{'_C__REPEaT__'};

    if ($repeating)
    {
        my($entries);

        # Determine number of entries in block values.
        #
        my($key);
        foreach $key (keys %$self)
        {
            next if ($key =~ /^_C__/);    # ignore control entries.

            my $tmp = $self->{$key};
            $entries = $#$tmp;
            $entries++;
            last;
        }

        my($ix);
        for ($ix=0; $ix < $entries; $ix++)
        {
            my($key);
            foreach $key (keys %$self)
            {
                next if ($key =~ /^_C__/);    # ignore control entries
+.

                my $tmp = $self->{$key};
                print "<tr><td>$key" . "</td><td>[$ix]</td><td>@$tmp[$
+ix]</td><tr>\n";
            }
        }
    }
    else
    {
        # Walk the array of html segments.
        #
        my $segs = $self->{'_C__HTML__'};
        my($seg);
        foreach $seg (@$segs)
        {
            if ($seg =~ /^__.+__$/)
            {
                # dump only the tokens
                #
                if ($seg =~ /^__x_.+__$/)
                {
                    # repeating block so treat as seperate section
                    #
                    chomp $seg;
                    print "<tr><td colspan=3 align=center>$seg</td></t
+r>\n";
                    dumpit(\%$seg);
                    print "<tr><td colspan=3 align=center>&nbsp;</td><
+/tr>\n";
                }    
                else
                {
                    print "<tr><td>$seg</td><td colspan=2>" . $self->{
+$seg} . "</td></tr>\n";
                }
            }
        }
    }

}

sub bailout()
{
    my $mess = splice @_;

    my($retVal) =<<HTML10;
content-type: text/html

<html><head></head>
<body bgcolor=red>
<p>
<font color=white>
<h3>Template Error!</h3>
<center>
$mess
</center>
</p>
<hr>
</body></html>
HTML10

    print $retVal;
    croak "Template Error : $mess";
}

sub DESTROY()
{
}
1;

[download]

Replies are listed 'Best First'.
Re (tilly) 1: A template module question
by tilly (Archbishop) on Mar 08, 2001 at 09:03 UTC
    My guess is really going to be that it is your select code, just because this code is playing no obvious games that would cause problems, and I know how often I have made simple mistakes leading to my thinking things like that. (I prefer to admit to the number of times that I have seen others make that kind of mistake..) Try this pattern: 
    my $file = "output.txt";
open (FOO, "> $file") or die "Cannot write '$file': $!";
select(FOO);
# Do stuff here during which default prints go to the file.
# BUT: print STDOUT $string; will still go to STDOUT.  It
# isn't gone, just ignored by default.
select(STDOUT);
# If you are going to do a bunch more stuff.
close (FOO);
# prints here are back to normal.

    [download]
    Another option. Run this and redirect on the command line. 
    perl yourscript and args > outputfile

    [download]
    Oh, and long-term I strongly recommend moving to Template::Toolkit. But that is another issue.

    UPDATE
    Another thought just struck me. If the above module is being called in a script you are running with the system command, then it will go to STDOUT even though you have another thing selected. That probably isn't your situation, but just in case...

[reply]
[d/l]
[select]
Re: A template module question
by Masem (Monsignor) on Mar 08, 2001 at 06:25 UTC
    First, I would caution against reinventing the wheel; I know of at least 3 good templating packages out there, Text::Template, HTML::Template, and Template Toolkit 2. Of course, this might be legacy code and you're stuck with it, which is fine.

    Since you only have about 5 print statements in this, and located in only a few subroutings, why not add a filehandle param to each of these? You can locally set the filehandle for each inside the subs, of if null, grab STDOUT. This way, the code remains portable, and there doesn't seem to be a lot more work than it looks like.

    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
[reply]
Re: A template module question
by Desdinova (Friar) on Mar 08, 2001 at 10:37 UTC
    I cant resist... how about
    script.pl >outfile
[reply]

Back to Seekers of Perl Wisdom