| … | |
… | |
| 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 | }{ |
