source: trunk/core/lib/Foswiki/Render.pm @ 14620

Revision 14620, 74.5 KB checked in by GeorgeClark, 4 weeks ago (diff)

Item11480: Protect input fields from rendering
  • Property svn:keywords set to Revision Date
Line 
1# See bottom of file for license and copyright information
2package Foswiki::Render;
3
4=begin TML
5
6---+ package Foswiki::Render
7
8This module provides most of the actual HTML rendering code in Foswiki.
9
10=cut
11
12use strict;
13use warnings;
14use Assert;
15use Error qw(:try);
16
17use Foswiki::Time            ();
18use Foswiki::Sandbox         ();
19use Foswiki::Render::Anchors ();
20
21# Counter used to generate unique placeholders for when we lift blocks
22# (such as <verbatim> out of the text during rendering.
23our $placeholderMarker = 0;
24
25# Limiting lookbehind and lookahead for wikiwords and emphasis.
26# use like \b
27our $STARTWW = qr/^|(?<=[\s\(])/m;
28our $ENDWW   = qr/$|(?=[\s,.;:!?)])/m;
29
30# Note: the following marker sequences are used in text to mark things that
31# have been hoisted or need to be marked for further processing. The strings
32# are carefully chosen so that they (1) are not normally present in written
33# text and (2) they do not combine with other characters to form valid
34# wide-byte characters. A subset of the 7-bit control characters is used
35# (codepoint < 0x07). Warning: the RENDERZONE_MARKER in Foswiki.pm uses \3
36
37# Marker used to indicate the start of a table
38our $TABLEMARKER = "\0\1\2TABLE\2\1\0";
39
40# Marker used to indicate table rows that are valid header/footer rows
41our $TRMARK = "is\1all\1th";
42
43# General purpose marker used to mark escapes inthe text; for example, we
44# use it to mark hoisted blocks, such as verbatim blocks.
45our $REMARKER = "\0";
46
47# Optional End marker for escapes where the default end character ; also
48# must be removed.  Used for email anti-spam encoding.
49our $REEND = "\1";
50
51# Characters that need to be %XX escaped in mailto URIs.
52our %ESCAPED = (
53    '<'  => '%3C',
54    '>'  => '%3E',
55    '#'  => '%23',
56    '"'  => '%22',
57    '%'  => '%25',
58    "'"  => '%27',
59    '{'  => '%7B',
60    '}'  => '%7D',
61    '|'  => '%7C',
62    '\\' => '%5C',
63    '^'  => '%5E',
64    '~'  => '%7E',
65    '`'  => '%60',
66    '?'  => '%3F',
67    '&'  => '%26',
68    '='  => '%3D',
69);
70
71# Default format for a link to a non-existant topic
72use constant DEFAULT_NEWLINKFORMAT => <<'NLF';
73<span class="foswikiNewLink">$text<a href="%SCRIPTURLPATH{"edit"}%/$web/$topic?topicparent=%WEB%.%TOPIC%" rel="nofollow" title="%MAKETEXT{"Create this topic"}%">?</a></span>
74NLF
75
76BEGIN {
77
78    # Do a dynamic 'use locale' for this module
79    if ( $Foswiki::cfg{UseLocale} ) {
80        require locale;
81        import locale();
82    }
83}
84
85=begin TML
86
87---++ ClassMethod new ($session)
88
89Creates a new renderer
90
91=cut
92
93sub new {
94    my ( $class, $session ) = @_;
95    my $this = bless( { session => $session }, $class );
96
97    return $this;
98}
99
100=begin TML
101
102---++ ObjectMethod finish()
103Break circular references.
104
105=cut
106
107# Note to developers; please undef *all* fields in the object explicitly,
108# whether they are references or not. That way this method is "golden
109# documentation" of the live fields in the object.
110sub finish {
111    my $this = shift;
112    undef $this->{NEWLINKFORMAT};
113    undef $this->{LINKTOOLTIPINFO};
114    undef $this->{LIST};
115    undef $this->{ffCache};
116    undef $this->{session};
117}
118
119sub _newLinkFormat {
120    my $this = shift;
121    unless ( $this->{NEWLINKFORMAT} ) {
122        $this->{NEWLINKFORMAT} =
123          $this->{session}->{prefs}->getPreference('NEWLINKFORMAT')
124          || DEFAULT_NEWLINKFORMAT;
125    }
126    return $this->{NEWLINKFORMAT};
127}
128
129=begin TML
130
131---++ ObjectMethod renderParent($topicObject, $params) -> $text
132
133Render parent meta-data
134
135=cut
136
137sub renderParent {
138    my ( $this, $topicObject, $ah ) = @_;
139    my $dontRecurse = $ah->{dontrecurse} || 0;
140    my $depth       = $ah->{depth}       || 0;
141    my $noWebHome   = $ah->{nowebhome}   || 0;
142    my $prefix      = $ah->{prefix}      || '';
143    my $suffix      = $ah->{suffix}      || '';
144    my $usesep      = $ah->{separator}   || ' &gt; ';
145    my $format      = $ah->{format}      || '[[$web.$topic][$topic]]';
146
147    my ( $web, $topic ) = ( $topicObject->web, $topicObject->topic );
148    return '' unless $web && $topic;
149
150    my %visited;
151    $visited{ $web . '.' . $topic } = 1;
152
153    my $pWeb = $web;
154    my $pTopic;
155    my $text       = '';
156    my $parentMeta = $topicObject->get('TOPICPARENT');
157    my $parent;
158
159    $parent = $parentMeta->{name} if $parentMeta;
160
161    my @stack;
162    my $currentDepth = 0;
163    $depth = 1 if $dontRecurse;
164
165    while ($parent) {
166        $currentDepth++;
167        ( $pWeb, $pTopic ) =
168          $this->{session}->normalizeWebTopicName( $pWeb, $parent );
169        $parent = $pWeb . '.' . $pTopic;
170        last
171          if ( $noWebHome && ( $pTopic eq $Foswiki::cfg{HomeTopicName} )
172            || $visited{$parent} );
173        $visited{$parent} = 1;
174        $text = $format;
175        $text =~ s/\$web/$pWeb/g;
176        $text =~ s/\$topic/$pTopic/g;
177
178        if ( !$depth or $currentDepth == $depth ) {
179            unshift( @stack, $text );
180        }
181        last if $currentDepth == $depth;
182
183        # Compromise; rather than supporting a hack in the store to support
184        # rapid access to parent meta (as in TWiki) accept the hit
185        # of reading the whole topic.
186        my $topicObject =
187          Foswiki::Meta->load( $this->{session}, $pWeb, $pTopic );
188        my $parentMeta = $topicObject->get('TOPICPARENT');
189        $parent = $parentMeta->{name} if $parentMeta;
190    }
191    $text = join( $usesep, @stack );
192
193    if ($text) {
194        $text = $prefix . $text if ($prefix);
195        $text .= $suffix if ($suffix);
196    }
197
198    return $text;
199}
200
201=begin TML
202
203---++ ObjectMethod renderMoved($topicObject, $params) -> $text
204
205Render moved meta-data
206
207=cut
208
209sub renderMoved {
210    my ( $this, $topicObject, $params ) = @_;
211    my $text   = '';
212    my $moved  = $topicObject->get('TOPICMOVED');
213    my $prefix = $params->{prefix} || '';
214    my $suffix = $params->{suffix} || '';
215
216    if ($moved) {
217        my ( $fromWeb, $fromTopic ) =
218          $this->{session}
219          ->normalizeWebTopicName( $topicObject->web, $moved->{from} );
220        my ( $toWeb, $toTopic ) =
221          $this->{session}
222          ->normalizeWebTopicName( $topicObject->web, $moved->{to} );
223        my $by    = $moved->{by};
224        my $u     = $by;
225        my $users = $this->{session}->{users};
226        $by = $users->webDotWikiName($u) if $u;
227        my $date = Foswiki::Time::formatTime( $moved->{date}, '', 'gmtime' );
228
229        # Only allow put back if current web and topic match
230        # stored information
231        my $putBack = '';
232        if ( $topicObject->web eq $toWeb && $topicObject->topic eq $toTopic ) {
233            $putBack = ' - '
234              . CGI::a(
235                {
236                    title => (
237                        $this->{session}->i18n->maketext(
238'Click to move topic back to previous location, with option to change references.'
239                        )
240                    ),
241                    href => $this->{session}->getScriptUrl(
242                        0, 'rename', $topicObject->web, $topicObject->topic
243                    ),
244                    rel => 'nofollow'
245                },
246                $this->{session}->i18n->maketext('Put it back...')
247              );
248        }
249        $text = $this->{session}->i18n->maketext(
250            "[_1] was renamed or moved from [_2] on [_3] by [_4]",
251            "<nop>$toWeb.<nop>$toTopic", "<nop>$fromWeb.<nop>$fromTopic",
252            $date, $by
253        ) . $putBack;
254    }
255    $text = "$prefix$text$suffix" if $text;
256    return $text;
257}
258
259# Add a list item, of the given type and indent depth. The list item may
260# cause the opening or closing of lists currently being handled.
261sub _addListItem {
262    my ( $this, $result, $type, $element, $css, $indent ) = @_;
263
264    $indent =~ s/   /\t/g;
265    my $depth = length($indent);
266
267    my $size = scalar( @{ $this->{LIST} } );
268
269    # The whitespaces either side of the tags are required for the
270    # emphasis REs to work.
271    if ( $size < $depth ) {
272        my $firstTime = 1;
273        while ( $size < $depth ) {
274            push( @{ $this->{LIST} }, { type => $type, element => $element } );
275            push( @$result,
276                " <$element" . ( $css ? " class='$css'" : "" ) . ">\n" )
277              unless ($firstTime);
278            push( @$result, ' <' . $type . ">\n" ) if $type;
279            $firstTime = 0;
280            $size++;
281        }
282    }
283    else {
284        while ( $size > $depth ) {
285            my $tags = pop( @{ $this->{LIST} } );
286            my $r    = "\n</" . $tags->{element} . '>';
287            $r .= '</' . $tags->{type} . '> ' if $tags->{type};
288            push( @$result, $r );
289            $size--;
290        }
291        if ($size) {
292            push( @$result,
293                "\n</" . $this->{LIST}->[ $size - 1 ]->{element} . '> ' );
294        }
295        else {
296            push( @$result, "\n" );
297        }
298    }
299
300    if ($size) {
301        my $oldt = $this->{LIST}->[ $size - 1 ];
302        if ( $oldt->{type} ne $type ) {
303            my $r = '';
304            $r .= ' </' . $oldt->{type} . '>' if $oldt->{type};
305            $r .= '<' . $type . ">\n" if $type;
306            push( @$result, $r ) if $r;
307            pop( @{ $this->{LIST} } );
308            push( @{ $this->{LIST} }, { type => $type, element => $element } );
309        }
310    }
311}
312
313# Given that we have just seen the end of a table, work out the thead,
314# tbody and tfoot sections
315sub _addTHEADandTFOOT {
316    my ($lines) = @_;
317
318    # scan back to the head of the table
319    my $i = scalar(@$lines) - 1;
320    my @thRows;
321    my $inFoot    = 1;
322    my $footLines = 0;
323    my $headLines = 0;
324
325    while ( $i >= 0 && $lines->[$i] ne $TABLEMARKER ) {
326        if ( $lines->[$i] =~ /^\s*$/ ) {
327
328            # Remove blank lines in tables; they generate spurious <p>'s
329            splice( @$lines, $i, 1 );
330        }
331        elsif ( $lines->[$i] =~ s/$TRMARK=(["'])(.*?)\1//i ) {
332            if ($2) {
333
334                # In head or foot
335                if ($inFoot) {
336
337                    #print STDERR "FOOT: $lines->[$i]\n";
338                    $footLines++;
339                }
340                else {
341
342                    #print STDERR "HEAD: $lines->[$i]\n";
343                    $headLines++;
344                }
345            }
346            else {
347
348                # In body
349                #print STDERR "BODY: $lines->[$i]\n";
350                $inFoot    = 0;
351                $headLines = 0;
352            }
353        }
354        $i--;
355    }
356    $lines->[ $i++ ] = CGI::start_table(
357        {
358            class       => 'foswikiTable',
359            border      => 1,
360            cellspacing => 0,
361            cellpadding => 0
362        }
363    );
364
365    if ($headLines) {
366        splice( @$lines, $i++,            0, '<thead>' );
367        splice( @$lines, $i + $headLines, 0, '</thead>' );
368        $i += $headLines + 1;
369    }
370
371    if ($footLines) {
372
373        # Extract the foot and stick it in the table after the head (if any)
374        # WRC says browsers prefer this
375        my $firstFoot = scalar(@$lines) - $footLines;
376        my @foot = splice( @$lines, $firstFoot, $footLines );
377        unshift( @foot, '<tfoot>' );
378        push( @foot, '</tfoot>' );
379        splice( @$lines, $i, 0, @foot );
380        $i += scalar(@foot);
381    }
382    splice( @$lines, $i, 0, '<tbody>' );
383    push( @$lines, '</tbody>' );
384}
385
386sub _emitTR {
387    my ( $this, $row ) = @_;
388
389    $row =~ s/\t/   /g;    # change tabs to space
390    $row =~ s/\s*$//;      # remove trailing spaces
391                           # calc COLSPAN
392    $row =~ s/(\|\|+)/
393      'colspan'.$REMARKER.length($1).'|'/ge;
394    my $cells = '';
395    my $containsTableHeader;
396    my $isAllTH = 1;
397    foreach ( split( /\|/, $row ) ) {
398        my %attr;
399
400        # Avoid matching single columns
401        if (s/colspan$REMARKER([0-9]+)//o) {
402            $attr{colspan} = $1;
403        }
404        s/^\s+$/ &nbsp; /;
405        my ( $l1, $l2 ) = ( 0, 0 );
406        if (/^(\s*).*?(\s*)$/) {
407            $l1 = length($1);
408            $l2 = length($2);
409        }
410        if ( $l1 >= 2 ) {
411            if ( $l2 <= 1 ) {
412                $attr{align} = 'right';
413            }
414            else {
415                $attr{align} = 'center';
416            }
417        }
418
419        # implicit untaint is OK, because we are just taking topic data
420        # and rendering it; no security step is bypassed.
421        if (/^\s*\*(.*)\*\s*$/) {
422            $cells .= CGI::th( \%attr, CGI::strong( {}, " $1 " ) ) . "\n";
423        }
424        else {
425            $cells .= CGI::td( \%attr, " $_ " ) . "\n";
426            $isAllTH = 0;
427        }
428    }
429    return CGI::Tr( { $TRMARK => $isAllTH }, $cells );
430}
431
432sub _fixedFontText {
433    my ( $text, $embolden ) = @_;
434
435    # preserve white space, so replace it by '&nbsp; ' patterns
436    $text =~ s/\t/   /g;
437    $text =~ s|((?:[\s]{2})+)([^\s])|'&nbsp; ' x (length($1) / 2) . $2|eg;
438    $text = CGI->b($text) if $embolden;
439    return CGI->code($text);
440}
441
442# Build an HTML &lt;Hn> element with suitable anchor for linking
443# from %<nop>TOC%
444sub _makeAnchorHeading {
445    my ( $this, $text, $level, $anchors ) = @_;
446
447    # - Build '<nop><h1><a name='atext'></a> heading </h1>' markup
448    # - Initial '<nop>' is needed to prevent subsequent matches.
449    # filter '!!', '%NOTOC%'
450    $text =~ s/$Foswiki::regex{headerPatternNoTOC}//o;
451
452    my $html =
453        '<nop><h' 
454      . $level . ' ' . 'id="'
455      . $anchors->makeHTMLTarget($text) . '"> '
456      . $text . ' </h'
457      . $level . '>';
458
459    return $html;
460}
461
462# Returns =title='...'= tooltip info if the LINKTOOLTIPINFO preference
463# is set. Warning: Slower performance if enabled.
464sub _linkToolTipInfo {
465    my ( $this, $web, $topic ) = @_;
466    unless ( defined( $this->{LINKTOOLTIPINFO} ) ) {
467        $this->{LINKTOOLTIPINFO} =
468          $this->{session}->{prefs}->getPreference('LINKTOOLTIPINFO')
469          || '';
470        $this->{LINKTOOLTIPINFO} = '$username - $date - r$rev: $summary'
471          if ( 'on' eq lc( $this->{LINKTOOLTIPINFO} ) );
472    }
473    return '' unless ( $this->{LINKTOOLTIPINFO} );
474    return '' if ( $this->{LINKTOOLTIPINFO} =~ /^off$/i );
475    return '' unless ( $this->{session}->inContext('view') );
476
477    # These are safe to untaint blindly because this method is only
478    # called when a regex matches a valid wikiword
479    $web   = Foswiki::Sandbox::untaintUnchecked($web);
480    $topic = Foswiki::Sandbox::untaintUnchecked($topic);
481
482    # FIXME: This is slow, it can be improved by caching topic rev
483    # info and summary
484    my $users = $this->{session}->{users};
485
486    my $topicObject = Foswiki::Meta->new( $this->{session}, $web, $topic );
487    my $info        = $topicObject->getRevisionInfo();
488    my $tooltip     = $this->{LINKTOOLTIPINFO};
489    $tooltip =~ s/\$web/<nop>$web/g;
490    $tooltip =~ s/\$topic/<nop>$topic/g;
491    $tooltip =~ s/\$rev/1.$info->{version}/g;
492    $tooltip =~ s/\$date/Foswiki::Time::formatTime( $info->{date} )/ge;
493    $tooltip =~ s/\$username/
494      $users->getLoginName($info->{author}) || $info->{author}/ge;
495    $tooltip =~ s/\$wikiname/
496      $users->getWikiName($info->{author}) || $info->{author}/ge;
497    $tooltip =~ s/\$wikiusername/
498      $users->webDotWikiName($info->{author}) || $info->{author}/ge;
499
500    if ( $tooltip =~ /\$summary/ ) {
501        my $summary;
502        if ( $topicObject->haveAccess('VIEW') ) {
503            $summary = $topicObject->text || '';
504        }
505        else {
506            $summary =
507              $this->{session}
508              ->inlineAlert( 'alerts', 'access_denied', "$web.$topic" );
509        }
510        $summary = $topicObject->summariseText();
511        $summary =~
512          s/[\"\']/<nop>/g;    # remove quotes (not allowed in title attribute)
513        $tooltip =~ s/\$summary/$summary/g;
514    }
515    return $tooltip;
516}
517
518=begin TML
519
520---++ ObjectMethod internalLink ( $web, $topic, $linkText, $anchor, $linkIfAbsent, $keepWebPrefix, $hasExplicitLinkLabel ) -> $html
521
522Generate a link.
523
524Note: Topic names may be spaced out. Spaced out names are converted
525to <nop>WikWords, for example, "spaced topic name" points to "SpacedTopicName".
526   * =$web= - the web containing the topic
527   * =$topic= - the topic to be link
528   * =$linkText= - text to use for the link
529   * =$anchor= - the link anchor, if any
530   * =$linkIfAbsent= - boolean: false means suppress link for
531     non-existing pages
532   * =$keepWebPrefix= - boolean: true to keep web prefix (for
533     non existing Web.TOPIC)
534   * =$hasExplicitLinkLabel= - boolean: true if
535     [[link][explicit link label]]
536
537Called from outside the package by Func::internalLink
538
539Calls _renderWikiWord, which in turn will use Plurals.pm to match fold
540plurals to equivalency with their singular form
541
542SMELL: why is this available to Func?
543
544=cut
545
546sub internalLink {
547    my ( $this, $web, $topic, $linkText, $anchor, $linkIfAbsent, $keepWebPrefix,
548        $hasExplicitLinkLabel, $params )
549      = @_;
550
551    # SMELL - shouldn't it be callable by Foswiki::Func as well?
552
553    #PN: Webname/Subweb/ -> Webname/Subweb
554    $web =~ s/\/\Z//o;
555
556    if ( $linkText eq $web ) {
557        $linkText =~ s/\//\./go;
558    }
559
560    #WebHome links to tother webs render as the WebName
561    if (   ( $linkText eq $Foswiki::cfg{HomeTopicName} )
562        && ( $web ne $this->{session}->{webName} ) )
563    {
564        $linkText = $web;
565    }
566
567    # Get rid of leading/trailing spaces in topic name
568    $topic =~ s/^\s*//o;
569    $topic =~ s/\s*$//o;
570
571    # Allow spacing out, etc.
572    # Plugin authors use $hasExplicitLinkLabel to determine if the link label
573    # should be rendered differently even if the topic author has used a
574    # specific link label.
575    $linkText =
576      $this->{session}->{plugins}
577      ->dispatch( 'renderWikiWordHandler', $linkText, $hasExplicitLinkLabel,
578        $web, $topic )
579      || $linkText;
580
581    # Turn spaced-out names into WikiWords - upper case first letter of
582    # whole link, and first of each word. TODO: Try to turn this off,
583    # avoiding spaces being stripped elsewhere
584    $topic = ucfirst($topic);
585    $topic =~ s/\s([$Foswiki::regex{mixedAlphaNum}])/\U$1/go;
586
587    # If locales are in effect, the above conversions will taint the topic
588    # name (Foswiki:Tasks:Item2091)
589    $topic = Foswiki::Sandbox::untaintUnchecked($topic);
590
591    # Add <nop> before WikiWord inside link text to prevent double links
592    $linkText =~ s/(?<=[\s\(])([$Foswiki::regex{upperAlpha}])/<nop>$1/go;
593    return _renderWikiWord( $this, $web, $topic, $linkText, $anchor,
594        $linkIfAbsent, $keepWebPrefix, $params );
595}
596
597# TODO: this should be overridable by plugins.
598sub _renderWikiWord {
599    my ( $this, $web, $topic, $linkText, $anchor, $linkIfAbsent, $keepWebPrefix,
600        $params )
601      = @_;
602    my $session = $this->{session};
603    my $topicExists = $session->topicExists( $web, $topic );
604
605    my $singular = '';
606    unless ($topicExists) {
607
608        # topic not found - try to singularise
609        require Foswiki::Plurals;
610        $singular = Foswiki::Plurals::singularForm( $web, $topic );
611        if ($singular) {
612            $topicExists = $session->topicExists( $web, $singular );
613            $topic = $singular if $topicExists;
614        }
615    }
616
617    if ($topicExists) {
618
619        # add a dependency so that the page gets invalidated as soon as the
620        # topic is deleted
621        $this->{session}->{cache}->addDependency( $web, $topic )
622          if $Foswiki::cfg{Cache}{Enabled};
623
624        return _renderExistingWikiWord( $this, $web, $topic, $linkText, $anchor,
625            $params );
626    }
627    if ($linkIfAbsent) {
628
629        # CDot: disabled until SuggestSingularNotPlural is resolved
630        # if ($singular && $singular ne $topic) {
631        #     #unshift( @topics, $singular);
632        # }
633
634        # add a dependency so that the page gets invalidated as soon as the
635        # WikiWord comes into existance
636        # Note we *ignore* the params if the target topic does not exist
637        $this->{session}->{cache}->addDependency( $web, $topic )
638          if $Foswiki::cfg{Cache}{Enabled};
639
640        return _renderNonExistingWikiWord( $this, $web, $topic, $linkText );
641    }
642    if ($keepWebPrefix) {
643        return $web . '.' . $linkText;
644    }
645
646    return $linkText;
647}
648
649sub _renderExistingWikiWord {
650    my ( $this, $web, $topic, $text, $anchor, $params ) = @_;
651
652    my @cssClasses;
653    push( @cssClasses, 'foswikiCurrentWebHomeLink' )
654      if ( ( $web eq $this->{session}->{webName} )
655        && ( $topic eq $Foswiki::cfg{HomeTopicName} ) );
656
657    my $inCurrentTopic = 0;
658
659    if (   ( $web eq $this->{session}->{webName} )
660        && ( $topic eq $this->{session}->{topicName} ) )
661    {
662        push( @cssClasses, 'foswikiCurrentTopicLink' );
663        $inCurrentTopic = 1;
664    }
665
666    my %attrs;
667    my $href = $this->{session}->getScriptUrl( 0, 'view', $web, $topic );
668    if ($params) {
669        $href .= $params;
670    }
671
672    if ($anchor) {
673        $anchor = Foswiki::Render::Anchors::make($anchor);
674        $anchor = Foswiki::urlEncode($anchor);
675
676        # No point in trying to make it unique; just aim at the first
677        # occurrence
678        # Item8556 - drop path if same topic
679        $href = $inCurrentTopic ? "#$anchor" : "$href#$anchor";
680    }
681    $attrs{class} = join( ' ', @cssClasses ) if ( $#cssClasses >= 0 );
682    $attrs{href} = $href;
683    my $tooltip = _linkToolTipInfo( $this, $web, $topic );
684    $attrs{title} = $tooltip if $tooltip;
685
686    my $aFlag = CGI::autoEscape(0);
687    my $link = CGI::a( \%attrs, $text );
688    CGI::autoEscape($aFlag);
689
690    # When we pass the tooltip text to CGI::a it may contain
691    # <nop>s, and CGI::a will convert the < to &lt;. This is a
692    # basic problem with <nop>.
693    #$link =~ s/&lt;nop&gt;/<nop>/g;
694    return $link;
695}
696
697sub _renderNonExistingWikiWord {
698    my ( $this, $web, $topic, $text ) = @_;
699
700    my $ans = $this->_newLinkFormat;
701    $ans =~ s/\$web/$web/g;
702    $ans =~ s/\$topic/$topic/g;
703    $ans =~ s/\$text/$text/g;
704    my $topicObject = Foswiki::Meta->new(
705        $this->{session},
706        $this->{session}->{webName},
707        $this->{session}->{topicName}
708    );
709    return $topicObject->expandMacros($ans);
710}
711
712# _handleWikiWord is called for a wiki word that needs linking.
713# Handle the various link constructions. e.g.:
714# WikiWord
715# Web.WikiWord
716# Web.WikiWord#anchor
717#
718# This routine adds missing parameters before passing off to internallink
719sub _handleWikiWord {
720    my ( $this, $topicObject, $web, $topic, $anchor ) = @_;
721
722    my $linkIfAbsent = 1;
723    my $keepWeb      = 0;
724    my $text;
725
726    # For some strange reason, $web doesn't get untainted by the regex
727    # that invokes this function. We can untaint it safely, because it's
728    # validated by the RE.
729    $web = Foswiki::Sandbox::untaintUnchecked($web);
730
731    $web = $topicObject->web() unless ( defined($web) );
732    if ( defined($anchor) ) {
733        ASSERT( ( $anchor =~ m/\#.*/ ) ) if DEBUG;    # must include a hash.
734    }
735    else {
736        $anchor = '';
737    }
738
739    if ( defined($anchor) ) {
740
741        # 'Web.TopicName#anchor' or 'Web.ABBREV#anchor' link
742        $text = $topic . $anchor;
743    }
744    else {
745        $anchor = '';
746
747        # 'Web.TopicName' or 'Web.ABBREV' link:
748        if (   $topic eq $Foswiki::cfg{HomeTopicName}
749            && $web ne $this->{session}->{webName} )
750        {
751            $text = $web;
752        }
753        else {
754            $text = $topic;
755        }
756    }
757
758    # true to keep web prefix for non-existing Web.TOPIC
759    # Have to leave "web part" of ABR.ABR.ABR intact if topic not found
760    $keepWeb =
761      (      $topic =~ /^$Foswiki::regex{abbrevRegex}$/o
762          && $web ne $this->{session}->{webName} );
763
764    # false means suppress link for non-existing pages
765    $linkIfAbsent = ( $topic !~ /^$Foswiki::regex{abbrevRegex}$/o );
766
767    return $this->internalLink( $web, $topic, $text, $anchor, $linkIfAbsent,
768        $keepWeb, undef );
769}
770
771# Protect WikiWords, TLAs and URLs from further rendering with <nop>
772sub _escapeAutoLinks {
773    my $text = shift;
774
775    if ($text) {
776
777        # WikiWords, TLAs, and email addresses
778        $text =~ s/(?<=[\s\(])
779                   (
780                       (?:
781                           (?:($Foswiki::regex{webNameRegex})\.)?
782                           (?: $Foswiki::regex{wikiWordRegex}
783                           | $Foswiki::regex{abbrevRegex} )
784                       )
785                   | $Foswiki::regex{emailAddrRegex}
786                   )/<nop>$1/gox;
787
788        # Explicit links
789        $text =~ s/($Foswiki::regex{linkProtocolPattern}):(?=\S)/$1<nop>:/go;
790    }
791    return $text;
792}
793
794# Handle SquareBracketed links mentioned on page $web.$topic
795# format: [[$link]]
796# format: [[$link][$text]]
797sub _handleSquareBracketedLink {
798    my ( $this, $topicObject, $link, $text ) = @_;
799
800    # Strip leading/trailing spaces
801    $link =~ s/^\s+//;
802    $link =~ s/\s+$//;
803
804    my $hasExplicitLinkLabel = 0;
805
806    if ( defined($text) ) {
807
808        # [[$link][$text]]
809        $hasExplicitLinkLabel = 1;
810        if ( my $img = $this->_isImageLink($text) ) {
811            $text = $img;
812        }
813        else {
814            $text = _escapeAutoLinks($text);
815        }
816    }
817
818    if ( $link =~ m#^($Foswiki::regex{linkProtocolPattern}:|/)# ) {
819
820        # Explicit external [[http://$link]] or [[http://$link][$text]]
821        # or explicit absolute [[/$link]] or [[/$link][$text]]
822        if ( !defined($text) && $link =~ /^(\S+)\s+(.*)$/ ) {
823
824            my $candidateLink = $1;
825            my $candidateText = $2;
826
827            # If the URL portion contains a ? indicating query parameters then
828            # the spaces are possibly embedded in the query string, so don't
829            # use the legacy format.
830            if ( $candidateLink !~ m/\?/ ) {
831
832                # Legacy case of '[[URL anchor display text]]' link
833                # implicit untaint is OK as we are just recycling topic content
834                $link = $candidateLink;
835                $text = _escapeAutoLinks($candidateText);
836            }
837        }
838        return $this->_externalLink( $link, $text );
839    }
840
841    # Extract '?params'
842    # $link =~ s/(\?.*?)(?>#|$)//;
843    my $params = '';
844    if ( $link =~ s/(\?.*$)// ) {
845        $params = $1;
846    }
847
848    $text = _escapeAutoLinks($link) unless defined $text;
849    $text =~ s/${STARTWW}==(\S+?|\S[^\n]*?\S)==$ENDWW/_fixedFontText($1,1)/gem;
850    $text =~ s/${STARTWW}__(\S+?|\S[^\n]*?\S)
851               __$ENDWW/<strong><em>$1<\/em><\/strong>/gmx;
852    $text =~ s/${STARTWW}\*(\S+?|\S[^\n]*?\S)\*$ENDWW/<strong>$1<\/strong>/gm;
853    $text =~ s/${STARTWW}\_(\S+?|\S[^\n]*?\S)\_$ENDWW/<em>$1<\/em>/gm;
854    $text =~ s/${STARTWW}\=(\S+?|\S[^\n]*?\S)\=$ENDWW/_fixedFontText($1,0)/gem;
855
856    # Extract '#anchor'
857    # $link =~ s/(\#[a-zA-Z_0-9\-]*$)//;
858    my $anchor = '';
859    if ( $link =~ s/($Foswiki::regex{anchorRegex}$)// ) {
860        $anchor = $1;
861
862        #$text =~ s/#$anchor//;
863    }
864
865    # filter out &any; entities (legacy)
866    $link =~ s/\&[a-z]+\;//gi;
867
868    # filter out &#123; entities (legacy)
869    $link =~ s/\&\#[0-9]+\;//g;
870
871    # Filter junk
872    $link =~ s/$Foswiki::cfg{NameFilter}+/ /g;
873
874    ASSERT( UNTAINTED($link) ) if DEBUG;
875
876    # Capitalise first word
877    $link = ucfirst($link);
878
879    # Collapse spaces and capitalise following letter
880    $link =~ s/\s([$Foswiki::regex{mixedAlphaNum}])/\U$1/go;
881
882    # Get rid of remaining spaces, i.e. spaces in front of -'s and ('s
883    $link =~ s/\s//go;
884
885    # The link is used in the topic name, and if locales are in effect,
886    # the above conversions will taint the name (Foswiki:Tasks:Item2091)
887    $link = Foswiki::Sandbox::untaintUnchecked($link);
888
889    $link ||= $topicObject->topic;
890
891    # Topic defaults to the current topic
892    my ( $web, $topic ) =
893      $this->{session}->normalizeWebTopicName( $topicObject->web, $link );
894
895    return $this->internalLink( $web, $topic, $text, $anchor, 1, undef,
896        $hasExplicitLinkLabel, $params );
897}
898
899# Check if text is an image # (as indicated by the file type)
900# return an img tag, otherwise nothing
901sub _isImageLink {
902    my ( $this, $url ) = @_;
903
904    return if $url =~ /<nop>/;
905    $url =~ s/^\s+//;
906    $url =~ s/\s+$//;
907    if ( $url =~ m#^https?://[^?]*\.(?:gif|jpg|jpeg|png)$#i ) {
908        my $filename = $url;
909        $filename =~ s@.*/@@;
910        return CGI::img( { src => $url, alt => $filename } );
911    }
912    return;
913}
914
915# Handle an external link typed directly into text. If it's an image
916# and no text is specified, then use an img tag, otherwise generate a link.
917sub _externalLink {
918    my ( $this, $url, $text ) = @_;
919
920    if ( !$text && ( my $img = $this->_isImageLink($url) ) ) {
921        return $img;
922    }
923    my $opt = '';
924    if ( $url =~ /^mailto:/i ) {
925        if ( $Foswiki::cfg{AntiSpam}{EmailPadding} ) {
926            $url =~ s/(\@[\w\_\-\+]+)(\.)
927                     /$1$Foswiki::cfg{AntiSpam}{EmailPadding}$2/x;
928            if ($text) {
929                $text =~ s/(\@[\w\_\-\+]+)(\.)
930                          /$1$Foswiki::cfg{AntiSpam}{EmailPadding}$2/x;
931            }
932        }
933        if ( $Foswiki::cfg{AntiSpam}{EntityEncode} ) {
934
935          # Much harder obfuscation scheme. For link text we only encode '@'
936          # See also http://develop.twiki.org/~twiki4/cgi-bin/view/Bugs/Item2928
937          # and http://develop.twiki.org/~twiki4/cgi-bin/view/Bugs/Item3430
938          # before touching this
939          # Note:  & is already encoded,  so don't encode any entities
940          # See http://foswiki.org/Tasks/Item10905
941            $url =~ s/&(\w+);/$REMARKER$1$REEND/g;                  # "&abc;"
942            $url =~ s/&(#x?[0-9a-f]+);/$REMARKER$1$REEND/gi;        # "&#123;"
943            $url =~ s/([^\w$REMARKER$REEND])/'&#'.ord($1).';'/ge;
944            $url =~ s/$REMARKER(#x?[0-9a-f]+)$REEND/&$1;/goi;
945            $url =~ s/$REMARKER(\w+)$REEND/&$1;/go;
946            if ($text) {
947                $text =~ s/\@/'&#'.ord('@').';'/ge;
948            }
949        }
950    }
951    else {
952        $opt = ' target="_top"';
953    }
954    $text ||= $url;
955
956    # Item5787: if a URL has spaces, escape them so the URL has less
957    # chance of being broken by later rendering.
958    $url =~ s/ /%20/g;
959
960    # SMELL: Can't use CGI::a here, because it encodes ampersands in
961    # the link, and those have already been encoded once in the
962    # rendering loop (they are identified as "stand-alone"). One
963    # encoding works; two is too many. None would be better for everyone!
964    return '<a href="' . $url . '"' . $opt . '>' . $text . '</a>';
965}
966
967# Generate a "mailTo" link
968sub _mailLink {
969    my ( $this, $text ) = @_;
970
971    my $url = $text;
972    return $text if $url =~ /^(?:!|\<nop\>)/;
973
974#use Email::Valid             ();
975#my $tmpEmail = $url;
976#$tmpEmail =~ s/^mailto://;
977#my $errtxt = '';
978#$errtxt =  "<b>INVALID</b> $tmpEmail " unless (Email::Valid->address($tmpEmail));
979
980    # Any special characters in the user portion must be %hex escaped.
981    $url =~ s/^((?:mailto\:)?)?(.*?)(@.*?)$/'mailto:'._escape( $2 ).$3/msiex;
982    my $lenLeft  = length($2);
983    my $lenRight = length($3);
984
985# Per RFC 3696 Errata,  length restricted to 254 overall per RFC 2821 RCPT limits
986    return $text
987      if ( $lenLeft > 64 || $lenRight > 254 || $lenLeft + $lenRight > 254 );
988
989    $url = 'mailto:' . $url unless $url =~ /^mailto:/i;
990    return _externalLink( $this, $url, $text );
991}
992
993sub _escape {
994    my $txt = shift;
995
996    my $chars = join( '', keys(%ESCAPED) );
997    $txt =~ s/([$chars])/$ESCAPED{$1}/g;
998    $txt =~ s/[\s]/%20/g;                  # Any folding white space
999    return $txt;
1000}
1001
1002=begin TML
1003
1004---++ ObjectMethod renderFORMFIELD ( %params, $topic, $web ) -> $html
1005
1006Returns the fully rendered expansion of a %FORMFIELD{}% tag.
1007
1008=cut
1009
1010sub renderFORMFIELD {
1011    my ( $this, $params, $topicObject ) = @_;
1012
1013    my $formField = $params->{_DEFAULT};
1014    return '' unless defined $formField;
1015    my $altText = $params->{alttext};
1016    my $default = $params->{default};
1017    my $rev     = $params->{rev} || '';
1018    my $format  = $params->{format};
1019
1020    $altText = '' unless defined $altText;
1021    $default = '' unless defined $default;
1022
1023    unless ( defined $format ) {
1024        $format = '$value';
1025    }
1026
1027    # SMELL: this local creation of a cache looks very suspicious. Suspect
1028    # this may have been a one-off optimisation.
1029    my $formTopicObject = $this->{ffCache}{ $topicObject->getPath() . $rev };
1030    unless ($formTopicObject) {
1031        $formTopicObject =
1032          Foswiki::Meta->load( $this->{session}, $topicObject->web,
1033            $topicObject->topic, $rev );
1034        unless ( $formTopicObject->haveAccess('VIEW') ) {
1035
1036            # Access violation, create dummy meta with empty text, so
1037            # it looks like it was already loaded.
1038            $formTopicObject =
1039              Foswiki::Meta->new( $this->{session}, $topicObject->web,
1040                $topicObject->topic, '' );
1041        }
1042        $this->{ffCache}{ $formTopicObject->getPath() . $rev } =
1043          $formTopicObject;
1044    }
1045
1046    my $text   = $format;
1047    my $found  = 0;
1048    my $title  = '';
1049    my @fields = $formTopicObject->find('FIELD');
1050    foreach my $field (@fields) {
1051        my $name = $field->{name};
1052        $title = $field->{title} || $name;
1053        if ( $title eq $formField || $name eq $formField ) {
1054            $found = 1;
1055            my $value = $field->{value};
1056            $text = $default if !length($value);
1057            $text =~ s/\$title/$title/go;
1058            $text =~ s/\$value/$value/go;
1059            $text =~ s/\$name/$name/g;
1060            if ( $text =~ m/\$form/ ) {
1061                my @defform = $formTopicObject->find('FORM');
1062                my $form  = $defform[0];     # only one form per topic
1063                my $fname = $form->{name};
1064                $text =~ s/\$form/$fname/g;
1065            }
1066
1067            last;                            # one hit suffices
1068        }
1069    }
1070
1071    unless ($found) {
1072        $text = $altText || '';
1073    }
1074
1075    $text = Foswiki::expandStandardEscapes($text);
1076
1077    # render nop exclamation marks before words as <nop>
1078    $text =~ s/!(\w+)/<nop>$1/gs;
1079
1080    return $text;
1081}
1082
1083# Adjust heading levels
1084# <h off="1"> will increase the indent level by 1
1085# <h off="-1"> will decrease the indent level by 1
1086sub _adjustH {
1087    my ($text) = @_;
1088
1089    my @blocks = split( /(<ho(?:\s+off="(?:[-+]?\d+)")?\s*\/?>)/i, $text );
1090
1091    return $text unless scalar(@blocks) > 1;
1092
1093    sub _cap {
1094        return 1 if ( $_[0] < 1 );
1095        return 6 if ( $_[0] > 6 );
1096        return $_[0];
1097    }
1098
1099    my $off = 0;
1100    my $out = '';
1101    while ( scalar(@blocks) ) {
1102        my $i = shift(@blocks);
1103        if ( $i =~ /^<ho(?:\s+off="([-+]?\d+)")?\s*\/?>$/i && $1 ) {
1104            $off += $1;
1105        }
1106        else {
1107            $i =~ s/(<\/?h)(\d)((\s+.*?)?>)/$1 . _cap($2 + $off) . $3/gesi
1108              if ($off);
1109            $out .= $i;
1110        }
1111    }
1112    return $out;
1113}
1114
1115=begin TML
1116
1117---++ ObjectMethod getRenderedVersion ( $text, $topicObject ) -> $html
1118
1119The main rendering function.
1120
1121=cut
1122
1123sub getRenderedVersion {
1124    my ( $this, $text, $topicObject ) = @_;
1125    ASSERT( $topicObject->isa('Foswiki::Meta') ) if DEBUG;
1126
1127    return '' unless defined $text;    # nothing to do
1128
1129    my $session = $this->{session};
1130    my $plugins = $session->{plugins};
1131    my $prefs   = $session->{prefs};
1132
1133    @{ $this->{LIST} } = ();
1134
1135    # Initial cleanup
1136    $text =~ s/\r//g;
1137
1138    # whitespace before <! tag (if it is the first thing) is illegal
1139    $text =~ s/^\s+(<![a-z])/$1/i;
1140
1141    # clutch to enforce correct rendering at end of doc
1142    $text =~ s/\n?$/\n<nop>\n/s;
1143
1144    # Maps of placeholders to tag parameters and text
1145    my $removed = {};
1146
1147    # verbatim before literal - see Item3431
1148    $text = Foswiki::takeOutBlocks( $text, 'verbatim',  $removed );
1149    $text = Foswiki::takeOutBlocks( $text, 'literal',   $removed );
1150    $text = Foswiki::takeOutBlocks( $text, 'dirtyarea', $removed )
1151      if $Foswiki::cfg{Cache}{Enabled};
1152
1153    $text =
1154      $this->_takeOutProtected( $text, qr/<\?([^?]*)\?>/s, 'comment',
1155        $removed );
1156    $text =
1157      $this->_takeOutProtected( $text, qr/<!DOCTYPE([^<>]*)>?/mi, 'comment',
1158        $removed );
1159    $text =
1160      $this->_takeOutProtected( $text, qr/<head.*?<\/head>/si, 'head',
1161        $removed );
1162    $text = $this->_takeOutProtected( $text, qr/<textarea\b.*?<\/textarea>/si,
1163        'textarea', $removed );
1164    $text =
1165      $this->_takeOutProtected( $text, qr/<script\b.*?<\/script>/si, 'script',
1166        $removed );
1167
1168    # Remove the sticky tags (used in WysiwygPlugin's TML2HTML conversion)
1169    # since they could potentially break a browser.
1170    # They are removed here and not in the plugin because the plugin might
1171    # not be installed but the sticky tags are standard markup.
1172    $text =~ s#</?sticky>##g;
1173
1174    # DEPRECATED startRenderingHandler before PRE removed
1175    # SMELL: could parse more efficiently if this wasn't
1176    # here.
1177    $plugins->dispatch( 'startRenderingHandler', $text, $topicObject->web,
1178        $topicObject->topic );
1179
1180    $text = Foswiki::takeOutBlocks( $text, 'pre', $removed );
1181
1182    # Join lines ending in '\' (don't need \r?, it was removed already)
1183    $text =~ s/\\\n//gs;
1184
1185    $plugins->dispatch( 'preRenderingHandler', $text, $removed );
1186
1187    if ( $plugins->haveHandlerFor('insidePREHandler') ) {
1188        foreach my $region ( sort keys %$removed ) {
1189            next unless ( $region =~ /^pre\d+$/i );
1190            my @lines = split( /\r?\n/, $removed->{$region}{text} );
1191            my $rt = '';
1192            while ( scalar(@lines) ) {
1193                my $line = shift(@lines);
1194                $plugins->dispatch( 'insidePREHandler', $line );
1195                if ( $line =~ /\n/ ) {
1196                    unshift( @lines, split( /\r?\n/, $line ) );
1197                    next;
1198                }
1199                $rt .= $line . "\n";
1200            }
1201            $removed->{$region}{text} = $rt;
1202        }
1203    }
1204
1205    if ( $plugins->haveHandlerFor('outsidePREHandler') ) {
1206
1207        # DEPRECATED - this is the one call preventing
1208        # effective optimisation of the TML processing loop,
1209        # as it exposes the concept of a 'line loop' to plugins,
1210        # but HTML is not a line-oriented language (though TML is).
1211        # But without it, a lot of processing could be moved
1212        # outside the line loop.
1213        my @lines = split( /\r?\n/, $text );
1214        my $rt = '';
1215        while ( scalar(@lines) ) {
1216            my $line = shift(@lines);
1217            $plugins->dispatch( 'outsidePREHandler', $line );
1218            if ( $line =~ /\n/ ) {
1219                unshift( @lines, split( /\r?\n/, $line ) );
1220                next;
1221            }
1222            $rt .= $line . "\n";
1223        }
1224
1225        $text = $rt;
1226    }
1227
1228    # Remove input fields: Item11480
1229    $text =
1230      $this->_takeOutProtected( $text, qr/<input\b.*?\/>/si, 'input',
1231        $removed );
1232
1233    # Escape rendering: Change ' !AnyWord' to ' <nop>AnyWord',
1234    # for final ' AnyWord' output
1235    $text =~ s/$STARTWW\!(?=[\w\*\=])/<nop>/gm;
1236
1237    # Blockquoted email (indented with '> ')
1238    # Could be used to provide different colours for different numbers of '>'
1239    $text =~ s/^>(.*?)$/'&gt;'.CGI::cite( {}, $1 ).CGI::br()/gem;
1240
1241    # locate isolated < and > and translate to entities
1242    # Protect isolated <!-- and -->
1243    $text =~ s/<!--/{$REMARKER!--/g;
1244    $text =~ s/-->/--}$REMARKER/g;
1245
1246    # SMELL: this next fragment does not handle the case where HTML tags
1247    # are embedded in the values provided to other tags. The only way to
1248    # do this correctly is to parse the HTML (bleagh!). So we just assume
1249    # they have been escaped.
1250    $text =~ s/<(\/?\w+(:\w+)?)>/{$REMARKER$1}$REMARKER/g;
1251    $text =~ s/<(\w+(:\w+)?(\s+.*?|\/)?)>/{$REMARKER$1}$REMARKER/g;
1252
1253    # XML processing instruction only valid at start of text
1254    $text =~ s/^<(\?\w.*?\?)>/{$REMARKER$1}$REMARKER/g;
1255
1256    # entitify lone < and >, praying that we haven't screwed up :-(
1257    # Item1985: CDATA sections are not lone < and >
1258    $text =~ s/<(?!\!\[CDATA\[)/&lt\;/g;
1259    $text =~ s/(?<!\]\])>/&gt\;/g;
1260    $text =~ s/{$REMARKER/</go;
1261    $text =~ s/}$REMARKER/>/go;
1262
1263    # other entities
1264    $text =~ s/&(\w+);/$REMARKER$1;/g;              # "&abc;"
1265    $text =~ s/&(#x?[0-9a-f]+);/$REMARKER$1;/gi;    # "&#123;"
1266    $text =~ s/&/&amp;/g;                           # escape standalone "&"
1267    $text =~ s/$REMARKER(#x?[0-9a-f]+;)/&$1/goi;
1268    $text =~ s/$REMARKER(\w+;)/&$1/go;
1269
1270    # clear the set of unique anchornames in order to inhibit
1271    # the 'relabeling' of anchor names if the same topic is processed
1272    # more than once, cf. explanation in expandMacros()
1273    my $anchors = $this->getAnchorNames($topicObject);
1274    $anchors->clear();
1275
1276    # '#WikiName' anchors. Don't attempt to make these unique; renaming
1277    # user-defined anchors is not sensible.
1278    $text =~ s/^(\#$Foswiki::regex{wikiWordRegex})/
1279      CGI::span({
1280          id => $anchors->add( $1 )
1281         }, '')/geom;
1282
1283    # Headings
1284    # '<h6>...</h6>' HTML rule
1285    $text =~ s/$Foswiki::regex{headerPatternHt}/
1286      _makeAnchorHeading($this, $2, $1, $anchors)/geo;
1287
1288    # '----+++++++' rule
1289    $text =~ s/$Foswiki::regex{headerPatternDa}/
1290      _makeAnchorHeading($this, $2, length($1), $anchors)/geo;
1291
1292    # Horizontal rule
1293    my $hr = CGI::hr();
1294    $text =~ s/^---+/$hr/gm;
1295
1296    # Now we really _do_ need a line loop, to process TML
1297    # line-oriented stuff.
1298    my $isList   = 0;    # True when within a list
1299    my $tableRow = 0;
1300    my @result;
1301    my $isFirst = 1;
1302
1303    foreach my $line ( split( /\r?\n/, $text ) ) {
1304
1305        # Table: | cell | cell |
1306        # allow trailing white space after the last |
1307        if ( $line =~ m/^(\s*)\|.*\|\s*$/ ) {
1308
1309            if ($isList) {
1310
1311                # Table start should terminate previous list
1312                _addListItem( $this, \@result, '', '', '', '' );
1313                $isList = 0;
1314            }
1315
1316            unless ($tableRow) {
1317
1318                # mark the head of the table
1319                push( @result, $TABLEMARKER );
1320            }
1321            $line =~ s/^(\s*)\|(.*)/$1._emitTR( $this, $2 )/e;
1322            $tableRow++;
1323        }
1324        elsif ($tableRow) {
1325            _addTHEADandTFOOT( \@result );
1326            push( @result, '</table>' );
1327            $tableRow = 0;
1328        }
1329
1330        # Lists and paragraphs
1331        if ( $line =~ m/^\s*$/ ) {
1332            unless ( $tableRow || $isFirst ) {
1333                $line = '<p></p>';
1334            }
1335            $isList = 0;
1336        }
1337        elsif ( $line =~ m/^\S/ ) {
1338            $isList = 0;
1339        }
1340        elsif ( $line =~ m/^(\t|   )+\S/ ) {
1341            if ( $line =~
1342                s/^((\t|   )+)\$\s(([^:]+|:[^\s]+)+?):\s/<dt> $3 <\/dt><dd> / )
1343            {
1344
1345                # Definition list
1346                _addListItem( $this, \@result, 'dl', 'dd', '', $1 );
1347                $isList = 1;
1348            }
1349            elsif ( $line =~ s/^((\t|   )+)(\S+?):\s/<dt> $3<\/dt><dd> /o ) {
1350
1351                # Definition list
1352                _addListItem( $this, \@result, 'dl', 'dd', '', $1 );
1353                $isList = 1;
1354            }
1355            elsif ( $line =~ s/^((\t|   )+)\* /<li> /o ) {
1356
1357                # Unnumbered list
1358                _addListItem( $this, \@result, 'ul', 'li', '', $1 );
1359                $isList = 1;
1360            }
1361            elsif ( $line =~ s/^((\t|   )+): /<div class='foswikiIndent'> /o ) {
1362
1363                # Indent pseudo-list
1364                _addListItem( $this, \@result, '', 'div', 'foswikiIndent', $1 );
1365                $isList = 1;
1366            }
1367            elsif ( $line =~ m/^((\t|   )+)([1AaIi]\.|\d+\.?) ?/ ) {
1368
1369                # Numbered list
1370                my $ot = $3;
1371                $ot =~ s/^(.).*/$1/;
1372                if ( $ot !~ /^\d$/ ) {
1373                    $ot = ' type="' . $ot . '"';
1374                }
1375                else {
1376                    $ot = '';
1377                }
1378                $line =~ s/^((\t|   )+)([1AaIi]\.|\d+\.?) ?/<li$ot> /;
1379                _addListItem( $this, \@result, 'ol', 'li', '', $1 );
1380                $isList = 1;
1381            }
1382            elsif ( $isList && $line =~ /^(\t|   )+\s*\S/ ) {
1383
1384                # indented line extending prior list item
1385                push( @result, $line );
1386                next;
1387            }
1388            else {
1389                $isList = 0;
1390            }
1391        }
1392        elsif ( $isList && $line =~ /^(\t|   )+\s*\S/ ) {
1393
1394            # indented line extending prior list item; case where indent
1395            # starts with is at least 3 spaces or a tab, but may not be a
1396            # multiple of 3.
1397            push( @result, $line );
1398            next;
1399        }
1400
1401        # Finish the list
1402        unless ( $isList || $isFirst ) {
1403            _addListItem( $this, \@result, '', '', '', '' );
1404        }
1405
1406        push( @result, $line );
1407        $isFirst = 0;
1408    }
1409
1410    if ($tableRow) {
1411        _addTHEADandTFOOT( \@result );
1412        push( @result, '</table>' );
1413    }
1414    _addListItem( $this, \@result, '', '', '', '' );
1415
1416    $text = join( '', @result );
1417
1418    # SMELL: use of $STARTWW and $ENDWW really limit the number of places
1419    # emphasis can happen. But it's a tradeoff between that and excessive
1420    # greed.
1421
1422    $text =~ s/${STARTWW}==(\S+?|\S[^\n]*?\S)==$ENDWW/_fixedFontText($1,1)/gem;
1423    $text =~ s/${STARTWW}__(\S+?|\S[^\n]*?\S)
1424               __$ENDWW/<strong><em>$1<\/em><\/strong>/gmx;
1425    $text =~ s/${STARTWW}\*(\S+?|\S[^\n]*?\S)\*$ENDWW/<strong>$1<\/strong>/gm;
1426    $text =~ s/${STARTWW}\_(\S+?|\S[^\n]*?\S)\_$ENDWW/<em>$1<\/em>/gm;
1427    $text =~ s/${STARTWW}\=(\S+?|\S[^\n]*?\S)\=$ENDWW/_fixedFontText($1,0)/gem;
1428
1429    # Handle [[][] and [[]] links
1430    # Change ' ![[...' to ' [<nop>[...' to protect from further rendering
1431    $text =~ s/(^|\s)\!\[\[/$1\[<nop>\[/gm;
1432
1433    # Spaced-out Wiki words with alternative link text
1434    # i.e. [[$1][$3]]
1435    $text =~ s(\[\[([^\]\[\n]+)\](\[([^\]\n]+)\])?\])
1436        (_handleSquareBracketedLink( $this,$topicObject,$1,$3))ge;
1437
1438    # URI - don't apply if the URI is surrounded by url() to avoid naffing
1439    # CSS
1440    $text =~ s/(^|(?<!url)[-*\s(|])
1441               ($Foswiki::regex{linkProtocolPattern}:
1442                   ([^\s<>"]+[^\s*.,!?;:)<|]))/
1443                     $1._externalLink( $this,$2)/geox;
1444
1445    # Normal mailto:foo@example.com ('mailto:' part optional)
1446    $text =~ s/$STARTWW((mailto\:)?
1447                   $Foswiki::regex{emailAddrRegex})$ENDWW/
1448                     _mailLink( $this, $1 )/gemx;
1449
1450    unless ( Foswiki::isTrue( $prefs->getPreference('NOAUTOLINK') ) ) {
1451
1452        # Handle WikiWords
1453        $text = Foswiki::takeOutBlocks( $text, 'noautolink', $removed );
1454        $text =~ s($STARTWW
1455            (?:($Foswiki::regex{webNameRegex})\.)?
1456            ($Foswiki::regex{wikiWordRegex}|
1457                $Foswiki::regex{abbrevRegex})
1458            ($Foswiki::regex{anchorRegex})?)
1459           (_handleWikiWord( $this, $topicObject, $1, $2, $3))gexom;
1460        Foswiki::putBackBlocks( \$text, $removed, 'noautolink' );
1461    }
1462
1463    # Restore input fields before calling the end/post handlers
1464    $this->_putBackProtected( \$text, 'input', $removed );
1465
1466    Foswiki::putBackBlocks( \$text, $removed, 'pre' );
1467
1468    # DEPRECATED plugins hook after PRE re-inserted
1469    $plugins->dispatch( 'endRenderingHandler', $text );
1470
1471    # replace verbatim with pre in the final output
1472    Foswiki::putBackBlocks( \$text, $removed, 'verbatim', 'pre',
1473        \&verbatimCallBack );
1474    $text =~ s|\n?<nop>\n$||o;    # clean up clutch
1475
1476    $this->_putBackProtected( \$text, 'script', $removed, \&_filterScript );
1477    Foswiki::putBackBlocks( \$text, $removed, 'literal', '', \&_filterLiteral );
1478    $this->_putBackProtected( \$text, 'literal', $removed );
1479    Foswiki::putBackBlocks( \$text, $removed, 'dirtyarea' )
1480      if $Foswiki::cfg{Cache}{Enabled};
1481    $this->_putBackProtected( \$text, 'comment',  $removed );
1482    $this->_putBackProtected( \$text, 'head',     $removed );
1483    $this->_putBackProtected( \$text, 'textarea', $removed );
1484
1485    $text = _adjustH($text);
1486
1487    $this->{session}->getLoginManager()->endRenderingHandler($text);
1488
1489    $plugins->dispatch( 'postRenderingHandler', $text );
1490    return $text;
1491}
1492
1493=begin TML
1494
1495---++ StaticMethod verbatimCallBack
1496
1497Callback for use with putBackBlocks that replaces &lt; and >
1498by their HTML entities &amp;lt; and &amp;gt;
1499
1500=cut
1501
1502sub verbatimCallBack {
1503    my $val = shift;
1504
1505    # SMELL: A shame to do this, but been in Foswiki.org have converted
1506    # 3 spaces to tabs since day 1
1507    $val =~ s/\t/   /g;
1508
1509    return Foswiki::entityEncode($val);
1510}
1511
1512# Only put script and literal sections back if they are allowed by options
1513sub _filterLiteral {
1514    my $val = shift;
1515    return $val if ( $Foswiki::cfg{AllowInlineScript} );
1516    return CGI::comment(
1517'<literal> is not allowed on this site - denied by deprecated {AllowInlineScript} setting'
1518    );
1519}
1520
1521sub _filterScript {
1522    my $val = shift;
1523    return $val if ( $Foswiki::cfg{AllowInlineScript} );
1524    return CGI::comment(
1525'<script> is not allowed on this site - denied by deprecated {AllowInlineScript} setting'
1526    );
1527}
1528
1529=begin TML
1530
1531---++ ObjectMethod TML2PlainText( $text, $topicObject, $opts ) -> $plainText
1532
1533Strip TML markup from text for display as plain text without
1534pushing it through the full rendering pipeline. Intended for
1535generation of topic and change summaries. Adds nop tags to
1536prevent subsequent rendering; nops get removed at the very end.
1537
1538$opts:
1539   * showvar - shows !%VAR% names if not expanded
1540   * expandvar - expands !%VARS%
1541   * nohead - strips ---+ headings at the top of the text
1542   * showmeta - does not filter meta-data
1543
1544=cut
1545
1546sub TML2PlainText {
1547    my ( $this, $text, $topicObject, $opts ) = @_;
1548    $opts ||= '';
1549
1550    return '' unless defined $text;
1551
1552    $text =~ s/\r//g;    # SMELL, what about OS10?
1553
1554    if ( $opts =~ /showmeta/ ) {
1555        $text =~ s/%META:/%<nop>META:/g;
1556    }
1557    else {
1558        $text =~ s/%META:[A-Z].*?}%//g;
1559    }
1560
1561    if ( $opts =~ /expandvar/ ) {
1562        $text =~ s/(\%)(SEARCH){/$1<nop>$2/g;    # prevent recursion
1563        $topicObject = Foswiki::Meta->new( $this->{session} )
1564          unless $topicObject;
1565        $text = $topicObject->expandMacros($text);
1566    }
1567    else {
1568        $text =~ s/%WEB%/$topicObject->web() || ''/ge;
1569        $text =~ s/%TOPIC%/$topicObject->topic() || ''/ge;
1570        my $wtn = $this->{session}->{prefs}->getPreference('WIKITOOLNAME')
1571          || '';
1572        $text =~ s/%WIKITOOLNAME%/$wtn/g;
1573        if ( $opts =~ /showvar/ ) {
1574            $text =~ s/%(\w+({.*?}))%/$1/g;      # defuse
1575        }
1576        else {
1577            $text =~ s/%$Foswiki::regex{tagNameRegex}({.*?})?%//g;    # remove
1578        }
1579    }
1580
1581    # Format e-mail to add spam padding (HTML tags removed later)
1582    $text =~ s/$STARTWW(
1583                   (mailto\:)?
1584                   [a-zA-Z0-9-_.+]+@[a-zA-Z0-9-_.]+\.[a-zA-Z0-9-_]+
1585                   )$ENDWW
1586              /_mailLink( $this, $1 )/gemx;
1587    $text =~ s/<!--.*?-->//gs;       # remove all HTML comments
1588    $text =~ s/<(?!nop)[^>]*>//g;    # remove all HTML tags except <nop>
1589    $text =~ s/\&[a-z]+;/ /g;        # remove entities
1590    if ( $opts =~ /nohead/ ) {
1591
1592        # skip headings on top
1593        while ( $text =~ s/^\s*\-\-\-+\+[^\n\r]*// ) { };    # remove heading
1594    }
1595
1596    # keep only link text of legacy [[prot://uri.tld/ link text]]
1597    $text =~ s/
1598            \[
1599                \[$Foswiki::regex{linkProtocolPattern}\:
1600                    ([^\s<>"\]]+[^\s*.,!?;:)<|\]])
1601                        \s+([^\[\]]*?)
1602                \]
1603            \]/$3/gx;
1604
1605    #keep only test portion of [[][]] links
1606    $text =~ s/\[\[([^\]]*\]\[)(.*?)\]\]/$2/g;
1607
1608    # SMELL: can't do this, it removes these characters even when they're
1609    # not for formatting
1610    #$text =~ s/[\[\]\*\|=_\&\<\>]/ /g;
1611
1612    $text =~ s/${STARTWW}==(\S+?|\S[^\n]*?\S)==$ENDWW/$1/gem;
1613    $text =~ s/${STARTWW}__(\S+?|\S[^\n]*?\S)__$ENDWW/$1/gm;
1614    $text =~ s/${STARTWW}\*(\S+?|\S[^\n]*?\S)\*$ENDWW/$1/gm;
1615    $text =~ s/${STARTWW}\_(\S+?|\S[^\n]*?\S)\_$ENDWW/$1/gm;
1616    $text =~ s/${STARTWW}\=(\S+?|\S[^\n]*?\S)\=$ENDWW/$1/gem;
1617
1618    #SMELL: need to correct these too
1619    $text =~ s/[\[\]\|\&]/ /g;    # remove remaining Wiki formatting chars
1620
1621    $text =~ s/^\-\-\-+\+*\s*\!*/ /gm;    # remove heading formatting and hbar
1622    $text =~ s/[\+\-]+/ /g;               # remove special chars
1623    $text =~ s/^\s+//;                    # remove leading whitespace
1624    $text =~ s/\s+$//;                    # remove trailing whitespace
1625    $text =~ s/!(\w+)/$1/gs;    # remove all nop exclamation marks before words
1626    $text =~ s/[\r\n]+/\n/s;
1627    $text =~ s/[ \t]+/ /s;
1628
1629    # defuse "Web." prefix in "Web.TopicName" link
1630    $text =~ s{$STARTWW
1631               (($Foswiki::regex{webNameRegex})\.
1632                   ($Foswiki::regex{wikiWordRegex}
1633                   | $Foswiki::regex{abbrevRegex}))}
1634              {$2.<nop>$3}gx;
1635    $text =~ s/\<nop\>//g;      # remove any remaining nops
1636    $text =~ s/[\<\>]/ /g;      # remove any remaining formatting
1637
1638    return $text;
1639}
1640
1641=begin TML
1642
1643---++ ObjectMethod protectPlainText($text) -> $tml
1644
1645Protect plain text from expansions that would normally be done
1646duing rendering, such as wikiwords. Topic summaries, for example,
1647have to be protected this way.
1648
1649=cut
1650
1651sub protectPlainText {
1652    my ( $this, $text ) = @_;
1653
1654    # prevent text from getting rendered in inline search and link tool
1655    # tip text by escaping links (external, internal, Interwiki)
1656    $text =~ s/((($Foswiki::regex{webNameRegex})\.)?
1657                   ($Foswiki::regex{wikiWordRegex}
1658                   |$Foswiki::regex{abbrevRegex}))/<nop>$1/gx;
1659
1660    $text =~ s/([@%])/<nop>$1<nop>/g;    # email address, macro
1661
1662    # Encode special chars into XML &#nnn; entities for use in RSS feeds
1663    # - no encoding for HTML pages, to avoid breaking international
1664    # characters. Only works for ISO-8859-1 sites, since the Unicode
1665    # encoding (&#nnn;) is identical for first 256 characters.
1666    # I18N TODO: Convert to Unicode from any site character set.
1667    if (   $this->{session}->inContext('rss')
1668        && $Foswiki::cfg{Site}{CharSet} =~ /^iso-?8859-?1$/i )
1669    {
1670        $text =~ s/([\x7f-\xff])/"\&\#" . unpack( 'C', $1 ) .';'/ge;
1671    }
1672
1673    return $text;
1674}
1675
1676# DEPRECATED: retained for compatibility with various hack-job extensions
1677sub makeTopicSummary {
1678    my ( $this, $text, $topic, $web, $flags ) = @_;
1679    my $topicObject = Foswiki::Meta->new( $this->{session}, $web, $topic );
1680    return $topicObject->summariseText( '', $text );
1681}
1682
1683# _takeOutProtected( \$text, $re, $id, \%map ) -> $text
1684#
1685#   * =$text= - Text to process
1686#   * =$re= - Regular expression that matches tag expressions to remove
1687#   * =\%map= - Reference to a hash to contain the removed blocks
1688#
1689# Return value: $text with blocks removed. Unlike takeOuBlocks, this
1690# *preserves* the tags.
1691#
1692# used to extract from $text comment type tags like &lt;!DOCTYPE blah>
1693#
1694# WARNING: if you want to take out &lt;!-- comments --> you _will_ need
1695# to re-write all the takeOuts to use a different placeholder
1696sub _takeOutProtected {
1697    my ( $this, $intext, $re, $id, $map ) = @_;
1698
1699    $intext =~ s/($re)/_replaceBlock($1, $id, $map)/ge;
1700
1701    return $intext;
1702}
1703
1704sub _replaceBlock {
1705    my ( $scoop, $id, $map ) = @_;
1706    my $placeholder = $placeholderMarker;
1707    $placeholderMarker++;
1708    $map->{ $id . $placeholder }{text} = $scoop;
1709
1710    return '<!--' . $REMARKER . $id . $placeholder . $REMARKER . '-->';
1711}
1712
1713# _putBackProtected( \$text, $id, \%map, $callback ) -> $text
1714# Return value: $text with blocks added back
1715#   * =\$text= - reference to text to process
1716#   * =$id= - type of taken-out block e.g. 'verbatim'
1717#   * =\%map= - map placeholders to blocks removed by takeOutBlocks
1718#   * =$callback= - Reference to function to call on each block being inserted (optional)
1719#
1720#Reverses the actions of takeOutProtected.
1721sub _putBackProtected {
1722    my ( $this, $text, $id, $map, $callback ) = @_;
1723    ASSERT( ref($map) eq 'HASH' ) if DEBUG;
1724
1725    foreach my $placeholder ( keys %$map ) {
1726        next unless $placeholder =~ /^$id\d+$/;
1727        my $val = $map->{$placeholder}{text};
1728        $val = &$callback($val) if ( defined($callback) );
1729        $$text =~ s/<!--$REMARKER$placeholder$REMARKER-->/$val/;
1730        delete( $map->{$placeholder} );
1731    }
1732}
1733
1734=begin TML
1735
1736---++ ObjectMethod renderRevisionInfo($topicObject, $rev, $format) -> $string
1737
1738Obtain and render revision info for a topic.
1739   * =$topicObject= - the topic
1740   * =$rev= - the rev number, defaults to latest rev
1741   * =$format= - the render format, defaults to
1742     =$rev - $time - $wikiusername=. =$format= can contain
1743     the following keys for expansion:
1744   | =$web= | the web name |
1745   | =$topic= | the topic name |
1746   | =$rev= | the rev number |
1747   | =$username= | the login of the saving user |
1748   | =$wikiname= | the wikiname of the saving user |
1749   | =$wikiusername= | the web.wikiname of the saving user |
1750   | =$date= | the date of the rev (no time) |
1751   | =$time= | the time of the rev |
1752   | =$min=, =$sec=, etc. | Same date format qualifiers as GMTIME |
1753
1754=cut
1755
1756sub renderRevisionInfo {
1757    my ( $this, $topicObject, $rrev, $format ) = @_;
1758    my $value = $format || 'r$rev - $date - $time - $wikiusername';
1759    $value = Foswiki::expandStandardEscapes($value);
1760
1761    # nop if there are no format tokens
1762    return $value
1763      unless $value =~
1764/\$(?:year|ye|wikiusername|wikiname|week|we|web|wday|username|tz|topic|time|seconds|sec|rev|rcs|month|mo|minutes|min|longdate|isotz|iso|http|hours|hou|epoch|email|dow|day|date)/x;
1765
1766    my $users = $this->{session}->{users};
1767    if ($rrev) {
1768        my $loadedRev = $topicObject->getLoadedRev() || 0;
1769        unless ( $rrev == $loadedRev ) {
1770            $topicObject = Foswiki::Meta->new($topicObject);
1771            $topicObject = $topicObject->load($rrev);
1772        }
1773    }
1774    my $info = $topicObject->getRevisionInfo();
1775
1776    my $wun = '';
1777    my $wn  = '';
1778    my $un  = '';
1779    if ( $info->{author} ) {
1780        my $cUID = $users->getCanonicalUserID( $info->{author} );
1781
1782#pre-set cuid if author is the unknown user from the basemapper (ie, default value) to avoid further guesswork
1783        $cUID = $info->{author}
1784          if ( $info->{author} eq
1785            $Foswiki::Users::BaseUserMapping::UNKNOWN_USER_CUID );
1786        if ( !$cUID ) {
1787            my $ln = $users->getLoginName( $info->{author} );
1788            $cUID = $info->{author}
1789              if ( defined($ln) and ( $ln ne 'unknown' ) );
1790        }
1791        if ($cUID) {
1792            $wun = $users->webDotWikiName($cUID);
1793            $wn  = $users->getWikiName($cUID);
1794            $un  = $users->getLoginName($cUID);
1795        }
1796
1797        #only do the legwork if we really have to
1798        if ( not( defined($wun) and defined($wn) and defined($un) )
1799            or ( ( $wun eq '' ) or ( $wn eq '' ) or ( $un eq '' ) ) )
1800        {
1801            my $user = $info->{author};
1802
1803            # If we are still unsure, then use whatever is saved in the meta.
1804            # But obscure it if the RenderLoggedInButUnknownUsers is enabled.
1805            if ( $Foswiki::cfg{RenderLoggedInButUnknownUsers} ) {
1806                $user = $info->{author} = 'unknown';
1807            }
1808            else {
1809
1810                #cUID's are forced to ascii by escaping other chars..
1811                #$cUID =~ s/([^a-zA-Z0-9])/'_'.sprintf('%02x', ord($1))/ge;
1812
1813#remove any SomeMapping_ prefix from the cuid - as that initial '_' is not escaped.
1814                $user =~ s/^[A-Z][A-Za-z]+Mapping_//;
1815
1816                #and then xform any escaped chars.
1817                use bytes;
1818                $user =~ s/_([0-9a-f][0-9a-f])/chr(hex($1))/ge;
1819                no bytes;
1820            }
1821            $wun ||= $user;
1822            $wn  ||= $user;
1823            $un  ||= $user;
1824        }
1825    }
1826
1827    $value =~ s/\$web/$topicObject->web() || ''/ge;
1828    $value =~ s/\$topic\(([^\)]*)\)/
1829      Foswiki::Render::breakName( $topicObject->topic(), $1 )/ge;
1830    $value =~ s/\$topic/$topicObject->topic() || ''/ge;
1831    $value =~ s/\$rev/$info->{version}/g;
1832    $value =~ s/\$time/
1833      Foswiki::Time::formatTime($info->{date}, '$hour:$min:$sec')/ge;
1834    $value =~ s/\$date/
1835      Foswiki::Time::formatTime(
1836          $info->{date}, $Foswiki::cfg{DefaultDateFormat} )/ge;
1837    $value =~ s/(\$(rcs|longdate|isotz|iso|http|email|))/
1838      Foswiki::Time::formatTime($info->{date}, $1 )/ge;
1839
1840    if ( $value =~
1841/\$(?:year|ye|week|we|web|wday|username|tz|seconds|sec|rcs|month|mo|minutes|min|longdate|hours|hou|epoch|dow|day)/
1842      )
1843    {
1844        $value = Foswiki::Time::formatTime( $info->{date}, $value );
1845    }
1846    $value =~ s/\$username/$un/g;
1847    $value =~ s/\$wikiname/$wn/g;
1848    $value =~ s/\$wikiusername/$wun/g;
1849
1850    return $value;
1851}
1852
1853=begin TML
1854
1855---++ ObjectMethod forEachLine( $text, \&fn, \%options ) -> $newText
1856
1857Iterate over each line, calling =\&fn= on each.
1858\%options may contain:
1859   * =pre= => true, will call fn for each line in pre blocks
1860   * =verbatim= => true, will call fn for each line in verbatim blocks
1861   * =literal= => true, will call fn for each line in literal blocks
1862   * =noautolink= => true, will call fn for each line in =noautolink= blocks
1863The spec of \&fn is =sub fn( $line, \%options ) -> $newLine=. The %options
1864hash passed into this function is passed down to the sub, and the keys
1865=in_literal=, =in_pre=, =in_verbatim= and =in_noautolink= are set boolean
1866TRUE if the line is from one (or more) of those block types.
1867
1868The return result replaces $line in $newText.
1869
1870=cut
1871
1872sub forEachLine {
1873    my ( $this, $text, $fn, $options ) = @_;
1874
1875    return '' unless defined $text;
1876
1877    $options->{in_pre}        = 0;
1878    $options->{in_pre}        = 0;
1879    $options->{in_verbatim}   = 0;
1880    $options->{in_literal}    = 0;
1881    $options->{in_noautolink} = 0;
1882    my $newText = '';
1883    foreach my $line ( split( /([\r\n]+)/, $text ) ) {
1884        if ( $line =~ /[\r\n]/ ) {
1885            $newText .= $line;
1886            next;
1887        }
1888        $options->{in_verbatim}++ if ( $line =~ m|^\s*<verbatim\b[^>]*>\s*$|i );
1889        $options->{in_verbatim}-- if ( $line =~ m|^\s*</verbatim>\s*$|i );
1890        $options->{in_literal}++  if ( $line =~ m|^\s*<literal\b[^>]*>\s*$|i );
1891        $options->{in_literal}--  if ( $line =~ m|^\s*</literal>\s*$|i );
1892        unless ( ( $options->{in_verbatim} > 0 )
1893            || ( ( $options->{in_literal} > 0 ) ) )
1894        {
1895            $options->{in_pre}++ if ( $line =~ m|<pre\b|i );
1896            $options->{in_pre}-- if ( $line =~ m|</pre>|i );
1897            $options->{in_noautolink}++
1898              if ( $line =~ m|^\s*<noautolink\b[^>]*>\s*$|i );
1899            $options->{in_noautolink}--
1900              if ( $line =~ m|^\s*</noautolink>\s*|i );
1901        }
1902        unless ( $options->{in_pre} > 0 && !$options->{pre}
1903            || $options->{in_verbatim} > 0   && !$options->{verbatim}
1904            || $options->{in_literal} > 0    && !$options->{literal}
1905            || $options->{in_noautolink} > 0 && !$options->{noautolink} )
1906        {
1907            $line = &$fn( $line, $options );
1908        }
1909        $newText .= $line;
1910    }
1911    return $newText;
1912}
1913
1914=begin TML
1915
1916---++ StaticMethod getReferenceRE($web, $topic, %options) -> $re
1917
1918   * $web, $topic - specify the topic being referred to, or web if $topic is
1919     undef.
1920   * %options - the following options are available
1921      * =interweb= - if true, then fully web-qualified references are required.
1922      * =grep= - if true, generate a GNU-grep compatible RE instead of the
1923        default Perl RE.
1924      * =nosot= - If true, do not generate "Spaced out text" match
1925      * =template= - If true, match for template setting in Set/Local statement
1926      * =in_noautolink= - Only match explicit (squabbed) WikiWords.   Used in <noautolink> blocks
1927      * =inMeta= - Re should match exact string. No delimiters needed.
1928      * =url= - if set, generates an expression that will match a Foswiki
1929        URL that points to the web/topic, instead of the default which
1930        matches topic links in plain text.
1931Generate a regular expression that can be used to match references to the
1932specified web/topic. Note that the resultant RE will only match fully
1933qualified (i.e. with web specifier) topic names and topic names that
1934are wikiwords in text. Works for spaced-out wikiwords for topic names.
1935
1936The RE returned is designed to be used with =s///=
1937
1938=cut
1939
1940sub getReferenceRE {
1941    my ( $web, $topic, %options ) = @_;
1942
1943    my $matchWeb = $web;
1944
1945    # Convert . and / to [./] (subweb separators) and quote
1946    # special characters
1947    $matchWeb =~ s#[./]#$REMARKER#g;
1948    $matchWeb = quotemeta($matchWeb);
1949
1950# SMELL: Item10176 -  Adding doublequote as a WikiWord delimiter.   This causes non-linking quoted
1951# WikiWords in tml to be incorrectly renamed.   But does handle quoted topic names inside macro parameters.
1952# But this doesn't really fully fix the issue - $quotWikiWord for example.
1953    my $reSTARTWW = qr/^|(?<=[\s"\*=_\(])/m;
1954    my $reENDWW   = qr/$|(?=[\s"\*#=_,.;:!?)])/m;
1955
1956    # $REMARKER is escaped by quotemeta so we need to match the escape
1957    $matchWeb =~ s#\\$REMARKER#[./]#go;
1958
1959    # Item1468/5791 - Quote special characters
1960    $topic = quotemeta($topic) if defined $topic;
1961
1962    # Note use of \b to match the empty string at the
1963    # edges of a word.
1964    my ( $bow, $eow, $forward, $back ) = ( '\b_?', '_?\b', '?=', '?<=' );
1965    if ( $options{grep} ) {
1966        $bow     = '\b_?';
1967        $eow     = '_?\b';
1968        $forward = '';
1969        $back    = '';
1970    }
1971    my $squabo = "($back\\[\\[)";
1972    my $squabc = "($forward(?:#.*?)?\\][][])";
1973
1974    my $re = '';
1975
1976    if ( $options{url} ) {
1977
1978        # URL fragment. Assume / separator (while . is legal, it's
1979        # undocumented and is not common usage)
1980        $re = "/$web/";
1981        $re .= $topic . $eow if $topic;
1982    }
1983    else {
1984        if ( defined($topic) ) {
1985
1986            my $sot;
1987            unless ( $options{nosot} ) {
1988
1989                # Work out spaced-out version (allows lc first chars on words)
1990                $sot = Foswiki::spaceOutWikiWord( $topic, ' *' );
1991                if ( $sot ne $topic ) {
1992                    $sot =~ s/\b([a-zA-Z])/'['.uc($1).lc($1).']'/ge;
1993                }
1994                else {
1995                    $sot = undef;
1996                }
1997            }
1998
1999            if ( $options{interweb} ) {
2000
2001                # Require web specifier
2002                if ( $options{grep} ) {
2003                    $re = "$bow$matchWeb\\.$topic$eow";
2004                }
2005                elsif ( $options{template} ) {
2006
2007# $1 is used in replace.  Can't use lookbehind because of variable length restriction
2008                    $re = '('
2009                      . $Foswiki::regex{setRegex}
2010                      . '(?:VIEW|EDIT)_TEMPLATE\s*=\s*)('
2011                      . $matchWeb . '\\.'
2012                      . $topic . ')\s*$';
2013                }
2014                elsif ( $options{in_noautolink} ) {
2015                    $re = "$squabo$matchWeb\\.$topic$squabc";
2016                }
2017                else {
2018                    $re = "$reSTARTWW$matchWeb\\.$topic$reENDWW";
2019                }
2020
2021                # Matching of spaced out topic names.
2022                if ($sot) {
2023
2024                    # match spaced out in squabs only
2025                    $re .= "|$squabo$matchWeb\\.$sot$squabc";
2026                }
2027            }
2028            else {
2029
2030                # Optional web specifier - but *only* if the topic name
2031                # is a wikiword
2032                if ( $topic =~ /$Foswiki::regex{wikiWordRegex}/ ) {
2033
2034                    # Bit of jigger-pokery at the front to avoid matching
2035                    # subweb specifiers
2036                    if ( $options{grep} ) {
2037                        $re = "(($back\[^./])|^)$bow($matchWeb\\.)?$topic$eow";
2038                    }
2039                    elsif ( $options{template} ) {
2040
2041# $1 is used in replace.  Can't use lookbehind because of variable length restriction
2042                        $re = '('
2043                          . $Foswiki::regex{setRegex}
2044                          . '(?:VIEW|EDIT)_TEMPLATE\s*=\s*)'
2045                          . "($matchWeb\\.)?$topic" . '\s*$';
2046                    }
2047                    elsif ( $options{in_noautolink} ) {
2048                        $re = "$squabo($matchWeb\\.)?$topic$squabc";
2049                    }
2050                    else {
2051                        $re = "$reSTARTWW($matchWeb\\.)?$topic$reENDWW";
2052                    }
2053
2054                    if ($sot) {
2055
2056                        # match spaced out in squabs only
2057                        $re .= "|$squabo($matchWeb\\.)?$sot$squabc";
2058                    }
2059                }
2060                else {
2061                    if ( $options{inMeta} ) {
2062                        $re = "^($matchWeb\\.)?$topic\$"
2063                          ;  # Updating a META item,  Exact match, no delimiters
2064                    }
2065                    else {
2066
2067                        # Non-wikiword; require web specifier or squabs
2068                        $re = "$squabo$topic$squabc";    # Squabbed topic
2069                        $re .= "|\"($matchWeb\\.)?$topic\""
2070                          ;    # Quoted string in Meta and Macros
2071                        $re .= "|(($back\[^./])|^)$bow$matchWeb\\.$topic$eow"
2072                          unless ( $options{in_noautolink} )
2073                          ;    # Web qualified topic outside of autolink blocks.
2074                    }
2075                }
2076            }
2077        }
2078        else {
2079
2080            # Searching for a web
2081            # SMELL:  Does this web search also need to allow for quoted
2082            # "Web.Topic" strings found in macros and META usage?
2083
2084            if ( $options{interweb} ) {
2085
2086                if ( $options{in_noautolink} ) {
2087
2088                    # web name used to refer to a topic
2089                    $re =
2090                        $squabo
2091                      . $matchWeb
2092                      . "(\.[$Foswiki::regex{mixedAlphaNum}]+)"
2093                      . $squabc;
2094                }
2095                else {
2096                    $re =
2097                        $bow
2098                      . $matchWeb
2099                      . "(\.[$Foswiki::regex{mixedAlphaNum}]+)"
2100                      . $eow;
2101                }
2102            }
2103            else {
2104
2105                # most general search for a reference to a topic or subweb
2106                # note that Foswiki::UI::Rename::_replaceWebReferences()
2107                # uses $1 from this regex
2108                if ( $options{in_noautolink} ) {
2109                    $re =
2110                        $squabo
2111                      . $matchWeb
2112                      . "(([\/\.][$Foswiki::regex{upperAlpha}]"
2113                      . "[$Foswiki::regex{mixedAlphaNum}_]*)+"
2114                      . "\.[$Foswiki::regex{mixedAlphaNum}]*)"
2115                      . $squabc;
2116                }
2117                else {
2118                    $re =
2119                        $bow
2120                      . $matchWeb
2121                      . "(([\/\.][$Foswiki::regex{upperAlpha}]"
2122                      . "[$Foswiki::regex{mixedAlphaNum}_]*)+"
2123                      . "\.[$Foswiki::regex{mixedAlphaNum}]*)"
2124                      . $eow;
2125                }
2126            }
2127        }
2128    }
2129
2130#my $optsx = '';
2131#$optsx .= "NOSOT=$options{nosot} " if ($options{nosot});
2132#$optsx .= "GREP=$options{grep} " if ($options{grep});
2133#$optsx .= "URL=$options{url} " if ($options{url});
2134#$optsx .= "INNOAUTOLINK=$options{in_noautolink} " if ($options{in_noautolink});
2135#$optsx .= "INTERWEB=$options{interweb} " if ($options{interweb});
2136#print STDERR "ReferenceRE returns $re $optsx  \n";
2137    return $re;
2138}
2139
2140=begin TML
2141
2142---++ StaticMethod breakName( $text, $args) -> $text
2143
2144   * =$text= - text to "break"
2145   * =$args= - string of format (\d+)([,\s*]\.\.\.)?)
2146Hyphenates $text every $1 characters, or if $2 is "..." then shortens to
2147$1 characters and appends "..." (making the final string $1+3 characters
2148long)
2149
2150_Moved from Search.pm because it was obviously unhappy there,
2151as it is a rendering function_
2152
2153=cut
2154
2155sub breakName {
2156    my ( $text, $args ) = @_;
2157
2158    my @params = split( /[\,\s]+/, $args, 2 );
2159    if (@params) {
2160        my $len = $params[0] || 1;
2161        $len = 1 if ( $len < 1 );
2162        my $sep = '- ';
2163        $sep = $params[1] if ( @params > 1 );
2164        if ( $sep =~ /^\.\.\./i ) {
2165
2166            # make name shorter like 'ThisIsALongTop...'
2167            $text =~ s/(.{$len})(.+)/$1.../s;
2168
2169        }
2170        else {
2171
2172            # split and hyphenate the topic like 'ThisIsALo- ngTopic'
2173            $text =~ s/(.{$len})/$1$sep/gs;
2174            $text =~ s/$sep$//;
2175        }
2176    }
2177    return $text;
2178}
2179
2180=begin TML
2181
2182---++ StaticMethod protectFormFieldValue($value, $attrs) -> $html
2183
2184Given the value of a form field, and a set of attributes that control how
2185to display that value, protect the value from further processing.
2186
2187The protected value is determined from the value of the field after:
2188   * newlines are replaced with &lt;br> or the value of $attrs->{newline}
2189   * processing through breakName if $attrs->{break} is defined
2190   * escaping of $vars if $attrs->{protectdollar} is defined
2191   * | is replaced with &amp;#124; or the value of $attrs->{bar} if defined
2192
2193=cut
2194
2195sub protectFormFieldValue {
2196    my ( $value, $attrs ) = @_;
2197
2198    $value = '' unless defined($value);
2199
2200    if ( $attrs && $attrs->{break} ) {
2201        $value =~ s/^\s*(.*?)\s*$/$1/g;
2202        $value = breakName( $value, $attrs->{break} );
2203    }
2204
2205    # Item3489, Item2837. Prevent $vars in formfields from
2206    # being expanded in formatted searches.
2207    if ( $attrs && $attrs->{protectdollar} ) {
2208        $value =~ s/\$(n|nop|quot|percnt|dollar)/\$<nop>$1/g;
2209    }
2210
2211    # change newlines
2212    my $newline = '<br />';
2213    if ( $attrs && defined $attrs->{newline} ) {
2214        $newline = $attrs->{newline};
2215        $newline =~ s/\$n/\n/gs;
2216    }
2217    $value =~ s/\r?\n/$newline/gs;
2218
2219    # change vbars
2220    my $bar = '&#124;';
2221    if ( $attrs && $attrs->{bar} ) {
2222        $bar = $attrs->{bar};
2223    }
2224    $value =~ s/\|/$bar/g;
2225
2226    return $value;
2227}
2228
2229=begin TML
2230
2231---++ ObjectMethod getAnchors( $topicObject ) -> $set
2232
2233Get the anchor name set generated for the given topic. This is so that the
2234same anchor names can be generated for each time the same topic is
2235%INCLUDEd (the same anchor target will be generated for each time the
2236topic is included.
2237
2238Note that anchor names generated this way are unique since the last time the
2239anchor set is cleared, which happens (1) whenever a new session is started
2240and (2) whenever a new %TOC macro is rendered (see Foswiki/Macros/TOC).
2241
2242Returns an object of type Foswiki::Render::Anchors.
2243
2244=cut
2245
2246sub getAnchorNames {
2247    my ( $this, $topicObject ) = @_;
2248    my $id = $topicObject->getPath();
2249    my $a  = $this->{_anchorNames}{$id};
2250    unless ($a) {
2251        $a = new Foswiki::Render::Anchors();
2252        $this->{_anchorNames}{$id} = $a;
2253    }
2254    return $a;
2255}
2256
2257=begin TML
2258
2259---++ ObjectMethod renderIconImage($url [, $alt]) -> $html
2260Generate the output for representing an 16x16 icon image. The source of
2261the image is taken from =$url=. The optional =$alt= specifies an alt string.
2262
2263re-written using TMPL:DEF{icon:image} in Foswiki.tmpl
2264%TMPL:DEF{"icon:image"}%<span class='foswikiIcon'><img src="%URL%" width="%WIDTH%" height="%HEIGHT%" alt="%ALT%" /></span>%TMPL:END%
2265see System.SkinTemplates:base.css for the default of .foswikiIcon img
2266
2267TODO: Sven's not sure this code belongs here - its only use appears to be the ICON macro
2268
2269=cut
2270
2271sub renderIconImage {
2272    my ( $this, $url, $alt ) = @_;
2273
2274    if ( !defined($alt) ) {
2275
2276        #yes, you really should have a useful alt text.
2277        $alt = $url;
2278    }
2279
2280    my $html = $this->{session}->templates->expandTemplate("icon:image");
2281    $html =~ s/%URL%/$url/ge;
2282    $html =~ s/%WIDTH%/16/g;
2283    $html =~ s/%HEIGHT%/16/g;
2284    $html =~ s/%ALT%/$alt/ge;
2285
2286    return $html;
2287}
2288
22891;
2290__END__
2291Foswiki - The Free and Open Source Wiki, http://foswiki.org/
2292
2293Copyright (C) 2008-2012 Foswiki Contributors. Foswiki Contributors
2294are listed in the AUTHORS file in the root of this distribution.
2295NOTE: Please extend that file, not this notice.
2296
2297Additional copyrights apply to some or all of the code in this
2298file as follows:
2299
2300Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
2301and TWiki Contributors. All Rights Reserved.
2302
2303This program is free software; you can redistribute it and/or
2304modify it under the terms of the GNU General Public License
2305as published by the Free Software Foundation; either version 2
2306of the License, or (at your option) any later version. For
2307more details read LICENSE in the root of this distribution.
2308
2309This program is distributed in the hope that it will be useful,
2310but WITHOUT ANY WARRANTY; without even the implied warranty of
2311MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
2312
2313As per the GPL, removal of this notice is prohibited.
Note: See TracBrowser for help on using the repository browser.