#!/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;
}

[download]

In reply to Template by kayos

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.