http://www.perlmonks.org?node_id=18386
Category: CGI Programming
Author/Contact Info T.R. Fullhart <kayos@kayos.org>
Description:

Sometimes we have to make websites for clients that don't know how to use the web. Usually there is a certain section of their website that must be updated often. For those spots, I use this script.

This script relies on ePerl for the templates.

In the directory with the script, I have a file called config.pl:

$config = {
        'parents' => {
                file     => 'data/parents.pl',
                name     => "Parent Link",
        },
        'highlights' => {
                file     => 'data/highlights.pl',
                name     => 'Issue Highlights',
                input    => "input/highlights.tmpl",
                output   => 'output/highlights.tmpl',
        },
        'financial' => {
                file     => 'data/financial.pl',
                name     => 'Financial / Public',
        }
};

[download]

Each section of this hash is for a file that the client needs to change. The sections specify where to store the data that is plugged into the template, a descriptive name, and which ePerl template to use.

My input/default.tmpl looks like:

<html>
<body>

<form method="POST">
<input type="hidden" name="file" value="<:= $::file :>">
<input type="hidden" name="action" value="save">

<textarea name="body" cols="70" rows="50" wrap="physical"><:=$body:></
+textarea>
<br>
<input type="submit" value="Save Changes">
</form>
</body>
</html>

[download]

My output/default.tmpl is below. I made a function in main to convert linebreaks into <br> and <p> tags.

<:= main::encode($body) :>

[download]

I can either use this script to generate pieces of webpages or entire webpages. Examples:

<!--#include virtual="/cgi-bin/template/admin.pl?file=parents" -->

[download]
 
#!/usr/local/bin/perl
# $Id: admin.pl,v 1.1.1.1 2000/06/15 19:56:30 kayos Exp $

BEGIN {
#--------------------------------------------------------------------
# configuration

# if you are having errors, make sure the first line of this program
#       has the correct path to the correct version of perl. Also,
#       try uncommenting the below line and making sure it is the path
#       to the directory containing this program, data directory, and 
#       modules
#
#$base_dir = "/path/to/cgi-bin/template/";




#----------------------------------

# try to determine what directory the script is in
#
if(! $base_dir) {
        $base_dir = $0;
        $base_dir =~ s/\\/\//g;  #substitute NT \ for /
        if(rindex($base_dir,"/") > 0) {
                $base_dir = substr($base_dir,0,rindex($base_dir,"/"));
        } else {
                $base_dir = '.';
        }
}
$base_dir =~ s/\/$//;

chdir($base_dir) 
        or die "Cannot change directory to $base_dir: $!";
}


#--------------------------------------------------------------------
# modules and pragmas

# pragmas

# standard modules
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;

# non-standard modules
use Parse::ePerl;

# declare global vars, each can be called from other packages like:
#       $main::base_dir or $main::cgi->url()
#
use vars
        qw($base_dir $cgi),                             # config vars
        qw($url $redirect $action),                     # state vars
        qw($config);


#--------------------------------------------------------------------
# configuration

my $configfile = "config.pl";

my %config_vars = (
        default => {
                output => 'output/default.tmpl',
                input  => 'input/default.tmpl'
        }
);

if( -f $configfile && ! do $configfile ) {
        if( $! ) {
                croak <<"               EOF";
                $!

                This program can't find or access $configfile in
                $base_dir. You 
                might have to explicitly set \$base_dir at the top of 
+$0        
                and make sure that $configfile is in that directory.
                EOF
        } elsif( $@ ) {
                croak <<"               EOF";
                $@

                There are errors in $configfile. Check over the file c
+arefully
                and correct any syntax errors.
                EOF
        }
}

for my $var ( keys %config_vars ) {
        if(! defined $config->{$var}) {
                $config->{$var} = $config_vars{$var};
        }
}


#--------------------------------------------------------------------
# main: initialize, branch to handler, cleanup

local $|=1;     # turn off buffering for STDOUT

# grab and parse CGI params and environment vars
#
my $cgi = new CGI;

# what's my url?
#
$url = $cgi->url();

# if a called action isn't a function that returns a page, then
#       do the action, then redirect
#
$redirect = $cgi->param('redirect') || $cgi->referer() || $cgi->url();
$cgi->delete('redirect');

# if the only parameter is an action, then you can, optionally, pass j
+ust
#       the action word as a query_string like "http://url?logout" ins
+tead
#       of "http://url?action=logout"
#
$action = $cgi->param('action') || $cgi->param('keywords') || "";
$cgi->delete('action');
$cgi->delete('keywords');


# branch to handler functions
#
$_ = $action;
     if ( /edit/i && $cgi->param('file') ) {
        edit();
} elsif ( /save/i && $cgi->param('file') ) {
        save();
} elsif ( $cgi->param('file') ) {
        load();
} else {
        list();
}

exit;


#--------------------------------------------------------------------
# handler functions

