Rewrote URL/email parsing code (SF trackers #730899, #745483, #945302)

docs/Changelog

@@ -2,6 +2,7 @@ pisg (0.61) - ??
    Changes by Christoph Berg:
    * Fix warning when running on empty logs.
    * Fix & conversion.
+   * Rewrote URL/email parsing code (SF trackers #730899, #745483, #945302).
    * More nick sanitizing.
    * Remove whitespace around user pictures, border="0", title.
    * Formats:

modules/Pisg/Common.pm

@@ -145,42 +145,19 @@ sub match_urls
 {
     my $str = shift;
 
-    # Interpret 'www.' as 'http://www.'
-    $str =~ s/\b(http:\/\/)?www\./http:\/\/www\./igo;
-
     my @urls;
-    while ($str =~ s/(http|https|ftp|telnet|news)(:\/\/[-a-zA-Z0-9_\/~\@:]+\.[-a-zA-Z0-9.,_~=:&\@%?#\/+]+)//io) { 
-        my $url = "$1$2";
-        if ($url_seen{$url}) {
-            push(@urls, $url);
-        } elsif ($url =~ s/\/$//) {
-            if ($url_seen{$url}) {
-                push(@urls, $url);
-            } else {
-                $url_seen{"$url/"} = 1;
-                push(@urls, "$url/");
-            }
-        } elsif ($url_seen{"$url/"}) {
-            push(@urls, "$url/");
-        } else {
-            $url_seen{$url} = 1;
-            push(@urls, $url);
-        }
+    # we don't treat mailto: as URL here
+    while ($str =~ /((?:(?:https?|ftp|telnet|news):\/\/|(?:(?:(www)|(ftp))[\w-]*\.))[-\w\/~\@:]+\.\S+[\w\/])/gio) {
+        my $url = $2 ? "http://$1" : ($3 ? "ftp://$1" : $1);
+        my $url_strip = $url;
+        $url_strip =~ s/\/$//;
+        $url_seen{$url_strip} ||= $url; # normalize URL to first seen form
+        push (@urls, $url_seen{$url_strip});
     }
 
     return @urls;
 }
 
-sub match_email
-{
-    my $str = shift;
-
-    if ($str =~ /([-a-zA-Z0-9._]+@[-a-zA-Z0-9_]+\.[-a-zA-Z0-9._]+)/) {
-        return $1;
-    }
-    return undef;
-}
-
 sub htmlentities
 {
     my $str = shift;

modules/Pisg/HTMLGenerator.pm

@@ -1589,7 +1589,7 @@ sub _template_text
 sub _format_word
 {
     # This function formats a word -- should ONLY be called on words used alone (EG: not whole line printed)
-    my ($self, $word, $nick) = @_;
+    my ($self, $word, $nick) = @_; # nick is only defined for user links in top table
 
     $word = htmlentities($word, $self->{cfg}->{charset});
     $word = $self->_replace_links($word, $nick);
@@ -1842,28 +1842,40 @@ sub _legend
 }
 
 
+sub _replace_url # used internally by _replace_links
+{
+    my ($self, $url, $www, $ftp, $text) = @_;
+    $url = "http://$url" if $www;
+    $url = "ftp://$url" if $ftp;
+    my $texturl = $self->_template_text("newwindow");
+    return "<a href=\"$url\" target=\"_blank\" title=\"$texturl $url\">" . $self->_split_long_text($text) . '</a>';
+}
+
+
+sub _replace_email # used internally by _replace_links
+{
+    my ($self, $mailto, $user, $domain, $nick) = @_;
+    $mailto = '' if $nick or not $mailto;
+    $nick ||= "$user&#64;$domain"; # obfuscate mail address
+    my $textmail = $self->_template_text("mailto");
+    return "<a href=\"mailto:$user&#64;$domain\" title=\"$textmail $nick\">" . $self->_split_long_text($mailto . $nick) . "<\/a>";
+}
+
+
 sub _replace_links
 {
-    # Sub to replace urls and e-mail addys to links
-    my ($self, $str, $nick) = @_;
+    # replace URLs and email addresses by links
+    my ($self, $str, $nick) = @_; # nick is only defined for user links in top table
 
     # Regular expressions are taken from match_urls() and match_email() in
     # Common.pm
 
-    my $texturl = $self->_template_text("newwindow");
-    my $textmail = $self->_template_text("mailto");
     my (@str) = split(/ /,$str);
 
     foreach (@str) {
-        if (m/(http|https|ftp|telnet|news)(:\/\/[-a-zA-Z0-9_\/~:@]+\.[-a-zA-Z0-9.,_~=:&amp;@%?#\/+]+)/o) {
-            my $nick = $nick || $1 . $2;
-            $_ = "<a href=\"$1$2\" target=\"_blank\" title=\"$texturl $1$2\">" . $self->_split_long_text($nick) . '</a>';
-        } elsif (m/(^|[^:])\b([-a-zA-Z0-9._]+@[-a-zA-Z0-9_]+\.[-a-zA-Z0-9._]+)/o) {
-            my $nick = $nick || $1 . $2;
-            $_ = "$1<a href=\"mailto:$2\" title=\"$textmail $nick\">" . $self->_split_long_text($nick) . "<\/a>";
-        } else {
-            $_ = $self->_split_long_text($_);
-        }
+        s/((?:(?:https?|ftp|telnet|news):\/\/|(?:(?:(www)|(ftp))[\w-]*\.))[-\w\/~\@:]+\.\S+[\w\/])/$self->_replace_url($1, $2, $3, $nick || $1)/egio
+            or s/(mailto:)?([-\w.]+)@([-\w]+\.[-\w.]+)/$self->_replace_email($1, $2, $3, $nick)/egio
+            or $_ = $self->_split_long_text($_);
      }
 
     return join(' ', @str);