source: trunk/WysiwygPlugin/lib/Foswiki/Plugins/WysiwygPlugin/HTML2TML/Node.pm @ 16738

Revision 16735, 57.6 KB checked in by CrawfordCurrie, 3 days ago (diff)

Item12444: HTML::Entities::_decode_entities assumes that the target string is unicode, and will expand all entities. However some entities are not representable by a single character in the default charset, so we have to reduce the set of converted entities to just those that can be converted. Also, the resulting string has the entities converted as unicode characters, which have to be converted to the site charset before further steps. Note that the translator is forced to work in the site charset because it has to use Foswiki::Func, which assumes it. If it could work in unicode, this would all be a lot simpler!
  • Property svn:keywords set to Revision Date
Line 
1# See bottom of file for license and copyright information
2
3# The generator works by expanding an HTML parse tree to "decorated"
4# text, where the decorators are non-printable characters. These characters
5# act to express format requirements - for example, the need to have a
6# newline before some text, or the need for a space. Whitespace is then
7# collapsed down to the minimum that satisfies the format requirements.
8
9=pod
10
11---+ package Foswiki::Plugins::WysiwygPlugin::HTML2TML::Node;
12
13Object for storing a parsed HTML tag, and processing it
14to generate TML from the parse tree.
15
16See also Foswiki::Plugins::WysiwygPlugin::HTML2TML::Leaf
17
18=cut
19
20package Foswiki::Plugins::WysiwygPlugin::HTML2TML::Node;
21use Foswiki::Plugins::WysiwygPlugin::HTML2TML::Base;
22our @ISA = qw( Foswiki::Plugins::WysiwygPlugin::HTML2TML::Base );
23
24use strict;
25use warnings;
26
27use Foswiki::Func;    # needed for regular expressions
28use Assert;
29
30use vars qw( $reww );
31
32use Foswiki::Plugins::WysiwygPlugin::Constants;
33use Foswiki::Plugins::WysiwygPlugin::HTML2TML::WC;
34use HTML::Entities ();
35
36my %jqueryChiliClass = map { $_ => 1 }
37  qw( cplusplus csharp css bash delphi html java js
38  lotusscript php-f php sql tml );
39
40my %tml2htmlClass = map { $_ => 1 }
41  qw( WYSIWYG_PROTECTED WYSIWYG_STICKY TMLverbatim WYSIWYG_LINK
42  TMLhtml WYSIWYG_HIDDENWHITESPACE );
43
44=pod
45
46---++ ObjectMethod new( $context, $tag, \%attrs )
47
48Construct a new HTML tag node using the given tag name
49and attribute hash.
50
51=cut
52
53sub new {
54    my ( $class, $context, $tag, $attrs ) = @_;
55
56    my $this = {};
57
58    $this->{context}  = $context;
59    $this->{tag}      = $tag;
60    $this->{nodeType} = 2;
61    $this->{attrs}    = {};
62    if ($attrs) {
63        foreach my $attr ( keys %$attrs ) {
64            $this->{attrs}->{ lc($attr) } = $attrs->{$attr};
65        }
66    }
67    $this->{head} = $this->{tail} = undef;
68
69    return bless( $this, $class );
70}
71
72# debug
73sub stringify {
74    my ( $this, $shallow ) = @_;
75    my $r = '';
76    if ( $this->{tag} ) {
77        $r .= '<' . $this->{tag};
78        foreach my $attr ( sort keys %{ $this->{attrs} } ) {
79            $r .= " " . $attr . "='" . $this->{attrs}->{$attr} . "'";
80        }
81        $r .= ' /' if $WC::SELFCLOSING{ lc( $this->{tag} ) };
82        $r .= '>';
83    }
84    if ($shallow) {
85        $r .= '...';
86    }
87    else {
88        my $kid = $this->{head};
89        while ($kid) {
90            $r .= $kid->stringify();
91            $kid = $kid->{next};
92        }
93    }
94    if ( $this->{tag} and not $WC::SELFCLOSING{ lc( $this->{tag} ) } ) {
95        $r .= '</' . $this->{tag} . '>';
96    }
97    return $r;
98}
99
100=pod
101
102---++ ObjectMethod addChild( $node )
103
104Add a child node to the ordered list of children of this node
105
106=cut
107
108sub addChild {
109    my ( $this, $node ) = @_;
110
111    ASSERT( $node != $this ) if DEBUG;
112
113    $node->{next}   = undef;
114    $node->{parent} = $this;
115    my $kid = $this->{tail};
116    if ($kid) {
117        $kid->{next}  = $node;
118        $node->{prev} = $kid;
119    }
120    else {
121        $node->{prev} = undef;
122        $this->{head} = $node;
123    }
124    $this->{tail} = $node;
125}
126
127# top and tail a string
128sub _trim {
129    my $s = shift;
130
131    # Item5076: removed CHECKn from the following exprs, because loss of it
132    # breaks line-sensitive TML content inside flattened content.
133    $s =~ s/^[ \t\n$WC::CHECKw$WC::CHECKs]+/$WC::CHECKw/o;
134    $s =~ s/[ \t\n$WC::CHECKw]+$/$WC::CHECKw/o;
135    return $s;
136}
137
138# Both object method and static method
139sub hasClass {
140    my ( $this, $class ) = @_;
141    return 0 unless $this;
142    if (
143        UNIVERSAL::isa(
144            $this, 'Foswiki::Plugins::WysiwygPlugin::HTML2TML::Node'
145        )
146      )
147    {
148        return hasClass( $this->{attrs}, $class );
149    }
150    return 0 unless defined $this->{class};
151
152    return $this->{class} =~ /\b$class\b/ ? 1 : 0;
153}
154
155# Both object method and static method
156sub _removeClass {
157    my ( $this, $class ) = @_;
158    return 0 unless $this;
159    if (
160        UNIVERSAL::isa(
161            $this, 'Foswiki::Plugins::WysiwygPlugin::HTML2TML::Node'
162        )
163      )
164    {
165        return _removeClass( $this->{attrs}, $class );
166    }
167    return 0 unless hasClass( $this, $class );
168
169    $this->{class} =~ s/\b$class\b//;
170    $this->{class} =~ s/\s+/ /g;
171    $this->{class} =~ s/^\s+//;
172    $this->{class} =~ s/\s+$//;
173    if ( !$this->{class} ) {
174        delete $this->{class};
175    }
176    return 1;
177}
178
179# Both object method and static method
180sub _addClass {
181    my ( $this, $class ) = @_;
182    if (
183        UNIVERSAL::isa(
184            $this, 'Foswiki::Plugins::WysiwygPlugin::HTML2TML::Node'
185        )
186      )
187    {
188        _addClass( $this->{attrs}, $class );
189        return;
190    }
191    _removeClass( $this, $class );    # avoid duplication
192    if ( $this->{class} ) {
193        $this->{class} .= ' ' . $class;
194    }
195    else {
196        $this->{class} = $class;
197    }
198}
199
200# Move the content of $node into $this
201sub _eat {
202    my ( $this, $node ) = @_;
203    my $kid = $this->{tail};
204    if ($kid) {
205        $kid->{next} = $node->{head};
206        if ( $node->{head} ) {
207            $node->{head}->{prev} = $kid;
208        }
209    }
210    else {
211        $this->{head} = $node->{head};
212    }
213    $this->{tail} = $node->{tail};
214    $kid = $node->{head};
215    while ($kid) {
216        $kid->{parent} = $this;
217        $kid = $kid->{next};
218    }
219    $node->{head} = $node->{tail} = undef;
220}
221
222=pod
223
224---++ ObjectMethod rootGenerate($opts) -> $text
225
226Generates TML from this HTML node. The generation is done
227top down and bottom up, so that higher level nodes can make
228decisions on whether to allow TML conversion in lower nodes,
229and lower level nodes can constrain conversion in higher level
230nodes.
231
232$opts is a bitset. $WC::VERY_CLEAN will cause the generator
233to drop unrecognised HTML (e.g. divs and spans that don't
234generate TML)
235
236=cut
237
238sub rootGenerate {
239    my ( $this, $opts ) = @_;
240
241    #print STDERR "Raw       [", WC::debugEncode($this->stringify()), "]\n\n";
242    $this->cleanParseTree();
243
244    #print STDERR "Cleaned   [", WC::debugEncode($this->stringify()), "]\n\n";
245    # Perform some transformations on the parse tree
246    $this->_collapse();
247
248    #print STDERR "Collapsed [", WC::debugEncode($this->stringify()), "]\n\n";
249
250    my ( $f, $text ) = $this->generate($opts);
251
252    # Debug support
253    #print STDERR "Converted [",WC::debugEncode($text),"]\n";
254
255    # Move leading \n out of protected region. Delicate hack fix required to
256    # maintain Foswiki variables at the start of lines.
257    $text =~ s/$WC::PON$WC::NBBR/$WC::CHECKn$WC::PON/g;
258
259    # isolate whitespace checks and convert to $NBSP
260    $text =~ s/$WC::CHECKw$WC::CHECKw+/$WC::CHECKw/go;
261    $text =~
262s/([$WC::CHECKn$WC::CHECKs$WC::NBSP $WC::TAB$WC::NBBR]($WC::PON|$WC::POFF)?)$WC::CHECKw/$1/go;
263    $text =~
264s/$WC::CHECKw(($WC::PON|$WC::POFF)?[$WC::CHECKn$WC::CHECKs$WC::NBSP $WC::NBBR])/$1/go;
265    $text =~ s/^($WC::CHECKw)+//gos;
266    $text =~ s/($WC::CHECKw)+$//gos;
267    $text =~ s/($WC::CHECKw)+/$WC::NBSP/go;
268
269    # isolate $CHECKs and convert to $NBSP
270    $text =~ s/$WC::CHECKs$WC::CHECKs+/$WC::CHECKs/go;
271    $text =~ s/([ $WC::NBSP$WC::TAB])$WC::CHECKs/$1/go;
272    $text =~ s/$WC::CHECKs( |$WC::NBSP)/$1/go;
273    $text =~ s/($WC::CHECKs)+/$WC::NBSP/go;
274
275    # SMELL:   Removed per Item11859.   This was done because TMCE used to
276    # insert a <br /> before <p>  ...   It doesn't do that in 3.4.9
277    #$text =~ s/<br( \/)?>$WC::NBBR/$WC::NBBR/g;    # Remove BR before P
278
279    #die "Converted ",WC::debugEncode($text),"\n";
280    #print STDERR "Conv2     [",WC::debugEncode($text),"]\n";
281
282    my @regions = split( /([$WC::PON$WC::POFF])/o, $text );
283    my $protect = 0;
284    $text = '';
285    foreach my $tml (@regions) {
286        if ( $tml eq $WC::PON ) {
287            $protect++;
288            next;
289        }
290        elsif ( $tml eq $WC::POFF ) {
291            $protect--;
292            next;
293        }
294
295        # isolate $NBBR and convert to \n.
296        unless ($protect) {
297
298            $tml =~ s/\n$WC::NBBR/$WC::NBBR$WC::NBBR/go;
299            $tml =~ s/$WC::NBBR\n/$WC::NBBR$WC::NBBR/go;
300            $tml =~ s/$WC::NBBR( |$WC::NBSP)+$WC::NBBR/$WC::NBBR$WC::NBBR/go;
301            $tml =~ s/ +$WC::NBBR/$WC::NBBR/go;
302            $tml =~ s/$WC::NBBR +/$WC::NBBR/go;
303            $tml =~ s/$WC::NBBR$WC::NBBR+/$WC::NBBR$WC::NBBR/go;
304
305            # Now convert adjacent NBBRs to recreate empty lines
306            # 1 NBBR  -> 1 newline
307            # 2 NBBRs -> <p /> - 1 blank line - 2 newlines
308            # 3 NBBRs -> 3 newlines
309            # 4 NBBRs -> <p /><p /> - 3 newlines
310            # 5 NBBRs -> 4 newlines
311            # 6 NBBRs -> <p /><p /><p /> - 3 blank lines - 4 newlines
312            # 7 NBBRs -> 5 newlines
313            # 8 NBBRs -> <p /><p /><p /><p /> - 4 blank lines - 5 newlines
314            $tml =~ s.($WC::NBBR$WC::NBBR$WC::NBBR$WC::NBBR+).
315              "\n" x ((length($1) + 1) / 2 + 1)
316                .geo;
317
318        }
319
320        # isolate $CHECKn and convert to $NBBR
321        $tml =~ s/$WC::CHECKn([$WC::NBSP $WC::TAB])*$WC::CHECKn/$WC::CHECKn/go;
322        $tml =~ s/$WC::CHECKn$WC::CHECKn+/$WC::CHECKn/go;
323        $tml =~ s/(?<=$WC::NBBR)$WC::CHECKn//gom;
324        $tml =~ s/$WC::CHECKn(?=$WC::NBBR)//gom;
325        $tml =~ s/$WC::CHECKn+/$WC::NBBR/gos;
326
327        $tml =~ s/$WC::NBBR/\n/gos;
328
329        # Convert tabs to NBSP
330        $tml =~ s/$WC::TAB/$WC::NBSP$WC::NBSP$WC::NBSP/go;
331
332        # isolate $NBSP and convert to space
333        unless ($protect) {
334            $tml =~ s/ +$WC::NBSP/$WC::NBSP/go;
335            $tml =~ s/$WC::NBSP +/$WC::NBSP/go;
336        }
337        $tml =~ s/$WC::NBSP/ /go;
338
339        $tml =~ s/$WC::CHECK1$WC::CHECK1+/$WC::CHECK1/go;
340        $tml =~ s/$WC::CHECK2$WC::CHECK2+/$WC::CHECK2/go;
341        $tml =~ s/$WC::CHECK2$WC::CHECK1/$WC::CHECK2/go;
342
343        $tml =~ s/(^|[\s\(])$WC::CHECK1/$1/gso;
344        $tml =~ s/$WC::CHECK2($|[\s\,\.\;\:\!\?\)\*])/$1/gso;
345
346        $tml =~ s/$WC::CHECK1(\s|$)/$1/gso;
347        $tml =~ s/(^|\s)$WC::CHECK2/$1/gso;
348
349        $tml =~ s/$WC::CHECK1/ /go;
350        $tml =~ s/$WC::CHECK2/ /go;
351
352        # SMELL:   Removed per Item11859.   This was done because TMCE used to
353        # insert a <br /> before <p>  ...   It doesn't do that in 3.4.9
354        # Item5127: Remove BR just before EOLs
355        #unless ($protect) {
356        #    $tml =~ s/<br( \/)?>\n/\n/g;
357        #}
358
359        #print STDERR " -> [",WC::debugEncode($tml),"]\n";
360        $text .= $tml;
361    }
362
363    # Collapse adjacent tags
364    # SMELL:  Can't collapse verbatim based upon simple close/open compare
365    # because the previous opening verbatim tag might have different
366    # class from the next one.
367    foreach my $tag (qw(noautolink literal)) {
368        $text =~ s#</$tag>(\s*)<$tag>#$1#gs;
369    }
370
371    # Top and tail, and terminate with a single newline
372    $text =~ s/^\n*//s;
373    $text =~ s/\s*$/\n/s;
374
375    #print STDERR "TML       [",WC::debugEncode($text),"]\n";
376
377    return $text;
378}
379
380sub _compareClass {
381    my ( $node1, $node2 ) = @_;
382
383    my $n1Class = $node1->{attrs}->{class} || '';
384    my $n1Sort = join( ' ', sort( split( / /, $n1Class ) ) );
385    my $n2Class = $node2->{attrs}->{class} || '';
386    my $n2Sort = join( ' ', sort( split( / /, $n2Class ) ) );
387
388    return ( $n1Sort eq $n2Sort );
389}
390
391# collapse adjacent nodes together, if they share the same class
392sub _collapseOneClass {
393    my $node  = shift;
394    my $class = shift;
395    if ( defined( $node->{tag} ) && $node->hasClass($class) ) {
396        my $next = $node->{next};
397        my @edible;
398        my $collapsible;
399        while (
400            $next
401            && (
402                ( !$next->{tag} && $next->{text} =~ /^\s*$/ )
403                || (   $node->{tag} eq $next->{tag}
404                    && $next->hasClass($class)
405                    && ( _compareClass( $node, $next ) ) )
406            )
407          )
408        {
409            push( @edible, $next );
410
411            $collapsible ||= $next->hasClass($class);
412            $next = $next->{next};
413        }
414        if ($collapsible) {
415            foreach my $meal (@edible) {
416                $meal->_remove();
417                if ( $meal->{tag} ) {
418                    require Foswiki::Plugins::WysiwygPlugin::HTML2TML::Leaf;
419                    $node->addChild(
420                        new Foswiki::Plugins::WysiwygPlugin::HTML2TML::Leaf(
421                            $WC::NBBR)
422                    );
423                    $node->_eat($meal);
424                }
425            }
426        }
427    }
428}
429
430# Collapse adjacent VERBATIM nodes together
431# Collapse adjacent STICKY nodes together
432# Collapse a <p> that contains only a protected span into a protected P
433# Collapse em in em
434# Collapse adjacent text nodes
435sub _collapse {
436    my $this = shift;
437
438    my @jobs = ($this);
439    while ( scalar(@jobs) ) {
440        my $node = shift(@jobs);
441
442     # SMELL: Not sure if we really still have to collapse consecutive verbatim.
443     # Extra whitespace to separate verbatim blocks is removed, and they will
444     # still eventually be merged.
445        _collapseOneClass( $node, 'TMLverbatim' );
446        _collapseOneClass( $node, 'WYSIWYG_STICKY' );
447        if (   $node->{tag} eq 'p'
448            && $node->{head}
449            && $node->{head} == $node->{tail} )
450        {
451            my $kid = $node->{head};
452            if ( uc( $kid->{tag} ) eq 'SPAN'
453                && $kid->hasClass('WYSIWYG_PROTECTED') )
454            {
455                $kid->_remove();
456                $node->_eat($kid);
457                $node->_addClass('WYSIWYG_PROTECTED');
458            }
459        }
460
461 # Pressing return in a "foswikiDeleteMe" paragraph will cause the paragraph
462 # to be split into a 2nd paragraph with the same class.   We only want to clean
463 # the first one in the blockquote, and preserve the rest without the class.
464        if (   $node->{tag} eq 'p'
465            && $node->hasClass('foswikiDeleteMe')
466            && $node->{parent}
467            && $node->{parent}->{tag} eq 'blockquote' )
468        {
469            my $next = $node->{next};
470            while ($next) {
471                if (   $next
472                    && $next->{tag} eq 'p'
473                    && $next->hasClass('foswikiDeleteMe') )
474                {
475                    $next->_removeClass('foswikiDeleteMe');
476                }
477                $next = $next->{next};
478            }
479            $node->_inline();
480        }
481
482        # If this is an emphasis (b, i, code, tt, strong) then
483        # flatten out any child nodes that express the same emphasis.
484        # This has to be done because Foswiki emphases are single level.
485        if ( $WC::EMPHTAG{ $node->{tag} } ) {
486            my $kid = $node->{head};
487            while ($kid) {
488                if (   $WC::EMPHTAG{ $kid->{tag} }
489                    && $WC::EMPHTAG{ $kid->{tag} } eq
490                    $WC::EMPHTAG{ $node->{tag} } )
491                {
492                    $kid = $kid->_inline();
493                }
494                else {
495                    $kid = $kid->{next};
496                }
497            }
498        }
499        $node->_combineLeaves();
500
501        my $kid = $node->{head};
502        while ($kid) {
503            push( @jobs, $kid );
504            $kid = $kid->{next};
505        }
506    }
507}
508
509# If this node has the specified class, insert a new "span" node with that
510# class between this node and all of this node's children.
511sub _moveClassToSpan {
512    my $this  = shift;
513    my $class = shift;
514
515    if (    $this->{tag}
516        and lc( $this->{tag} ) ne 'span'
517        and $this->_removeClass($class) )
518    {
519
520        my %new_attrs = ( class => $class );
521        $new_attrs{style} = $this->{attrs}->{style}
522          if exists $this->{attrs}->{style};
523        my $newspan =
524          new Foswiki::Plugins::WysiwygPlugin::HTML2TML::Node( $this->{context},
525            'span', \%new_attrs );
526        my $kid = $this->{head};
527        while ($kid) {
528            $newspan->addChild($kid);
529            $kid = $kid->{next};
530        }
531        $this->{head} = $this->{tail} = $newspan;
532    }
533}
534
535# the actual generate function. rootGenerate is only applied to the root node.
536sub generate {
537    my ( $this, $options ) = @_;
538    my $fn;
539    my $flags;
540    my $text;
541
542    if ( $this->_isProtectedByAttrs() ) {
543        return $this->_defaultTag($options);
544    }
545
546    if ( $this->hasClass('TMLhtml') ) {
547        return $this->_defaultTag( $options & ~$WC::VERY_CLEAN );
548    }
549
550    my $tag = $this->{tag};
551
552    if ( $this->hasClass('WYSIWYG_LITERAL') ) {
553        if ( $tag eq 'div' || $tag eq 'p' || $tag eq 'span' ) {
554            $text = '';
555            my $kid = $this->{head};
556            while ($kid) {
557                $text .= $kid->stringify();
558                $kid = $kid->{next};
559            }
560        }
561        else {
562            $this->_removeClass('WYSIWYG_LITERAL');
563            $text = $this->stringify();
564        }
565        return ( 0, '<literal>' . $text . '</literal>' );
566    }
567
568    if ( $options & $WC::NO_HTML ) {
569
570        # NO_HTML implies NO_TML
571        my $brats = $this->_flatten($options);
572        return ( 0, $brats );
573    }
574
575    if ( $options & $WC::NO_TML ) {
576        return ( 0, $this->stringify() );
577    }
578
579    # make the names of the function versions
580    $tag =~ s/!//;    # DOCTYPE
581    my $tmlFn = '_handle' . uc($tag);
582
583    $this->_moveClassToSpan('WYSIWYG_TT');
584    $this->_moveClassToSpan('WYSIWYG_COLOR')
585      if lc( $this->{tag} ) ne 'font';
586
587    # See if we have a TML translation function for this tag
588    # the translation functions will work out the rendering
589    # of their own children.
590    if ( $this->{tag} && defined(&$tmlFn) ) {
591        no strict 'refs';
592        ( $flags, $text ) = &$tmlFn( $this, $options );
593        use strict 'refs';
594
595        # if the function returns undef, drop through
596        return ( $flags, $text ) if defined $text;
597    }
598
599    unless ( $this->{tag} ) {
600
601        # No translation, so we need the text of the children
602        ( $flags, $text ) = $this->_flatten($options);
603
604        # just return the text if there is no tag name
605        return ( $flags, $text );
606    }
607
608    return $this->_defaultTag($options);
609}
610
611# Return the children flattened out subject to the options
612sub _flatten {
613    my ( $this, $options ) = @_;
614    my $text  = '';
615    my $flags = 0;
616
617    my $protected =
618         ( $options & $WC::PROTECTED )
619      || $this->hasClass('WYSIWYG_PROTECTED')
620      || $this->hasClass('WYSIWYG_STICKY')
621      || 0;
622
623    if ($protected) {
624
625        # Expand brs, which are used in the protected encoding in place of
626        # newlines, and protect whitespace
627        $options |= $WC::BR2NL | $WC::KEEP_WS;
628    }
629
630    my $kid = $this->{head};
631    while ($kid) {
632        my ( $f, $t ) = $kid->generate($options);
633        if (   !( $options & $WC::KEEP_WS )
634            && $text
635            && $text =~ /\w$/
636            && $t =~ /^\w/ )
637        {
638
639            # if the last child ends in a \w and this child
640            # starts in a \w, we need to insert a space
641            $text .= ' ';
642        }
643        $text .= $t;
644        $flags |= $f;
645        $kid = $kid->{next};
646    }
647    if ($protected) {
648        $text =~ s/[$WC::PON$WC::POFF]//g;
649
650        unless ( $options & $WC::KEEP_ENTITIES ) {
651
652            # This will decode only those entities that
653            # have a representation in the site charset.
654            WC::decodeRepresentableEntities($text);
655
656            # &nbsp; decodes to \240, which we want to make a space.
657            $text =~ s/\240/$WC::NBSP/g;
658        }
659        $text =~ s/ /$WC::NBSP/g;
660        $text =~ s/\n/$WC::NBBR/g;
661        $text = $WC::PON . $text . $WC::POFF;
662    }
663
664    $text = _trim($text) unless ( $options & $WC::KEEP_WS );
665
666    return ( $flags, $text );
667}
668
669# $cutClasses is an RE matching class names to cut
670sub _htmlParams {
671    my ( $attrs, $options ) = @_;
672    my @params;
673
674    # Sort the attributes when converting back to TML
675    # so that the conversion is deterministic
676  ATTR: for my $k ( sort keys %$attrs ) {
677        next ATTR unless $k;
678        my $v = $attrs->{$k};
679        if ( $k eq 'class' ) {
680            my @classes;
681            $v =~ s/^\s*(.*?)\s*$/$1/;
682          CLASS: for my $class ( split /\s+/, $v ) {
683
684                next CLASS unless $class =~ /\S/;
685
686                next CLASS if $tml2htmlClass{$class};
687
688                # if cleaning aggressively, remove class attributes
689                # except for the JQuery "Chili" classes
690                next CLASS
691                  if (  $options & $WC::VERY_CLEAN
692                    and not $jqueryChiliClass{$class}
693                    and not $class =~ /^foswiki/ );
694
695                push @classes, $class;
696            }
697            next ATTR unless @classes;
698
699            $v = join( ' ', @classes );
700        }
701        my $q = $v =~ /"/ ? "'" : '"';
702        push( @params, $k . '=' . $q . $v . $q );
703    }
704    my $p = join( ' ', @params );
705    return '' unless $p;
706    return ' ' . $p;
707}
708
709# generate the default representation of an HTML tag
710sub _defaultTag {
711    my ( $this,  $options ) = @_;
712    my ( $flags, $text )    = $this->_flatten($options);
713    my $tag = $this->{tag};
714    my $p = _htmlParams( $this->{attrs}, $options );
715
716    if ( $text =~ /^\s*$/ && $WC::SELFCLOSING{$tag} ) {
717        return ( $flags, '<' . $tag . $p . ' />' );
718    }
719    else {
720        return ( $flags, '<' . $tag . $p . '>' . $text . '</' . $tag . '>' );
721    }
722}
723
724# Check to see if the HTML tag is protected by the presence of
725# specific attributes that block conversion to TML. The conversion
726# table is defined in
727sub _isProtectedByAttrs {
728    my $this = shift;
729
730    require Foswiki::Plugins::WysiwygPlugin::Handlers;
731    foreach my $attr ( keys %{ $this->{attrs} } ) {
732        next unless length( $this->{attrs}->{$attr} );    # ignore nulls
733        return $attr
734          if Foswiki::Plugins::WysiwygPlugin::Handlers::protectedByAttr(
735            $this->{tag}, $attr );
736    }
737    return 0;
738}
739
740sub _convertIndent {
741    my ( $this, $options ) = @_;
742    my $indent = $WC::TAB;
743
744    my ( $f, $t ) = $this->_handleP($options);
745    return $t unless Foswiki::Func::getContext->{SUPPORTS_PARA_INDENT};
746
747    if ( $t =~ /^$WC::WS_NOTAB*($WC::TAB+):(.*)$/ ) {
748        return "$WC::CHECKn$1:$2";
749    }
750
751    # Zoom up through the tree and see how many layers of indent we have
752    my $p = $this;
753    while ( $p = $p->{parent} ) {
754        if ( $p->{tag} eq 'div' && $p->hasClass('foswikiIndent') ) {
755            $indent .= $WC::TAB;
756        }
757    }
758    $t =~ s/^$WC::WS*//s;
759    $t =~ s/$WC::WS*$//s;
760    $t = "$WC::CHECKn$indent: " . $t;
761    return $t;
762}
763
764# perform conversion on a list type
765sub _convertList {
766    my ( $this, $indent ) = @_;
767    my $basebullet;
768    my $isdl = ( $this->{tag} eq 'dl' );
769
770    if ($isdl) {
771        $basebullet = '';
772    }
773    elsif ( $this->{tag} eq 'ol' ) {
774        $basebullet = '1';
775    }
776    else {
777        $basebullet = '*';
778    }
779
780    my $f;
781    my $text      = '';
782    my $pendingDT = 0;
783    my $kid       = $this->{head};
784    while ($kid) {
785
786        # be tolerant of dl, ol and ul with no li
787        if ( $kid->{tag} =~ m/^[dou]l$/ ) {
788            $text .= $kid->_convertList( $indent . $WC::TAB );
789            $kid = $kid->{next};
790            next;
791        }
792        unless ( $kid->{tag} =~ m/^(dt|dd|li)$/ ) {
793            $kid = $kid->{next};
794            next;
795        }
796        if ( $isdl && ( $kid->{tag} eq 'dt' ) ) {
797
798            # DT, set the bullet type for subsequent DT
799            $basebullet = $kid->_flatten($WC::NO_BLOCK_TML);
800            $basebullet =~ s/[\s$WC::CHECKw$WC::CHECKs]+$//;
801            $basebullet .= ':';
802            $basebullet =~ s/$WC::CHECKn/ /g;
803            $basebullet =~ s/^\s+//;
804            $basebullet = '$ ' . $basebullet;
805            $pendingDT  = 1;                   # remember in case there is no DD
806            $kid        = $kid->{next};
807            next;
808        }
809        my $bullet = $basebullet;
810        if ( $basebullet eq '1' && $kid->{attrs}->{type} ) {
811            $bullet = $kid->{attrs}->{type} . '.';
812        }
813        my $spawn = '';
814        my $t;
815        my $grandkid = $kid->{head};
816        if ($grandkid) {
817
818            # IE generates spurious empty divs inside LIs. Detect and skip
819            # them.
820            if (   $grandkid->{tag}
821                && $grandkid->{tag} =~ /^div$/
822                && $grandkid == $kid->{tail}
823                && scalar( keys %{ $this->{attrs} } ) == 0 )
824            {
825                $grandkid = $grandkid->{head};
826            }
827            while ($grandkid) {
828                if ( $grandkid->{tag} && $grandkid->{tag} =~ /^[dou]l$/ ) {
829
830                    #$spawn = _trim( $spawn );
831                    $t = $grandkid->_convertList( $indent . $WC::TAB );
832                }
833                else {
834                    ( $f, $t ) = $grandkid->generate($WC::NO_BLOCK_TML);
835                    $t =~ s/$WC::CHECKn/ /g;
836
837                    # Item5257: If this is the last child of the LI, trim
838                    # trailing spaces. Otherwise spaces generated by the
839                    # editor before the </li> will be appended to the line.
840                    # It is safe to remove them, as TML never depends on
841                    # these spaces. If there are any intentional spaces at
842                    # the end of protected content, these will have been
843                    # converted to &nbsp; and protected that way.
844                    $t =~ s/\s+$// unless $grandkid->{next};
845                }
846                $spawn .= $t;
847                $grandkid = $grandkid->{next};
848            }
849        }
850
851        #$spawn = _trim($spawn);
852        $text .=
853          $WC::CHECKn . $indent . $bullet . $WC::CHECKs . $spawn . $WC::CHECKn;
854        $pendingDT  = 0;
855        $basebullet = '' if $isdl;
856        $kid        = $kid->{next};
857    }
858    if ($pendingDT) {
859
860        # DT with no corresponding DD
861        $text .= $WC::CHECKn . $indent . $basebullet . $WC::CHECKn;
862    }
863    return $text;
864}
865
866sub _isConvertableIndent {
867    my ( $this, $options ) = @_;
868
869    return 0 unless Foswiki::Func::getContext->{SUPPORTS_PARA_INDENT};
870
871    return 0 if ( $this->_isProtectedByAttrs() );
872
873    return $this->{tag} eq 'div' && $this->hasClass('foswikiIndent');
874}
875
876# probe down into a list type to determine if it
877# can be converted to TML.
878sub _isConvertableList {
879    my ( $this, $options ) = @_;
880
881    return 0 if ( $this->_isProtectedByAttrs() );
882
883    my $kid = $this->{head};
884    while ($kid) {
885
886        # check for malformed list. We can still handle it,
887        # by simply ignoring illegal text.
888        # be tolerant of dl, ol and ul with no li
889        if ( $kid->{tag} =~ m/^[dou]l$/ ) {
890            return 0 unless $kid->_isConvertableList($options);
891        }
892        elsif ( $kid->{tag} =~ m/^(dt|dd|li)$/ ) {
893            unless ( $kid->_isConvertableListItem( $options, $this ) ) {
894                return 0;
895            }
896        }
897        $kid = $kid->{next};
898    }
899    return 1;
900}
901
902# probe down into a list item to determine if the
903# containing list can be converted to TML.
904sub _isConvertableListItem {
905    my ( $this, $options, $parent ) = @_;
906    my ( $flags, $text );
907
908    return 0 if ( $this->_isProtectedByAttrs() );
909
910    if ( $parent->{tag} eq 'dl' ) {
911        return 0 unless ( $this->{tag} =~ /^d[td]$/ );
912    }
913    else {
914        return 0 unless ( $this->{tag} eq 'li' );
915    }
916
917    my $kid = $this->{head};
918    while ($kid) {
919        if ( $kid->{tag} =~ /^[oud]l$/ ) {
920            unless ( $kid->_isConvertableList($options) ) {
921                return 0;
922            }
923        }
924        else {
925            ( $flags, $text ) = $kid->generate($options);
926            if ( $flags & $WC::BLOCK_TML ) {
927                return 0;
928            }
929        }
930        $kid = $kid->{next};
931    }
932    return 1;
933}
934
935# probe down into a table to determine if it
936# can be converted to TML.
937sub _isConvertableTable {
938    my ( $this, $options, $table ) = @_;
939
940    return 0 if ( $this->_isProtectedByAttrs() );
941
942    my $rowspan = undef;
943    $rowspan = [] if Foswiki::Func::getContext()->{'TablePluginEnabled'};
944
945    my $kid = $this->{head};
946    while ($kid) {
947        if ( $kid->{tag} =~ /^(colgroup|thead|tbody|tfoot|col)$/ ) {
948            unless ( $kid->_isConvertableTable( $options, $table ) ) {
949                return 0;
950            }
951        }
952        elsif ( $kid->{tag} ) {
953            unless ( $kid->{tag} eq 'tr' ) {
954                return 0;
955            }
956            my $row = $kid->_isConvertableTableRow( $options, $rowspan );
957            unless ($row) {
958                return 0;
959            }
960            push( @$table, $row );
961        }
962        $kid = $kid->{next};
963    }
964
965    if ( $rowspan and grep { $_ } @$rowspan ) {
966
967        # One or more cells span rows past the last row in the table.
968        # This is a defect in the HTML table which TML cannot represent.
969        return 0;
970    }
971    return 1;
972}
973
974# Tidy up whitespace on the sides of a table cell, and also strip trailing
975# BRs, as added by some table editors.
976sub _TDtrim {
977    my $td = shift;
978    $td =~
979s/^($WC::NBSP|$WC::NBBR|$WC::CHECKn|$WC::CHECKs|$WC::CHECKw|$WC::CHECK1|$WC::CHECK2|$WC::TAB|\s)+//so;
980    $td =~
981s/(<br \/>|<br>|$WC::NBSP|$WC::NBBR|$WC::CHECKn|$WC::CHECKs|$WC::CHECKw|$WC::CHECK1|$WC::CHECK2|$WC::TAB|\s)+$//so;
982    return $td;
983}
984
985# probe down into a table row to determine if the
986# containing table can be converted to TML.
987sub _isConvertableTableRow {
988    my ( $this, $options, $rowspan ) = @_;
989
990    return 0 if ( $this->_isProtectedByAttrs() );
991
992    my ( $flags, $text );
993    my @row;
994    my $ignoreCols = 0;
995    my $kid        = $this->{head};
996    my $colIdx     = 0;
997    while ( $rowspan and $rowspan->[$colIdx] ) {
998        push @row, $WC::NBSP . '^' . $WC::NBSP;
999        $rowspan->[$colIdx]--;
1000        $colIdx++;
1001    }
1002    while ($kid) {
1003        if ( $kid->{tag} eq 'th' ) {
1004            $kid->_removePWrapper();
1005            $kid->_moveClassToSpan('WYSIWYG_TT');
1006            $kid->_moveClassToSpan('WYSIWYG_COLOR');
1007            ( $flags, $text ) = $kid->_flatten( $options | $WC::IN_TABLE );
1008            $text = _TDtrim($text);
1009            $text = "*$text*" if length($text);
1010        }
1011        elsif ( $kid->{tag} eq 'td' ) {
1012            $kid->_removePWrapper();
1013            $kid->_moveClassToSpan('WYSIWYG_TT');
1014            $kid->_moveClassToSpan('WYSIWYG_COLOR');
1015            ( $flags, $text ) = $kid->_flatten( $options | $WC::IN_TABLE );
1016            $text = _TDtrim($text);
1017        }
1018        elsif ( !$kid->{tag} ) {
1019            $kid = $kid->{next};
1020            next;
1021        }
1022        else {
1023
1024            # some other sort of (unexpected) tag
1025            return 0;
1026        }
1027        return 0 if ( $flags & $WC::BLOCK_TML );
1028
1029        if ( $kid->{attrs} ) {
1030            my $a = _deduceAlignment($kid);
1031            if ( $text && $a eq 'right' ) {
1032                $text = $WC::NBSP . $text;
1033            }
1034            elsif ( $text && $a eq 'center' ) {
1035                $text = $WC::NBSP . $text . $WC::NBSP;
1036            }
1037            elsif ( $text && $a eq 'left' ) {
1038                $text .= $WC::NBSP;
1039            }
1040            if ( $kid->{attrs}->{rowspan} && $kid->{attrs}->{rowspan} > 1 ) {
1041                return 0 unless $rowspan;
1042                $rowspan->[$colIdx] = $kid->{attrs}->{rowspan} - 1;
1043            }
1044        }
1045        $text =~ s/&nbsp;/$WC::NBSP/g;
1046        $text =~ s/&#160;/$WC::NBSP/g;
1047
1048        #if (--$ignoreCols > 0) {
1049        #    # colspanned
1050        #    $text = '';
1051        #} els
1052        if ( $text =~ /^$WC::NBSP*$/ ) {
1053            $text = $WC::NBSP;
1054        }
1055        else {
1056            $text = $WC::NBSP . $text . $WC::NBSP;
1057        }
1058        if (   $kid->{attrs}
1059            && $kid->{attrs}->{colspan}
1060            && $kid->{attrs}->{colspan} > 1 )
1061        {
1062            $ignoreCols = $kid->{attrs}->{colspan};
1063        }
1064
1065        # Pad to allow wikiwords to work
1066        push( @row, $text );
1067        $colIdx++;
1068        while ( $ignoreCols > 1 ) {
1069            if ( $rowspan and $rowspan->[$colIdx] ) {
1070
1071                # rowspan and colspan into the same cell
1072                return 0;
1073            }
1074            push( @row, '' );
1075            $ignoreCols--;
1076            $colIdx++;
1077        }
1078        while ( $rowspan and $rowspan->[$colIdx] ) {
1079            push @row, $WC::NBSP . '^' . $WC::NBSP;
1080            $rowspan->[$colIdx]--;
1081            $colIdx++;
1082        }
1083        $kid = $kid->{next};
1084    }
1085    return \@row;
1086}
1087
1088# Remove the P tag from a table cell when it surrounds the whole content
1089# These "wrapper P tags" come from TMCE, when you press Enter
1090# in a table cell. They are impossible to remove in TMCE itself
1091# and they mess up the vertical alignment of table text.
1092sub _removePWrapper {
1093    my $this = shift;
1094
1095    # Find the first kid that is a tag,
1096    # keeping track of any content before it
1097    my $kid            = $this->{head};
1098    my $leadingContent = '';
1099    while ( $kid->{next} and not $kid->{tag} ) {
1100        $leadingContent .= $kid->{text};
1101        $kid = $kid->{next};
1102    }
1103
1104    # If there are no enclosed tags, then there is nothing further to do
1105    return unless $kid;
1106    return unless $kid->{tag};
1107
1108    # If there is something (non-whitespace) before the first tag,
1109    # then there is nothing further to do
1110    return if $leadingContent =~ /\S/;
1111
1112    # This is the first node (tag)
1113    my $firstNodeKid = $kid;
1114
1115    # Find the last kid that is a tag,
1116    # keeping track of any content after it
1117    $kid = $this->{tail};
1118    my $trailingContent = '';
1119    while ( $kid->{prev} and not $kid->{tag} ) {
1120        $trailingContent .= $kid->{text};
1121        $kid = $kid->{prev};
1122    }
1123
1124    # Note that there is at least one kid that is a node (tag)
1125    # so the checks here are for safety's sake
1126    ASSERT($kid) if DEBUG;
1127    ASSERT( $kid->{tag} ) if DEBUG;
1128    return unless $kid;
1129    return unless $kid->{tag};
1130
1131    # If there is something (non-whitespace) after the last tag,
1132    # then there is nothing further to do
1133    return if $trailingContent =~ /\S/;
1134
1135    # This is the last node (tag)
1136    my $lastNodeKid = $kid;
1137
1138    # If there are multiple kids that are nodes (tags)
1139    # then there is no "wrapper" tag to be removed
1140    return unless $firstNodeKid eq $lastNodeKid;
1141
1142    # There is only a problem if the surrounding tag is a <p> tag
1143    return unless uc( $firstNodeKid->{tag} ) eq 'P';
1144
1145    $firstNodeKid->_remove();
1146
1147    # Check if the tag has attributes
1148    if ( keys %{ $firstNodeKid->{attrs} } ) {
1149
1150        # Replace the wrapper P tag with a span
1151        my $newspan =
1152          new Foswiki::Plugins::WysiwygPlugin::HTML2TML::Node( $this->{context},
1153            'span', $firstNodeKid->{attrs} );
1154        $newspan->_eat($firstNodeKid);
1155        $this->addChild($newspan);
1156    }
1157    else {
1158
1159        # Remove the wrapper P tag
1160        $this->_eat($firstNodeKid);
1161    }
1162}
1163
1164# Work out the alignment of a table cell from the style and/or class
1165sub _deduceAlignment {
1166    my $td = shift;
1167
1168    if ( $td->{attrs}->{align} ) {
1169        return lc( $td->{attrs}->{align} );
1170    }
1171    else {
1172        if (   $td->{attrs}->{style}
1173            && $td->{attrs}->{style} =~ /text-align\s*:\s*(left|right|center)/ )
1174        {
1175            return $1;
1176        }
1177        if ( $td->hasClass(qr/align-(left|right|center)/) ) {
1178            return $1;
1179        }
1180    }
1181    return '';
1182}
1183
1184# convert a heading tag
1185sub _H {
1186    my ( $this, $options, $depth ) = @_;
1187    my ( $flags, $contents ) = $this->_flatten($options);
1188    return ( 0, undef )
1189      if ( ( $flags & $WC::BLOCK_TML )
1190        || ( $flags & $WC::IN_TABLE ) );
1191    my $notoc = '';
1192    if ( $this->hasClass('notoc') ) {
1193        $notoc = '!!';
1194    }
1195    my $indicator = '+';
1196    if ( $this->hasClass('numbered') ) {
1197        $indicator = '#';
1198    }
1199    $contents =~ s/^\s+/ /;
1200    $contents =~ s/\s+$//;
1201    my $res =
1202        $WC::CHECKn . '---'
1203      . ( $indicator x $depth )
1204      . $notoc
1205      . $WC::CHECKs
1206      . $contents
1207      . $WC::CHECKn;
1208    return ( $flags | $WC::BLOCK_TML, $res );
1209}
1210
1211# generate an emphasis
1212sub _emphasis {
1213    my ( $this, $options, $ch ) = @_;
1214    my ( $flags, $contents ) = $this->_flatten( $options | $WC::NO_BLOCK_TML );
1215    return ( 0, undef )
1216      if ( !defined($contents) || ( $flags & $WC::BLOCK_TML ) );
1217
1218    # Remove whitespace from either side of the contents, retaining the
1219    # whitespace
1220    $contents =~ s/&nbsp;/$WC::NBSP/go;
1221    $contents =~ s/&#160;/$WC::NBSP/go;
1222    $contents =~ /^($WC::WS)(.*?)($WC::WS)$/s;
1223    my ( $pre, $post ) = ( $1, $3 );
1224    $contents = $2;
1225    return ( 0, undef ) if ( $contents =~ /^</ || $contents =~ />$/ );
1226    return ( 0, '' ) unless ( $contents =~ /\S/ );
1227
1228    # Now see if we can collapse the emphases
1229    if (   $ch eq '_' && $contents =~ s/^\*(.*)\*$/$1/
1230        || $ch eq '*' && $contents =~ s/^_(?!_)(.*)(?<!_)_$/$1/ )
1231    {
1232        $ch = '__';
1233    }
1234    elsif ($ch eq '=' && $contents =~ s/^\*(.*)\*$/$1/
1235        || $ch eq '*' && $contents =~ s/^=(?!=)(.*)(?<!=)=$/$1/ )
1236    {
1237        $ch = '==';
1238    }
1239    elsif ( $contents =~ /^([*_=]).*\1$/ ) {
1240        return ( 0, undef );
1241    }
1242
1243    my $be = $this->_checkBeforeEmphasis();
1244    my $ae = $this->_checkAfterEmphasis();
1245    return ( 0, undef ) unless $ae && $be;
1246
1247    return ( $flags,
1248        $pre . $WC::CHECK1 . $ch . $contents . $ch . $WC::CHECK2 . $post );
1249}
1250
1251sub isBlockNode {
1252    my $node = shift;
1253    return ( $node->{tag}
1254          && $node->{tag} =~
1255/^(address|blockquote|center|dir|div|dl|fieldset|form|h\d|hr|isindex|menu|noframes|noscript|ol|p|pre|table|ul)$/
1256    );
1257}
1258
1259sub previousLeaf {
1260    my $node = shift;
1261    if ( !$node ) {
1262        return;
1263    }
1264    do {
1265        while ( !$node->{prev} ) {
1266            if ( !$node->{parent} ) {
1267                return;    # can't go any further back
1268            }
1269            $node = $node->{parent};
1270        }
1271        $node = $node->{prev};
1272        while ( !$node->isTextNode() ) {
1273            $node = $node->{tail};
1274        }
1275    } while ( !$node->isTextNode() );
1276    return $node;
1277}
1278
1279# Test for /^|(?<=[\s\(])/ at the end of the leaf node before.
1280sub _checkBeforeEmphasis {
1281    my ($this) = @_;
1282    my $tb = $this->previousLeaf();
1283    return 1 unless $tb;
1284    return 1 if ( $tb->isBlockNode() );
1285    return 1 if ( $tb->{nodeType} == 3 && $tb->{text} =~ /[\s(*_=]$/ );
1286    return 0;
1287}
1288
1289sub nextLeaf {
1290    my $node = shift;
1291    if ( !$node ) {
1292        return;
1293    }
1294    do {
1295        while ( !$node->{next} ) {
1296            if ( !$node->{parent} ) {
1297                return;    # end of the road
1298            }
1299            $node = $node->{parent};
1300            if ( $node->isBlockNode() ) {
1301
1302                # leaving this $node
1303                return $node;
1304            }
1305        }
1306        $node = $node->{next};
1307        while ( !$node->isTextNode() ) {
1308            $node = $node->{head};
1309        }
1310    } while ( !$node->isTextNode() );
1311    return $node;
1312}
1313
1314# Test for /$|(?=[\s,.;:!?)])/ at the start of the leaf node after.
1315sub _checkAfterEmphasis {
1316    my ($this) = @_;
1317    my $tb = $this->nextLeaf();
1318    return 1 unless $tb;
1319    return 1 if ( $tb->isBlockNode() );
1320    return 1 if ( $tb->{nodeType} == 3 && $tb->{text} =~ /^[\s,.;:!?)*_=]/ );
1321    return 0;
1322}
1323
1324# generate verbatim for P, SPAN or PRE
1325sub _verbatim {
1326    my ( $this, $tag, $options ) = @_;
1327
1328    $options |= $WC::PROTECTED | $WC::KEEP_ENTITIES | $WC::BR2NL | $WC::KEEP_WS;
1329    my ( $flags, $text ) = $this->_flatten($options);
1330
1331    # decode once, and once only. This will decode only those
1332    # entities than have a representation in the site charset.
1333    WC::decodeRepresentableEntities($text);
1334
1335    # &nbsp; decodes to \240, which we want to make a space.
1336    $text =~ s/\240/$WC::NBSP/g;
1337    my $p = _htmlParams( $this->{attrs}, $options );
1338
1339    return ( $flags, "<$tag$p>$text</$tag>" );
1340}
1341
1342# pseudo-tags that may leak through in Macros
1343# We have to handle this to avoid a matching close tag </nop>
1344sub _handleNOP {
1345    my ( $this,  $options ) = @_;
1346    my ( $flags, $text )    = $this->_flatten($options);
1347    return ( $flags, '<nop>' . $text );
1348}
1349
1350sub _handleNOPRESULT {
1351    my ( $this,  $options ) = @_;
1352    my ( $flags, $text )    = $this->_flatten($options);
1353    return ( $flags, '<nop>' . $text );
1354}
1355
1356# tags we ignore completely (contents as well)
1357sub _handleDOCTYPE { return ( 0, '' ); }
1358
1359sub _LIST {
1360    my ( $this, $options ) = @_;
1361    if ( ( $options & $WC::NO_BLOCK_TML )
1362        || !$this->_isConvertableList( $options | $WC::NO_BLOCK_TML ) )
1363    {
1364        return ( 0, undef );
1365    }
1366    return ( $WC::BLOCK_TML, $this->_convertList($WC::TAB) );
1367}
1368
1369# Performs initial cleanup of the parse tree before generation. Walks the
1370# tree, making parent links and removing attributes that don't add value.
1371# This simplifies determining whether a node is to be kept, or flattened
1372# out.
1373# $opts may include $WC::VERY_CLEAN
1374sub cleanNode {
1375    my ( $this, $opts ) = @_;
1376    my $a;
1377
1378    # Always delete these attrs
1379    foreach $a (qw( lang _moz_dirty )) {
1380        delete $this->{attrs}->{$a}
1381          if ( defined( $this->{attrs}->{$a} ) );
1382    }
1383
1384    # Delete these attrs if their value is empty
1385    foreach $a (qw( class style )) {
1386        if ( defined( $this->{attrs}->{$a} )
1387            && $this->{attrs}->{$a} !~ /\S/ )
1388        {
1389            delete $this->{attrs}->{$a};
1390        }
1391    }
1392
1393    # Sometimes (rarely!) there's a <span id='__caret'> </span>, an artifact of
1394    # one of the strategies TinyMCE uses to recover lost cursor positioning,
1395    # see Item2618 where this can break TML tables. #SMELL: TMCE specific
1396    if (   ( $this->{tag} eq 'span' )
1397        && ( defined $this->{attrs}->{id} )
1398        && ( $this->{attrs}->{id} eq '__caret' ) )
1399    {
1400        $this->{tag}      = q{};
1401        $this->{attrs}    = {};
1402        $this->{nodeType} = 0;
1403    }
1404}
1405
1406######################################################
1407# Handlers for different HTML tag types. Each handler returns
1408# a pair (flags,text) containing the result of the expansion.
1409#
1410# There are four ways of handling a tag:
1411# 1. Return (0,undef) which will cause the tag to be output
1412#    as HTML tags.
1413# 2. Return _flatten which will cause the tag to be ignored,
1414#    but the content expanded
1415# 3. Return (0, '') which will cause the tag not to be output
1416# 4. Something else more complex
1417#
1418# Note that tags like TFOOT and DT are handled inside the table
1419# and list processors.
1420# They only have handler methods in case the tag is seen outside
1421# the content of a table or list. In this case they are usually
1422# simply removed from the output.
1423#
1424sub _handleA {
1425    my ( $this, $options ) = @_;
1426
1427    my ( $flags, $text ) = $this->_flatten( $options | $WC::NO_BLOCK_TML );
1428    if ( $text && $text =~ /\S/ && $this->{attrs}->{href} ) {
1429
1430        # there's text and an href
1431        my $href = $this->{attrs}->{href};
1432
1433        my $forceTML =
1434          (      $this->{attrs}->{class}
1435              && $this->{attrs}->{class} =~ m/\bTMLlink\b/ );
1436
1437        my $origWikiword;
1438        if ( $this->{attrs}->{'data-wikiword'} ) {
1439            $origWikiword = $this->{attrs}->{'data-wikiword'};
1440        }
1441
1442# SMELL:  Item11814 - decoding corrupts URL's that must be encoded,  ex. embedded Newline
1443# No unit test covers why the decode is required.  However restricting it to known
1444# protocols fixes Item11814.  Need to figure out if this can just be removed?
1445#if ( $href !~ /${WC::PROTOCOL}[^?]*/ ) {
1446#    $href =~ s/%([0-9A-F]{2})/chr(hex($1))/gei;
1447#}
1448
1449        if ( $this->{context} && $this->{context}->{rewriteURL} ) {
1450            $href = $this->{context}->{rewriteURL}->( $href, $this->{context} );
1451        }
1452
1453        $reww = Foswiki::Func::getRegularExpression('wikiWordRegex')
1454          unless $reww;
1455        my $nop = ( $options & $WC::NOP_ALL ) ? '<nop>' : '';
1456
1457        my $cleantext = $text;
1458        $cleantext =~ s/<nop>//g;
1459
1460# The original WikiWord for auto links as well as [[Squab]] links is stashed in a pseudo class
1461#  - class="TMLwikiword<TheWikiWord>"
1462# If the original WikiWord and the href match, and the text is a wikiword
1463# the replace the href with the new wikiword.
1464        if (   $origWikiword
1465            && $href eq $origWikiword
1466            && $cleantext =~ m/^(\w+\.)?($reww)(#\w+)?$/ )
1467        {
1468            $href = $text;
1469
1470            #print STDERR "HREF $href updated\n";
1471        }
1472
1473        if ( $href =~ /^(\w+\.)?($reww)(#\w+)?$/ ) {
1474            my $web    = $1 || '';
1475            my $topic  = $2;
1476            my $anchor = $3 || '';
1477
1478            # if the clean text is the known topic we can ignore it
1479            if ( ( $cleantext eq $href || $href =~ /\.$cleantext$/ )
1480                && !$forceTML )
1481            {
1482                return ( 0,
1483                        $WC::CHECK1
1484                      . $nop
1485                      . $web
1486                      . $topic
1487                      . $anchor
1488                      . $WC::CHECK2 );
1489            }
1490        }
1491        if (   $href =~ /${WC::PROTOCOL}[^?]*$/
1492            && $text eq $href
1493            && !$forceTML )
1494        {
1495            return ( 0, $WC::CHECK1 . $nop . $text . $WC::CHECK2 );
1496        }
1497
1498        #print STDERR "TEXT ($text) HREF ($href)\n";
1499        if ( $text eq $href ) {
1500            return ( 0, $WC::CHECKw . '[' . $nop . '[' . $href . ']]' );
1501        }
1502
1503        # we must quote square brackets in [[...][...]] notation
1504        $text =~ s/[[]/&#91;/g;
1505        $text =~ s/[]]/&#93;/g;
1506        $href =~ s/[[]/%5B/g;
1507        $href =~ s/[]]/%5D/g;
1508
1509        return ( 0,
1510            $WC::CHECKw . '[' . $nop . '[' . $href . '][' . $text . ']]' );
1511    }
1512    elsif ( $this->{attrs}->{name} ) {
1513
1514        # allow anchors to be expanded normally. This won't generate
1515        # wiki anchors, but it's a small price to pay - it would
1516        # be too complex to generate wiki anchors, given their
1517        # line-oriented nature.
1518        return ( 0, undef );
1519    }
1520
1521    # Otherwise generate nothing
1522    return ( 0, '' );
1523}
1524
1525sub _handleABBR    { return _flatten(@_); }
1526sub _handleACRONYM { return _flatten(@_); }
1527sub _handleADDRESS { return _flatten(@_); }
1528
1529sub _handleB { return _emphasis( @_, '*' ); }
1530sub _handleBASE     { return ( 0, '' ); }
1531sub _handleBASEFONT { return ( 0, '' ); }
1532
1533sub _handleBIG { return _flatten(@_); }
1534
1535# BLOCKQUOTE
1536sub _handleBODY { return _flatten(@_); }
1537
1538# BUTTON
1539
1540sub _handleBR {
1541    my ( $this, $options ) = @_;
1542    my ( $f,    $kids )    = $this->_flatten($options);
1543
1544    # Test conditions for keeping a <br>. These are:
1545    # 1. We haven't explicitly been told to convert to \n (by BR2NL)
1546    # 2. We have been told that block TML is illegal
1547    # 3. The previous node is an inline element node or text node
1548    # 4. The next node is an inline element or text node
1549    my $sep = "\n";
1550    if ( $options & $WC::BR2NL ) {
1551    }
1552    elsif ( $options & $WC::NO_BLOCK_TML ) {
1553        $sep = '<br />';
1554    }
1555    elsif ( $this->prevIsInline() ) {
1556        if ( $this->isInline() ) {
1557
1558            # Both <br> and </br> cause a NL
1559            # if this is empty, look at next
1560            if ( $kids !~ /^[\000-\037]*$/ && $kids !~ /^[\000-\037]*$WC::NBBR/
1561                || $this->nextIsInline() )
1562            {
1563                $sep = '<br />';
1564            }
1565        }
1566    }
1567    return ( $f, $sep . $kids );
1568}
1569
1570sub _handleCAPTION { return ( 0, '' ); }
1571
1572# CENTER
1573# CITE
1574
1575sub _handleCODE { return _emphasis( @_, '=' ); }
1576
1577sub _handleCOL      { return _flatten(@_); }
1578sub _handleCOLGROUP { return _flatten(@_); }
1579sub _handleDD       { return _flatten(@_); }
1580sub _handleDFN      { return _flatten(@_); }
1581
1582# DIR
1583
1584sub _handleDIV {
1585    my ( $this, $options ) = @_;
1586
1587    if ( ( $options & $WC::NO_BLOCK_TML )
1588        || !$this->_isConvertableIndent( $options | $WC::NO_BLOCK_TML ) )
1589    {
1590        return $this->_handleP($options);
1591    }
1592    return ( $WC::BLOCK_TML, $this->_convertIndent($options) );
1593}
1594
1595sub _handleDL { return _LIST(@_); }
1596sub _handleDT { return _flatten(@_); }
1597
1598sub _handleEM { return _emphasis( @_, '_' ); }
1599
1600sub _handleFIELDSET { return _flatten(@_); }
1601
1602sub _handleFONT {
1603    my ( $this, $options ) = @_;
1604
1605    my %atts = %{ $this->{attrs} };
1606
1607    # Try to convert font tags into %COLOUR%..%ENDCOLOR%
1608
1609    # First extract the colour from a style= param, if we can.
1610    my $colour;
1611    if ( defined $atts{style}
1612        && $atts{style} =~ s/(^|\s|;)color\s*:\s*(#?\w+)\s*(;|$)// )
1613    {
1614        $colour = $2;
1615    }
1616
1617    # override it with a color= param, if there is one.
1618    if ( defined $atts{color} ) {
1619        $colour = $atts{color};
1620    }
1621
1622    # The presence of the WYSIWYG_COLOR class _forces_ the tag to be
1623    # converted to a Foswiki colour macro, as long as the colour is
1624    # recognised.
1625    if ( hasClass( \%atts, 'WYSIWYG_COLOR' ) ) {
1626        my $percentColour = $WC::HTML2TML_COLOURMAP{ uc($colour) };
1627        if ( defined $percentColour ) {
1628
1629            # All other font information will be lost.
1630            my ( $f, $kids ) = $this->_flatten($options);
1631            return ( $f, '%' . $percentColour . '%' . $kids . '%ENDCOLOR%' );
1632        }
1633    }
1634
1635    # May still be able to convert if there is no other font information.
1636    delete $atts{class} if defined $atts{class} && $atts{class} =~ /^\s*$/;
1637    delete $atts{style} if defined $atts{style} && $atts{style} =~ /^[\s;]*$/;
1638    delete $atts{color} if defined $atts{color};
1639    if ( defined $colour && !scalar keys %atts ) {
1640        my $percentColour = $WC::HTML2TML_COLOURMAP{ uc($colour) };
1641        if ( defined $percentColour ) {
1642            my ( $f, $kids ) = $this->_flatten($options);
1643            return ( $f, '%' . $percentColour . '%' . $kids . '%ENDCOLOR%' );
1644        }
1645    }
1646
1647    # Either the colour can't be mapped, or we can't do the conversion
1648    # without loss of information
1649    return ( 0, undef );
1650}
1651
1652# FORM
1653sub _handleFRAME    { return _flatten(@_); }
1654sub _handleFRAMESET { return _flatten(@_); }
1655sub _handleHEAD     { return ( 0, '' ); }
1656
1657sub _handleHR {
1658    my ( $this, $options ) = @_;
1659
1660    my ( $f, $kids ) = $this->_flatten($options);
1661    return ( $f, '<hr />' . $kids ) if ( $options & $WC::NO_BLOCK_TML );
1662
1663    my $dashes = 3;
1664    if (    $this->{attrs}->{style}
1665        and $this->{attrs}->{style} =~ s/\bnumdashes\s*:\s*(\d+)\b// )
1666    {
1667        $dashes = $1;
1668        $dashes = 3 if $dashes < 3;
1669        $dashes = 160 if $dashes > 160;    # Filter out probably-bad data
1670    }
1671    return ( $f | $WC::BLOCK_TML,
1672        $WC::CHECKn . ( '-' x $dashes ) . $WC::CHECKn . $kids );
1673}
1674
1675sub _handleHTML { return _flatten(@_); }
1676sub _handleH1   { return _H( @_, 1 ); }
1677sub _handleH2   { return _H( @_, 2 ); }
1678sub _handleH3   { return _H( @_, 3 ); }
1679sub _handleH4   { return _H( @_, 4 ); }
1680sub _handleH5   { return _H( @_, 5 ); }
1681sub _handleH6   { return _H( @_, 6 ); }
1682sub _handleI    { return _emphasis( @_, '_' ); }
1683
1684sub _handleIMG {
1685    my ( $this, $options ) = @_;
1686
1687    # Hack out mce_src, which is TinyMCE-specific and causes indigestion
1688    # when the topic is reloaded
1689    delete $this->{attrs}->{mce_src} if defined $this->{attrs}->{mce_src};
1690    if ( $this->{context} && $this->{context}->{rewriteURL} ) {
1691        my $href = $this->{attrs}->{src};
1692
1693        # decode URL params in the href
1694        $href =~ s/%([0-9A-F]{2})/chr(hex($1))/gei;
1695        $href = &{ $this->{context}->{rewriteURL} }( $href, $this->{context} );
1696        $this->{attrs}->{src} = $href;
1697    }
1698
1699    return ( 0, undef )
1700      unless $this->{context}
1701      && defined $this->{context}->{convertImage};
1702
1703    my $alt =
1704      &{ $this->{context}->{convertImage} }
1705      ( $this->{attrs}->{src}, $this->{context} );
1706    if ($alt) {
1707        return ( 0, $alt );
1708    }
1709    return ( 0, undef );
1710}
1711
1712# INPUT
1713# INS
1714# ISINDEX
1715sub _handleKBD { return _handleTT(@_); }
1716
1717# LABEL
1718# LI
1719sub _handleLINK { return ( 0, '' ); }
1720
1721# MAP
1722# MENU
1723sub _handleMETA     { return ( 0, '' ); }
1724sub _handleNOFRAMES { return ( 0, '' ); }
1725sub _handleNOSCRIPT { return ( 0, '' ); }
1726sub _handleOL       { return _LIST(@_); }
1727
1728# OPTGROUP
1729# OPTION
1730
1731sub _handleP {
1732    my ( $this, $options ) = @_;
1733
1734    my $nbnl = $this->hasClass('WYSIWYG_NBNL');
1735
1736    if ( $this->hasClass('WYSIWYG_WARNING') ) {
1737        return ( 0, '' );
1738    }
1739
1740    if ( $this->hasClass('TMLverbatim') ) {
1741        return $this->_verbatim( 'verbatim', $options );
1742    }
1743    if ( $this->hasClass('WYSIWYG_STICKY') ) {
1744        return $this->_verbatim( 'sticky', $options );
1745    }
1746    my ( $f, $kids ) = $this->_flatten($options);
1747    return ( $f, '<p>' . $kids . '</p>' ) if ( $options & $WC::NO_BLOCK_TML );
1748    my $prevNode = $this->{prev};
1749    if ( $prevNode and not $prevNode->{tag} ) {
1750        $prevNode = $prevNode->{prev};
1751    }
1752    my $afterTable = ( $prevNode and uc( $prevNode->{tag} ) eq 'TABLE' );
1753    my $nextNode = $this->{next};
1754    if ( $nextNode and not $nextNode->{tag} ) {
1755        $nextNode = $nextNode->{next};
1756    }
1757    my $beforeTable = ( $nextNode and uc( $nextNode->{tag} ) eq 'TABLE' );
1758    my $pre;
1759    if ( $afterTable and not $beforeTable ) {
1760        $pre = '';
1761    }
1762    elsif ( $this->prevIsInline() ) {
1763        $pre = $WC::NBBR . $WC::NBBR;
1764    }
1765    else {
1766        $pre = $WC::NBBR;
1767    }
1768    $pre = $WC::NBBR . $pre if $nbnl;
1769    return ( $f | $WC::BLOCK_TML, $pre . $kids . $WC::NBBR );
1770}
1771
1772# PARAM
1773
1774sub _handlePRE {
1775    my ( $this, $options ) = @_;
1776
1777    my $tag = 'pre';
1778    if ( $this->hasClass('TMLverbatim') ) {
1779        return $this->_verbatim( 'verbatim', $options );
1780    }
1781    if ( $this->hasClass('WYSIWYG_STICKY') ) {
1782        return $this->_verbatim( 'sticky', $options );
1783    }
1784    unless ( $options & $WC::NO_BLOCK_TML ) {
1785        my ( $flags, $text ) =
1786          $this->_flatten( $options | $WC::NO_TML | $WC::BR2NL | $WC::KEEP_WS );
1787        my $p = _htmlParams( $this->{attrs}, $options );
1788        return ( $WC::BLOCK_TML, "<$tag$p>$text</$tag>" );
1789    }
1790    return ( 0, undef );
1791}
1792
1793sub _handleQ { return _flatten(@_); }
1794
1795# S
1796sub _handleSAMP { return _handleTT(@_); }
1797
1798# SCRIPT
1799# SELECT
1800# SMALL
1801
1802sub _handleSPAN {
1803    my ( $this, $options ) = @_;
1804
1805    my %atts = %{ $this->{attrs} };
1806    if ( _removeClass( \%atts, 'TMLverbatim' ) ) {
1807        return $this->_verbatim( 'verbatim', $options );
1808    }
1809    if ( _removeClass( \%atts, 'WYSIWYG_STICKY' ) ) {
1810        return $this->_verbatim( 'sticky', $options );
1811    }
1812
1813    if ( _removeClass( \%atts, 'WYSIWYG_LINK' ) ) {
1814        $options |= $WC::NO_BLOCK_TML;
1815    }
1816
1817    if ( _removeClass( \%atts, 'WYSIWYG_TT' ) ) {
1818        return _emphasis( @_, '=' );
1819    }
1820
1821    # If we have WYSIWYG_COLOR and the colour can be mapped, then convert
1822    # to a macro.
1823    if ( _removeClass( \%atts, 'WYSIWYG_COLOR' ) ) {
1824        my $colour;
1825        if ( $atts{style} ) {
1826            my $style = $atts{style};
1827            if ( $style =~ s/(^|\s|;)color\s*:\s*(#?\w+)\s*(;|$)// ) {
1828                $colour = $2;
1829            }
1830        }
1831        my $percentColour = $WC::HTML2TML_COLOURMAP{ uc($colour) };
1832        if ( defined $percentColour ) {
1833            my ( $f, $kids ) = $this->_flatten($options);
1834            return ( $f, '%' . $percentColour . '%' . $kids . '%ENDCOLOR%' );
1835        }
1836    }
1837
1838    if ( _removeClass( \%atts, 'WYSIWYG_HIDDENWHITESPACE' ) ) {
1839
1840# This regular expression ensures the encoded whitespace is valid.
1841# The limit on the number of digits will ensure that the numbers are reasonable.
1842        if (    $atts{style}
1843            and $atts{style} =~
1844            s/\bencoded\s*:\s*(['"])((?:b|n|t\d{1,2}|s\d{1,3})+)\1;?// )
1845        {
1846            my $whitespace = $2;
1847
1848            #print STDERR "'$whitespace' -> ";
1849            $whitespace =~ s/b/\\/g;
1850            $whitespace =~ s/n/$WC::NBBR/g;
1851            $whitespace =~ s/t(\d+)/'\t' x $1/ge;
1852            $whitespace =~ s/s(\d+)/$WC::NBSP x $1/ge;
1853
1854            #print STDERR "'$whitespace'\n";
1855            #require Data::Dumper;
1856            my ( $f, $kids ) =
1857              $this->_flatten( $options | $WC::KEEP_WS | $WC::KEEP_ENTITIES );
1858
1859            #die Data::Dumper::Dumper($kids);
1860            if ( $kids eq '&nbsp;' ) {
1861
1862                # The space was not changed
1863                # So restore the encoded whitespace
1864                return ( $f, $whitespace );
1865            }
1866            elsif ( length($kids) == 0 ) {
1867
1868                # The user deleted the space
1869                # So return blank
1870                return ( 0, '' );
1871            }
1872
1873            #else {die "'".ord($kids)."'";}if(1){}
1874            elsif ( 0
1875                and
1876                ( $kids eq '&nbsp;' or $kids eq '&#160;' or $kids eq chr(160) )
1877              )
1878            {    # SMELL: Firefox-specific
1879                 # This was probably inserted by Firefox after the user deleted the space.
1880                 # So return blank
1881                return ( 0, '' );
1882            }
1883            else {
1884
1885             # The user entered some new text
1886             # Return the combination.
1887             # Assume that a leading space corresponds to the encoded whitespace
1888                $kids =~ s/^ //;
1889                return ( $f, $whitespace . $kids );
1890            }
1891        }
1892    }
1893
1894    # Remove all other (non foswiki) classes
1895    if ( defined $atts{class} && $atts{class} !~ /foswiki/ ) {
1896        delete $atts{class};
1897    }
1898
1899    #    if ( $options & $WC::VERY_CLEAN ) {
1900    # remove style attribute if cleaning aggressively.
1901    #        delete $atts{style} if defined $atts{style};
1902    #    }
1903
1904    # ignore the span tag if there are no other attrs
1905    if ( scalar( keys %atts ) == 0 ) {
1906        return $this->_flatten($options);
1907    }
1908
1909    # otherwise use the default generator.
1910    return ( 0, undef );
1911}
1912
1913# STRIKE
1914
1915sub _handleSTRONG { return _emphasis( @_, '*' ); }
1916
1917sub _handleSTYLE { return ( 0, '' ); }
1918
1919# SUB
1920# SUP
1921
1922sub _handleTABLE {
1923    my ( $this, $options ) = @_;
1924    return ( 0, undef ) if ( $options & $WC::NO_BLOCK_TML );
1925
1926    # Should really look at the table attrs, but to heck with it
1927
1928    return ( 0, undef ) if ( $options & $WC::NO_BLOCK_TML );
1929
1930    my @table;
1931    return ( 0, undef )
1932      unless $this->_isConvertableTable( $options | $WC::NO_BLOCK_TML,
1933        \@table );
1934
1935    my $text = $WC::CHECKn;
1936    foreach my $row (@table) {
1937
1938        # isConvertableTableRow has already formatted the cell
1939        $text .= $WC::CHECKn . '|' . join( '|', @$row ) . '|' . $WC::CHECKn;
1940    }
1941
1942    return ( $WC::BLOCK_TML, $text );
1943}
1944
1945# TBODY
1946# TD
1947
1948# TEXTAREA {
1949# TFOOT
1950# TH
1951# THEAD
1952sub _handleTITLE { return ( 0, '' ); }
1953
1954# TR
1955sub _handleTT { return _handleCODE(@_); }
1956
1957# U
1958sub _handleUL { return _LIST(@_); }
1959
1960sub _handleVAR { return _flatten(@_); }
1961
19621;
1963__END__
1964Foswiki - The Free and Open Source Wiki, http://foswiki.org/
1965
1966Copyright (C) 2008-2010 Foswiki Contributors. Foswiki Contributors
1967are listed in the AUTHORS file in the root of this distribution.
1968NOTE: Please extend that file, not this notice.
1969
1970Additional copyrights apply to some or all of the code in this
1971file as follows:
1972
1973Copyright (C) 2005 ILOG http://www.ilog.fr
1974
1975This program is free software; you can redistribute it and/or
1976modify it under the terms of the GNU General Public License
1977as published by the Free Software Foundation; either version 2
1978of the License, or (at your option) any later version. For
1979more details read LICENSE in the root of this distribution.
1980
1981This program is distributed in the hope that it will be useful,
1982but WITHOUT ANY WARRANTY; without even the implied warranty of
1983MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
1984
1985As per the GPL, removal of this notice is prohibited.
Note: See TracBrowser for help on using the repository browser.