line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Maypole::View::Base; |
2
|
1
|
|
|
1
|
|
5305
|
use File::Spec; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
3
|
1
|
|
|
1
|
|
1073
|
use UNIVERSAL::moniker; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
use strict; |
5
|
|
|
|
|
|
|
use Maypole::Constants; |
6
|
|
|
|
|
|
|
use Carp; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub new { bless {}, shift } # By default, do nothing. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub paths { |
11
|
|
|
|
|
|
|
my ( $self, $r ) = @_; |
12
|
|
|
|
|
|
|
my $root = $r->config->template_root || $r->get_template_root; |
13
|
|
|
|
|
|
|
if(ref($root) ne 'ARRAY') { |
14
|
|
|
|
|
|
|
$root = [ $root ]; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
my @output = (); |
17
|
|
|
|
|
|
|
my $i = 0; |
18
|
|
|
|
|
|
|
foreach my $path (@$root) { |
19
|
|
|
|
|
|
|
push(@output, |
20
|
|
|
|
|
|
|
( |
21
|
|
|
|
|
|
|
$r->model_class |
22
|
|
|
|
|
|
|
&& File::Spec->catdir( $path, $r->model_class->table ) |
23
|
|
|
|
|
|
|
) |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
push(@output, File::Spec->catdir( $path, "custom" )) unless ($i); |
26
|
|
|
|
|
|
|
push(@output, $path); |
27
|
|
|
|
|
|
|
push(@output, File::Spec->catdir( $path, "factory" )) unless ($i); |
28
|
|
|
|
|
|
|
$i = 1; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
return grep( $_, @output); |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub vars { |
35
|
|
|
|
|
|
|
my ( $self, $r ) = @_; |
36
|
|
|
|
|
|
|
my $class = $r->model_class; |
37
|
|
|
|
|
|
|
my $base = $r->config->uri_base; |
38
|
|
|
|
|
|
|
$base =~ s/\/+$//; |
39
|
|
|
|
|
|
|
my %args = ( |
40
|
|
|
|
|
|
|
request => $r, |
41
|
|
|
|
|
|
|
objects => $r->objects, |
42
|
|
|
|
|
|
|
base => $base, |
43
|
|
|
|
|
|
|
config => $r->config, |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$args{object} = $r->object if ($r->can('object')); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
if ($class) { |
49
|
|
|
|
|
|
|
my $classmeta = $r->template_args->{classmetadata} ||= {}; |
50
|
|
|
|
|
|
|
$classmeta->{name} ||= $class; |
51
|
|
|
|
|
|
|
$classmeta->{table} ||= $class->table; |
52
|
|
|
|
|
|
|
$classmeta->{columns} ||= [ $class->display_columns ] if ($class->can('display_columns')); |
53
|
|
|
|
|
|
|
$classmeta->{list_columns} ||= [ $class->list_columns ] if ($class->can('list_columns')); |
54
|
|
|
|
|
|
|
$classmeta->{colnames} ||= { $class->column_names } if ($class->can('column_names')); |
55
|
|
|
|
|
|
|
$classmeta->{related_accessors} ||= [ $class->related($r) ]; |
56
|
|
|
|
|
|
|
$classmeta->{moniker} ||= $class->moniker; |
57
|
|
|
|
|
|
|
$classmeta->{plural} ||= $class->plural_moniker; |
58
|
|
|
|
|
|
|
$classmeta->{cgi} ||= { $class->to_cgi } if ($r->build_form_elements && $class->can('to_cgi')); |
59
|
|
|
|
|
|
|
$classmeta->{stringify_column} ||= $class->stringify_column if ($class->can('stringify_column')); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# User-friendliness facility for custom template writers. |
62
|
|
|
|
|
|
|
if ( @{ $r->objects || [] } > 1 ) { |
63
|
|
|
|
|
|
|
$args{ $r->model_class->plural_moniker } = $r->objects; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
else { |
66
|
|
|
|
|
|
|
( $args{ $r->model_class->moniker } ) = @{ $r->objects || [] }; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# Overrides |
71
|
|
|
|
|
|
|
%args = ( %args, %{ $r->template_args || {} } ); |
72
|
|
|
|
|
|
|
%args; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub process { |
76
|
|
|
|
|
|
|
my ( $self, $r ) = @_; |
77
|
|
|
|
|
|
|
my $status = $self->template($r); |
78
|
|
|
|
|
|
|
return $self->error($r) if $status != OK; |
79
|
|
|
|
|
|
|
return OK; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub error { |
83
|
|
|
|
|
|
|
my ( $self, $r, $desc ) = @_; |
84
|
|
|
|
|
|
|
$desc = $desc ? "$desc: " : ""; |
85
|
|
|
|
|
|
|
if ( $r->{error} =~ /not found$/ ) { |
86
|
|
|
|
|
|
|
warn "template not found error : ", $r->{error}; |
87
|
|
|
|
|
|
|
# This is a rough test to see whether or not we're a template or |
88
|
|
|
|
|
|
|
# a static page |
89
|
|
|
|
|
|
|
return -1 unless @{ $r->{objects} || [] }; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my $template_error = $r->{error}; |
92
|
|
|
|
|
|
|
$r->{error} = <
|
93
|
|
|
|
|
|
|
Template not found |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
A template was not found while processing the following request: |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
@{[$r->{action}]} on table |
98
|
|
|
|
|
|
|
@{[ $r->{table} ]} with objects: |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
@{[join "\n", @{$r->{objects}}]} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
The main template is @{[$r->{template}]}. |
106
|
|
|
|
|
|
|
The template subsystem's error message was |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
$template_error |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
We looked in paths: |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
@{[ join "\n", $self->paths($r) ]} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
EOF |
116
|
|
|
|
|
|
|
$r->{content_type} = "text/html"; |
117
|
|
|
|
|
|
|
$r->{output} = $r->{error}; |
118
|
|
|
|
|
|
|
return OK; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
return ERROR; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub template { die shift() . " didn't define a decent template method!" } |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
1; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 NAME |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Maypole::View::Base - Base class for view classes |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 DESCRIPTION |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
This is the base class for Maypole view classes. This is an abstract class |
135
|
|
|
|
|
|
|
that defines the interface, and can't be used directly. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 process |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
This is the entry point for the view. It templates the request and returns a |
140
|
|
|
|
|
|
|
C indicate success or failure for the view phase. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Anyone subclassing this for a different rendering mechanism needs to provide |
143
|
|
|
|
|
|
|
the following methods: |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head2 template |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
In this method you do the actual processing of your template. it should use |
148
|
|
|
|
|
|
|
L to search for components, and provide the templates with easy access |
149
|
|
|
|
|
|
|
to the contents of L. It should put the result in C<$r-Eoutput> and |
150
|
|
|
|
|
|
|
return C if processing was sucessfull, or populate C<$r-Eerror> and |
151
|
|
|
|
|
|
|
return C if it fails. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 Other overrides |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Additionally, individual derived model classes may want to override the |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 new |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
The default constructor does nothing. You can override this to perform actions |
160
|
|
|
|
|
|
|
during view initialization. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head2 paths |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Returns search paths for templates. the default method returns folders for the |
165
|
|
|
|
|
|
|
model class's C, factory, custom under the configured template root. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head2 vars |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
returns a hash of data the template should have access to. The default one |
170
|
|
|
|
|
|
|
populates classmetadata if there is a table class, as well as setting the data |
171
|
|
|
|
|
|
|
objects by name if there is one or more objects available. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head2 error |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=cut |