Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: 2259a9579a
Fetching contributors…

Cannot retrieve contributors at this time

118 lines (91 sloc) 2.609 kB
#============================================================= -*-Perl-*-
#
# Template::Map
#
# DESCRIPTION
# This module implements a generic name to template mapping service. It
# replaces part of the functionality of the experimental Template::View
# module.
#
# NOTE
# This is a work-in-progress. It is not part of the standard TT
# distribution and may never be.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 2007 Andy Wardley. All Rights Reserved.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
#============================================================================
package Template::Map;
use strict;
use warnings;
use base 'Template::Base';
our $VERSION = 2.30;
our $DEBUG = 0 unless defined $DEBUG;
our $MAP = {
HASH => 'hash',
ARRAY => 'list',
TEXT => 'text',
default => '',
};
our $METHOD = 'TT_name';
#$DEBUG = 1;
#------------------------------------------------------------------------
# _init(\%config)
#
# Initialisation method called by the Template::Base class new()
# constructor.
#------------------------------------------------------------------------
sub _init {
my ($self, $config) = @_;
foreach my $arg (qw( prefix suffix default )) {
$self->{ $arg } = $config->{ $arg } || '';
}
my $format = $config->{ format } || [ ];
$format = [ $format ] unless ref $format eq 'ARRAY';
$self->{ format } = $format;
my $map = $config->{ map } || { };
$self->{ map } = { %$MAP, %$map };
return $self;
}
sub map {
my ($self, $item) = @_;
return $self->names( $self->name($item) );
}
sub names {
my ($self, $name) = @_;
my (@names);
# apply each format
foreach my $format (@{ $self->{ format } }) {
push(@names, sprintf($format, $name));
}
# also add the name with optional prefix/suffix added
push(@names, "$self->{ prefix }$name$self->{ suffix }")
unless @names;
# finally add any default option
push(@names, $self->{ default }) if $self->{ default };
return \@names;
}
sub name {
my ($self, $item) = @_;
my $map = $self->{ map } || $MAP;
my $type = ref $item || return $map->{ TEXT };
my $method = $METHOD;
my $name;
return $map->{ $type }
if defined $map->{ $type };
if ( UNIVERSAL::can($item, $method) ) {
$self->DEBUG("Calling \$item->$method\n") if $DEBUG;
$name = $item->$method();
}
else {
($name = $type) =~ s/\W+/_/g;
}
return $name;
}
1;
Jump to Line
Something went wrong with that request. Please try again.