seasharp/anvil
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
345d2e33d4
anvil/Anvil/Tools/Template.pm
Digimer 5835e49ef4 * Got the install manifest form step 1 sanity checks done. Got the form for step 2 done. 
* Updated Template->select_form() to add the 'style' paramter (for CSS style options), and added the ability to set the 'options' to the special value 'subnet' that builds an options box showing usable CIDR subnets.

Signed-off-by: Digimer <digimer@alteeve.ca>
2020-05-04 22:56:23 -04:00

621 lines
21 KiB
Perl
Raw Blame History

package Anvil::Tools::Template;
#
# This module contains methods used to handle templates.
#
use strict;
use warnings;
use Data::Dumper;
use Scalar::Util qw(weaken isweak);
our $VERSION = "3.0.0";
my $THIS_FILE = "Template.pm";
### Methods;
# get
# select_form
# skin
=pod
=encoding utf8
=head1 NAME
Anvil::Tools::Template
Provides all methods related to template handling.
=head1 SYNOPSIS
use Anvil::Tools;
# Template a common object handle on all Anvil::Tools modules.
my $anvil = Anvil::Tools->new();
# Access to methods using '$anvil->Template->X'.
#
# Example using '()';
=head1 METHODS
Methods in this module;
=cut
sub new
{
my $class = shift;
my $self = {
SKIN => {
HTML => "",
},
};
bless $self, $class;
return ($self);
}
# Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent.
sub parent
{
my $self = shift;
my $parent = shift;
$self->{HANDLE}{TOOLS} = $parent if $parent;
# Defend against memory leads. See Scalar::Util'.
if (not isweak($self->{HANDLE}{TOOLS}))
{
weaken($self->{HANDLE}{TOOLS});
}
return ($self->{HANDLE}{TOOLS});
}
#############################################################################################################
# Public methods #
#############################################################################################################
=head2 get
This method takes a template file name and a template section name and returns that body template.
my $body = $anvil->Template->get({file => "foo.html", name => "bar"}))
=head2 Parameters;
=head3 file (required)
This is the name of the template file containing the template section you want to read.
=head3 language (optional)
This is the language (iso code) to use when inserting strings into the template. When not specified, 'C<< Words->language >>' is used.
=head3 name (required)
This is the name of the template section, bounded by 'C<< <!-- start foo --> >>' and 'C<< <!-- end food --> >>' to read in from the file.
=head3 show_name (optional)
If set the C<< 1 >>, the HTML will have comments shows which parts came from what file. By default, this is disabled.
=head3 skin (optional)
By default, the active skin is set by 'C<< defaults::template::html >>' ('C<< alteeve >>' by default). This can be checked or set using 'C<< Template->skin >>'.
This parameter allows for an override to use another skin.
=head3 variables (optional)
If there are variables to inject into the template, pass them as a hash referencce using this paramter.
=cut
sub get
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $test = defined $parameter->{test} ? $parameter->{test} : 0;
my $file = defined $parameter->{file} ? $parameter->{file} : "";
my $language = defined $parameter->{language} ? $parameter->{language} : $anvil->Words->language({debug => $debug});
my $name = defined $parameter->{name} ? $parameter->{name} : "";
my $show_name = defined $parameter->{show_name} ? $parameter->{show_name} : 1;
my $skin = defined $parameter->{skin} ? $parameter->{skin} : $anvil->Template->skin({debug => $debug});
my $variables = defined $parameter->{variables} ? $parameter->{variables} : "";
$skin = $anvil->data->{path}{directories}{skins}."/".$skin;
my $template = "";
my $source = "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
file => $file,
language => $language,
name => $name,
skin => $skin,
variables => ref($variables) ? ref($variables) : $variables,
}});
if (($anvil->Log->level >= $debug) && (ref($variables) eq "HASH"))
{
foreach my $key (sort {$a cmp $b} keys %{$variables})
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "variables->{$key}" => $variables->{$key} }});
}
}
# The 'http_headers' template can never show the name
$show_name = 0 if $name eq "http_headers";
my $error = 0;
if (not $file)
{
# No file passed.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0024"});
$error = 1;
}
else
{
# Make sure the file exists.
if ($file =~ /^\//)
{
# Fully defined path, don't alter it.
$source = $file;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }});
}
else
{
# Just a file name, prepend the skin path.
$source = $skin."/".$file;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }});
}
if (not -e $source)
{
# See if it's a special one in the /sbin/ directory.
if ($file !~ /^\//)
{
$source = "/usr/sbin/".$file;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }});
}
# If I still don't have it, we're out.
if (not -e $source)
{
# Source doesn't exist
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0025", variables => { source => $source }});
$error = 1;
}
}
elsif (not -r $source)
{
# Source isn't readable.
my $user_name = getpwuid($<);
$user_name = $< if not $user_name;
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0026", variables => { source => $source, user_name => $user_name }});
$error = 1;
}
}
if (not $name)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0027"});
$error = 1;
}
if (not $error)
{
my $template_found = 0;
my $in_template = 0;
my $template_file = $anvil->Storage->read_file({debug => $debug, file => $source});
foreach my $line (split/\n/, $template_file)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0023", variables => { line => $line }});
if ($line =~ /^<!-- start $name -->/)
{
$in_template = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { in_template => $in_template }});
if ($show_name)
{
$template .= "<!-- start: [$source] -> [$name] -->\n";
}
next;
}
if ($in_template)
{
if ($line =~ /^<!-- end $name -->/)
{
$in_template = 0;
$template_found = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
in_template => $in_template,
template_found => $template_found,
}});
if ($show_name)
{
$template .= "<!-- end: [$source] -> [$name] -->\n";
}
last;
}
else
{
$template .= $line."\n";
}
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { template => $template }});
# Insert variables if I found something.
# Now that I have the skin, inject my variables. We'll use Words->string() to do this for us.
if (($template_found) && ($template))
{
$template = $anvil->Words->string({
string => $template,
variables => $variables,
});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { template => $template }});
}
# If we failed to read the template, then load an error message.
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
template_found => $template_found,
template => $template,
}});
if ((not $template_found) or ($template eq "#!not_found!#"))
{
# Woops!
$template = $anvil->Words->string({key => "error_0029", variables => {
template => $name,
file => $source,
}});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { template => $template }});
}
# If there was a problem processing the template, it will be '#!error!#'.
if ($template eq "#!error!#")
{
$template = $anvil->Words->string({key => "error_0030", variables => {
template => $name,
file => $source,
}});
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { template => $template }});
return($template);
}
=head2 select_form
This builds a <select/> form field for use when building forms in templates.
Parameters;
=head3 blank (optional, default C<< 0 >>)
By default, only the options passed are available in the select menu. If this is set to C<< 1 >>, then a blank entry will be inserted to the top of the select list.
=head3 class (optional)
This allows a custom CSS class to be used.
=head3 id (optional)
This is the ID to set. If this is not passed, the C<< name >> is used for the ID.
=head3 name (required)
This is the name of the select box.
=head3 options (required)
This is an array reference of options to put into the select box.
B<NOTE>: The special value C<< subnet >> is allowed. When C<< options >> is C<< subnet >>, a list of valid subnets with CIDR notaion is returned. The common values C<< 255.255.255.0 >>, C<< 255.255.0.0 >> and C<< 255.0.0.0 >> are the first three options and the rest of the useful values (C<< 128.0.0.0 (/1)>> through to C<< 255.255.255.248 (/29) >>) follow. When used, C<< select >> can be set to the dotted-decimal (ie: C<< 255.255.0.0 >>) to select an entry.
Example;
my $options = ["a", "b", "c"];
If you wanted to have a separate value passed to the form versus what is shown to the user, you can do so by using c<< <value>#!#<string> >>. In the case, C<< <string >> is what the user sees but C<< <value> >> is what is returned if that option is selected.
Example
my $options = ["MiB#!#Mibibyte", "GiB#!#Gibibyte"];
Would create a list where the user can choose between C<< Mibibyte >> or C<< Gibibyte >>, and the form would return C<< MiB >> or C<< GiB >>, respectively.
=head3 say_blank (optional)
If C<< blank >> is set, this can be a string to show in the place of the empty entry. This entry will use the C<< subtle_text >> CSS class and if it is selected, nothing is returned when the form is submitted.
=head3 selected (optional)
If this is set and if it matches one of the C<< options >> array values, then that option will be selected when the form is loaded.
=head3 sort (optional, default C<< 1 >>)
By default, the options array will be sorted alphabetically. If this is set to C<< 0 >>, then the order the options were entered into the array is used.
=head3 style (optional)
If desired, this can be set to assign a CSS style to the selection box.
=cut
sub select_form
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $name = defined $parameter->{name} ? $parameter->{name} : "";
my $blank = defined $parameter->{blank} ? $parameter->{blank} : 0; # Add a blank/null entry?
my $class = defined $parameter->{class} ? $parameter->{class} : "";
my $id = defined $parameter->{id} ? $parameter->{id} : $name;
my $options = defined $parameter->{options} ? $parameter->{options} : "";
my $say_blank = defined $parameter->{say_blank} ? $parameter->{say_blank} : ""; # An optional, grayed-out string in the place of the "blank" option
my $selected = defined $parameter->{selected} ? $parameter->{selected} : ""; # Pre-select an option?
my $sort = defined $parameter->{'sort'} ? $parameter->{'sort'} : 1; # Sort the entries?
my $style = defined $parameter->{style} ? $parameter->{style} : ""; # CSS style attribute
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
blank => $blank,
class => $class,
id => $id,
name => $name,
options => $options,
say_blank => $say_blank,
selected => $selected,
'sort' => $sort,
style => $style,
}});
# Lets start!
my $select = "<select name=\"$name\" id=\"$id\">\n";
if (($class) && ($style))
{
$select = "<select name=\"$name\" id=\"$id\" class=\"$class\" style=\"$style\">\n";
}
elsif ($class)
{
$select = "<select name=\"$name\" id=\"$id\" class=\"$class\">\n";
}
elsif ($style)
{
$select = "<select name=\"$name\" id=\"$id\" style=\"$style\">\n";
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
# Insert a blank line.
if ($blank)
{
# If 'say_blank' is a string key, use it.
my $blank_string = "";
my $blank_class = "";
if ($say_blank)
{
$blank_string = $say_blank;
$blank_class = "class=\"subtle_text\"";
}
if ($selected eq "new")
{
$selected = "";
$select .= "<option value=\"\" $blank_class selected>$blank_string</option>\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
}
else
{
$select .= "<option value=\"\" $blank_class>$blank_string</option>\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
}
}
# If 'options' is 'subnet', set ours;
if ($options eq "subnet")
{
=cut
CIDR Total number Network Description:
Notation: of addresses: Mask:
--------------------------------------------------------------
/0 4,294,967,296 0.0.0.0 Every Address
/1 2,147,483,648 128.0.0.0 128 /8 nets
/2 1,073,741,824 192.0.0.0 64 /8 nets
/3 536,870,912 224.0.0.0 32 /8 nets
/4 268,435,456 240.0.0.0 16 /8 nets
/5 134,217,728 248.0.0.0 8 /8 nets
/6 67,108,864 252.0.0.0 4 /8 nets
/7 33,554,432 254.0.0.0 2 /8 nets
/8 16,777,214 255.0.0.0 1 /8 net
--------------------------------------------------------------
/9 8,388,608 255.128.0.0 128 /16 nets
/10 4,194,304 255.192.0.0 64 /16 nets
/11 2,097,152 255.224.0.0 32 /16 nets
/12 1,048,576 255.240.0.0 16 /16 nets
/13 524,288 255.248.0.0 8 /16 nets
/14 262,144 255.252.0.0 4 /16 nets
/15 131.072 255.254.0.0 2 /16 nets
/16 65,536 255.255.0.0 1 /16
--------------------------------------------------------------
/17 32,768 255.255.128.0 128 /24 nets
/18 16,384 255.255.192.0 64 /24 nets
/19 8,192 255.255.224.0 32 /24 nets
/20 4,096 255.255.240.0 16 /24 nets
/21 2,048 255.255.248.0 8 /24 nets
/22 1,024 255.255.252.0 4 /24 nets
/23 512 255.255.254.0 2 /24 nets
/24 256 255.255.255.0 1 /24
--------------------------------------------------------------
/25 128 255.255.255.128 Half of a /24
/26 64 255.255.255.192 Fourth of a /24
/27 32 255.255.255.224 Eighth of a /24
/28 16 255.255.255.240 1/16th of a /24
/29 8 255.255.255.248 5 Usable addresses
/30 4 255.255.255.252 1 Usable address
/31 2 255.255.255.254 Unusable
/32 1 255.255.255.255 Single host
--------------------------------------------------------------
=cut
$sort = 0;
$options = [
"255.255.255.0#!#255.255.255.0 (/24)",
"255.255.0.0#!#255.255.0.0 (/16)",
"255.0.0.0#!#255.0.0.0 (/8)",
"255.255.255.248#!#255.255.255.248 (/29)",
"255.255.255.240#!#255.255.255.240 (/28)",
"255.255.255.224#!#255.255.255.224 (/27)",
"255.255.255.192#!#255.255.255.192 (/26)",
"255.255.255.128#!#255.255.255.128 (/25)",
"255.255.254.0#!#255.255.254.0 (/23)",
"255.255.252.0#!#255.255.252.0 (/22)",
"255.255.248.0#!#255.255.248.0 (/21)",
"255.255.240.0#!#255.255.240.0 (/20)",
"255.255.224.0#!#255.255.224.0 (/19)",
"255.255.192.0#!#255.255.192.0 (/18)",
"255.255.128.0#!#255.255.128.0 (/17)",
"255.254.0.0#!#255.254.0.0 (/15)",
"255.252.0.0#!#255.252.0.0 (/14)",
"255.248.0.0#!#255.248.0.0 (/13)",
"255.240.0.0#!#255.240.0.0 (/12)",
"255.224.0.0#!#255.224.0.0 (/11)",
"255.192.0.0#!#255.192.0.0 (/10)",
"255.128.0.0#!#255.128.0.0 (/9)",
"254.0.0.0#!#254.0.0.0 (/7)",
"252.0.0.0#!#252.0.0.0 (/6)",
"248.0.0.0#!#248.0.0.0 (/5)",
"240.0.0.0#!#240.0.0.0 (/4)",
"224.0.0.0#!#224.0.0.0 (/3)",
"192.0.0.0#!#192.0.0.0 (/2)",
"128.0.0.0#!#128.0.0.0 (/1)",
];
}
# TODO: This needs to be smarter... I shouldn't need two loops for sorted/not sorted.
if ($sort)
{
foreach my $entry (sort {$a cmp $b} @{$options})
{
next if not $entry;
if ($entry =~ /^(.*?)#!#(.*)$/)
{
my $value = $1;
my $description = $2;
$select .= "<option value=\"$value\">$description</option>\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
}
else
{
$select .= "<option value=\"$entry\">$entry</option>\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
}
}
}
else
{
foreach my $entry (@{$options})
{
next if not $entry;
if ($entry =~ /^(.*?)#!#(.*)$/)
{
my $value = $1;
my $description = $2;
$select .= "<option value=\"$value\">$description</option>\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
}
else
{
$select .= "<option value=\"$entry\">$entry</option>\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
}
}
}
# Was an entry selected?
if ($selected)
{
$select =~ s/value=\"$selected\">/value=\"$selected\" selected>/m;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
}
# Done!
$select .= "</select>\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
return($select);
}
=head2 skin
This sets or returns the active skin used when rendering web output.
The default skin is set via 'C<< defaults::template::html >>' and it must be the same as the directory name under 'C<< /var/www/html/skins/ >>'.
Get the active skin directory;
my $skin = $anvil->Template->skin;
Set the active skin to 'C<< foo >>'. Only pass the skin name, not the full path.
$anvil->Template->skin({set => "foo"});
Parameters;
=head3 fatal (optional)
If passed along with C<< set >>, the skin will be set even if the skin directory does not exit.
=head3 set (optional)
If passed a string, that will become the new active skin. If the skin directory does not exist, however, and C<< fatal >> is not set, the request will be ignored.
=cut
sub skin
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $fatal = defined $parameter->{fatal} ? $parameter->{fatal} : 1;
my $set = defined $parameter->{set} ? $parameter->{set} : "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { fatal => $fatal, set => $set }});
if ($set)
{
my $skin_directory = $anvil->data->{path}{directories}{skins}."/".$set;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { skin_directory => $skin_directory }});
if ((-d $skin_directory) or (not $fatal))
{
$self->{SKIN}{HTML} = $set;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }});
}
else
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0031", variables => { set => $set, skin_directory => $skin_directory }});
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }});
if (not $self->{SKIN}{HTML})
{
$self->{SKIN}{HTML} = $anvil->data->{defaults}{template}{html};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML}, 'defaults::template::html' => $anvil->data->{defaults}{template}{html} }});
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }});
return($self->{SKIN}{HTML});
}
# =head3
#
# Private Functions;
#
# =cut
#############################################################################################################
# Private functions #
#############################################################################################################
1;
Reference in New Issue View Git Blame Copy Permalink