First pass at adding key files
This commit is contained in:
dsainty
417
site/slowtwitch.com/cgi-bin/articles/GT/Template/Editor.pm
Normal file
417
site/slowtwitch.com/cgi-bin/articles/GT/Template/Editor.pm
Normal file
@@ -0,0 +1,417 @@
|
||||
# ====================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::Template::Editor
|
||||
# Author: Alex Krohn
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: Editor.pm,v 2.20 2009/05/09 17:28:30 brewt Exp $
|
||||
#
|
||||
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
# ====================================================================
|
||||
#
|
||||
# Description:
|
||||
# A module for editing templates via an HTML browser.
|
||||
#
|
||||
|
||||
package GT::Template::Editor;
|
||||
# ===============================================================
|
||||
use strict;
|
||||
use GT::Base;
|
||||
use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS);
|
||||
@ISA = qw/GT::Base/;
|
||||
$VERSION = sprintf "%d.%03d", q$Revision: 2.20 $ =~ /(\d+)\.(\d+)/;
|
||||
$DEBUG = 0;
|
||||
$ATTRIBS = {
|
||||
cgi => undef,
|
||||
root => undef,
|
||||
backup => undef,
|
||||
default_dir => '',
|
||||
default_file => '',
|
||||
date_format => '',
|
||||
class => undef,
|
||||
skip_dir => undef,
|
||||
skip_file => undef,
|
||||
select_dir => 'tpl_dir',
|
||||
demo => undef
|
||||
};
|
||||
$ERRORS = {
|
||||
CANTOVERWRITE => "Unable to overwrite file: %s (Permission Denied). Please set permissions properly and save again.",
|
||||
CANTCREATE => "Unable to create new files in directory %s. Please set permissions properly and save again.",
|
||||
CANTMOVE => "Unable to move file %s to %s: %s",
|
||||
CANTMOVE => "Unable to copy file %s to %s: %s",
|
||||
FILECOPY => "File::Copy is required in order to make backups.",
|
||||
};
|
||||
|
||||
sub process {
|
||||
# ------------------------------------------------------------------
|
||||
# Loads the template editor.
|
||||
#
|
||||
my $self = shift;
|
||||
|
||||
my $sel_tpl_dir = $self->{select_dir};
|
||||
my $selected_dir = $self->{cgi}->param($sel_tpl_dir) || $self->{default_dir} || 'default';
|
||||
my $selected_file = $self->{cgi}->param('tpl_file') || '';
|
||||
my $tpl_text = '';
|
||||
my $error_msg = '';
|
||||
my $success_msg = '';
|
||||
my ($local, $restore) = (0, 0);
|
||||
|
||||
# Check the template directory and file
|
||||
if ($selected_dir =~ m[[\\/\x00-\x1f]] or $selected_dir eq '..') {
|
||||
$error_msg = "Invalid template directory $selected_dir";
|
||||
$selected_dir = '';
|
||||
$selected_file = '';
|
||||
}
|
||||
if ($selected_file =~ m[[\\/\x00-\x1f]]) {
|
||||
$error_msg = "Invalid template $selected_file";
|
||||
$selected_dir = '';
|
||||
$selected_file = '';
|
||||
}
|
||||
|
||||
# Create the local directory if it doesn't exist.
|
||||
my $tpl_dir = $self->{root} . '/' . $selected_dir;
|
||||
my $local_dir = $tpl_dir . "/local";
|
||||
if ($selected_dir and ! -d $local_dir) {
|
||||
mkdir($local_dir, 0777) or return $self->error('MKDIR', 'FATAL', $local_dir, "$!");
|
||||
chmod(0777, $local_dir);
|
||||
}
|
||||
my $dir = $local_dir;
|
||||
|
||||
my $save = $self->{cgi}->param('tpl_name') || $self->{cgi}->param('tpl_file');
|
||||
# Perform a save if requested.
|
||||
if ($self->{cgi}->param('saveas') and $save and !$self->{demo}) {
|
||||
$tpl_text = $self->{cgi}->param('tpl_text');
|
||||
if (-e "$dir/$save" and ! -w _) {
|
||||
$error_msg = sprintf($ERRORS->{CANTOVERWRITE}, $save);
|
||||
}
|
||||
elsif (! -e _ and ! -w $dir) {
|
||||
$error_msg = sprintf($ERRORS->{CANTCREATE}, $dir);
|
||||
}
|
||||
else {
|
||||
if ($self->{backup} and -e "$dir/$save") {
|
||||
$self->copy("$dir/$save", "$dir/$save.bak");
|
||||
}
|
||||
local *FILE;
|
||||
open (FILE, "> $dir/$save") or return $self->error(CANTOPEN => FATAL => "$dir/$save", "$!");
|
||||
$tpl_text =~ s/\r\n/\n/g;
|
||||
print FILE $tpl_text;
|
||||
close FILE;
|
||||
chmod 0666, "$dir/$save";
|
||||
$success_msg = "File has been successfully saved.";
|
||||
$local = 1;
|
||||
$restore = 1 if -e "$self->{root}/$selected_dir/$save";
|
||||
$selected_file = $save;
|
||||
$tpl_text = '';
|
||||
}
|
||||
}
|
||||
# Delete a local template (thereby restoring the system template)
|
||||
elsif (my $restore = $self->{cgi}->param("restore") and !$self->{demo}) {
|
||||
if ($self->{backup}) {
|
||||
if ($self->move("$dir/$restore", "$dir/$restore.bak")) {
|
||||
$success_msg = "System template '$restore' restored";
|
||||
}
|
||||
else {
|
||||
$error_msg = "Unable to restore system template '$restore': Cannot move '$dir/$restore': $!";
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (unlink "$dir/$restore") {
|
||||
$success_msg = "System template '$restore' restored";
|
||||
}
|
||||
else {
|
||||
$error_msg = "Unable to remove $dir/$restore: $!";
|
||||
}
|
||||
}
|
||||
}
|
||||
# Delete a local template (This is like restore, but happens when there is no system template)
|
||||
elsif (my $delete = $self->{cgi}->param("delete") and !$self->{demo}) {
|
||||
if ($self->{backup}) {
|
||||
if ($self->move("$dir/$delete", "$dir/$delete.bak")) {
|
||||
$success_msg = "Template '$delete' deleted";
|
||||
}
|
||||
else {
|
||||
$error_msg = "Unable to delete template '$delete': Cannot move '$dir/$delete': $!";
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (unlink "$dir/$delete") {
|
||||
$success_msg = "Template '$delete' deleted";
|
||||
}
|
||||
else {
|
||||
$error_msg = "Unable to remove $dir/$delete: $!";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Load any selected template file.
|
||||
if ($selected_file and ! $tpl_text) {
|
||||
if (-f "$dir/$selected_file") {
|
||||
local (*FILE, $/);
|
||||
open FILE, "$dir/$selected_file" or die "Unable to open file $dir/$selected_file: $!";
|
||||
$tpl_text = <FILE>;
|
||||
close FILE;
|
||||
$local = 1;
|
||||
$restore = 1 if -e "$self->{root}/$selected_dir/$selected_file";
|
||||
}
|
||||
elsif (-f "$self->{root}/$selected_dir/$selected_file") {
|
||||
local (*FILE, $/);
|
||||
open FILE, "$self->{root}/$selected_dir/$selected_file" or die "Unable to open file $self->{root}/$selected_dir/$selected_file: $!";
|
||||
$tpl_text = <FILE>;
|
||||
close FILE;
|
||||
}
|
||||
else {
|
||||
$selected_file = '';
|
||||
}
|
||||
}
|
||||
|
||||
# Load a README if it exists.
|
||||
my $readme;
|
||||
if (-e "$dir/README") {
|
||||
local (*FILE, $/);
|
||||
open FILE, "$dir/README" or die "unable to open readme: $dir/README ($!)";
|
||||
$readme = <FILE>;
|
||||
close FILE;
|
||||
}
|
||||
|
||||
# Set the textarea width and height.
|
||||
my $editor_rows = $self->{cgi}->param('cookie-editor_rows') || $self->{cgi}->cookie('editor_rows') || 25;
|
||||
my $editor_cols = $self->{cgi}->param('cookie-editor_cols') || $self->{cgi}->cookie('editor_cols') || 100;
|
||||
my $file_select = $self->template_file_select;
|
||||
my $dir_select = $self->template_dir_select;
|
||||
$tpl_text = $self->{cgi}->html_escape($tpl_text);
|
||||
my $stats = $selected_file ? $self->template_file_stats($selected_file) : {};
|
||||
|
||||
if ($self->{demo} and ($self->{cgi}->param('saveas') or $self->{cgi}->param("delete") or $self->{cgi}->param("restore"))) {
|
||||
$error_msg = 'This feature has been disabled in the demo!';
|
||||
}
|
||||
return {
|
||||
tpl_name => $selected_file,
|
||||
tpl_file => $selected_file,
|
||||
local => $local,
|
||||
restore => $restore,
|
||||
tpl_text => \$tpl_text,
|
||||
error_message => $error_msg,
|
||||
success_message => $success_msg,
|
||||
tpl_dir => $selected_dir,
|
||||
readme => $readme,
|
||||
editor_rows => $editor_rows,
|
||||
editor_cols => $editor_cols,
|
||||
dir_select => $dir_select,
|
||||
file_select => $file_select,
|
||||
%$stats
|
||||
};
|
||||
}
|
||||
|
||||
sub _skip_files {
|
||||
my ($skip, $file) = @_;
|
||||
return 1 if $skip->{$file}
|
||||
or substr($file, 0, 1) eq '.' # skip dotfiles
|
||||
or substr($file, -4) eq '.bak'; # skip .bak files
|
||||
foreach my $f (keys %$skip) {
|
||||
my $match = quotemeta $f;
|
||||
$match =~ s/\\\*/.*/g;
|
||||
$match =~ s/\\\?/./g;
|
||||
return 1 if $file =~ /^$match$/;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub template_file_select {
|
||||
# ------------------------------------------------------------------
|
||||
# Returns a select list of templates in a given dir.
|
||||
#
|
||||
my $self = shift;
|
||||
my $path = $self->{root};
|
||||
my %files;
|
||||
my $sel_tpl_dir = $self->{select_dir};
|
||||
my $selected_dir = $self->{cgi}->param($sel_tpl_dir) || $self->{default_dir} || 'default';
|
||||
my $selected_file = $self->{cgi}->param('tpl_file') || $self->{default_file} || 'default';
|
||||
$selected_file = $self->{cgi}->param('tpl_name') if $self->{cgi}->param('saveas');
|
||||
my %skip;
|
||||
if ($self->{skip_file}) {
|
||||
for (@{$self->{skip_file}}) {
|
||||
$skip{$_}++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$skip{README} = $skip{'language.txt'} = $skip{'globals.txt'} = 1;
|
||||
}
|
||||
|
||||
# Check the template directory
|
||||
return if $selected_dir =~ m[[\\/\x00-\x1f]] or $selected_dir eq '..';
|
||||
|
||||
my $system_dir = $path . "/" . $selected_dir;
|
||||
my $local_dir = $path . "/" . $selected_dir . '/local';
|
||||
foreach my $dir ($system_dir, $local_dir) {
|
||||
opendir (TPL, $dir) or next;
|
||||
while (defined(my $file = readdir TPL)) {
|
||||
next unless -f "$dir/$file" and -r _;
|
||||
next if _skip_files(\%skip, $file);
|
||||
|
||||
$files{$file} = 1;
|
||||
}
|
||||
closedir TPL;
|
||||
}
|
||||
my $f_select_list = '<select name="tpl_file"';
|
||||
$f_select_list .= qq' class="$self->{class}"' if $self->{class};
|
||||
$f_select_list .= ">\n";
|
||||
|
||||
foreach (sort keys %files) {
|
||||
my $system = -e $path . '/' . $selected_dir . '/' . $_;
|
||||
my $local = -e $path . '/' . $selected_dir . '/local/' . $_;
|
||||
my $changed = $system && $local ? ' *' : $local ? ' +' : '';
|
||||
$f_select_list .= qq' <option value="$_"';
|
||||
$f_select_list .= ' selected' if $_ eq $selected_file;
|
||||
$f_select_list .= ">$_$changed</option>\n";
|
||||
}
|
||||
$f_select_list .= "</select>";
|
||||
|
||||
return $f_select_list;
|
||||
}
|
||||
|
||||
sub template_dir_select {
|
||||
# ------------------------------------------------------------------
|
||||
# Returns a select list of template directories.
|
||||
#
|
||||
my $self = shift;
|
||||
my ($dir, $file, @dirs);
|
||||
my $name = $self->{select_dir};
|
||||
my $selected_dir = $self->{cgi}->param($name) || $self->{default_dir} || 'default';
|
||||
|
||||
$dir = $self->{root};
|
||||
|
||||
my %skip = ('..' => 1, '.' => 1);
|
||||
if ($self->{skip_dir}) {
|
||||
for (@{$self->{skip_dir}}) { $skip{$_}++ }
|
||||
}
|
||||
else {
|
||||
$skip{admin} = $skip{help} = $skip{CVS} = 1;
|
||||
}
|
||||
|
||||
opendir (TPL, $dir) or die "unable to open directory: '$dir' ($!)";
|
||||
while (defined($file = readdir TPL)) {
|
||||
next if $skip{$file};
|
||||
next unless (-d "$dir/$file");
|
||||
push @dirs, $file;
|
||||
}
|
||||
closedir TPL;
|
||||
|
||||
my $d_select_list = qq'<select name="$name"';
|
||||
$d_select_list .= qq' class="$self->{class}"' if $self->{class};
|
||||
$d_select_list .= ">\n";
|
||||
foreach (sort @dirs) {
|
||||
$d_select_list .= qq' <option value="$_"';
|
||||
$d_select_list .= ' selected' if $_ eq $selected_dir;
|
||||
$d_select_list .= ">$_</option>\n";
|
||||
}
|
||||
$d_select_list .= "</select>";
|
||||
return $d_select_list;
|
||||
}
|
||||
|
||||
sub template_file_stats {
|
||||
# ------------------------------------------------------------------
|
||||
# Returns information about a file. Takes the following arguments:
|
||||
# - filename
|
||||
# - template set
|
||||
# The following tags are returned:
|
||||
# - file_path - the full path to the file, relative to the admin root directory
|
||||
# - file_size - the size of the file in bytes
|
||||
# - file_local - 1 or 0 - true if it is a local file
|
||||
# - file_restore - 1 or 0 - true if it is a local file and a non-local file of the same name exists (The non-local can be restored)
|
||||
# - file_mod_time - the date the file was last modified
|
||||
#
|
||||
require GT::Date;
|
||||
my ($self, $file) = @_;
|
||||
my $sel_tpl_dir = $self->{select_dir};
|
||||
my $tpl_dir = $self->{cgi}->param($sel_tpl_dir) || $self->{default_dir} || 'default';
|
||||
my $return = { file_local => 1, file_restore => 1 };
|
||||
my $dir = "$self->{root}/$tpl_dir";
|
||||
if (-f "$dir/local/$file" and -r _) {
|
||||
$return->{file_path} = "templates/$tpl_dir/local/$file";
|
||||
$return->{file_size} = -s _;
|
||||
$return->{file_local} = 1;
|
||||
my $mod_time = (stat _)[9];
|
||||
$return->{file_restore} = (-f "$dir/$file" and -r _) ? 1 : 0;
|
||||
if ($self->{date_format}) {
|
||||
require GT::Date;
|
||||
$return->{file_mod_time} = GT::Date::date_get($mod_time, $self->{date_format});
|
||||
}
|
||||
else {
|
||||
$return->{file_mod_time} = localtime($mod_time);
|
||||
}
|
||||
}
|
||||
else {
|
||||
$return->{file_path} = "templates/$tpl_dir/$file";
|
||||
$return->{file_size} = -s "$dir/$file";
|
||||
$return->{file_local} = 0;
|
||||
$return->{file_restore} = 0;
|
||||
my $mod_time = (stat _)[9];
|
||||
if ($self->{date_format}) {
|
||||
require GT::Date;
|
||||
$return->{file_mod_time} = GT::Date::date_get($mod_time, $self->{date_format});
|
||||
}
|
||||
else {
|
||||
$return->{file_mod_time} = localtime($mod_time);
|
||||
}
|
||||
}
|
||||
return $return;
|
||||
}
|
||||
|
||||
sub move {
|
||||
# -------------------------------------------------------------------
|
||||
# Uses File::Copy to move a file.
|
||||
#
|
||||
my $self = shift;
|
||||
my ($from, $to) = @_;
|
||||
eval { require File::Copy; };
|
||||
if ($@) {
|
||||
return $self->error('FILECOPY', $@);
|
||||
}
|
||||
File::Copy::mv($from, $to) or return $self->error('CANTMOVE', $from, $to, "$!");
|
||||
}
|
||||
|
||||
sub copy {
|
||||
# -------------------------------------------------------------------
|
||||
# Uses File::Copy to move a file.
|
||||
#
|
||||
my $self = shift;
|
||||
my ($from, $to) = @_;
|
||||
eval { require File::Copy; };
|
||||
if ($@) {
|
||||
return $self->error('FILECOPY', $@);
|
||||
}
|
||||
File::Copy::cp($from, $to) or return $self->error('CANTCOPY', $from, $to, "$!");
|
||||
}
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GT::Template::Editor - This module provides an easy way to edit templates.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Should be called like:
|
||||
|
||||
require GT::Template::Editor;
|
||||
my $editor = new GT::Template::Editor (
|
||||
root => $CFG->{admin_root_path} . '/templates',
|
||||
default_dir => $CFG->{build_default_tpl},
|
||||
backup => 1,
|
||||
cgi => $IN
|
||||
);
|
||||
return $editor->process;
|
||||
|
||||
and it returns a hsah ref of variables used for displaying a template editor page.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
http://www.gossamer-threads.com/
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Revision: $Id: Editor.pm,v 2.20 2009/05/09 17:28:30 brewt Exp $
|
||||
|
||||
=cut
|
||||
|
||||
250
site/slowtwitch.com/cgi-bin/articles/GT/Template/Inheritance.pm
Normal file
250
site/slowtwitch.com/cgi-bin/articles/GT/Template/Inheritance.pm
Normal file
@@ -0,0 +1,250 @@
|
||||
# ==================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::Template::Inheritance
|
||||
# Author: Scott Beck
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: Inheritance.pm,v 1.7 2005/02/09 20:51:27 jagerman Exp $
|
||||
#
|
||||
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
# ==================================================================
|
||||
#
|
||||
# Description: Provides class methods to deal with template
|
||||
# inheritance.
|
||||
#
|
||||
|
||||
package GT::Template::Inheritance;
|
||||
# ==================================================================
|
||||
|
||||
use strict;
|
||||
use vars qw($ERRORS);
|
||||
use bases 'GT::Base' => '';
|
||||
use GT::Template;
|
||||
|
||||
$ERRORS = { RECURSION => q _Recursive inheritance detected and interrupted: '%s'_ };
|
||||
|
||||
sub get_all_paths {
|
||||
# ----------------------------------------------------------------------------
|
||||
my ($class, %opts) = @_;
|
||||
|
||||
my $file = delete $opts{file};
|
||||
my $single = delete $opts{_single};
|
||||
$class->fatal(BADARGS => "No file specified to $class->" . ($single ? 'get_path' : 'get_all_paths')) unless defined $file;
|
||||
|
||||
my $root = delete $opts{path};
|
||||
$class->fatal(BADARGS => "No path specified to $class->" . ($single ? 'get_path' : 'get_all_paths')) unless defined $root;
|
||||
$class->fatal(BADARGS => "Path $root does not exist or is not a directory") unless -d $root;
|
||||
|
||||
my $local = exists $opts{local} ? delete $opts{local} : 1;
|
||||
my $inheritance = exists $opts{inheritance} ? delete $opts{inheritance} : 1;
|
||||
|
||||
# Old no-longer-supported option:
|
||||
delete @opts{qw/use_inheritance use_local local_inheritance/};
|
||||
|
||||
$class->fatal(BADARGS => "Unknown arguments: " . join ", ", keys %opts) if keys %opts;
|
||||
|
||||
my @paths = $class->tree(path => $root, local => $local, inheritance => $inheritance);
|
||||
my @files;
|
||||
for (@paths) {
|
||||
if (-f "$_/$file" and -r _) {
|
||||
return "$_/$file" if $single;
|
||||
push @files, "$_/$file";
|
||||
}
|
||||
}
|
||||
return if $single;
|
||||
return @files;
|
||||
}
|
||||
|
||||
sub get_path {
|
||||
# ----------------------------------------------------------------------------
|
||||
shift->get_all_paths(@_, _single => 1);
|
||||
}
|
||||
|
||||
sub tree {
|
||||
# -----------------------------------------------------------------------------
|
||||
my $class = shift;
|
||||
my %opts = @_ > 1 ? @_ : (path => shift);
|
||||
|
||||
my $root = delete $opts{path};
|
||||
$class->fatal(BADARGS => "No path specified for $class->tree") unless defined $root;
|
||||
$class->fatal(BADARGS => "Path '$root' does not exist or is not a directory") unless -d $root;
|
||||
|
||||
my $local = exists $opts{local} ? delete $opts{local} : 1;
|
||||
my $inheritance = exists $opts{inheritance} ? delete $opts{inheritance} : 1;
|
||||
|
||||
$class->fatal(BADARGS => "Unknown arguments: " . join ", ", keys %opts) if keys %opts;
|
||||
|
||||
my @paths;
|
||||
push @paths, $root;
|
||||
my %encountered = ($root => 1);
|
||||
if ($inheritance) {
|
||||
for my $path (@paths) {
|
||||
my $tplinfo = GT::Template->load_tplinfo($path);
|
||||
next if not defined $tplinfo->{inheritance};
|
||||
my @inherit = ref $tplinfo->{inheritance} eq 'ARRAY' ? @{$tplinfo->{inheritance}} : $tplinfo->{inheritance};
|
||||
|
||||
for (@inherit) {
|
||||
my $inh = m!^(?:[a-zA-Z]:)?[\\/]! ? $_ : "$path/$_";
|
||||
if (length $inh > 500 or $encountered{$inh}++) {
|
||||
return $class->fatal(RECURSION => $inh);
|
||||
}
|
||||
|
||||
push @paths, $inh;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($local) {
|
||||
for (my $i = 0; $i < @paths; $i++) {
|
||||
if (-d "$paths[$i]/local") {
|
||||
splice @paths, $i, 0, "$paths[$i]/local";
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return @paths;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GT::Template::Inheritance - Provides GT::Template inheritance/local file
|
||||
determination.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use GT::Template::Inheritance;
|
||||
|
||||
my $file = GT::Template::Inheritance->get_path(
|
||||
file => "foo.htm",
|
||||
path => "/path/to/my/template/set"
|
||||
);
|
||||
|
||||
my @files = GT::Template::Inheritance->get_all_paths(
|
||||
file => "foo.htm",
|
||||
path => "/path/to/my/template/set"
|
||||
);
|
||||
|
||||
my @paths = GT::Template::Inheritance->tree(
|
||||
path => "/path/to/my/template/set"
|
||||
);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
GT::Template::Inheritance provides an interface to accessing files for
|
||||
GT::Template template parsing and include handling. It supports following
|
||||
inheritance directories and respects "local" template directories.
|
||||
|
||||
|
||||
=head2 Inheritance
|
||||
|
||||
GT::Template inheritance works by looking for a .tplinfo file in the template
|
||||
directory (or local/.tplinfo, if it exists). In order for the template
|
||||
directory to inherit from another template directory, this file must exist and
|
||||
must evaluate to a hash reference containing an C<inheritance> key. The
|
||||
following is a possible .tplinfo file contents:
|
||||
|
||||
{
|
||||
inheritance => '../other'
|
||||
}
|
||||
|
||||
The above example would indicate that files in this template set can be
|
||||
inherited from the ../other path, relative to the current template set
|
||||
directory. The inheritance directory may also contain a full path.
|
||||
|
||||
=head2 Inheriting from multiple locations
|
||||
|
||||
You may also inherit from multiple locations by using an array reference for
|
||||
the inheritance value:
|
||||
|
||||
{
|
||||
inheritance => ['../other', '/full/path/to/a/third']
|
||||
}
|
||||
|
||||
With the above .tplinfo file, files would be checked for in the current path,
|
||||
then C<../other>, then any of C<../other>'s inherited directories, then in
|
||||
C<third>, then in any of C<third>'s inherited directories.
|
||||
|
||||
Also keep in mind that "local" directories, if they exist, will be checked for
|
||||
the file before each of their respective directories.
|
||||
|
||||
Assuming that the initial template path was C</full/path/one>, and assuming
|
||||
that C<../other> inherited from C<../other2>, the directories checked would be
|
||||
as follows:
|
||||
|
||||
/full/path/one/local
|
||||
/full/path/one
|
||||
/full/path/one/../other/local # i.e. /full/path/other/local
|
||||
/full/path/one/../other # i.e. /full/path/other
|
||||
/full/path/one/../other/../other2/local # i.e. /full/path/other2/local
|
||||
/full/path/one/../other/../other2 # i.e. /full/path/other2
|
||||
/full/path/to/a/third/local
|
||||
/full/path/to/a/third
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
All methods in GT::Template::Inheritance are class methods. Each method takes
|
||||
a hash of options as an argument.
|
||||
|
||||
=head2 get_path
|
||||
|
||||
=head2 get_all_paths
|
||||
|
||||
These methods are used to obtain the location of the file GT::Template will
|
||||
use, taking into account all inherited and "local" template directories. The
|
||||
get_path option will return the path to the file that will be included, while
|
||||
the get_all_paths option returns the path to B<all> copies of the file found in
|
||||
the local/inheritance tree. Both methods take a hash containing the following:
|
||||
|
||||
=over 4
|
||||
|
||||
=item file
|
||||
|
||||
The name of the file desired.
|
||||
|
||||
=item path
|
||||
|
||||
The template directory at which to start looking for the above file. Depending
|
||||
on the existance of "local" directories and template inheritance, more than
|
||||
just this directory will be checked for the file.
|
||||
|
||||
=item local
|
||||
|
||||
Optional. Can be passed with a false value to override the checking of "local"
|
||||
directories for files.
|
||||
|
||||
=item inheritance
|
||||
|
||||
Optional. Can be passed with a false value to override the checking of
|
||||
inheritance directories for files.
|
||||
|
||||
=back
|
||||
|
||||
=head2 tree
|
||||
|
||||
This method returns a list of directories that would be searched for a given
|
||||
file, in the order they would be searched. It takes the C<path>, C<local>, and
|
||||
C<inheritance> options above, but not the C<file> option.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<GT::Template>
|
||||
|
||||
=head1 MAINTAINER
|
||||
|
||||
Jason Rhinelander
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005 Gossamer Threads Inc. All Rights Reserved.
|
||||
http://www.gossamer-threads.com/
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Revision: $Id: Inheritance.pm,v 1.7 2005/02/09 20:51:27 jagerman Exp $
|
||||
|
||||
=cut
|
||||
1044
site/slowtwitch.com/cgi-bin/articles/GT/Template/Parser.pm
Normal file
1044
site/slowtwitch.com/cgi-bin/articles/GT/Template/Parser.pm
Normal file
File diff suppressed because it is too large
Load Diff
1072
site/slowtwitch.com/cgi-bin/articles/GT/Template/Tutorial.pod
Normal file
1072
site/slowtwitch.com/cgi-bin/articles/GT/Template/Tutorial.pod
Normal file
File diff suppressed because it is too large
Load Diff
205
site/slowtwitch.com/cgi-bin/articles/GT/Template/Vars.pm
Normal file
205
site/slowtwitch.com/cgi-bin/articles/GT/Template/Vars.pm
Normal file
@@ -0,0 +1,205 @@
|
||||
# ====================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::Template::Vars
|
||||
# Author: Jason Rhinelander
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: Vars.pm,v 1.8 2006/12/06 23:55:52 brewt Exp $
|
||||
#
|
||||
# Copyright (c) 2005 Gossamer Threads Inc. All Rights Reserved.
|
||||
# ====================================================================
|
||||
#
|
||||
# Description:
|
||||
# GT::Template variable handling tied hash reference.
|
||||
#
|
||||
|
||||
package GT::Template::Vars;
|
||||
use strict;
|
||||
use Carp 'croak';
|
||||
|
||||
sub TIEHASH {
|
||||
my ($class, $tpl) = @_;
|
||||
|
||||
my $self = { t => $tpl, keys => [] };
|
||||
bless $self, ref $class || $class;
|
||||
}
|
||||
|
||||
sub STORE {
|
||||
my ($self, $key, $value) = @_;
|
||||
if ($key =~ /^\w+(?:\.\$?\w+)+$/) {
|
||||
my $cur = \$self->{t}->{VARS};
|
||||
my @set = split /\./, $key;
|
||||
for (my $i = 0; $i < @set; $i++) {
|
||||
if ($set[$i] =~ /^\$/) {
|
||||
my $val = $self->{t}->_get_var(substr($set[$i], 1));
|
||||
$val = '' if not defined $val;
|
||||
my @pieces = split /\./, $val;
|
||||
@pieces = '' if !@pieces;
|
||||
splice @set, $i, 1, @pieces;
|
||||
$i += @pieces - 1 if @pieces > 1;
|
||||
}
|
||||
}
|
||||
while (@set) {
|
||||
my $k = shift @set;
|
||||
if ($k =~ s/^\$//) {
|
||||
$k = '' . ($self->FETCH($k) || '');
|
||||
}
|
||||
if (ref $$cur eq 'ARRAY' and $k =~ /^\d+$/) {
|
||||
$cur = \$$cur->[$k];
|
||||
}
|
||||
elsif (ref $$cur eq 'ARRAY' and $k eq 'push') {
|
||||
$cur = \$$cur->[@$$cur];
|
||||
}
|
||||
elsif (ref $$cur eq 'ARRAY' and $k =~ /^last(\d+)?$/) {
|
||||
$cur = \$$cur->[-($1 || 1)];
|
||||
}
|
||||
elsif (ref $$cur eq 'HASH' or not defined $$cur or UNIVERSAL::isa($$cur, 'GT::Config')) {
|
||||
if (exists $$cur->{$k} and ref $$cur->{$k} eq 'SCALAR') {
|
||||
$set[0] = $k . '.' . $set[0];
|
||||
}
|
||||
else {
|
||||
$cur = \$$cur->{$k};
|
||||
}
|
||||
}
|
||||
elsif (UNIVERSAL::isa($$cur, 'GT::CGI') and !@set) {
|
||||
# You can set a GT::CGI parameter, but only to a scalar value (or reference to a scalar value)
|
||||
return $$cur->param(
|
||||
$k => ((ref $value eq 'SCALAR' or ref $value eq 'LVALUE') and not ref $$value) ? $$value : "$value"
|
||||
);
|
||||
}
|
||||
else {
|
||||
croak 'Not a HASH reference';
|
||||
}
|
||||
}
|
||||
$$cur = $value;
|
||||
}
|
||||
else {
|
||||
$self->{t}->{VARS}->{$key} = $value;
|
||||
}
|
||||
}
|
||||
|
||||
# Fetching returns the template parser's raw value, bypassing the usual
|
||||
# _get_var-based approach which can escape, be strict, and will flatten
|
||||
# references.
|
||||
sub FETCH {
|
||||
my ($self, $key) = @_;
|
||||
my $value = $self->{t}->_raw_value($key);
|
||||
$value = $$value if ref $value eq 'SCALAR' or ref $value eq 'LVALUE';
|
||||
return $value;
|
||||
}
|
||||
|
||||
# Keys/exists are a little strange - if "foo" is set to { a => 1 }, exists
|
||||
# $tags->{"foo.a"} will be true, but only "foo", not "foo.a", will be returned
|
||||
# by keys %$tags.
|
||||
sub FIRSTKEY {
|
||||
my $self = shift;
|
||||
my @keys;
|
||||
for (keys %{$self->{t}->{VARS}}) {
|
||||
push @keys, $_;
|
||||
}
|
||||
for (keys %{$self->{t}->{ALIAS}}) {
|
||||
push @keys, $_ unless exists $self->{t}->{VARS}->{$_};
|
||||
}
|
||||
|
||||
$self->{keys} = \@keys;
|
||||
|
||||
return shift @keys;
|
||||
}
|
||||
|
||||
sub EXISTS {
|
||||
my ($self, $key) = @_;
|
||||
my @val = $self->{t}->_raw_value($key);
|
||||
return !!@val;
|
||||
}
|
||||
|
||||
sub NEXTKEY {
|
||||
my $self = shift;
|
||||
if (!$self->{keys}) {
|
||||
return $self->FIRSTKEY;
|
||||
}
|
||||
elsif (!@{$self->{keys}}) {
|
||||
delete $self->{keys};
|
||||
return;
|
||||
}
|
||||
return shift @{$self->{keys}};
|
||||
}
|
||||
|
||||
sub DELETE {
|
||||
my ($self, $key) = @_;
|
||||
my $value = $self->FETCH($key);
|
||||
delete $self->{t}->{VARS}->{$key};
|
||||
$value;
|
||||
}
|
||||
sub CLEAR { %{$_[0]->{t}->{VARS}} = () }
|
||||
sub SCALAR { scalar %{$_[0]->{t}->{VARS}} }
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GT::Template::Vars - Tied hash for template tags handling
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $vars = GT::Template->vars;
|
||||
print $vars->{foo};
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is designed to provide a simple interface to GT::Template tags from
|
||||
Perl code. Prior to this module, the tags() method of GT::Template returned a
|
||||
hash reference which could contain all sorts of different values - scalar
|
||||
references, LVALUE references, GT::Config objects, etc. This new interface
|
||||
provides a tied hash reference designed to aid in retrieving and setting values
|
||||
in the same way template variables are retrieved and set from templates.
|
||||
|
||||
=head1 INTERFACE
|
||||
|
||||
=head2 Accessing values
|
||||
|
||||
Accessing a value is simple - just access C<$vars-E<gt>{name}>. The regular
|
||||
rules of escaping apply here: if the value would have been HTML-escaped in the
|
||||
template, it will be escaped when you get it.
|
||||
|
||||
=head2 Setting values
|
||||
|
||||
Setting a value is easy - simply do: C<$vars-E<gt>{name} = $value;>. "name"
|
||||
can be anything GT::Template recognises as a variable, so
|
||||
C<$vars-E<gt>{'name.key'}> would set C<-E<gt>{name}-E<gt>{key}> (see
|
||||
L<GT::Template::Tutorial/"Advanced variables using references"> for more
|
||||
information on complex variables).
|
||||
|
||||
The regular rules of escaping apply here: if escaping is turned on, a value you
|
||||
set will be escaped when accessed again via $vars or in a template. If you
|
||||
want to set a tag containing raw HTML, you should set a scalar reference, such
|
||||
as: C<$vars-E<gt>{name} = \$value;>.
|
||||
|
||||
=head2 Keys, Exists
|
||||
|
||||
You can use C<keys %$vars> to get a list of keys of the tag object, but you
|
||||
should note that while C<$vars-E<gt>{"a.b"}> is valid and
|
||||
C<exists $vars-E<gt>{"a.b"}> may return true, it will B<not> be present in the
|
||||
list of keys returned by C<keys %$vars>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<GT::Template>
|
||||
|
||||
L<GT::Template::Tutorial>
|
||||
|
||||
=head1 MAINTAINER
|
||||
|
||||
Jason Rhinelander
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2005 Gossamer Threads Inc. All Rights Reserved.
|
||||
http://www.gossamer-threads.com/
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Revision: $Id: Vars.pm,v 1.8 2006/12/06 23:55:52 brewt Exp $
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user