Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 118 lines (91 sloc) 2.609 kB
81b3f86 @abw added Map.pm
authored
1 #============================================================= -*-Perl-*-
2 #
3 # Template::Map
4 #
5 # DESCRIPTION
6 # This module implements a generic name to template mapping service. It
7 # replaces part of the functionality of the experimental Template::View
8 # module.
9 #
10 # NOTE
11 # This is a work-in-progress. It is not part of the standard TT
12 # distribution and may never be.
13 #
14 # AUTHOR
a668899 @abw big documentation cleanup - no longer using docsrc
authored
15 # Andy Wardley <abw@wardley.org>
81b3f86 @abw added Map.pm
authored
16 #
17 # COPYRIGHT
a668899 @abw big documentation cleanup - no longer using docsrc
authored
18 # Copyright (C) 2007 Andy Wardley. All Rights Reserved.
81b3f86 @abw added Map.pm
authored
19 #
20 # This module is free software; you can redistribute it and/or
21 # modify it under the same terms as Perl itself.
22 #
23 #============================================================================
24
25 package Template::Map;
26
27 use strict;
d76e841 @abw * Fixed all the version numbers
authored
28 use warnings;
29 use base 'Template::Base';
81b3f86 @abw added Map.pm
authored
30
d76e841 @abw * Fixed all the version numbers
authored
31 our $VERSION = 2.30;
32 our $DEBUG = 0 unless defined $DEBUG;
33 our $MAP = {
81b3f86 @abw added Map.pm
authored
34 HASH => 'hash',
35 ARRAY => 'list',
36 TEXT => 'text',
37 default => '',
38 };
d76e841 @abw * Fixed all the version numbers
authored
39 our $METHOD = 'TT_name';
81b3f86 @abw added Map.pm
authored
40
41 #$DEBUG = 1;
42
43 #------------------------------------------------------------------------
44 # _init(\%config)
45 #
46 # Initialisation method called by the Template::Base class new()
47 # constructor.
48 #------------------------------------------------------------------------
49
50 sub _init {
51 my ($self, $config) = @_;
52
53 foreach my $arg (qw( prefix suffix default )) {
54 $self->{ $arg } = $config->{ $arg } || '';
55 }
56
57 my $format = $config->{ format } || [ ];
58 $format = [ $format ] unless ref $format eq 'ARRAY';
59 $self->{ format } = $format;
60
d914545 @abw version 2.09
authored
61 my $map = $config->{ map } || { };
62 $self->{ map } = { %$MAP, %$map };
81b3f86 @abw added Map.pm
authored
63
64 return $self;
65 }
66
67
68 sub map {
d914545 @abw version 2.09
authored
69 my ($self, $item) = @_;
70 return $self->names( $self->name($item) );
71 }
72
81b3f86 @abw added Map.pm
authored
73
d914545 @abw version 2.09
authored
74 sub names {
75 my ($self, $name) = @_;
76 my (@names);
81b3f86 @abw added Map.pm
authored
77
78 # apply each format
79 foreach my $format (@{ $self->{ format } }) {
d914545 @abw version 2.09
authored
80 push(@names, sprintf($format, $name));
81b3f86 @abw added Map.pm
authored
81 }
82
83 # also add the name with optional prefix/suffix added
d914545 @abw version 2.09
authored
84 push(@names, "$self->{ prefix }$name$self->{ suffix }")
85 unless @names;
81b3f86 @abw added Map.pm
authored
86
87 # finally add any default option
d914545 @abw version 2.09
authored
88 push(@names, $self->{ default }) if $self->{ default };
81b3f86 @abw added Map.pm
authored
89
d914545 @abw version 2.09
authored
90 return \@names;
81b3f86 @abw added Map.pm
authored
91 }
92
93
94 sub name {
95 my ($self, $item) = @_;
d914545 @abw version 2.09
authored
96 my $map = $self->{ map } || $MAP;
97 my $type = ref $item || return $map->{ TEXT };
81b3f86 @abw added Map.pm
authored
98 my $method = $METHOD;
99 my $name;
100
101 return $map->{ $type }
102 if defined $map->{ $type };
103
104 if ( UNIVERSAL::can($item, $method) ) {
105 $self->DEBUG("Calling \$item->$method\n") if $DEBUG;
106 $name = $item->$method();
107 }
108 else {
109 ($name = $type) =~ s/\W+/_/g;
110 }
111
112 return $name;
113 }
114
115
116 1;
117
Something went wrong with that request. Please try again.