package Text::Hatena::AutoLink;
use strict;
use warnings;
use Carp;
use Regexp::Assemble;
use base qw(Class::Data::Inheritable);
use vars qw($VERSION);
__PACKAGE__->mk_classdata('syntax');
__PACKAGE__->syntax({});
$VERSION = '0.20';
my $ra;
my $syntax = {
'\[\](.+?)\[\]' => \&unbracket,
'(?:\[)?(ftp:\/\/[A-Za-z0-9~\/._\?\&=\-%#\+:\;,\@\']+)(?:\])?' => \&http,
'(?:\[)?(https?:\/\/[A-Za-z0-9~\/._\?\&=\-%#\+:\;,\@\']+)(?:\])?' => \&http,
'\[(https?:\/\/[A-Za-z0-9~\/._\?\&=\-%#\+:\;,\@\']+(?:jpg|jpeg|gif|png|bmp)):image(:[hw]\d+)?\]' => \&http_image,
'\[(https?:\/\/[A-Za-z0-9~\/._\?\&=\-%#\+:\;,\@\']+):title=([^\]]+)\]' => \&http_title,
'(?:\[)?mailto:(\w[\w\.-]+\@\w[\w\.\-]*\w)(?:\])?' => \&mailto,
};
sub parse {
my $class = shift;
my $text = shift;
my $html = '';
my $ra = $class->ra;
while ($text && $ra->match($text)) {
$html .= substr($text, 0, $ra->mbegin->[0]) if $ra->mbegin->[0];
my $handler = $class->syntax->{$ra->matched} || $syntax->{$ra->matched};
$html .= $handler->($ra->mvar());
$text = substr($text, $ra->mend->[0]);
}
$html .= $text if $text;
return $html;
}
sub ra {
my $class = shift;
unless ($ra) {
$ra = Regexp::Assemble->new(
flags => 'i',
track => 1,
reduce => 1,
);
$ra->add(keys %$syntax, keys %{$class->syntax});
}
return $ra;
}
sub unbracket {
my $mvar = shift;
return $mvar->[1];
}
sub http {
my $mvar = shift;
my $url = $mvar->[0];
return sprintf('<a href="%s">%s</a>', $url, $url);
}
sub http_image {
my $mvar = shift;
my $url = $mvar->[1];
my $size = '';
if ($mvar->[2] && $mvar->[2] =~ /^:([hw])(\d+)$/o) {
my $hw = $1 eq 'h' ? 'height' : 'width';
$size = sprintf(qq|$hw="%d" |, $2);
}
return sprintf('<a href="%s"><img src="%s" alt="%s" %s/></a>',
$url, $url, $url, $size);
}
sub http_title {
my $mvar = shift;
my $url = $mvar->[1];
my $title = $mvar->[2];
return sprintf('<a href="%s">%s</a>', $url, $title);
}
sub mailto {
my $mvar = shift;
my $addr = $mvar->[1];
return sprintf('<a href="mailto:%s">mailto:%s</a>', $addr, $addr);
}
1;
__END__
=head1 NAME
Text::AutoLink - Perl extension for making hyperlinks in text automatically.
=head1 SYNOPSIS
use Text::Hatena::AutoLink;
my $parser = Text::Hatena::AutoLink->new;
my $html = $parser->parse($text);
=head1 DESCRIPTION
Text::Hatena::AutoLink makes many hyperlinks in text automatically.
Urls will be changed into hyperlinks.
=over 4
=item Incompatibility at version 0.20
All codes were rewritten at version 0.20 and some functions were removed.
API for parsing text were changed too. Please be careful to upgrade your
Text::Hatena::AutoLink to version 0.20+.
=back
=head1 METHODS
Here are common methods of Text::Hatena::AutoLink.
=over 4
=item parse
my $html = $parser->parse($text);
parses text and make links. It returns html.
=back
=head1 Text::Hatena::AutoLink Syntax
Text::Hatena::AutoLink supports some simple syntaxes.
http://www.hatena.ne.jp/
[http://www.hatena.ne.jp/:title=Hatena]
[http://www.hatena.ne.jp/images/top/h1.gif:image]
[http://www.hatena.ne.jp/images/top/h1.gif:image:w300]
mailto:someone@example.com
These lines all become into hyperlinks.
[]http://dont.link.to.me/[]
You can avoid being hyperlinked with 2 pair brackets like the above line.
=head1 SEE ALSO
L<Text::Hatena>
=head1 AUTHOR
Junya Kondo, E<lt>jkondo@hatena.ne.jpE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) Hatena Inc. All Rights Reserved.
This library is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.
=cut