discourse-legacysite-perl/site/glist/lib/GList/Template.pm
2024-06-17 21:49:12 +10:00

145 lines
4.7 KiB
Perl

# ==================================================================
# Gossamer List - enhanced mailing list management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info :
# Revision : $Id: Template.pm,v 1.6 2004/03/10 01:04:53 bao Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
package GList::Template;
# ==================================================================
use strict;
use GList qw/:objects $DEBUG/;
use GList::Config;
use GT::Template;
use vars qw/@ISA %VARS %MVARS/;
@ISA = qw/GT::Template/;
# Need to reset %VARS on each access of the page for mod_perl.
# Takes no args.
sub reset_env {
%VARS = ();
}
# Takes no args, returns all the mlist globals
sub globals {
my $g = {
version => $GList::CFG->{version},
image_url => $GList::CFG->{image_url},
cgi_url => $GList::CFG->{cgi_url},
root_path => $GList::CFG->{root_path},
priv_path => $GList::CFG->{priv_path}
};
if ($ENV{HTTP_USER_AGENT} and $ENV{HTTP_USER_AGENT} =~ /MSIE (\d+(?:\.\d+)?)/i and $ENV{HTTP_USER_AGENT} !~ /mac/i) {
$g->{is_ie} = 1;
$g->{ie_version} = $1;
}
$g;
}
# Takes 0 or 1 args - the template set. If not provided, it will try to use hidden 't' or else fall back to the Config default.
sub template_globals {
my $globals = GT::Config->load("$GList::CFG->{priv_path}/templates/common/globals.txt", { create_ok => 1, inheritance => 1, local => 1, compile_subs => 'GList', header => <<HEADER });
# This file is auto-generated and contains a perl hash of your
# global variables for the template set.
# Generated: [localtime]
# vim:syn=perl:ts=4
HEADER
my $ret = {}; # Since we are converting the values in $globals to scalar references, the cache will become screwed up under mod_perl, so we have to copy them out into this.
for (keys %$globals) {
my $val = $globals->{$_};
if (ref $val) {
$ret->{$_} = $val;
}
else {
$val =~ s/<%image_url%>/$CFG->{image_url}/g;
$ret->{$_} = \$val;
}
}
$ret;
}
# This is useful to set variables inside a loop, then retrieve them outside the
# loop. It stores them in %VARS.
# It takes args as a hash ref.
sub store_gvars {
my %vars = @_;
@MVARS{keys %vars} = values %vars;
return;
}
# Takes no args, but returns a reference to the hash containing the "kept"
# variables that were set inside some sort of loop
sub retrieve_gvars {
\%MVARS
}
# Takes all the args of GT::Template, but this changes them a bit before giving them to
# GT::Template to add on the variables, globals, and template set globals.
sub parse {
my $globals = globals();
my $set_globals = template_globals();
my $self = shift;
local %MVARS; # Localize this so that it will be empty for this parse
my $page = $_[0];
my ($vars, $opt) = @_[1, 2];
my ($retvars, $retopt);
if (ref $vars eq 'ARRAY') {
# put it on the beginning so that anything else will overwrite it
$retvars = [{ ($set_globals ? (%$set_globals) : ()), %$globals, %VARS }, @$vars]
}
elsif (ref $vars eq 'HASH' or UNIVERSAL::isa($vars, 'GT::Config')) {
$retvars = {%$vars};
# %VARS is first because it overrides mlist globals and template set globals.
for (keys %VARS) {
$retvars->{$_} = $VARS{$_} unless exists $retvars->{$_}
}
# Generally, installation globals should be be overridable by template set globals.
for (keys %$globals) {
$retvars->{$_} = $globals->{$_} unless exists $retvars->{$_}
}
# Template set globals are considered last and are only set if nothing else has set them.
for (keys %$set_globals) {
$retvars->{$_} = $set_globals->{$_} unless exists $retvars->{$_}
}
}
elsif (ref $vars) {
$retvars = [{ %$set_globals, %$globals, %VARS }, $vars]
}
else {
$retvars = { %$set_globals, %$globals, %VARS }
}
# Put the "escape" option on by default - it specifically has to be
# specified as 0 to disable it.
if ($opt) {
$retopt = {%$opt};
$retopt->{escape} = 1 unless exists $retopt->{escape};
$retopt->{compress} = $CFG->{compress} unless exists $retopt->{compress};
}
else {
$retopt = { escape => 1, compress => $CFG->{compress} };
}
$retopt->{debug_level} = $CFG->{debug_level} if $CFG->{debug_level};
$self->SUPER::parse($_[0], $retvars, $retopt, @_[3 .. $#_]);
}
1;