Greatly improved accuracy of URL-to-link conversion

1 files changed, 33 insertions, 13 deletions

diff --git a/index.cgi b/index.cgi
index e3259a9..e040fbb 100755
--- a/index.cgi
+++ b/index.cgi
@@ -87,6 +87,35 @@ sub escape {
 }
 
 
+sub escape_url {
+  my $str = shift;
+  my $r = '';
+  my $last = 0;
+  while($str =~ m{((?:https?|ftp)://[^ ><"\n\s]+[\d\w=/-])}g) {
+    $r .= sprintf '%s<a href="%s">%2$s</a>', escape(substr $str, $last, (pos($str)-length($1))-$last), escape($1);
+    $last = pos $str;
+  }
+  return $r.escape(substr $str, $last);
+}
+
+
+sub get_html {
+  my $p = shift;
+  return $p->{html} if $p->{html};
+  my $e = $p->{parse_urls} ? \&escape_url : \&escape;
+  return $e->($p->{raw}) if $p->{syntax} eq 'nosyntax';
+
+  require Text::VimColor;
+  my $m = Text::VimColor->new(string => encode_utf8($p->{raw}), filetype => $p->{syntax})->marked();
+  my $html = '';
+  foreach (@$m) {
+    my $t = $e->(decode_utf8($_->[1]));
+    $html .= $_->[0] eq '' ? $t : qq|<span class="syn$_->[0]">$t</span>|;
+  }
+  return $html;
+}
+
+
 sub passcode {
   my ($p, $ps) = @_;
   $p = $cgi->param($p);
@@ -112,10 +141,7 @@ sub upload {
     if !eval { $dat = decode_utf8($dat, 1); 1; };
   msg("You don't have much to paste, do you?", 'backform') if $dat =~ /^[ \n\s\t]*$/s && $s ne 'whitespace';
 
-  require Text::VimColor if $s ne 'nosyntax';
-
-  my $html = $s eq 'nosyntax' ? undef
-    : decode_utf8(Text::VimColor->new(string => encode_utf8($dat), filetype => $s)->html());
+  my $html = $s eq 'nosyntax' ? undef : get_html({ raw => $dat, syntax => $s, parse_urls => $c});
   $db->do('INSERT INTO pastes (code, syntax, wrap, raw, html, ip, parse_urls, passcode) VALUES(?,?,?,?,?,?,?,?)',
     undef, $code, $s, $w, $dat, $html, $ENV{REMOTE_ADDR}, $c, $p || undef);
 
@@ -140,17 +166,11 @@ sub get {
 
 sub view {
   my $code = shift;
-  my $r = get $code, 'wrap, raw, html, parse_urls';
+  my $r = get $code, 'wrap, raw, html, parse_urls, syntax';
 
   my $cnt = ($r->{raw} =~ y/\n/\n/);
   $cnt += 1 if $r->{raw} !~ /\n$/;
-  if(!$r->{html}) {
-    $r->{html} = escape $r->{raw};
-  } else {
-    $r->{html} =~ s/\n/<br \/>/g;
-  }
-  $r->{html} =~ s/&quot;/"/g;
-  $r->{html} =~ s{(http|ftp|https)://([\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&:/~\+#]*[\w\-\@?^=%&/~\+#])?)}{<a href="$1://$2" rel="nofollow">$1://$2</a>}g if $r->{parse_urls};
+  my $html = get_html($r);
   html(
     qq{<a href="#" onclick="return unpaste('/$code')">unpaste</a>},
     qq{<a href="/$code.txt">raw</a>},
@@ -158,7 +178,7 @@ sub view {
     sprintf q|<tr><td class="numbers"><pre>%s</pre></td><td class="top code"><pre%s>%s</pre></td></tr>|,
       $r->{wrap} ? '' : join("\n", map qq|<a name="r$_" href="#r$_">$_</a>|, 1..$cnt),
       $r->{wrap} ? ' class="allowwrap"' : '',
-      $r->{html},
+      $html
   );
   exit;
 }