… | |
… | |
632 | $LAST_QUERY = $prompt; |
632 | $LAST_QUERY = $prompt; |
633 | |
633 | |
634 | $self->{query}-> ($self, $flags, $prompt); |
634 | $self->{query}-> ($self, $flags, $prompt); |
635 | } |
635 | } |
636 | |
636 | |
|
|
637 | sub sanitise_xml($) { |
|
|
638 | local $_ = shift; |
|
|
639 | |
|
|
640 | # we now weed out all tags we do not support |
|
|
641 | s%<(?!/?i>|/?u>|/?b>|fg |/fg>)%<%g; |
|
|
642 | # now all entities |
|
|
643 | s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&/g; |
|
|
644 | |
|
|
645 | # handle some elements |
|
|
646 | s/<fg name='([^']*)'>(.*?)<\/fg>/<span foreground='$1'>$2<\/span>/gs; |
|
|
647 | s/<fg name="([^"]*)">(.*?)<\/fg>/<span foreground="$1">$2<\/span>/gs; |
|
|
648 | |
|
|
649 | $_ |
|
|
650 | } |
|
|
651 | |
637 | our %NAME_TO_COLOR = ( |
652 | our %NAME_TO_COLOR = ( |
638 | black => 0, |
653 | black => 0, |
639 | white => 1, |
654 | white => 1, |
640 | darkblue => 2, |
655 | darkblue => 2, |
641 | red => 3, |
656 | red => 3, |
… | |
… | |
667 | ); |
682 | ); |
668 | |
683 | |
669 | sub msg { |
684 | sub msg { |
670 | my ($self, $color, $type, $text, @extra) = @_; |
685 | my ($self, $color, $type, $text, @extra) = @_; |
671 | |
686 | |
672 | # we now weed out all tags we do not support |
687 | $text = sanitise_xml $text; |
673 | $text =~ s%<(?!/?i>|/?u>|/?b>|fg |/fg>)%<%g; |
|
|
674 | # now all entities |
|
|
675 | $text =~ s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&/g; |
|
|
676 | |
|
|
677 | # handle some elements |
|
|
678 | $text =~ s/<fg name='([^']*)'>(.*?)<\/fg>/<span foreground='$1'>$2<\/span>/gs; |
|
|
679 | $text =~ s/<fg name="([^"]*)">(.*?)<\/fg>/<span foreground="$1">$2<\/span>/gs; |
|
|
680 | |
688 | |
681 | if (my $cb = $self->{cb_msg}{$type}) { |
689 | if (my $cb = $self->{cb_msg}{$type}) { |
682 | $_->($self, $color, $type, $text, @extra) for values %$cb; |
690 | $_->($self, $color, $type, $text, @extra) for values %$cb; |
683 | } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) { |
691 | } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) { |
684 | $type =~ s/-/_/g; |
692 | $type =~ s/-/_/g; |
… | |
… | |
1119 | |
1127 | |
1120 | if ($msg->{msgtype} eq "reply") { |
1128 | if ($msg->{msgtype} eq "reply") { |
1121 | $self->{kw}{$_} = 1 for @{$msg->{add_topics} || []}; |
1129 | $self->{kw}{$_} = 1 for @{$msg->{add_topics} || []}; |
1122 | $self->{kw}{$_} = 0 for @{$msg->{del_topics} || []}; |
1130 | $self->{kw}{$_} = 0 for @{$msg->{del_topics} || []}; |
1123 | |
1131 | |
1124 | my $text = "\n" . CFPlus::asxml $msg->{msg}; |
1132 | my $text = "\n" . CFPlus::Protocol::sanitise_xml $msg->{msg}; |
1125 | my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} }; |
1133 | my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} }; |
1126 | my @link; |
1134 | my @link; |
1127 | $text =~ s{ |
1135 | $text =~ s{ |
1128 | ($match) |
1136 | ($match) |
1129 | }{ |
1137 | }{ |