diff options
author | Yorhel <git@yorhel.nl> | 2010-10-16 12:39:41 +0200 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2010-10-16 12:39:41 +0200 |
commit | ac7b16d0ec0f195d00a0a79698f67c3010e8cf7d (patch) | |
tree | 31217a7b16cdfcb30231b19a2826f3f6121c247b /index.cgi | |
parent | 2541eef8a806d56c06614199ce7826ca675c892d (diff) |
Greatly improved accuracy of URL-to-link conversion
Diffstat (limited to 'index.cgi')
-rwxr-xr-x | index.cgi | 46 |
1 files changed, 33 insertions, 13 deletions
@@ -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/"/"/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; } |