102 lines
2.8 KiB
Perl
102 lines
2.8 KiB
Perl
# Selima Website Content Management System
|
|
# A2HTML.pm: The text to HTML converter.
|
|
|
|
# Copyright (c) 2003-2018 imacat.
|
|
#
|
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
|
# you may not use this file except in compliance with the License.
|
|
# You may obtain a copy of the License at
|
|
#
|
|
# http://www.apache.org/licenses/LICENSE-2.0
|
|
#
|
|
# Unless required by applicable law or agreed to in writing, software
|
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
# See the License for the specific language governing permissions and
|
|
# limitations under the License.
|
|
|
|
# Author: imacat <imacat@mail.imacat.idv.tw>
|
|
# First written: 2003-03-24
|
|
|
|
package Selima::A2HTML;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Exporter);
|
|
use vars qw(@EXPORT @EXPORT_OK);
|
|
BEGIN {
|
|
@EXPORT = qw(a2html);
|
|
@EXPORT_OK = @EXPORT;
|
|
# Prototype declaration
|
|
sub a2html($);
|
|
}
|
|
|
|
use Email::Find qw();
|
|
use URI::Find qw();
|
|
|
|
use Selima::MarkAbbr;
|
|
use Selima::MungAddr;
|
|
use Selima::ShortCut;
|
|
use Selima::Unicode;
|
|
|
|
use vars qw(%SUBST $TEXT $uri_finder $email_finder);
|
|
$uri_finder = new URI::Find( \&uri_subst );
|
|
$email_finder = new Email::Find( \&email_subst );
|
|
|
|
# a2html: Convert a textarea input into HTML content
|
|
sub a2html($) {
|
|
local ($_, %_);
|
|
$TEXT = $_[0];
|
|
|
|
# Clear the registry
|
|
%SUBST = qw();
|
|
# Strip the URLs
|
|
$uri_finder->find(\$TEXT);
|
|
# Strip the e-mails
|
|
$email_finder->find(\$TEXT);
|
|
# Escape the HTML characters and mark the abbreviation
|
|
$TEXT = h_abbr($TEXT);
|
|
# Return the substitutied URLs and e-mails as links
|
|
$TEXT =~ s/(\[subst:(\d{9})\])/exists $SUBST{$2}? $SUBST{$2}: $1;/ge;
|
|
# Normal text-to-HTML substitution
|
|
$TEXT =~ s/^ / /mg;
|
|
$TEXT =~ s/ / /g;
|
|
$TEXT =~ s/\n/<br \/>\n/g;
|
|
|
|
return $TEXT;
|
|
}
|
|
|
|
# uri_subst: Substitute an URL in the content
|
|
sub uri_subst {
|
|
local ($_, %_);
|
|
my ($uri, $uritext);
|
|
($uri, $uritext) = @_;
|
|
do {
|
|
# Generate a random serial number
|
|
$_ = 100000000 + int rand 900000000;
|
|
} until $TEXT !~ /\[subst:$_\]/;
|
|
# Register this URI
|
|
$SUBST{$_} = "<a href=\"" . h($uri) . "\"><samp>"
|
|
. mung_email_span(h($uritext)) . "</samp></a>";
|
|
# Return the substitution
|
|
return "[subst:$_]";
|
|
}
|
|
|
|
# email_subst: Substitute an e-mail in the content
|
|
sub email_subst {
|
|
local ($_, %_);
|
|
my ($email, $emailtext);
|
|
($email, $emailtext) = @_;
|
|
do {
|
|
# Generate a random serial number
|
|
$_ = 100000000 + int rand 900000000;
|
|
} until $TEXT !~ /\[subst:$_\]/;
|
|
# Register this URI
|
|
$SUBST{$_} = "<a href=\"mailto:" . h($email->format) . "\"><samp>"
|
|
. mung_email_span(h($emailtext)) . "</samp></a>";
|
|
# Return the substitution
|
|
return "[subst:$_]";
|
|
}
|
|
|
|
return 1;
|