sub list {
        # give them a choice of files to edit
        print $cgi->header();
        print <<"       EOF";
        <html>
        <body>
        <form method="GET">
        <input type="hidden" name="action" value="edit">
        <table>
        EOF
        for my $file ( keys %{$config} ) {
                if( $file ne 'default' ) {
                        my $description = $config->{$file}{'name'}
                                        || $config->{'default'}{'name'
+};
                        print <<"                       EOF";
                        <tr>
                                <td><input type="radio" name="file" va
+lue="$file
"></td>
                                <td><b>$description</b></td>
                        </tr>
                        EOF
                }
        }
        print <<"       EOF";
        <tr>
                <td colspan="2" align="center">
                        <input type="submit" value="Edit The File">
                </td>
        </tr>
        </table>
        </form>
        </body>
        </html>
        EOF
}

sub edit {
        local $::file;
        $file = $cgi->param('file');

        # load the input template
        my $input;
        {
                local $/;
                my $inputfile = $config->{$file}{'input'} 
                                || $config->{'default'}{'input'};
                open(INPUT,$inputfile)
                        or error("Can't open $inputfile: $!");
                $input = <INPUT>;
                close(INPUT);
        }

        # load the template data
        my $data;
        {
                local $/;
                my $datafile = $config->{$file}{'file'} 
                                || $config->{'default'}{'file'};
                if( open(DATA,$datafile) ) {
                        $data = <DATA>;
                        close(DATA);
                } else {
                        $data = '';
                }
        }
 
        my $result;
        my $error;
        Parse::ePerl::Translate({
                Script => $input,
                Result => \$result,
        }) or error( "Couldn't parse the template." );

        Parse::ePerl::Evaluate({
                Script => 'no strict; '.$data.$result,
                Result => \$result,
                Error => \$error
        }) or error( $error );

        print $cgi->header();
        print $result;
}

sub save {
        my $file = $cgi->param('file');
        $cgi->delete('file');

        my $filename = $config->{$file}{'file'}
                        || $config->{'default'}{'file'};        
        open(FILE,">$filename") or error($!);
        for my $field ( $cgi->param() ) {
                print FILE Data::Dumper->Dump([$cgi->param($field)],[$
+field]);
                print FILE "\n";
        }
        print FILE "1;\n";
        close(FILE);

        confirmation();
}

sub load {
        my $file = $cgi->param('file');

        # load the output template
        my $output;
        {
                local $/;
                my $outputfile = $config->{$file}{'output'} 
                                || $config->{'default'}{'output'};
                open(OUTPUT,$outputfile)
                        or error("Can't open $outputfile: $!");
                $output = <OUTPUT>;
                close(OUTPUT);
        }

        # load the template data
        my $data;
        {
                local $/;
                my $datafile = $config->{$file}{'file'} 
                                || $config->{'default'}{'file'};
                if( open(DATA,$datafile) ) {
                        $data = <DATA>;
                        close(DATA);
                } else {
                        $data = '';
                }
        }
 
        my $result;
        my $error;
        Parse::ePerl::Translate({
                Script => $output,
                Result => \$result,
        }) or error( $result );

        Parse::ePerl::Evaluate({
                Script => 'no strict;'.$data.$result,
                Result => \$result,
                Error => \$error
        }) or error( $error );

        print $cgi->header();
        print $result;
}


#--------------------------------------------------------------------

sub confirmation {
        print $cgi->header();
        print <<"       EOF";
        <html>
        <body>
        <h3>The file was successfully saved!</h3>
        <p><a href="$redirect">Click here to edit more files</a></p>
        </body>
        </html>
        EOF
}

sub encode {
        my $body = shift;
        $body =~ s/(\015\012|\015|\012)/\n/gs;
        $body =~ s/\n\n/<p>/gs;
        $body =~ s/\n/<br>/gs;
        $body =~ s/<br>/<br>\n/gis;
        $body =~ s/<p>/\n<p>/gis;
        return $body;
}

sub decode { 
        my $body = shift;
        $body =~ s/(\015|\012)//gs;
        $body =~ s/<br>/\n/gis;
        $body =~ s/<p>/\n\n/gis;
        return $body;
}

sub error {
        my $error = shift;
        die $error;
}
Replies are listed 'Best First'.
RE: Template
by davorg (Chancellor) on Jun 21, 2000 at 13:19 UTC

    Interesting code. You might like to take a look at the Template Toolkit which is another Perl-based way to address the same problem.


    --
    <a href="http://www.dave.org.uk><http://www.dave.org.uk>

    European Perl Conference - Sept 22/24 2000
    <http://www.yapc.org/Europe/>
[reply]
      I have been looking for this sort of thing, how exactly do you use it?
[reply]

        There are pretty good examples in the docs that come with the distribution and a lively mailing list which is happy to answer any other questions.

        If you have any specific questions, I'd be happy to to help as much as I can.

        --
        <http://www.dave.org.uk>

        European Perl Conference - Sept 22/24 2000
        <http://www.yapc.org/Europe/>
[reply]

Back to Code Catacombs