Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Re: How to recognize url in text and convert to hyperlink, unless already in anchor

by pizza_milkshake (Monk)
on Oct 11, 2004 at 23:19 UTC ( #398331=note: print w/replies, xml ) Need Help??

in reply to How to recognize url in text and convert to hyperlink, unless already in anchor

$ cat
#!perl -l # ex: set ts=4: use strict; use warnings; use HTML::Parser; use URI; my (@tagstack, $BUF); sub start { # enter into tags my ($tag, $attr, $text) = @_; $tag .= " href" if ($tag eq "a" && defined $attr->{"href"}); push @tagstack, $tag; output($text); } sub end { # escape out of tags my ($tag, $text) = @_; shift @tagstack while (scalar @tagstack && $tagstack[0] ne $tag); shift @tagstack if scalar @tagstack; # actually nuke element we're + looking for output($text); } sub text { # handle everything inside and around tags my ($text) = @_; if (unlinked()) { # replace URLs with their linked equivalent if we're not withi +n a link $text =~ s{ \b(http://\S+) }{ "<a href=\"" . URI->new($1)->can +onical . "\">$1</a>" }gex; } output($text); } # are we inside a link right now? sub unlinked { return not scalar grep { /^a href$/ } @tagstack; } # add to output buffer sub output { $BUF .= shift @_; } # start code my $p = HTML::Parser->new( "start_h" => [ \&start, "tagname, attr, text" ] ,"end_h" => [ \&end, "tagname, text" ] ,"text_h" => [ \&text, "dtext" ] ); $p->parse(do{ local $/; <DATA> }); print $BUF; __DATA__ <a href=""></a> <a style="" href='bob'></a> <a href="whatever"></a> <a nolink></a> http://unlinked1
$ perl
<a href=""></a> <a style="" href='bob'></a> <a href="whatever"></a> <a nolink><a href=""></a></a> <a href="http://unlinked1/">http://unlinked1</a> <a href=""></a>

perl -e"\$_=qq/nwdd\x7F^n\x7Flm{{llql0}qs\x14/;s/./chr(ord$&^30)/ge;print"

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://398331]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2017-11-21 03:30 GMT
Find Nodes?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:

    Results (295 votes). Check out past polls.