line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package HTML::WebMake::SiteMap; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
4
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
7
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
8
|
1
|
|
|
1
|
|
5
|
use HTML::WebMake::Main; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
|
|
1449
|
use vars qw{ |
11
|
|
|
|
|
|
|
@ISA $ROOTNAME |
12
|
1
|
|
|
1
|
|
5
|
}; |
|
1
|
|
|
|
|
1
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
########################################################################### |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$ROOTNAME = "{ROOT}"; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
########################################################################### |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub new { |
24
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
25
|
0
|
|
0
|
|
|
|
$class = ref($class) || $class; |
26
|
0
|
|
|
|
|
|
my ($main) = @_; |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
my $self = { |
29
|
|
|
|
|
|
|
'main' => $main, |
30
|
|
|
|
|
|
|
'default_score' => 50, |
31
|
|
|
|
|
|
|
'root_content' => undef, |
32
|
|
|
|
|
|
|
'set_navlinks' => 0, |
33
|
|
|
|
|
|
|
}; |
34
|
|
|
|
|
|
|
|
35
|
0
|
|
|
|
|
|
bless ($self, $class); |
36
|
0
|
|
|
|
|
|
$self; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
0
|
|
|
0
|
0
|
|
sub dbg { HTML::WebMake::Main::dbg (@_); } |
40
|
0
|
|
|
0
|
0
|
|
sub dbg2 { HTML::WebMake::Main::dbg2 (@_); } |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub set_default_score { |
45
|
0
|
|
|
0
|
0
|
|
my ($self, $score) = @_; |
46
|
0
|
|
|
|
|
|
$self->{default_score} = $score; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub set_root { |
50
|
0
|
|
|
0
|
0
|
|
my ($self, $contobj) = @_; |
51
|
|
|
|
|
|
|
|
52
|
0
|
0
|
0
|
|
|
|
if (defined $self->{root_content} && $self->{root_content} != $contobj) |
53
|
|
|
|
|
|
|
{ |
54
|
0
|
|
|
|
|
|
warn "multiple root items defined: ". |
55
|
|
|
|
|
|
|
$self->{root_content}->as_string()." vs. ". |
56
|
|
|
|
|
|
|
$contobj->as_string()."\n"; |
57
|
0
|
|
|
|
|
|
return; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
dbg ("set root content item: \${".$contobj->{name}."}"); |
61
|
0
|
|
|
|
|
|
$self->{root_content} = $contobj; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub get_root { |
65
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$self->{root_content}; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub create_up_links { |
73
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# only do this once |
76
|
0
|
0
|
|
|
|
|
if ($self->{created_up_links}) { return; } |
|
0
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
$self->{created_up_links} = 1; |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
foreach my $contobj (values %{$self->{main}->{contents}}, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
values %{$self->{main}->{metadatas}}) |
81
|
|
|
|
|
|
|
{ |
82
|
0
|
0
|
|
|
|
|
if (!defined $contobj) { |
83
|
0
|
|
|
|
|
|
warn "map_site: content object not defined\n"; |
84
|
0
|
|
|
|
|
|
next; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
0
|
0
|
|
|
|
|
next if ($contobj->{no_map}); |
88
|
|
|
|
|
|
|
# no magic variables or this.foo metadata please. |
89
|
0
|
0
|
|
|
|
|
next if ($contobj->{name} =~ /^(?:|WebMake|this)\./); |
90
|
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
my $upobj = $contobj->get_up_content(); |
92
|
0
|
0
|
|
|
|
|
if (!defined $upobj) { $upobj = $self->{root_content}; } |
|
0
|
|
|
|
|
|
|
93
|
0
|
0
|
|
|
|
|
if (!defined $upobj) { next; } |
|
0
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
dbg ("mapping site: $contobj->{name}: up=$upobj->{name}"); |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
$upobj->add_kid ($contobj); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub map_site { |
104
|
0
|
|
|
0
|
0
|
|
my ($self, $top, $map_generated_content, $contname) = @_; |
105
|
0
|
|
|
|
|
|
my $output; |
106
|
|
|
|
|
|
|
|
107
|
0
|
0
|
|
|
|
|
return "" if ($self->{mapping_now}); |
108
|
|
|
|
|
|
|
|
109
|
0
|
|
|
|
|
|
my $contobj = $self->{main}->get_content_obj ($contname); |
110
|
0
|
0
|
|
|
|
|
die "map_site: no content object defined for $contname" |
111
|
|
|
|
|
|
|
if (!defined $contobj); |
112
|
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
|
$self->{mapping_now} = 1; # avoid re-entrance |
114
|
|
|
|
|
|
|
{ |
115
|
0
|
|
|
|
|
|
$self->create_up_links(); |
|
0
|
|
|
|
|
|
|
116
|
0
|
0
|
|
|
|
|
if (!defined $top) { |
117
|
0
|
|
|
|
|
|
$top = $self->{root_content}; |
118
|
|
|
|
|
|
|
} else { |
119
|
|
|
|
|
|
|
# from now on, this is the default root for breadcrumbs etc. |
120
|
0
|
|
|
|
|
|
$self->set_root ($top); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# can't make a sitemap from the root if no root content is defined! |
124
|
0
|
0
|
|
|
|
|
if (!defined $top) { |
125
|
0
|
|
|
|
|
|
$self->{main}->fail ("sitemap: no root item was defined!"); |
126
|
0
|
|
|
|
|
|
goto failure; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
my $context = { |
130
|
|
|
|
|
|
|
'top' => $top, |
131
|
|
|
|
|
|
|
'include_generated' => $map_generated_content, |
132
|
|
|
|
|
|
|
'sortby' => $contobj->{sortorder}, |
133
|
|
|
|
|
|
|
'node' => $contobj->{sitemap_node_name}, |
134
|
|
|
|
|
|
|
'leaf' => $contobj->{sitemap_leaf_name}, |
135
|
|
|
|
|
|
|
'dynamic' => $contobj->{sitemap_dynamic_name}, |
136
|
|
|
|
|
|
|
'up' => undef, |
137
|
|
|
|
|
|
|
'prev' => undef, |
138
|
|
|
|
|
|
|
}; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
|
141
|
0
|
0
|
|
|
|
|
if (!defined $context->{node}) { |
142
|
0
|
|
|
|
|
|
$self->{main}->fail |
143
|
|
|
|
|
|
|
("sitemap: node content not found: ".$context->{node}); |
144
|
0
|
|
|
|
|
|
goto failure; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
0
|
0
|
|
|
|
|
if (!defined $context->{leaf}) { |
148
|
0
|
|
|
|
|
|
$self->{main}->fail |
149
|
|
|
|
|
|
|
("sitemap: leaf content not found: ".$context->{leaf}); |
150
|
0
|
|
|
|
|
|
goto failure; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
$output = $self->map_level ($context, $top, 0, undef); |
154
|
0
|
|
|
|
|
|
$self->{main}->del_url ('url'); |
155
|
|
|
|
|
|
|
} |
156
|
0
|
|
|
|
|
|
$self->{mapping_now} = 0; return $output; |
|
0
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
|
failure: |
159
|
0
|
|
|
|
|
|
$self->{mapping_now} = 0; return ""; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub map_level { |
163
|
0
|
|
|
0
|
0
|
|
my ($self, $context, $node, $levnum, $upnode) = @_; |
164
|
0
|
|
|
|
|
|
local ($_); |
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
my $top = $context->{top}; |
167
|
0
|
|
|
|
|
|
my $include_gens = $context->{include_generated}; |
168
|
0
|
|
|
|
|
|
my $grep = $context->{'grep'}; |
169
|
|
|
|
|
|
|
|
170
|
0
|
0
|
0
|
|
|
|
return '' if (!$include_gens && $node->is_generated_content()); |
171
|
0
|
|
|
|
|
|
my $allkids = ''; |
172
|
|
|
|
|
|
|
|
173
|
0
|
0
|
|
|
|
|
if ($levnum++ > 20) { |
174
|
0
|
|
|
|
|
|
warn "sitemap: stopped recursing at $node->{name}\n"; |
175
|
0
|
|
|
|
|
|
return ''; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
0
|
0
|
|
|
|
|
if ($self->{set_navlinks}) { |
179
|
0
|
|
|
|
|
|
my $prev = $context->{prev}; |
180
|
0
|
0
|
|
|
|
|
if (defined $prev) { |
181
|
0
|
|
|
|
|
|
dbg2 ("nav links: prev=$prev->{name} <--> next=$node->{name}"); |
182
|
0
|
|
|
|
|
|
$prev->set_next ($node); |
183
|
0
|
|
|
|
|
|
$node->set_prev ($prev); |
184
|
|
|
|
|
|
|
} |
185
|
0
|
|
|
|
|
|
$context->{prev} = $node; |
186
|
|
|
|
|
|
|
|
187
|
0
|
0
|
|
|
|
|
if (defined $upnode) { |
188
|
0
|
|
|
|
|
|
dbg2 ("nav links: up=$upnode->{name}"); |
189
|
0
|
|
|
|
|
|
$node->set_up ($upnode); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# since we're setting the nav links now, any navigation-related |
193
|
|
|
|
|
|
|
# metadata from previous runs is invalid. |
194
|
0
|
|
|
|
|
|
$node->invalidate_cached_nav_metadata(); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
my $added_kids = 0; |
198
|
0
|
|
|
|
|
|
foreach my $kid ($node->get_sorted_kids($context->{sortby})) { |
199
|
0
|
0
|
|
|
|
|
if (!defined $kid) { |
200
|
0
|
|
|
|
|
|
warn "undef kid under ".$node->{name}; next; |
|
0
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
0
|
0
|
0
|
|
|
|
next if (!$include_gens && $kid->is_generated_content()); |
204
|
0
|
0
|
|
|
|
|
next if ($kid eq $top); |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
$_ = $kid->{name}; |
207
|
0
|
0
|
|
|
|
|
next if (/^this\./); # no this.foo metadata thx |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
my $PRUNE = 0; |
210
|
0
|
0
|
|
|
|
|
if (defined $grep) { |
211
|
0
|
|
|
|
|
|
$_ = $kid->{name}; |
212
|
0
|
|
|
|
|
|
my $ret = (eval $grep); |
213
|
0
|
0
|
|
|
|
|
if (!defined $ret) { |
214
|
0
|
|
|
|
|
|
warn "eval failed: { $grep }\n"; return ''; |
|
0
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
} |
216
|
0
|
0
|
|
|
|
|
next if ($ret == 0); |
217
|
0
|
0
|
|
|
|
|
last if ($PRUNE); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
0
|
|
|
|
|
|
$allkids .= $self->map_level ($context, $kid, $levnum, $node); |
221
|
0
|
|
|
|
|
|
$added_kids = 1; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
0
|
0
|
|
|
|
|
if ($added_kids) { |
|
|
0
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
return $self->output_node ($context, $node, $levnum, $allkids); |
226
|
|
|
|
|
|
|
} elsif ($node->is_generated_content()) { |
227
|
0
|
|
|
|
|
|
return $self->output_dynamic ($context, $node, $levnum); |
228
|
|
|
|
|
|
|
} else { |
229
|
0
|
|
|
|
|
|
return $self->output_leaf ($context, $node, $levnum); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub set_per_node_contents { |
234
|
0
|
|
|
0
|
0
|
|
my ($self, $context, $node, $haskids) = @_; |
235
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
my $title = $node->get_title(); |
237
|
0
|
|
|
|
|
|
my $score = $node->get_score(); |
238
|
0
|
|
0
|
|
|
|
my $url = $node->get_url(); $url ||= ''; |
|
0
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
$self->{main}->set_transient_content ('title', $title); |
241
|
0
|
|
|
|
|
|
$self->{main}->set_transient_content ('score', $score); |
242
|
0
|
|
|
|
|
|
$self->{main}->set_transient_content ('name', $node->{name}); |
243
|
0
|
|
|
|
|
|
$self->{main}->set_transient_content ('is_node', $haskids); |
244
|
0
|
|
|
|
|
|
$self->{main}->add_url ('url', $url); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub output_node { |
248
|
0
|
|
|
0
|
0
|
|
my ($self, $context, $node, $levnum, $leafitems) = @_; |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
$self->set_per_node_contents ($context, $node, 1); |
251
|
0
|
|
|
|
|
|
$self->{main}->set_transient_content ('list', $leafitems); |
252
|
0
|
|
|
|
|
|
return $self->{main}->curly_subst ($HTML::WebMake::Main::SUBST_EVAL, $context->{node}); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub output_leaf { |
256
|
0
|
|
|
0
|
0
|
|
my ($self, $context, $node, $levnum) = @_; |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$self->set_per_node_contents ($context, $node, 0); |
259
|
0
|
|
|
|
|
|
return $self->{main}->curly_subst ($HTML::WebMake::Main::SUBST_EVAL, $context->{leaf}); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub output_dynamic { |
263
|
0
|
|
|
0
|
0
|
|
my ($self, $context, $node, $levnum) = @_; |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
$self->set_per_node_contents ($context, $node, 0); |
266
|
0
|
|
|
|
|
|
return $self->{main}->curly_subst ($HTML::WebMake::Main::SUBST_EVAL, $context->{dynamic}); |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
1; |