1023 lines
37 KiB
Perl
1023 lines
37 KiB
Perl
# ==================================================================
|
|
# Gossamer Links - enhanced directory management system
|
|
#
|
|
# Website : http://gossamer-threads.com/
|
|
# Support : http://gossamer-threads.com/scripts/support/
|
|
# CVS Info : 087,071,086,086,085
|
|
# Revision : $Id: Links.pm,v 1.227 2009/05/09 17:01:33 brewt Exp $
|
|
#
|
|
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
|
|
# Redistribution in part or in whole strictly prohibited. Please
|
|
# see LICENSE file for full details.
|
|
# ==================================================================
|
|
|
|
package Links;
|
|
# ==================================================================
|
|
use strict;
|
|
use vars qw/
|
|
$VERSION $DEBUG
|
|
$IN $DB $CFG $USER
|
|
$PLG $GLOBALS $TPL $LANGUAGE
|
|
%STASH
|
|
@EXPORT_OK %EXPORT_TAGS @ISA
|
|
/;
|
|
|
|
# Load Links::Custom before anything else. Usually, it is empty, but it is not
|
|
# overwritten during upgrades, and so site-specific options (for example, a
|
|
# "use lib" required to make your installation work) can go in there.
|
|
use Links::Custom;
|
|
|
|
use GT::Base qw/:all/;
|
|
use Exporter();
|
|
use GT::AutoLoader;
|
|
|
|
use GT::Config;
|
|
use GT::CGI;
|
|
use GT::Template;
|
|
use GT::Plugins;
|
|
use GT::Delay;
|
|
use GT::Date;
|
|
use Links::Config;
|
|
|
|
use constants
|
|
# Payment option constants
|
|
GLOBAL => 0,
|
|
NOT_ACCEPTED => 1,
|
|
OPTIONAL => 2,
|
|
REQUIRED => 3,
|
|
|
|
# Payment expiry special values (anything else is a unix time)
|
|
UNPAID => -1,
|
|
UNLIMITED => 0x7fff_fffe,
|
|
FREE => 0x7fff_ffff;
|
|
|
|
$DEBUG = 0;
|
|
$VERSION = '3.3.0';
|
|
|
|
@ISA = 'Exporter';
|
|
# $TPL is still exported for compatibility with (very) old plugins
|
|
@EXPORT_OK = qw(
|
|
$IN $CFG $DB $USER $PLG $TPL %STASH $MOD_PERL MOD_PERL SPEEDY PERSIST
|
|
GLOBAL NOT_ACCEPTED OPTIONAL REQUIRED UNPAID FREE UNLIMITED
|
|
VIEWABLE
|
|
);
|
|
|
|
%EXPORT_TAGS = (
|
|
'payment' => [qw/GLOBAL NOT_ACCEPTED OPTIONAL REQUIRED UNPAID FREE UNLIMITED/],
|
|
'objects' => [qw/$IN $CFG $DB $USER $PLG %STASH VIEWABLE/],
|
|
'persist' => [qw/MOD_PERL SPEEDY PERSIST/]
|
|
);
|
|
|
|
# Returns a new condition object to use for viewable links. Currently, this
|
|
# means isValidated = 'Yes', and, if payment support is enabled,
|
|
# ExpiryDate >= time. You can use it as:
|
|
# my $cond = VIEWABLE; $cond->add(some => other => condition);
|
|
# or:
|
|
# $table->select(VIEWABLE);
|
|
# or:
|
|
# $table->select({ column => $value }, VIEWABLE);
|
|
sub VIEWABLE() {
|
|
require GT::SQL::Condition;
|
|
my $cond = GT::SQL::Condition->new(isValidated => '=' => 'Yes');
|
|
$cond->add(ExpiryDate => '>=' => time) if $CFG->{payment}->{enabled};
|
|
$cond;
|
|
}
|
|
|
|
sub init {
|
|
# --------------------------------------------------------------------
|
|
# This function initializes Gossamer Links, and must be called before any other
|
|
# action is performed.
|
|
#
|
|
my $path = shift || '.';
|
|
|
|
# If under mod_perl, reset our environments.
|
|
if (PERSIST) {
|
|
GT::SQL->reset_env if $INC{'GT/SQL.pm'};
|
|
GT::CGI->reset_env();
|
|
}
|
|
|
|
# Get our config object.
|
|
$CFG = Links::Config->new($path);
|
|
my $debug = $CFG->{debug_level} || $DEBUG;
|
|
|
|
# Set our tmp directory to store files.
|
|
$ENV{GT_TMPDIR} = $CFG->{admin_root_path} . '/tmp';
|
|
$IN = GT::CGI->new();
|
|
$PLG = GT::Plugins->new(directory => "$CFG->{admin_root_path}/Plugins", debug => $debug);
|
|
|
|
if ($DB and not ref $DB eq 'GT::Delay') { # $DB is already a GT::SQL object
|
|
$DB = GT::SQL->new({
|
|
def_path => $CFG->{admin_root_path} . '/defs',
|
|
cache => 1,
|
|
debug => $debug,
|
|
});
|
|
}
|
|
else {
|
|
$DB = GT::Delay(
|
|
'GT::SQL', 'HASH',
|
|
{
|
|
def_path => $CFG->{admin_root_path} . '/defs',
|
|
cache => 1,
|
|
debug => $debug,
|
|
}
|
|
);
|
|
}
|
|
|
|
$PLG->dispatch('init', sub {});
|
|
|
|
(%STASH, $GLOBALS, $LANGUAGE, $USER) = ();
|
|
}
|
|
|
|
sub init_date {
|
|
# --------------------------------------------------------------------
|
|
# Load the date module and setup any custom date strings.
|
|
#
|
|
return unless $CFG and not $STASH{date_loaded};
|
|
|
|
my $debug = defined $CFG->{debug_level} ? $CFG->{debug_level} : $DEBUG;
|
|
|
|
require GT::Date;
|
|
$GT::Date::DEBUG = $debug if ($debug);
|
|
$GT::Date::OFFSET = $CFG->{date_offset} * 3600;
|
|
$GT::Date::LANGUAGE = {
|
|
'month_names' => $CFG->{date_month_long},
|
|
'day_names' => $CFG->{date_days_long},
|
|
'short_month_names' => $CFG->{date_month_short},
|
|
'short_day_names' => $CFG->{date_days_short}
|
|
};
|
|
GT::Date::build_lang();
|
|
$STASH{date_loaded} = 1;
|
|
}
|
|
|
|
sub init_user {
|
|
# --------------------------------------------------------------------
|
|
# User initialization, but passes through plugins.
|
|
#
|
|
$PLG->dispatch('init_user', sub { _plg_init_user(@_); }, @_);
|
|
}
|
|
|
|
sub _plg_init_user {
|
|
# --------------------------------------------------------------------
|
|
# Check to see if the request is for a valid user, if so, set
|
|
# $USER to the user.
|
|
#
|
|
GT::Template->root("$CFG->{admin_root_path}/templates/" . template_set());
|
|
|
|
# Authenticate the user.
|
|
require Links::Authenticate;
|
|
Links::Authenticate::auth('init');
|
|
|
|
$USER = undef;
|
|
|
|
my $username = shift || $IN->param('Username') || undef;
|
|
my $password = shift || $IN->param('Password') || undef;
|
|
|
|
# Validate the username, either through logging on, or checking the
|
|
# session.
|
|
my $valid_user;
|
|
if (defined $username && defined $password) {
|
|
if (Links::Authenticate::auth('valid_user', { Username => $username, Password => $password })) {
|
|
$valid_user = $username;
|
|
}
|
|
}
|
|
else {
|
|
$valid_user = Links::Authenticate::auth('valid_session');
|
|
}
|
|
return unless $valid_user;
|
|
|
|
# We have a valid_user, now let's get the user from Gossamer Links, if he's not there
|
|
# then we auto-create him.
|
|
$USER = Links::Authenticate::auth('get_user', { Username => $valid_user, Password => $password, auto_create => 1 });
|
|
if ($USER and $USER->{Status} eq 'Not Validated') {
|
|
return;
|
|
}
|
|
return $USER;
|
|
}
|
|
|
|
sub init_admin {
|
|
# -----------------------------------------------------------------------------
|
|
$PLG->dispatch('init_admin', sub { _plg_init_admin(@_); }, @_);
|
|
}
|
|
|
|
sub _plg_init_admin {
|
|
# -----------------------------------------------------------------------------
|
|
$LANGUAGE = GT::Config->load("$CFG->{admin_root_path}/templates/admin/language.txt", { inheritance => 1, local => 1 });
|
|
}
|
|
|
|
sub check_request {
|
|
# --------------------------------------------------------------------
|
|
# Checks to make sure the request is allowed.
|
|
#
|
|
if ($CFG->{disabled}) {
|
|
print $IN->header;
|
|
print Links::SiteHTML::display('error', { error => Links::language('GENERAL_DISABLED') });
|
|
return;
|
|
}
|
|
if (ref $CFG->{bans}) {
|
|
for (@{$CFG->{bans}}) {
|
|
# Turn a ban into a regexp
|
|
my $ban = quotemeta;
|
|
# *'s match anything
|
|
$ban =~ s/\\\*/.*/g;
|
|
# +'s match anything with at least one character
|
|
$ban =~ s/\\\+/.+/g;
|
|
# ?'s match any single character
|
|
$ban =~ s/\\\?/./g;
|
|
if ($ENV{REMOTE_HOST} and $ENV{REMOTE_HOST} =~ /^$ban$/i or $ENV{REMOTE_ADDR} =~ /^$ban$/i) {
|
|
print $IN->header;
|
|
print Links::SiteHTML::display('error', { error => Links::language('GENERAL_BANNED') });
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub language {
|
|
# --------------------------------------------------------------------
|
|
# Process a language request, it's only loaded once, and saved in
|
|
# $LANGUAGE. All arguments are automatically html escaped unless the argument
|
|
# is passed as a scalar ref.
|
|
#
|
|
$_[0] and $_[0] eq 'Links' and shift;
|
|
my $code = shift || '';
|
|
|
|
$LANGUAGE ||= GT::Config->load("$CFG->{admin_root_path}/templates/" . template_set() . "/language.txt", { inheritance => 1, local => 1 });
|
|
if (exists $LANGUAGE->{$code}) {
|
|
return @_ ? sprintf($LANGUAGE->{$code}, map { ref $_ ? $$_ : $IN->html_escape($_) } @_) : $LANGUAGE->{$code};
|
|
}
|
|
else {
|
|
return if ($code =~ /^PAYMENT_/);
|
|
return $code;
|
|
}
|
|
}
|
|
|
|
sub https {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns 1 if the request is (probably) under HTTPS. Under CGI or front-end
|
|
# mod_perl servers this is easy - just check for $ENV{HTTPS} eq 'on'. Under
|
|
# proxied back-end mod_perl servers it is _IMPOSSIBLE_.
|
|
#
|
|
return ($ENV{HTTPS} and $ENV{HTTPS} eq 'on');
|
|
}
|
|
|
|
sub config_vars {
|
|
# --------------------------------------------------------------------
|
|
# Return the config as a hash for use in templates. We flatten array refs
|
|
# and hash refs.
|
|
#
|
|
my $t = {};
|
|
while (my ($key, $val) = each %$CFG) {
|
|
(ref $val eq 'ARRAY') and ($val = join ",", @$val);
|
|
(ref $val eq 'HASH') and do { my $tmp; foreach (sort keys %$val) { $tmp .= "$_ = $val->{$_}, "; } chop $tmp; chop $tmp; $val = $tmp; };
|
|
$t->{"cfg_$key"} = $val;
|
|
}
|
|
return $t;
|
|
}
|
|
|
|
$COMPILE{admin_page} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_page {
|
|
# ------------------------------------------------------------------
|
|
# Display an admin template page.
|
|
#
|
|
(defined $_[0] and $_[0] eq 'Links') and shift;
|
|
my ($file, $params, $opts) = @_;
|
|
|
|
$file ||= $IN->param('page');
|
|
$file =~ /\.\./ and return die "Invalid template '$file' requested (Invalid name)";
|
|
$file =~ m,^/, and return die "Invalid template '$file' requested (Invalid name)";
|
|
|
|
# Add on $IN
|
|
$params ||= [];
|
|
my $cgi = $IN->get_hash;
|
|
for (keys %$cgi) {
|
|
$cgi->{$_} = ref $cgi->{$_} eq 'ARRAY' ? join("\n", @{$cgi->{$_}}) : $cgi->{$_};
|
|
}
|
|
ref $params eq 'ARRAY' ? (push @$params, $cgi) : ($params = [$cgi, $params]);
|
|
|
|
push @$params, { config => $CFG, in => $IN };
|
|
|
|
# Make sure a root is set.
|
|
$opts ||= {};
|
|
$opts->{root} ||= "$CFG->{admin_root_path}/templates/admin";
|
|
defined $opts->{print} or ($opts->{print} = 1);
|
|
defined $opts->{inheritance} or ($opts->{inheritance} = 1);
|
|
$opts->{stream} = 1 if not exists $opts->{stream} and $IN->param('stream');
|
|
|
|
my $cookies = [];
|
|
if ($IN->param('set-cookie')) {
|
|
foreach my $key ($IN->param) {
|
|
if ($key =~ /^cookie-(.*)/) {
|
|
my $path = $IN->param("cookie_path-$1") || '/';
|
|
my $exp = $IN->param("cookie_exp-$1") || '+5y';
|
|
push @$cookies, $IN->cookie(-name => $1, -value => $IN->param($key), -path => $path, -expires => $exp);
|
|
}
|
|
}
|
|
}
|
|
if ($opts->{print}) {
|
|
@$cookies ? print $IN->header(-cookie => $cookies, -charset => $CFG->{header_charset}) : print $IN->header(-charset => $CFG->{header_charset});
|
|
}
|
|
|
|
# Print the page.
|
|
GT::Template->parse($file, $params, $opts);
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub template_set {
|
|
# -----------------------------------------------------------------------------
|
|
# Tries to find and return a valid user template set name as well as a template
|
|
# theme name. It will check input from the following in the listed order:
|
|
# 1) The first argument to template_set()
|
|
# 2) CGI input ($IN->param('t'))
|
|
# 3) $CFG->{build_default_tpl}
|
|
# If no valid template is found, then it fatals. If no valid theme exists then
|
|
# no theme value is returned.
|
|
#
|
|
shift if @_ and UNIVERSAL::isa($_[0], 'Links');
|
|
my $template_set = shift;
|
|
|
|
for ($template_set, $IN->param('t'), $CFG->{build_default_tpl}, 'luna') {
|
|
next unless $_;
|
|
# Template name + theme can be passed in as: <template set name>.<template theme name>
|
|
my ($ts, $theme) = split(/\./, $_, 2);
|
|
if (not $ts or $ts eq 'admin' or $ts eq 'browser' or $ts eq 'help' or $ts eq 'CVS' or
|
|
$ts !~ /^[\w-]+$/o or not -d "$CFG->{admin_root_path}/templates/$ts") {
|
|
next;
|
|
}
|
|
|
|
return $ts if not wantarray;
|
|
|
|
# Check to see if a valid theme was passed in with the name
|
|
if ($theme and not theme_exists($ts, $theme)) {
|
|
$theme = '';
|
|
}
|
|
if (not $theme) {
|
|
# Get a default theme name from the template set's .tplinfo
|
|
my $tplinfo = GT::Template->load_tplinfo("$CFG->{admin_root_path}/templates/$ts");
|
|
if ($tplinfo and $tplinfo->{default_theme} and theme_exists($ts, $tplinfo->{default_theme})) {
|
|
$theme = $tplinfo->{default_theme};
|
|
}
|
|
}
|
|
if (not $theme and theme_exists($ts, $ts)) {
|
|
# Last resort is to just take the template set name as the theme name
|
|
$theme = $ts;
|
|
}
|
|
|
|
my $full = $ts;
|
|
$full .= ".$theme" if $theme and $theme ne $ts;
|
|
return ($ts, $theme, $full);
|
|
}
|
|
|
|
die "Could not find a valid template set!";
|
|
}
|
|
|
|
sub template_exists {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns true/false value indicating whether the given template exists in the
|
|
# given template set, honouring inheritance.
|
|
# Example usage: template_exists('default', 'home.html');
|
|
#
|
|
shift if @_ > 2 and $_[0] and UNIVERSAL::isa($_[0], 'Links');
|
|
require GT::Template::Inheritance;
|
|
my ($template_set, $filename) = @_;
|
|
my $found = GT::Template::Inheritance->get_path(
|
|
file => $filename,
|
|
path => "$CFG->{admin_root_path}/templates/$template_set",
|
|
use_local => 1,
|
|
use_inheritance => 1
|
|
);
|
|
|
|
return $found ? 1 : undef;
|
|
}
|
|
|
|
sub theme_exists {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns true/false value indicating whether the given template them exists in
|
|
# the given template set (the template set must exist).
|
|
# Example usage: template_theme_exists('luna', 'mytheme');
|
|
#
|
|
shift if @_ > 2 and $_[0] and UNIVERSAL::isa($_[0], 'Links');
|
|
my ($template, $theme) = @_;
|
|
|
|
return if $theme =~ /_core$/;
|
|
return -e "$CFG->{build_static_path}/$template/$theme.css";
|
|
}
|
|
|
|
sub user_page {
|
|
# ------------------------------------------------------------------
|
|
# Load a user template and return it.
|
|
#
|
|
(defined $_[0] and $_[0] eq 'Links') and shift;
|
|
my ($file, $vars, $opts) = @_;
|
|
|
|
# Replace $vars with hash if it is a CGI object.
|
|
$vars = $vars->get_hash if UNIVERSAL::isa($vars, 'GT::CGI');
|
|
|
|
# Figure out what template set we will use.
|
|
my ($template_set, $theme) = template_set(delete $opts->{template});
|
|
|
|
unless ((ref $opts and exists $opts->{string}) or ($file =~ /^[\w\-]+\.\w+$/)) {
|
|
die "Invalid template name: $file";
|
|
}
|
|
|
|
# Load our global variables.
|
|
$GLOBALS = GT::Config->load("$CFG->{admin_root_path}/templates/$template_set/globals.txt", { inheritance => 1, compile_subs => 'Links', local => 1 });
|
|
|
|
# Add in selected config options.
|
|
for (qw/db_cgi_url build_root_url build_images_url build_new_url build_ratings_url build_cool_url/) {
|
|
$vars->{$_} ||= $CFG->{$_};
|
|
}
|
|
|
|
# Variables we use that we don't want $IN to override if they don't exist
|
|
# (prevent XSS vulnerabilities)
|
|
for (@{$CFG->{protected_vars}}) {
|
|
$vars->{$_} = '' unless exists $vars->{$_};
|
|
}
|
|
|
|
# Set up config.*, in.*, user.* template tags:
|
|
$vars->{config} = $CFG;
|
|
$vars->{in} = $IN;
|
|
$vars->{user} = $USER;
|
|
|
|
# Whether or not the site is being built using nph-build.cgi
|
|
$vars->{building_static} = $STASH{building_static} ? 1 : 0;
|
|
|
|
# Make 't' and 'theme' always available for the currently-used template set:
|
|
$vars->{t} = $template_set;
|
|
$vars->{theme} = $theme;
|
|
|
|
# Set a page_id so users can do <%if page_id eq 'home'%>
|
|
($vars->{page_id} = $file) =~ s/\..{3,4}$//;
|
|
|
|
# This is used all over the place in the templates, so generate it here instead
|
|
# of in template code, since it's cleaner to do it here
|
|
$vars->{home_index} = $CFG->{build_home} || ($CFG->{build_index_include} ? $CFG->{build_index} : '');
|
|
|
|
# If db_cgi_url_https is empty, figure it out from db_cgi_url
|
|
my $https_url = $CFG->{db_cgi_url_https};
|
|
unless ($https_url and $https_url =~ /\S/) {
|
|
($https_url = $CFG->{db_cgi_url}) =~ s|^(?:\w+://)?|https://|;
|
|
}
|
|
$vars->{db_cgi_url_https} = $https_url;
|
|
|
|
# Return a query string
|
|
my $in_hash = $IN->get_hash(0);
|
|
my @url_hidden;
|
|
foreach (@{$CFG->{dynamic_preserve}}) {
|
|
next unless defined $in_hash->{$_} and $in_hash->{$_} =~ /\S/;
|
|
push @url_hidden, $IN->escape($_) . "=" . $IN->escape($in_hash->{$_});
|
|
$vars->{form_hidden} .= qq|<input type="hidden" name="| . $IN->escape($_) . qq|" value="| . $IN->escape($in_hash->{$_}) . qq|" />|;
|
|
}
|
|
$vars->{url_hidden} = join ';', @url_hidden;
|
|
|
|
# Parse and return the template, turn off compression for .txt templates.
|
|
my $dynamic = delete $opts->{dynamic};
|
|
$opts ||= {};
|
|
$opts->{root} ||= "$CFG->{admin_root_path}/templates/$template_set";
|
|
$opts->{compress} = $CFG->{compress} unless defined $opts->{compress};
|
|
$opts->{print} ||= 0;
|
|
$opts->{inheritance} = 1 unless defined $opts->{inheritance};
|
|
my $output = GT::Template->parse($file, [$IN, $GLOBALS, $USER || (), $vars], $opts);
|
|
if ($dynamic and !$opts->{print} and $IN->param('d')) {
|
|
$PLG->dispatch('clean_output', \&clean_output, \$output, $vars->{page_id});
|
|
}
|
|
return $output;
|
|
}
|
|
|
|
$COMPILE{send_email} = __LINE__ . <<'END_OF_SUB';
|
|
sub send_email {
|
|
# ------------------------------------------------------------------
|
|
# Send an email generated from a template.
|
|
# send_email takes 3 arguments: <template_name>, <tags>, <options>
|
|
# The available options are:
|
|
# admin_email
|
|
# The email should be sent as an admin email, that is, the template
|
|
# is pulled from the admin template set directory and some of the
|
|
# available template variables are different (see code below).
|
|
# body
|
|
# Replace the body of the email with the contents of this option.
|
|
# get_body
|
|
# Parse the email and return the body of the email (does not
|
|
# send the email).
|
|
#
|
|
# Note that send_email uses user_page for parsing non admin emails. This can
|
|
# be a problem because user_page adds $USER to the template's variables, which
|
|
# may be not the correct user if you're sending emails in places like the
|
|
# browser code (ie. $USER is the editor, rather than the user the email is being
|
|
# sent to).
|
|
#
|
|
# WARNING: this function does NOT do any input validation. Your code should do
|
|
# the proper input validation on the e-mail addresses, subject and any other
|
|
# data that you put into the headers. In particular e-mail addresses should be
|
|
# valid addresses, but more importantly, these headers should NOT contain
|
|
# newlines in them. This would allow users to add in their own headers to the
|
|
# e-mail (eg. allow them to spam using your script).
|
|
#
|
|
(defined $_[0] and $_[0] eq 'Links') and shift;
|
|
my ($template, $vars, $opts) = @_;
|
|
$vars ||= {};
|
|
$opts ||= {};
|
|
|
|
$vars->{db_admin_email} ||= $CFG->{db_admin_email};
|
|
|
|
my $parsed;
|
|
if ($opts->{admin_email}) {
|
|
my $cfg = Links::Config::load_vars();
|
|
$vars->{Host} ||= $ENV{REMOTE_HOST} ? "$ENV{REMOTE_HOST} ($ENV{REMOTE_ADDR})" : $ENV{REMOTE_ADDR} ? $ENV{REMOTE_ADDR} : 'none';
|
|
$vars->{Referer} ||= $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : 'none';
|
|
my $globals = GT::Config->load("$CFG->{admin_root_path}/templates/admin/globals.txt", { inheritance => 1, compile_subs => 'Links', local => 1, create_ok => 1 });
|
|
$parsed = GT::Template->parse($template, { %$globals, %$vars, %$cfg, config => $CFG, in => $IN }, { compress => 0, root => "$CFG->{admin_root_path}/templates/admin" });
|
|
}
|
|
else {
|
|
$parsed = user_page($template, $vars, { compress => 0 });
|
|
}
|
|
return unless $parsed;
|
|
|
|
require GT::Mail;
|
|
require GT::Mail::Parse;
|
|
my $top = GT::Mail::Parse->new(
|
|
debug => $CFG->{debug_level},
|
|
in_string => $parsed,
|
|
crlf => "\n",
|
|
headers_intact => 0,
|
|
)->parse();
|
|
|
|
# Replace the body with the body that was passed in
|
|
if ($opts->{body}) {
|
|
$top->body_data($opts->{body});
|
|
}
|
|
|
|
return $top->body_data() if $opts->{get_body};
|
|
|
|
my $charset = $top->delete('GT-Header-Charset');
|
|
$top->{header_charset} = $charset if $charset;
|
|
|
|
my $mail = new GT::Mail;
|
|
$mail->top_part($top);
|
|
|
|
my %send_opts;
|
|
if ($CFG->{db_smtp_server}) {
|
|
my ($host, $port) = $CFG->{db_smtp_server} =~ /^([\w.-]+)(?::(\d+))?$/;
|
|
%send_opts = (
|
|
smtp => $host,
|
|
smtp_port => $port,
|
|
smtp_ssl => $CFG->{db_smtp_ssl} || '',
|
|
smtp_user => $CFG->{db_smtp_user} || '',
|
|
smtp_pass => $CFG->{db_smtp_pass} || '',
|
|
pbs_host => $CFG->{db_smtp_pbs_host} || '',
|
|
pbs_port => $CFG->{db_smtp_pbs_port} || '',
|
|
pbs_user => $CFG->{db_smtp_pbs_user} || '',
|
|
pbs_pass => $CFG->{db_smtp_pbs_pass} || '',
|
|
pbs_ssl => $CFG->{db_smtp_pbs_ssl} || '',
|
|
pbs_auth_mode => $CFG->{db_smtp_pbs_auth_mode} || ''
|
|
);
|
|
}
|
|
else {
|
|
my ($path, $args) = split(' ', $CFG->{db_mail_path}, 2);
|
|
$send_opts{sendmail} = $path;
|
|
$send_opts{flags} = $args if $args;
|
|
}
|
|
$send_opts{debug} = $CFG->{debug_level};
|
|
|
|
$mail->top_part->delete('Date');
|
|
$mail->send(%send_opts);
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub clean_output {
|
|
# --------------------------------------------------------
|
|
# Cleans up the output for any dynamically generated pages, makes sure all
|
|
# the links go through the page.cgi script.
|
|
#
|
|
my ($output_ref, $page_id) = @_;
|
|
|
|
# Quit if we are not using dynamic pages.
|
|
return unless $CFG->{dynamic_pages};
|
|
|
|
my $query = '';
|
|
my $form = '';
|
|
my $in = $IN->get_hash(0); # Don't concat multiple values.
|
|
|
|
# Build a query string.
|
|
foreach (@{$CFG->{dynamic_preserve}}) {
|
|
next if not defined $in->{$_} or $in->{$_} =~ /^\s*$/;
|
|
$query .= $IN->escape($_) . '=' . $IN->escape($in->{$_}) . ';';
|
|
$form .= qq|<input type="hidden" name="| . $IN->html_escape($_) . qq|" value="| . $IN->html_escape($in->{$_}) . qq|" />|;
|
|
}
|
|
chop $query;
|
|
|
|
# Fix up the CGI references.
|
|
$$output_ref =~ s{(<(?:a[^>]+href|i?frame[^>]+src)\s*=\s*["']*)(\Q$CFG->{db_cgi_url}\E/[^"'>]+\.(?:cgi|pl)\??[^"'>]*)}{
|
|
my ($begin, $url) = ($1, $2);
|
|
$begin .= $PLG->dispatch('transform_url', \&transform_url, $url, $query, undef, $page_id);
|
|
}eig;
|
|
|
|
# Fix up any HTML forms, and insert hidden tags.
|
|
$$output_ref =~ s!(<form[^>]+>)!$1$form!ig;
|
|
|
|
# Build a list of urls that shouldn't be transformed (default includes
|
|
# build_static_url). This allows users to still put other files/directories in
|
|
# the build_root_url, but not have them their urls transformed to go through
|
|
# page.cgi
|
|
my @no_transform = @{$CFG->{dynamic_no_url_transform}};
|
|
for (@no_transform) {
|
|
$_ =~ s/<%(.*?)%>/if (exists $CFG->{$1}) { $CFG->{$1} } else { "<%$1%>" }/eg;
|
|
}
|
|
|
|
# Fix up the HTML references
|
|
$$output_ref =~ s{(<(?:a[^>]+href|i?frame[^>]+src)\s*=\s*["']*)(\Q$CFG->{build_root_url}\E/?[^"'>]*)}{
|
|
my ($begin, $url) = ($1, $2);
|
|
my $transform = 1;
|
|
for (@no_transform) {
|
|
if ($url =~ m/^\Q$_\E.+/) {
|
|
$begin .= $url;
|
|
$transform = 0;
|
|
last;
|
|
}
|
|
}
|
|
if ($transform) {
|
|
$begin .= $PLG->dispatch('transform_url', \&transform_url, $url, $query, undef, $page_id);
|
|
}
|
|
$begin;
|
|
}eig;
|
|
}
|
|
|
|
sub transform_url {
|
|
# --------------------------------------------------------------
|
|
# Tranform static urls into dynamic ones if dynamic mode is enabled.
|
|
# You'll want to pass in a separator (eg. &) if you're using the url in a meta
|
|
# refresh since you can't use ; in the url.
|
|
#
|
|
my ($url, $query, $separator, $page_id) = @_;
|
|
|
|
return $url unless $IN->param('d');
|
|
|
|
($url, my $anchor) = split(/#/, $url, 2);
|
|
|
|
my $in = $IN->get_hash(0);
|
|
unless ($query) {
|
|
foreach (@{$CFG->{dynamic_preserve}}) {
|
|
next if not defined $in->{$_} or $in->{$_} =~ /^\s*$/;
|
|
$query .= $IN->escape($_) . '=' . $IN->escape($in->{$_}) . ';';
|
|
}
|
|
chop $query;
|
|
}
|
|
|
|
if ($url =~ m%^\Q$CFG->{db_cgi_url}\E/(.+\.(?:cgi|pl))\??(.*)%) {
|
|
my ($script, $qs) = ($1, $2);
|
|
if ($query and $qs) {
|
|
$url = "$CFG->{db_cgi_url}/$script?$qs";
|
|
foreach (@{$CFG->{dynamic_preserve}}) {
|
|
next if not defined $in->{$_} or $in->{$_} =~ /^\s*$/;
|
|
unless ($qs =~ /(?:\A|[&;])$_=/) {
|
|
$url .= ';' . $IN->escape($_) . '=' . $IN->escape($in->{$_});
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$url = "$CFG->{db_cgi_url}/$script" . ($query ? "?$query" : '');
|
|
}
|
|
}
|
|
elsif ($url =~ m%^\Q$CFG->{build_root_url}\E/?(.*)%) {
|
|
my $obj = $1;
|
|
if ($obj =~ /\.(?:jpeg|jp[eg]|gif|png|mng|js|css|cgi|pl)$/) {
|
|
$url = "$CFG->{build_root_url}/$obj";
|
|
}
|
|
else {
|
|
$url = "$CFG->{db_cgi_url}/page.cgi?g=" . $IN->escape($obj) . ($query ? ";$query" : '');
|
|
# Preserve link/category sort order as well as link column filtering
|
|
my $pages_re = join('|', @{$CFG->{dynamic_preserve_sort_pages}});
|
|
if ($page_id =~ /^(?:$pages_re)$/) {
|
|
my ($new_match) = $CFG->{build_new_url} =~ m{^\Q$CFG->{build_root_url}\E/(.+)};
|
|
my ($cool_match) = $CFG->{build_cool_url} =~ m{^\Q$CFG->{build_root_url}\E/(.+)};
|
|
my ($rate_match) = $CFG->{build_ratings_url} =~ m{^\Q$CFG->{build_root_url}\E/(.+)};
|
|
if ($obj !~ /^(?:\Q$new_match\E|\Q$cool_match\E|\Q$rate_match\E)\/$/) {
|
|
for (qw/sb so cat_sb cat_so/, keys %{$DB->table('Links')->cols}) {
|
|
if ($IN->param($_)) {
|
|
$url .= ';' . $IN->escape($_) . '=' . $IN->escape($IN->param($_));
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($separator) {
|
|
$url =~ s/[&;]/$separator/g;
|
|
}
|
|
|
|
$url .= "#$anchor" if $anchor;
|
|
return $url;
|
|
}
|
|
|
|
sub redirect_login_url {
|
|
# --------------------------------------------------------------
|
|
# Redirects a user to the login screen, through a plugin.
|
|
#
|
|
my $from = shift;
|
|
$PLG->dispatch('auth_redirect_login', \&_redirect_login_url, $from);
|
|
}
|
|
|
|
sub _redirect_login_url {
|
|
# --------------------------------------------------------------
|
|
# Redirect the user to the login screen.
|
|
#
|
|
my ($from) = shift;
|
|
my $url = $IN->url(query_string => 1);
|
|
$url = $IN->escape($CFG->{db_cgi_url} . '/' . $url);
|
|
$url = $CFG->{db_cgi_url} . "/user.cgi?url=$url&from=$from";
|
|
foreach my $preserve (@{$CFG->{dynamic_preserve}}) {
|
|
my $val = $IN->param($preserve);
|
|
defined $val or next;
|
|
$url .= "&$preserve=" . $IN->escape($val);
|
|
}
|
|
return $url;
|
|
}
|
|
|
|
sub header {
|
|
# --------------------------------------------------------------
|
|
# Produces an admin header.
|
|
#
|
|
my $title = defined $_[0] ? $_[0] : '';
|
|
my $msg = defined $_[1] ? ($_[1] eq '0' ? '' : $_[1]) : '';
|
|
my $msg2 = defined $_[2] ? ($_[2] eq '0' ? '' : qq~<p><font size="2" face="Tahoma,Arial,Helvetica">$_[2]</font></p>~) : '';
|
|
|
|
return <<END_OF_HEAD;
|
|
<table border="1" cellpadding="0" cellspacing="0"><tr><td>
|
|
<table bgColor="#ffffff" border="0" cellPadding="3" cellSpacing="3" width="500" valign="top">
|
|
<tr>
|
|
<td align="left" bgColor="navy"><b><font color="#ffffff" size="2" face="Tahoma,Arial,Helvetica">$title</font></b></td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<p align="center"><b><font color="#000000" size="2" face="Tahoma,Arial,Helvetica">$title</font></b></p>
|
|
<p><font size="2" face="Tahoma,Arial,Helvetica">$msg</font>
|
|
$msg2
|
|
</td>
|
|
</tr>
|
|
</table>
|
|
</td></tr>
|
|
</table>
|
|
END_OF_HEAD
|
|
}
|
|
|
|
sub fatal {
|
|
# --------------------------------------------------------------
|
|
# Return a fatal error message to the browser.
|
|
#
|
|
die @_ if (GT::Base->in_eval()); # Don't do anything if we are in eval.
|
|
|
|
my $msg = $IN->html_escape(shift);
|
|
my $debug = defined $CFG->{debug_level} ? $CFG->{debug_level} : $DEBUG;
|
|
|
|
$IN ||= new GT::CGI;
|
|
print $IN->header();
|
|
|
|
|
|
# Use a custom header if one is defined.
|
|
if (defined $CFG and exists $CFG->{error_message} and $CFG->{error_message}) {
|
|
$CFG->{error_message} =~ s,<%error%>,$msg,g;
|
|
$CFG->{error_message} =~ s,<%environment%>,environment(),eg;
|
|
print $CFG->{error_message};
|
|
}
|
|
# Otherwise, print our standard header.
|
|
else {
|
|
print "<p><font face='Tahoma,Arial,Helvetica' size=2>A fatal error has occured:</font></p><blockquote><pre>$msg</pre></blockquote><p><font face='Tahoma,Arial,Helvetica' size=2>Please enable debugging in setup for more details.</font></p>\n";
|
|
if ($debug) {
|
|
print environment();
|
|
}
|
|
}
|
|
}
|
|
|
|
$COMPILE{environment} = __LINE__ . <<'END_OF_SUB';
|
|
sub environment {
|
|
# --------------------------------------------------------------------
|
|
# Return HTML formatted environment for error messages.
|
|
#
|
|
my $info = '<pre>';
|
|
my ($oserr, $evalerr) = ($@, $!);
|
|
|
|
# Stack trace.
|
|
$info .= "<b>Stack Trace</b>\n======================================\n";
|
|
$info .= GT::Base::stack_trace('Links', 1, 1);
|
|
$info .= "\n";
|
|
|
|
# Print GT::SQL error if it exists.
|
|
$info .= "<b>System Information</b>\n======================================\n";
|
|
if (my @user = eval { getpwuid($>) }) {
|
|
$info .= "Current user: $user[0] ($>)\n";
|
|
}
|
|
$info .= "Perl version: " . ($^V ? sprintf("%vd", $^V) : $]) . "\n";
|
|
$info .= "Gossamer Links version: $Links::VERSION\n" if $Links::VERSION;
|
|
$info .= "GT::SQL version: $GT::SQL::VERSION\n" if $GT::SQL::VERSION;
|
|
$info .= "GT::Template version: $GT::Template::VERSION\n" if $GT::Template::VERSION;
|
|
$info .= "DBI.pm version: $DBI::VERSION\n" if $DBI::VERSION;
|
|
$info .= "Running under mod_perl: " . (MOD_PERL ? "Yes (version " . MOD_PERL . ")" . (MOD_PERL >= 1.99 ? ', mod_perl 2 detected' : '') : "No") . "\n";
|
|
$info .= "Running under SpeedyCGI: " . (SPEEDY ? "Yes (version " . SPEEDY . ")" : "No") . "\n";
|
|
$info .= "\@INC = \n\t" . join("\n\t", @INC) . "\n";
|
|
$info .= "GT::SQL::error = " . $IN->html_escape($GT::SQL::error) . "\n" if $GT::SQL::error;
|
|
$info .= "DBI::errstr = " . $IN->html_escape($DBI::errstr) . "\n" if defined $DBI::errstr;
|
|
$info .= "\$\@: " . $IN->html_escape($oserr) . "\n" if $oserr;
|
|
$info .= "\$!: " . $IN->html_escape($evalerr) . "\n" if $evalerr;
|
|
$info .= "\n";
|
|
|
|
# CGI Parameters and Cookies.
|
|
if ($IN and ref($IN) eq 'GT::CGI') {
|
|
if ($IN->param) {
|
|
$info .= "<b>CGI Input</b>\n======================================\n";
|
|
foreach (sort $IN->param) {
|
|
$info .= $IN->html_escape($_) . " => " . $IN->html_escape($IN->param($_)) . "\n";
|
|
}
|
|
$info .= "\n";
|
|
}
|
|
if ($IN->cookie) {
|
|
$info .= "<b>CGI Cookies</b>\n======================================\n";
|
|
foreach (sort $IN->cookie) {
|
|
$info .= $IN->html_escape($_) . " => " . $IN->html_escape($IN->cookie($_)) . "\n";
|
|
}
|
|
$info .= "\n";
|
|
}
|
|
}
|
|
|
|
# Environment info.
|
|
$info .= "<b>Environment</b>\n======================================\n";
|
|
foreach (sort keys %ENV) {
|
|
$info .= $IN->html_escape($_) . " => " . $IN->html_escape($ENV{$_}) . "\n";
|
|
}
|
|
|
|
$info .= "</pre>";
|
|
return $info;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{module_environment} = __LINE__ . <<'END_OF_SUB';
|
|
sub module_environment {
|
|
my @loop;
|
|
for (sort {
|
|
my $apath = $a !~ m{^\w+(?:/\w+)*\.p[ml]$};
|
|
my $bpath = $b !~ m{^\w+(?:/\w+)*\.p[ml]$};
|
|
return 1 if $apath and not $bpath;
|
|
return -1 if $bpath and not $apath;
|
|
return $a cmp $b;
|
|
} keys %INC) {
|
|
my %info = (inc_path => $INC{$_});
|
|
(my $pkg = $_) =~ s|/|::|g;
|
|
my $m = ($pkg =~ s/\.pm$// and $pkg =~ /^\w+(?:::\w+)*$/);
|
|
my $ver;
|
|
$ver = ${"${pkg}::VERSION"} if $m;
|
|
$m = $m ? $pkg : $_;
|
|
if ($m eq $INC{$_}) {
|
|
$info{file_type} = 'file';
|
|
}
|
|
else {
|
|
@info{qw/file_type module module_version/} = ('module', $m, $ver);
|
|
}
|
|
push @loop, \%info;
|
|
}
|
|
|
|
return { modules => \@loop, current_pid => $$ };
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub date_to_time {
|
|
# --------------------------------------------------------------
|
|
# Taken from GForum
|
|
#
|
|
my $date = shift;
|
|
my $lt;
|
|
my @localtime;
|
|
DATE: {
|
|
(uc $date eq 'NOW') and (@localtime = localtime), last DATE;
|
|
|
|
# localtime format
|
|
$date =~ m|^\w+ \w{3} \d{1,2} \d{1,2}:\d{1,2}:\d{1,2} \d{4}$| and (@localtime = @{GT::Date::parse_format($date, '%ddd% %mmm% %d% %H%:%M%:%s% %yyyy%')}), last DATE;
|
|
$date =~ m|^\w+ \w{3} \d{1,2} \d{1,2}:\d{1,2}:\d{1,2} \d{4}$| and (@localtime = @{GT::Date::parse_format($date, '%ddd% %mmm% %d% %H%:%M%:%s% %yyyy%')}), last DATE;
|
|
|
|
# Okay, it wasn't simply them modifying what was displayed, so let's try some other common formats:
|
|
# just the date, no time:
|
|
# yyyy/mm/dd
|
|
$date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2}$| and (@localtime = @{GT::Date::parse_format($date, "%yyyy%$1%m%$2%d%")}), last DATE;
|
|
# 12 hour time:
|
|
# yyyy/mm/dd hh:MM [AP]M
|
|
$date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}[Hh:]\d{1,2} [AaPp][Mm]$| and (@localtime = @{GT::Date::parse_format($date, "%yyyy%$1%m%$2%d% %h%:%M% %tt%")}), last DATE;
|
|
# yyyy/mm/dd hh:MM:ss [AP]M
|
|
$date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}:\d{1,2} [AaPp][Mm]$| and (@localtime = @{GT::Date::parse_format($date, "%yyyy%$1%m%$2%d% %h%:%M%:%s% %tt%")}), last DATE;
|
|
# 24 hour time:
|
|
# yyyy/mm/dd HH:MM
|
|
$date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}$| and (@localtime = @{GT::Date::parse_format($date, "%yyyy%$1%m%$2%d% %H%:%M%")}), last DATE;
|
|
# yyyy/mm/dd HH:MM:ss
|
|
$date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}$| and (@localtime = @{GT::Date::parse_format($date, "%yyyy%$1%m%$2%d% %H%:%M%:%s%")}), last DATE;
|
|
# Common formats that can't be recognized:
|
|
# dd/mm/yyyy - These two are conflicting US/European formats and so it would
|
|
# mm/dd/yyyy - be impossible to figure out which one you are trying to use.
|
|
|
|
# First, try the admin format:
|
|
ref($lt = GT::Date::parse_format($date, GT::Date::FORMAT_DATE)) eq 'ARRAY' and (@localtime = @$lt), last DATE;
|
|
}
|
|
|
|
return scalar @localtime ? GT::Date::timelocal(@localtime) : undef;
|
|
}
|
|
|
|
sub paging {
|
|
# --------------------------------------------------------------
|
|
# General-purpose paging code (taken from GForum)
|
|
# Returns paging variables for templates (but can be used elsewhere).
|
|
# Takes 4 arguments: number of hits, hits per page, the current page, and the number of pages to show.
|
|
# Takes 1 additional optional argument - true or false, indicating whether or not a ... system will be
|
|
# used. If set, one extra number will be returned if there is just one extra number needed, and a
|
|
# 'dotdotdot' variable will be available as 1 if ... is needed.
|
|
# Example: when displaying paging of 9 with 11 pages, you would get:
|
|
# 1 2 3 4 5 6 7 8 9 and you would have the "dotdotdot" variable set, so you would put a ... and then 11.
|
|
# Now, if you were displaying paging of 9 with 10 pages, you would actually get _10_ numbers:
|
|
# 1 2 3 4 5 6 7 8 9 10 and the "dotdotdot" wouldn't be set, so you wouldn't put the ... 10, since
|
|
# 1 2 3 4 5 6 7 8 9 ... 10 would look silly.
|
|
# Returned is a hashref: { paging => LOOP/ARRAYREF, top_page => INTEGER }, and possibly dotdotdot => 1
|
|
# Inside the loop you have: <%page_num%> and <%is_current_page%>.
|
|
#
|
|
shift if @_ and UNIVERSAL::isa($_[0], __PACKAGE__); # Can be called as function or method
|
|
my ($num_hits, $max_hits, $current_page, $disp_pages, $want_dotdotdot) = @_;
|
|
|
|
$disp_pages ||= 20;
|
|
my $num_pages = int($num_hits / $max_hits);
|
|
$num_pages++ if $num_hits % $max_hits;
|
|
my ($start, $end);
|
|
if ($num_pages <= $disp_pages) {
|
|
$start = 1;
|
|
$end = $num_pages;
|
|
}
|
|
elsif ($current_page >= $num_pages - $disp_pages / 2) {
|
|
$end = $num_pages;
|
|
$start = $end - $disp_pages + 1;
|
|
}
|
|
elsif ($current_page <= $disp_pages / 2) {
|
|
$start = 1;
|
|
$end = $disp_pages;
|
|
}
|
|
else {
|
|
$start = $current_page - int($disp_pages / 2) + 1;
|
|
$start-- if $disp_pages % 2;
|
|
$end = $current_page + int($disp_pages / 2);
|
|
}
|
|
my $need_dotdotdot;
|
|
if ($want_dotdotdot) {
|
|
if ($num_pages == $end + 1) {
|
|
++$end;
|
|
}
|
|
elsif ($num_pages > $end) {
|
|
$need_dotdotdot = 1;
|
|
}
|
|
}
|
|
my @pages = map +{ page_num => $_, (($_ == $current_page) ? (is_current_page => 1) : ()) }, $start .. $end;
|
|
return {
|
|
paging => \@pages,
|
|
top_page => $num_pages,
|
|
($want_dotdotdot && $need_dotdotdot ? (dotdotdot => 1) : ())
|
|
};
|
|
}
|
|
|
|
sub limit_offset {
|
|
# -----------------------------------------------------------------------------
|
|
# Takes a list of options, verifies mh/nh values, then returns
|
|
# ($limit, $offset, $nh) - $nh is really just (offset * mh + 1).
|
|
#
|
|
# Options accepted are:
|
|
# ($mh, $nh, $default_mh)
|
|
# ($mh, $nh)
|
|
# ($default_mh)
|
|
# ()
|
|
#
|
|
# The first two take the $mh and $nh values, the latter two read them from
|
|
# $IN->param. $default_mh is used if $mh is not set (or is invalid) - if not
|
|
# specified, it defaults to 25. $nh, if unset, defaults to 1.
|
|
#
|
|
my ($mh, $nh, $default_mh);
|
|
if (@_ >= 2) {
|
|
($mh, $nh, $default_mh) = @_;
|
|
}
|
|
else {
|
|
$mh = $IN->param('mh');
|
|
$nh = $IN->param('nh');
|
|
$default_mh = $_[0];
|
|
}
|
|
|
|
$default_mh = 25 unless $default_mh and $default_mh =~ /^\d+$/;
|
|
|
|
$mh = $default_mh unless $mh and $mh =~ /^\d+$/;
|
|
$nh = 1 unless $nh and $nh =~ /^\d+$/;
|
|
|
|
return ($mh, $mh * ($nh - 1), $nh);
|
|
}
|
|
|
|
sub debug {
|
|
# --------------------------------------------------------------
|
|
# Display debug message to stderr.
|
|
#
|
|
my $msg = shift;
|
|
warn "Links ($$): $msg\n";
|
|
if ($DEBUG > 1) {
|
|
GT::SQL->stack_trace;
|
|
}
|
|
}
|
|
|
|
1;
|