allow hypens in formlink form name values
[bse.git] / site / cgi-bin / modules / BSE / Formatter.pm
CommitLineData
4772671f
TC
1package BSE::Formatter;
2use strict;
3f9c8a96 3use BSE::Util::HTML;
6a8a205a 4use Carp 'confess';
4772671f 5
794a5517 6our $VERSION = "1.011";
cb7fd78d 7
4772671f
TC
8use base 'DevHelp::Formatter';
9
def1a923
TC
10my $pop_nameid = 'AAAAAA';
11
4772671f 12sub new {
c5286ebe 13 my $class = shift;
4772671f 14
c5286ebe
TC
15 my (%opts) =
16 (
17 images => [],
18 files => [],
19 abs_urls => 0,
20 acts => {},
21 @_
22 );
4772671f 23
c5286ebe 24 my $self = $class->SUPER::new;
4772671f 25
c5286ebe
TC
26 $self->{gen} = $opts{gen};
27 $self->{acts} = $opts{acts};
a85fb6e0 28 $self->{articles} = $opts{articles} || "BSE::TB::Articles";
c5286ebe
TC
29 $self->{abs_urls} = $opts{abs_urls};
30 my $dummy;
31 $self->{auto_images} = $opts{auto_images} || \$dummy;
32 $self->{images} = $opts{images};
33 $self->{files} = $opts{files};
34 $self->{templater} = $opts{templater};
35
a85fb6e0 36 my $cfg = $self->{cfg} = $self->{gen} ? $self->{gen}->{cfg} : BSE::Cfg->single;
62533efa
TC
37 if ($cfg->entry('html', 'mbcs', 0)) {
38 $self->{conservative_escape} = 1;
39 }
f2bf0d11
TC
40 elsif ($cfg->entry('html', 'msentify', 0)) {
41 $self->{msentify} = 1;
42 }
0ef1d253 43 $self->{xhtml} = $cfg->entry('basic', 'xhtml', 1);
62533efa 44
5af99440
TC
45 $self->{redirect_links} = $cfg->entry('html', 'redirect_links', '');
46 $self->{redirect_salt} = $cfg->entry('html', 'redirect_salt', '');
47
4772671f
TC
48 $self;
49}
50
2f0b8669
TC
51sub abs_image_urls {
52 1;
6703152e
TC
53}
54
daee3409 55sub _image {
41f10371 56 my ($self, $im, $align, $url, $style) = @_;
daee3409 57
501bb599 58 my $extras = '';
0ef1d253
TC
59 my @classes;
60 if ($self->{xhtml}) {
a85fb6e0 61 push @classes, $self->{cfg}->entry
81501320 62 ("html", "formatter_image_class", "bse_image_inline");
0ef1d253 63 }
41f10371 64 if ($style) {
015362d9 65 if ($style =~ /^\d/) {
501bb599 66 $extras .= qq! style="padding: $style"!;
41f10371 67 }
05c025ef 68 elsif ($style =~ /^\w[\w-]*$/) {
0ef1d253 69 push @classes, $style;
015362d9 70 }
41f10371 71 else {
501bb599 72 $extras .= qq! style="$style"!;
41f10371
TC
73 }
74 }
0ef1d253 75 if (@classes) {
501bb599 76 $extras .= qq! class="@classes"!;
daee3409
TC
77 }
78
501bb599
TC
79 return $im->formatted
80 (
a85fb6e0 81 cfg => $self->{cfg},
501bb599
TC
82 class => "bse_image_inline",
83 align => $align,
84 extras => $extras,
2f0b8669 85 abs_urls => $self->abs_image_urls,
501bb599
TC
86 $url ? ( url => unescape_html($url) ) : (),
87 );
daee3409
TC
88}
89
90sub gimage {
91 my ($self, $args) = @_;
92
41f10371 93 my ($name, $align, $url, $style) = split /\|/, $args, 4;
daee3409
TC
94 my $im = $self->{gen}->get_gimage($name);
95 if ($im) {
e07460b8 96 $self->_image($im, $align, $url, $style);
daee3409
TC
97 }
98 else {
99 return '';
100 }
101}
102
4772671f
TC
103sub image {
104 my ($self, $args) = @_;
105
106 my $images = $self->{images};
41f10371 107 my ($index, $align, $url, $style) = split /\|/, $args, 4;
4772671f
TC
108 my $text = '';
109 my $im;
110 if ($index =~ /^\d+$/) {
111 if ($index >=1 && $index <= @$images) {
112 $im = $images->[$index-1];
dbe0477f 113 ${$self->{auto_images}} = 0;
4772671f
TC
114 }
115 }
116 elsif ($index =~ /^[a-z]\w*$/i){
117 # scan the names
118 for my $image (@$images) {
119 if ($image->{name} && lc $image->{name} eq lc $index) {
120 $im = $image;
121 last;
122 }
123 }
124 }
125 if ($im) {
41f10371 126 return $self->_image($im, $align, $url, $style);
daee3409
TC
127 }
128 else {
129 return '';
4772671f 130 }
4772671f
TC
131}
132
133sub embed {
134 my ($self, $name, $templateid, $maxdepth) = @_;
135
a85fb6e0
TC
136 $self->{gen} or return "** cannot embed here - missing gen **";
137
138 my $embed;
139 if ($name =~ /^[1-9][0-9]*$/) {
140 $embed = $self->{articles}->getByPkey($name);
141 }
142 elsif ($name =~ /\A[a-zA-Z0-9_]*[a-zA-Z][a-zA-Z0-9_]*\z/) {
143 $embed = $self->{articles}->getBy(linkAlias => $name);
144 }
145
146 $embed or return "** article $name not found **";
147
148 $self->{gen}->_embed_low($embed, $self->{articles}, $templateid, $maxdepth);
4772671f
TC
149}
150
00dd8d82
TC
151sub _get_article {
152 my ($self, $id, $error) = @_;
153
a85fb6e0 154 my $cfg = $self->{cfg}
6a8a205a
TC
155 or confess "cfg not set in acts";
156 my $dispid;
c76e86ea 157 my $art;
6a8a205a
TC
158 if ($id =~ /^\d+$/) {
159 $dispid = $id;
c76e86ea 160 $art = $self->{articles}->getByPkey($id);
6a8a205a 161 }
c76e86ea 162 elsif (my $work = $cfg->entry('articles', $id)) {
6a8a205a 163 # try to find it in the config
6a8a205a
TC
164 $dispid = "$id ($work)";
165 $id = $work;
c76e86ea
TC
166 $art = $self->{articles}->getByPkey($id);
167 }
168 else {
169 ($art) = $self->{articles}->getBy(linkAlias => $id);
170 unless ($art) {
171 $$error = "&#42;&#42; No article name '".escape_html($id)."' found &#42;&#42;";
172 return;
173 }
6a8a205a 174 }
c76e86ea 175
6a8a205a 176 unless ($art) {
00dd8d82
TC
177 $$error = "&#42;&#42; Cannot find article id $dispid &#42;&#42;";
178 return;
6a8a205a
TC
179 }
180
00dd8d82
TC
181 return $art;
182}
183
184sub doclink {
8f84f3f1 185 my ($self, $id, $title, $target, $type) = @_;
00dd8d82
TC
186
187 my $error;
188 my $art = $self->_get_article($id, \$error)
189 or return $error;
190
a85fb6e0 191 my $cfg = $self->{cfg}
00dd8d82
TC
192 or confess "cfg not set in acts";
193
6a8a205a 194 # make the URL absolute if necessary
4d4fdaaa 195 my $admin = $self->{gen}{admin_links};
7c14ac33
TC
196 my $url;
197 if ($admin) {
ec5a2133 198 $url = $art->admin;
7c14ac33
TC
199 if (!$self->{gen}{admin}) {
200 $url .= $url =~ /\?/ ? "&" : "?";
201 $url .= "admin=0&admin_links=1";
202 }
203 }
204 else {
a85fb6e0 205 $url = $art->link($self->{cfg});
7c14ac33 206 }
6a8a205a
TC
207
208 unless ($title) {
209 $title = escape_html($art->{title});
210 }
3fa9f5b4 211
a739c25d
TC
212 if ($url) {
213 if ($self->{abs_urls}) {
214 $url = $cfg->entryErr('site', 'url') . $url
215 unless $url =~ /^\w+:/;
216 }
217 $url = escape_html($url);
218 }
219
220
221 $url
222 or return $title;
223
3fa9f5b4 224 $target = $target ? qq! target="$target"! : '';
63e99d77 225 my $title_attrib = escape_html($art->{title});
8f84f3f1
TC
226 my $class_text = '';
227 if ($type) {
228 my $class = $self->tag_class($type);
229 if ($class) {
230 $class_text = qq/ class="$class"/;
231 }
232 }
6a8a205a 233
8f84f3f1 234 return qq!<a href="$url" title="$title_attrib"$target$class_text>$title</a>!;
6a8a205a
TC
235}
236
def1a923
TC
237sub popimage {
238 my ($self, $args) = @_;
239
8a153d74 240 my ($image_id, $class) = split /\|/, $args;
def1a923 241
8a153d74
TC
242 return $self->{gen}->do_popimage($image_id, $class, $self->{images});
243}
def1a923 244
8a153d74
TC
245sub gpopimage {
246 my ($self, $args) = @_;
def1a923 247
8a153d74 248 my ($image_id, $class) = split /\|/, $args;
def1a923 249
8a153d74 250 return $self->{gen}->do_gpopimage($image_id, $class, $self->{images});
def1a923
TC
251}
252
9366cd70
TC
253sub _file {
254 my ($self, $file, $text, $type) = @_;
c5286ebe 255
589c9475 256 my $title = defined $text ? $text : escape_html($file->{displayName});
c5286ebe
TC
257 if ($file->{forSale}) {
258 return escape_html($title);
259 }
260 else {
59087469
AO
261 my $title_attrib = "Filename: " . escape_html($file->{displayName});
262 my $class_text = '';
263 if ($type) {
264 my $class = $self->tag_class($type);
265 if ($class) {
266 $class_text = qq/ class="$class"/;
267 }
268 }
c5286ebe 269 my $url = "/cgi-bin/user.pl?download_file=1&file=$file->{id}";
59087469 270 return qq!<a href="! . escape_html($url) . qq!" title="$title_attrib"$class_text>! .
589c9475 271 $title . "</a>";
c5286ebe
TC
272 }
273}
274
9366cd70
TC
275sub filelink {
276 my ($self, $fileid, $text, $type) = @_;
277
278 my ($file) = grep $_->{name} eq $fileid, @{$self->{files}}
279 or return "** unknown file $fileid **";
280
281 return $self->_file($file, $text, $type);
282}
283
284sub gfilelink {
285 my ($self, $fileid, $text, $type) = @_;
286
287 unless ($self->{gfiles}) {
e0ed81d7 288 $self->{gfiles} = [ BSE::TB::Articles->global_files ];
9366cd70
TC
289 }
290 my ($file) = grep $_->{name} eq $fileid, @{$self->{gfiles}}
291 or return "** unknown file $fileid **";
292
293 return $self->_file($file, $text, $type);
294}
295
6430ee52
TC
296sub file {
297 my ($self, $fileid, $field, $type) = @_;
298
299 my ($file) = grep $_->{name} eq $fileid, @{$self->{files}}
300 or return "* unknown file $fileid *";
301
302 return $file->inline
303 (
304 field => $field,
305 cfg => $self->{gen}->cfg,
306 );
307}
308
195977cd
TC
309sub thumbimage {
310 my ($self, $geo_id, $image_id) = @_;
311
312 return $self->{gen}->do_thumbimage($geo_id, $image_id, '', $self->{images});
313}
314
315sub gthumbimage {
316 my ($self, $geo_id, $image_id) = @_;
317
318 return $self->{gen}->do_gthumbimage($geo_id, $image_id, '');
319}
320
daee3409
TC
321sub replace {
322 my ($self, $rpart) = @_;
323
195977cd
TC
324 $$rpart =~ s#gthumbimage\[([^\]\[|]+)\|([^\]\[|]+)\]# $self->gthumbimage($1, $2) #ge
325 and return 1;
326 $$rpart =~ s#thumbimage\[([^\]\[|]+)\|([^\]\[|]+)\]# $self->thumbimage($1, $2) #ge
327 and return 1;
daee3409
TC
328 $$rpart =~ s#gimage\[([^\]\[]+)\]# $self->gimage($1) #ige
329 and return 1;
f365ae01
TC
330 $$rpart =~ s#popdoclink\[([\w-]+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]#
331 "\n\n\x02" . $self->doclink($1, $self->_blockify($2), "_blank", 'popdoclink')
332 . "\x03\n\n" #ige
333 and return 1;
82d7cc3e 334 $$rpart =~ s#popdoclink\[([\w-]+)\|([^\]\[]+)\]# $self->doclink($1, $2, "_blank", 'popdoclink') #ige
8f84f3f1 335 and return 1;
82d7cc3e 336 $$rpart =~ s#popdoclink\[([\w-]+)\]# $self->doclink($1, undef, "_blank", 'popdoclink') #ige
8f84f3f1 337 and return 1;
f365ae01
TC
338 $$rpart =~ s#doclink\[([\w-]+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]#
339 "\n\n\x02" . $self->doclink($1, $self->_blockify($2), undef, 'doclink')
340 . "\x03\n\n" #ige
341 and return 1;
82d7cc3e 342 $$rpart =~ s#doclink\[([\w-]+)\|([^\]\[]+)\]# $self->doclink($1, $2, undef, 'doclink') #ige
8f84f3f1 343 and return 1;
82d7cc3e 344 $$rpart =~ s#doclink\[([\w-]+)\]# $self->doclink($1, undef, undef, 'doclink') #ige
8f84f3f1
TC
345 and return 1;
346
794a5517 347 $$rpart =~ s#popformlink\[([\w-]+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]#
f365ae01
TC
348 "\n\n\x02" . $self->formlink($1, 'popformlink', $self->_blockify($2), '_blank') . "\x03\n\n"#ige
349 and return 1;
794a5517 350 $$rpart =~ s#popformlink\[([\w-]+)\|([^\]\[]+)\]#
8f84f3f1 351 $self->formlink($1, 'popformlink', $2, '_blank') #ige
3fa9f5b4 352 and return 1;
794a5517 353 $$rpart =~ s#popformlink\[([\w-]+)\]#
8f84f3f1 354 $self->formlink($1, 'popformlink', undef, '_blank') #ige
3fa9f5b4 355 and return 1;
794a5517 356 $$rpart =~ s#formlink\[([\w-]+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]#
f365ae01
TC
357 "\n\n\x02" . $self->formlink($1, 'formlink', $self->_blockify($2)) . "\x03\n\n" #ige
358 and return 1;
794a5517 359 $$rpart =~ s#formlink\[([\w-]+)\|([^\]\[]+)\]#
8f84f3f1 360 $self->formlink($1, 'formlink', $2) #ige
6a8a205a 361 and return 1;
794a5517 362 $$rpart =~ s#formlink\[([\w-]+)\]# $self->formlink($1, 'formlink', undef) #ige
6a8a205a 363 and return 1;
f1f139e5
AO
364 $$rpart =~ s#gfilelink\[(\w+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]#
365 "\n\n\x02" . $self->gfilelink($1, $self->_blockify($2), undef, 'gfilelink')
366 . "\x03\n\n" #ige
367 and return 1;
9366cd70
TC
368 $$rpart =~ s#gfilelink\[\s*(\w+)\s*\|([^\]\[]+)\]# $self->gfilelink($1, $2, 'gfilelink') #ige
369 and return 1;
370 $$rpart =~ s#gfilelink\[\s*(\w+)\s*\]# $self->gfilelink($1, undef, 'gfilelink') #ige
371 and return 1;
f1f139e5
AO
372 $$rpart =~ s#filelink\[(\w+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]#
373 "\n\n\x02" . $self->filelink($1, $self->_blockify($2), undef, 'filelink')
374 . "\x03\n\n" #ige
375 and return 1;
59087469 376 $$rpart =~ s#filelink\[\s*(\w+)\s*\|([^\]\[]+)\]# $self->filelink($1, $2, 'filelink') #ige
c5286ebe 377 and return 1;
59087469 378 $$rpart =~ s#filelink\[\s*(\w+)\s*\]# $self->filelink($1, undef, 'filelink') #ige
c5286ebe 379 and return 1;
6430ee52
TC
380 $$rpart =~ s#file\[(\w+)(?:\|([\w.]*))?\]# $self->file($1, $2, 'file') #ige
381 and return 1;
8a153d74
TC
382 $$rpart =~ s#gpopimage\[([^\[\]]+)\]# $self->gpopimage($1) #ige
383 and return 1;
def1a923
TC
384 $$rpart =~ s#popimage\[([^\[\]]+)\]# $self->popimage($1) #ige
385 and return 1;
daee3409
TC
386
387 return $self->SUPER::replace($rpart);
388}
389
8f84f3f1
TC
390sub formlink {
391 my ($self, $id, $type, $text, $target) = @_;
392
a85fb6e0 393 my $cfg = $self->{cfg};
6866b8dd
TC
394 my $section = "$id form";
395 my $title = escape_html($cfg->entry($section, 'title', "Send us a comment"));
8f84f3f1 396 $text ||= $title;
6866b8dd
TC
397 my $secure = $cfg->entry($section, 'secure', 0);
398 my $abs_url = $self->{abs_urls} || $secure;
399
400 my $prefix = '';
401 if ($abs_url) {
402 $prefix = $cfg->entryVar('site', $secure ? 'secureurl' : 'url');
403 }
8f84f3f1
TC
404
405 my $extras = '';
406 if ($type) {
407 my $class = $self->tag_class($type);
408 if ($class) {
409 $extras .= qq/ class="$class"/;
410 }
411 }
412 if ($target) {
413 $extras .= qq/ target="$target"/;
414 }
415
6866b8dd 416 return qq!<a href="$prefix/cgi-bin/fmail.pl?form=$id" title="$title"$extras>$text</a>!;
8f84f3f1
TC
417}
418
00dd8d82
TC
419sub remove_doclink {
420 my ($self, $id) = @_;
421
422 my $error;
423 my $art = $self->_get_article ($id, \$error)
424 or return $error;
425
426 return $art->{title};
427}
428
8f84f3f1
TC
429sub remove_formlink {
430 my ($self, $id) = @_;
431
a85fb6e0 432 return $self->{cfg}->entry("$id form", 'title', "Send us a comment");
8f84f3f1
TC
433}
434
def1a923
TC
435sub remove_popimage {
436 my ($self, $args) = @_;
437
8a153d74 438 my ($image1, $class) = split /\|/, $args;
def1a923
TC
439
440 my $images = $self->{images};
441 if ($image1 =~ /^\d+$/) { # image index
442 if ($image1 >= 1 and $image1 <= @$images) {
443 return $images->[$image1-1]{alt};
444 }
445 }
446 elsif ($image1 =~ /^\w+$/) { # image name
447 my ($image) = grep $_->{name} eq $image1, @$images;
448 return $image ? $image->{alt} : '';
449 }
450 else {
451 return $image1;
452 }
453}
454
8a153d74
TC
455sub remove_gpopimage {
456 my ($self, $args) = @_;
457
458 my ($image1, $class) = split /\|/, $args;
459
460 my $im = $self->{gen}->get_gimage($image1);
461 if ($im) {
462 return $im->{alt};
463 }
464 else {
465 return $image1;
466 }
467}
468
c5286ebe
TC
469sub remove_filelink {
470 my ($self, $fileid, $text) = @_;
471
472 my ($file) = grep $_->{name} eq $fileid, @{$self->{files}}
473 or return "** unknown file $fileid **";
474
475 return defined $text ? $text : $file->{displayName};
476}
477
b864cc90
TC
478sub remove_gfilelink {
479 my ($self, $fileid, $text, $type) = @_;
480
481 unless ($self->{gfiles}) {
e0ed81d7 482 $self->{gfiles} = [ BSE::TB::Articles->global_files ];
b864cc90
TC
483 }
484 my ($file) = grep $_->{name} eq $fileid, @{$self->{gfiles}}
485 or return "** unknown file $fileid **";
486
487 return defined $text ? $text : $file->{displayName};
488}
489
00dd8d82
TC
490sub remove {
491 my ($self, $rpart) = @_;
492
b864cc90 493 $$rpart =~ s#g?thumbimage\[([^\]\[|]+)\|([^\]\[|]+)\]##g
195977cd 494 and return 1;
00dd8d82
TC
495 $$rpart =~ s#gimage\[([^\]\[]+)\]##ig
496 and return 1;
829c9ed9 497 $$rpart =~ s#popdoclink\[(\w+)\|([^\]\[]*)\]#$2#ig
3fa9f5b4
TC
498 and return 1;
499 $$rpart =~ s#popdoclink\[(\w+)\]# $self->remove_doclink($1) #ige
500 and return 1;
829c9ed9 501 $$rpart =~ s#doclink\[(\w+)\|([^\]\[]*)\]#$2#ig
00dd8d82
TC
502 and return 1;
503 $$rpart =~ s#doclink\[(\w+)\]# $self->remove_doclink($1) #ige
504 and return 1;
8f84f3f1 505
794a5517 506 $$rpart =~ s#popformlink\[([\w-]+)\|([^\]\[]*)\]#$2#ig
8f84f3f1 507 and return 1;
794a5517 508 $$rpart =~ s#popformlink\[([\w-]+)\]# $self->remove_formlink($1) #ige
8f84f3f1 509 and return 1;
c5286ebe 510
b864cc90
TC
511 $$rpart =~ s#gfilelink\[\s*(\w+)\s*\|([^\]\[]+)\]# $self->remove_gfilelink($1, $2) #ige
512 and return 1;
513 $$rpart =~ s#gfilelink\[\s*(\w+)\s*\]# $self->remove_gfilelink($1) #ige
514 and return 1;
515
c5286ebe
TC
516 $$rpart =~ s#filelink\[\s*(\w+)\s*\|([^\]\[]+)\]# $self->remove_filelink($1, $2) #ige
517 and return 1;
518 $$rpart =~ s#filelink\[\s*(\w+)\s*\]# $self->remove_filelink($1) #ige
519 and return 1;
520
794a5517 521 $$rpart =~ s#formlink\[([\w-]+)\|([^\]\[]*)\]#$2#ig
8f84f3f1 522 and return 1;
794a5517 523 $$rpart =~ s#formlink\[([\w-]+)\]# $self->remove_formlink($1) #ige
def1a923 524 and return 1;
8a153d74
TC
525 $$rpart =~ s#gpopimage\[([^\[\]]+)\]# $self->remove_gpopimage($1) #ige
526 and return 1;
def1a923 527 $$rpart =~ s#popimage\[([^\[\]]+)\]# $self->remove_popimage($1) #ige
8f84f3f1 528 and return 1;
00dd8d82
TC
529
530}
531
8f84f3f1
TC
532sub tag_class {
533 my ($self, $type) = @_;
534
535 my $default = $type eq 'p' ? '' : $type;
536
a85fb6e0 537 return $self->{cfg}->entry('body class', $type, $default);
8f84f3f1
TC
538}
539
4772671f 5401;