# Main Module of TWiki Collaboration Platform, http://TWiki.org/
# ($wikiversion has version info)
#
# Copyright (C) 1999-2003 Peter Thoeny, peter@thoeny.com
#
# Based on parts of Ward Cunninghams original Wiki and JosWiki.
# Copyright (C) 1998 Markus Peter - SPiN GmbH (warpi@spin.de)
# Some changes by Dave Harris (drh@bhresearch.co.uk) incorporated
#
# For licensing info read license.txt file in the TWiki root.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details, published at
# http://www.gnu.org/copyleft/gpl.html
#
# Notes:
# - Latest version at http://twiki.org/
# - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt
# - Customize variables in TWiki.cfg when installing TWiki.
# - Optionally create a new plugin or customize DefaultPlugin.pm for
# custom rendering rules.
# - Upgrading TWiki is easy as long as you only customize DefaultPlugin.pm.
# - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log
#
# 20000501 Kevin Kinnell : changed beta0404 to have many new search
# capabilities. This file had a new hash added
# for month name-to-number look-ups, a slight
# change in the parameter list for the search
# script call in &handleSearchWeb, and a new
# sub -- &revDate2EpSecs -- for calculating the
# epoch seconds from a rev date (the only way
# to sort dates.)
package TWiki;
use strict;
use Time::Local; # Added for revDate2EpSecs
use Cwd qw( cwd ); # Added for getTWikiLibDir
require 5.005; # For regex objects and internationalisation
# ===========================
# TWiki config variables from TWiki.cfg:
use vars qw(
$webName $topicName $includingWebName $includingTopicName
$defaultUserName $userName $wikiName $wikiUserName
$wikiHomeUrl $defaultUrlHost $urlHost
$scriptUrlPath $pubUrlPath $viewScript
$pubDir $templateDir $dataDir $logDir $twikiLibDir
$siteWebTopicName $wikiToolName $securityFilter $uploadFilter
$debugFilename $warningFilename $htpasswdFilename
$logFilename $remoteUserFilename $wikiUsersTopicname
$userListFilename %userToWikiList %wikiToUserList
$twikiWebname $mainWebname $mainTopicname $notifyTopicname
$wikiPrefsTopicname $webPrefsTopicname
$statisticsTopicname $statsTopViews $statsTopContrib $doDebugStatistics
$numberOfRevisions $editLockTime
$attachAsciiPath $scriptSuffix $wikiversion
$safeEnvPath $mailProgram $noSpamPadding $mimeTypesFilename
$doKeepRevIfEditLock $doGetScriptUrlFromCgi $doRemovePortNumber
$doRemoveImgInMailnotify $doRememberRemoteUser $doPluralToSingular
$doHidePasswdInRegistration $doSecureInclude
$doLogTopicView $doLogTopicEdit $doLogTopicSave $doLogRename
$doLogTopicAttach $doLogTopicUpload $doLogTopicRdiff
$doLogTopicChanges $doLogTopicSearch $doLogRegistration
$disableAllPlugins
);
# ===========================
# Global variables:
use vars qw(
@isoMonth @weekDay
$TranslationToken %mon2num $isList @listTypes @listElements
$newTopicFontColor $newTopicBgColor $noAutoLink $linkProtocolPattern
$headerPatternDa $headerPatternSp $headerPatternHt $headerPatternNoTOC
$debugUserTime $debugSystemTime
$viewableAttachmentCount $noviewableAttachmentCount
$superAdminGroup $doSuperAdminGroup
$cgiQuery @publicWebList
$formatVersion $OS
$readTopicPermissionFailed
$pageMode
);
# Internationalisation and regex setup:
use vars qw(
$basicInitDone $useLocale $localeRegexes $siteLocale $siteCharset $siteLang
$upperNational $lowerNational
$upperAlpha $lowerAlpha $mixedAlpha $mixedAlphaNum $lowerAlphaNum $numeric
$wikiWordRegex $webNameRegex $defaultWebNameRegex $anchorRegex $abbrevRegex $emailAddrRegex
$singleUpperAlphaRegex $singleLowerAlphaRegex $singleUpperAlphaNumRegex
$singleMixedAlphaNumRegex $singleMixedNonAlphaNumRegex
$singleMixedNonAlphaRegex $mixedAlphaNumRegex
);
# TWiki::Store config:
use vars qw(
$rcsDir $rcsArg $nullDev $endRcsCmd $storeTopicImpl $keywordMode
$storeImpl @storeSettings
);
# TWiki::Search config:
use vars qw(
$cmdQuote $lsCmd $egrepCmd $fgrepCmd
);
# ===========================
# TWiki version:
$wikiversion = "01 Feb 2003";
# ===========================
# Key Global variables, required for writeDebug
# (new variables must be declared in "use vars qw(..)" above)
@isoMonth = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
@weekDay = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
{
my $count = 0;
%mon2num = map { $_ => $count++ } @isoMonth;
}
# ===========================
# Read the configuration file at compile time in order to set locale
BEGIN {
do "TWiki.cfg";
# Do a dynamic 'use locale' for this module
if( $useLocale ) {
require locale;
import locale ();
}
}
sub writeDebug;
sub writeWarning;
# writeDebug "got useLocale = $useLocale";
# ===========================
# use TWiki and other modules
use TWiki::Prefs; # preferences
use TWiki::Search; # search engine
use TWiki::Access; # access control
use TWiki::Meta; # Meta class - topic meta data
use TWiki::Store; # file I/O and rcs related functions
use TWiki::Attach; # file attachment functions
use TWiki::Form; # forms for topics
use TWiki::Func; # official TWiki functions for plugins
use TWiki::Plugins; # plugins handler #AS
use TWiki::Net; # SMTP, get URL
# ===========================
# Other Global variables
# Token character/string that must not occur in any normal text - converted
# to a flag character if it ever does occur (very unlikely).
$TranslationToken= "\0"; # Null should not be used by any charsets
# Use a multi-byte token only if above clashes with multi-byte character sets
# $TranslationToken= "_token_\0";
# The following are also initialized in initialize, here for cases where
# initialize not called.
$cgiQuery = 0;
@publicWebList = ();
$noAutoLink = 0;
$viewScript = "view";
$linkProtocolPattern = "(http|ftp|gopher|news|file|https|telnet)";
# Header patterns based on '+++'. The '###' are reserved for numbered headers
$headerPatternDa = '^---+(\++|\#+)\s*(.+)\s*$'; # '---++ Header', '---## Header'
$headerPatternSp = '^\t(\++|\#+)\s*(.+)\s*$'; # ' ++ Header', ' + Header'
$headerPatternHt = '^
.*$/io ) {
$insidePre = 1;
$line = "";
}
if( $line =~ /^.*<\/pre>.*$/io ) {
$insidePre = 0;
$line = "";
}
if (!$insidePre) {
$level = $line ;
if ( $line =~ /$headerPatternDa/o ) {
$level =~ s/$headerPatternDa/$1/go;
$level = length $level;
$line =~ s/$headerPatternDa/$2/go;
} elsif
( $line =~ /$headerPatternSp/o ) {
$level =~ s/$headerPatternSp/$1/go;
$level = length $level;
$line =~ s/$headerPatternSp/$2/go;
} elsif
( $line =~ /$headerPatternHt/io ) {
$level =~ s/$headerPatternHt/$1/gio;
$line =~ s/$headerPatternHt/$2/gio;
}
if( ( $line ) && ( $level <= $depth ) ) {
$anchor = makeAnchorName( $line );
# cut TOC exclude '---+ heading !! exclude'
$line =~ s/\s*$headerPatternNoTOC.+$//go;
next unless $line;
$highest = $level if( $level < $highest );
$tabs = "";
for( $i=0 ; $i<$level ; $i++ ) {
$tabs = "\t$tabs";
}
# Remove *bold* and _italic_ formatting
$line =~ s/(^|[\s\(])\*([^\s]+?|[^\s].*?[^\s])\*($|[\s\,\.\;\:\!\?\)])/$1$2$3/g;
$line =~ s/(^|[\s\(])_+([^\s]+?|[^\s].*?[^\s])_+($|[\s\,\.\;\:\!\?\)])/$1$2$3/g;
# Prevent WikiLinks
$line =~ s/\[\[.*\]\[(.*?)\]\]/$1/g; # '[[...][...]]'
$line =~ s/\[\[(.*?)\]\]/$1/ge; # '[[...]]'
$line =~ s/([\s\(])($webNameRegex)\.($wikiWordRegex)/$1$3/g; # 'Web.TopicName'
$line =~ s/([\s\(])($wikiWordRegex)/$1$2/g; # 'TopicName'
$line =~ s/([\s\(])($abbrevRegex)/$1$2/g; # 'TLA'
# create linked bullet item
$line = "$tabs* $line";
$result .= "\n$line";
}
}
}
if( $result ) {
if( $highest > 1 ) {
# left shift TOC
$highest--;
$result =~ s/^\t{$highest}//gm;
}
return $result;
} else {
return showError("TOC: No TOC in \"$web.$topicname\"");
}
}
# =========================
sub getPublicWebList
{
# FIXME: Should this go elsewhere?
# (Not in Store because Store should not be dependent on Prefs.)
if( ! @publicWebList ) {
# build public web list, e.g. exclude hidden webs, but include current web
my @list = &TWiki::Store::getAllWebs( "" );
my $item = "";
my $hidden = "";
foreach $item ( @list ) {
$hidden = &TWiki::Prefs::getPreferencesValue( "NOSEARCHALL", $item );
# exclude topics that are hidden or start with . or _ unless current web
if( ( $item eq $TWiki::webName ) || ( ( ! $hidden ) && ( $item =~ /^[^\.\_]/ ) ) ) {
push( @publicWebList, $item );
}
}
}
return @publicWebList;
}
# =========================
sub handleWebAndTopicList
{
my( $theAttr, $isWeb ) = @_;
my $format = extractNameValuePair( $theAttr );
$format = extractNameValuePair( $theAttr, "format" ) if( ! $format );
my $separator = extractNameValuePair( $theAttr, "separator" ) || "\n";
$format .= '$name' if( ! ( $format =~ /\$name/ ) );
my $web = extractNameValuePair( $theAttr, "web" ) || "";
my $webs = extractNameValuePair( $theAttr, "webs" ) || "public";
my $selection = extractNameValuePair( $theAttr, "selection" ) || "";
my $marker = extractNameValuePair( $theAttr, "marker" ) || "selected";
my @list = ();
if( $isWeb ) {
my @webslist = split( /,/, $webs );
foreach my $aweb ( @webslist ) {
if( $aweb eq "public" ) {
push( @list, getPublicWebList() );
} elsif( $aweb eq "webtemplate" ) {
push( @list, grep { /^\_/o } &TWiki::Store::getAllWebs( "" ) );
} else{
push( @list, $aweb ) if( &TWiki::Store::webExists( $aweb ) );
}
}
} else {
$web = $webName if( ! $web );
my $hidden = &TWiki::Prefs::getPreferencesValue( "NOSEARCHALL", $web );
if( ( $web eq $TWiki::webName ) || ( ! $hidden ) ) {
@list = &TWiki::Store::getTopicNames( $web );
}
}
my $text = "";
my $item = "";
my $line = "";
my $mark = "";
foreach $item ( @list ) {
$line = $format;
$line =~ s/\$web/$web/goi;
$line =~ s/\$name/$item/goi;
$line =~ s/\$qname/"$item"/goi;
$mark = ( $item eq $selection ) ? $marker : "";
$line =~ s/\$marker/$mark/goi;
$text .= "$line$separator";
}
$text =~ s/$separator$//s; # remove last separator
return $text;
}
# =========================
sub handleUrlParam
{
my( $theParam ) = @_;
$theParam = extractNameValuePair( $theParam );
my $value = "";
if( $cgiQuery ) {
$value = $cgiQuery->param( $theParam );
$value = "" unless( defined $value );
}
return $value;
}
# =========================
# Encode 8-bit-set characters for use in URLs (not using UTF8 URL
# encoding by browser)
sub handleUrlEncode
{
my( $theStr, $doExtract ) = @_;
$theStr = extractNameValuePair( $theStr ) if( $doExtract );
$theStr =~ s/[\n\r]/\%3Cbr\%20\%3E/g;
$theStr =~ s/\s+/\%20/g;
$theStr =~ s/\&/\%26/g;
$theStr =~ s/\\%3C/g;
$theStr =~ s/\>/\%3E/g;
$theStr =~ s/([\x7f-\xff])/'%' . unpack( "H*", $1 ) /ge;
return $theStr;
}
# =========================
sub handleEnvVariable
{
my( $theVar ) = @_;
my $value = $ENV{$theVar} || "";
return $value;
}
# =========================
sub handleTmplP
{
my( $theParam ) = @_;
$theParam = extractNameValuePair( $theParam );
my $value = &TWiki::Store::handleTmplP( $theParam );
return $value;
}
# =========================
# Create spaced-out topic name for Ref-By search
sub handleSpacedTopic
{
my( $theTopic ) = @_;
my $spacedTopic = $theTopic;
$spacedTopic =~ s/($singleLowerAlphaRegex+)($singleUpperAlphaNumRegex+)/$1%20*$2/go; # "%20*" is " *"
return $spacedTopic;
}
# =========================
sub handleInternalTags
{
# modify arguments directly, i.e. call by reference
# $_[0] is text
# $_[1] is topic
# $_[2] is web
# Make Edit URL unique for every edit - fix for RefreshEditPage
$_[0] =~ s!%EDITURL%!"$scriptUrlPath/edit$scriptSuffix/%URLENCODE{\"%WEB%/%TOPIC%\"}%\?t=" . time()!ge;
$_[0] =~ s/%NOP{(.*?)}%/$1/gs; # remove NOP tag in template topics but show content
$_[0] =~ s/%NOP%//g;
$_[0] =~ s/%TMPL\:P{(.*?)}%/&handleTmplP($1)/ge;
$_[0] =~ s/%SEP%/&handleTmplP('"sep"')/ge;
$_[0] =~ s/%HTTP_HOST%/&handleEnvVariable('HTTP_HOST')/ge;
$_[0] =~ s/%REMOTE_ADDR%/&handleEnvVariable('REMOTE_ADDR')/ge;
$_[0] =~ s/%REMOTE_PORT%/&handleEnvVariable('REMOTE_PORT')/ge;
$_[0] =~ s/%REMOTE_USER%/&handleEnvVariable('REMOTE_USER')/ge;
# Un-encoded topic and web names. Note: In form action, URL encode variables
# that might have 8-bit characters with %INTURLENCODE{"%TOPIC%"}%
$_[0] =~ s/%TOPIC%/$_[1]/g;
$_[0] =~ s/%BASETOPIC%/$topicName/g;
$_[0] =~ s/%INCLUDINGTOPIC%/$includingTopicName/g;
$_[0] =~ s/%SPACEDTOPIC%/&handleSpacedTopic($_[1])/ge;
$_[0] =~ s/%WEB%/$_[2]/g;
$_[0] =~ s/%BASEWEB%/$webName/g;
$_[0] =~ s/%INCLUDINGWEB%/$includingWebName/g;
$_[0] =~ s/%CHARSET%/$siteCharset/g;
$_[0] =~ s/%TOPICLIST{(.*?)}%/&handleWebAndTopicList($1,'0')/ge;
$_[0] =~ s/%WEBLIST{(.*?)}%/&handleWebAndTopicList($1,'1')/ge;
$_[0] =~ s/%WIKIHOMEURL%/$wikiHomeUrl/g;
$_[0] =~ s/%SCRIPTURL%/$urlHost$scriptUrlPath/g;
$_[0] =~ s/%SCRIPTURLPATH%/$scriptUrlPath/g;
$_[0] =~ s/%SCRIPTSUFFIX%/$scriptSuffix/g;
$_[0] =~ s/%PUBURL%/$urlHost$pubUrlPath/g;
$_[0] =~ s/%PUBURLPATH%/$pubUrlPath/g;
$_[0] =~ s/%ATTACHURL%/$urlHost$pubUrlPath\/$_[2]\/$_[1]/g;
$_[0] =~ s/%ATTACHURLPATH%/$pubUrlPath\/$_[2]\/$_[1]/g;
$_[0] =~ s/%URLPARAM{(.*?)}%/&handleUrlParam($1)/ge;
$_[0] =~ s/%URLENCODE{(.*?)}%/&handleUrlEncode($1,1)/ge;
$_[0] =~ s/%INTURLENCODE{(.*?)}%/&handleUrlEncode($1,1)/ge;
$_[0] =~ s/%DATE%/&getGmDate()/ge; # deprecated, but used in signatures
$_[0] =~ s/%GMTIME%/&handleTime("","gmtime")/ge;
$_[0] =~ s/%GMTIME{(.*?)}%/&handleTime($1,"gmtime")/ge;
$_[0] =~ s/%SERVERTIME%/&handleTime("","servertime")/ge;
$_[0] =~ s/%SERVERTIME{(.*?)}%/&handleTime($1,"servertime")/ge;
$_[0] =~ s/%WIKIVERSION%/$wikiversion/g;
$_[0] =~ s/%USERNAME%/$userName/g;
$_[0] =~ s/%WIKINAME%/$wikiName/g;
$_[0] =~ s/%WIKIUSERNAME%/$wikiUserName/g;
$_[0] =~ s/%WIKITOOLNAME%/$wikiToolName/g;
$_[0] =~ s/%MAINWEB%/$mainWebname/g;
$_[0] =~ s/%TWIKIWEB%/$twikiWebname/g;
$_[0] =~ s/%HOMETOPIC%/$mainTopicname/g;
$_[0] =~ s/%WIKIUSERSTOPIC%/$wikiUsersTopicname/g;
$_[0] =~ s/%WIKIPREFSTOPIC%/$wikiPrefsTopicname/g;
$_[0] =~ s/%WEBPREFSTOPIC%/$webPrefsTopicname/g;
$_[0] =~ s/%NOTIFYTOPIC%/$notifyTopicname/g;
$_[0] =~ s/%STATISTICSTOPIC%/$statisticsTopicname/g;
$_[0] =~ s/%STARTINCLUDE%//g;
$_[0] =~ s/%STOPINCLUDE%//g;
$_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/ge; # can be nested
$_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/ge if( $_[0] =~ /%SEARCH/o );
$_[0] =~ s/%METASEARCH{(.*?)}%/&handleMetaSearch($1)/ge;
}
# =========================
sub takeOutVerbatim
{
my( $intext, $verbatim ) = @_;
if( $intext !~ //oi ) {
return( $intext );
}
# Exclude text inside verbatim from variable substitution
my $tmp = "";
my $outtext = "";
my $nesting = 0;
my $verbatimCount = $#{$verbatim} + 1;
foreach( split( /\n/, $intext ) ) {
if( /^(\s*)\s*$/i ) {
$nesting++;
if( $nesting == 1 ) {
$outtext .= "$1%_VERBATIM$verbatimCount%\n";
$tmp = "";
next;
}
} elsif( m|^\s* \s*$|i ) {
$nesting--;
if( ! $nesting ) {
$verbatim->[$verbatimCount++] = $tmp;
next;
}
}
if( $nesting ) {
$tmp .= "$_\n";
} else {
$outtext .= "$_\n";
}
}
# Deal with unclosed verbatim
if( $nesting ) {
$verbatim->[$verbatimCount] = $tmp;
}
return $outtext;
}
# =========================
# set type=verbatim to get back original text
# type=pre to convert to HTML readable verbatim text
sub putBackVerbatim
{
my( $text, $type, @verbatim ) = @_;
for( my $i=0; $i<=$#verbatim; $i++ ) {
my $val = $verbatim[$i];
if( $type ne "verbatim" ) {
$val =~ s/</g;
$val =~ s/>/g;
$val =~ s/\t/ /g; # A shame to do this, but been in TWiki.org have converted
# 3 spaces to tabs since day 1
}
$text =~ s|%_VERBATIM$i%|<$type>\n$val$type>|;
}
return $text;
}
# =========================
sub handleCommonTags
{
my( $text, $theTopic, $theWeb, @theProcessedTopics ) = @_;
# PTh 22 Jul 2000: added $theWeb for correct handling of %INCLUDE%, %SEARCH%
if( !$theWeb ) {
$theWeb = $webName;
}
my @verbatim = ();
$text = takeOutVerbatim( $text, \@verbatim );
# handle all preferences and internal tags (for speed: call by reference)
$includingWebName = $theWeb;
$includingTopicName = $theTopic;
&TWiki::Prefs::handlePreferencesTags( $text );
handleInternalTags( $text, $theTopic, $theWeb );
# recursively process multiple embedded %INCLUDE% statements and prefs
$text =~ s/%INCLUDE{(.*?)}%/&handleIncludeFile($1, $theTopic, $theWeb, \@verbatim, @theProcessedTopics )/ge;
# Wiki Plugin Hook
&TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb, 0 );
# handle tags again because of plugin hook
&TWiki::Prefs::handlePreferencesTags( $text );
handleInternalTags( $text, $theTopic, $theWeb );
$text =~ s/%TOC{([^}]*)}%/&handleToc($text,$theTopic,$theWeb,$1)/ge;
$text =~ s/%TOC%/&handleToc($text,$theTopic,$theWeb,"")/ge;
# Ideally would put back in getRenderedVersion rather than here which would save removing
# it again! But this would mean altering many scripts to pass back verbatim
$text = putBackVerbatim( $text, "verbatim", @verbatim );
return $text;
}
# =========================
sub handleMetaTags
{
my( $theWeb, $theTopic, $text, $meta, $isTopRev ) = @_;
$text =~ s/%META{\s*"form"\s*}%/&renderFormData( $theWeb, $theTopic, $meta )/ge;
$text =~ s/%META{\s*"attachments"\s*(.*)}%/&TWiki::Attach::renderMetaData( $theWeb,
$theTopic, $meta, $1, $isTopRev )/ge;
$text =~ s/%META{\s*"moved"\s*}%/&renderMoved( $theWeb, $theTopic, $meta )/ge;
$text =~ s/%META{\s*"parent"\s*(.*)}%/&renderParent( $theWeb, $theTopic, $meta, $1 )/ge;
$text = &TWiki::handleCommonTags( $text, $theTopic );
return $text;
}
# ========================
sub renderParent
{
my( $web, $topic, $meta, $args ) = @_;
my $text = "";
my $dontRecurse = 0;
my $noWebHome = 0;
my $prefix = "";
my $suffix = "";
my $usesep = "";
if( $args ) {
$dontRecurse = extractNameValuePair( $args, "dontrecurse" );
$noWebHome = extractNameValuePair( $args, "nowebhome" );
$prefix = extractNameValuePair( $args, "prefix" );
$suffix = extractNameValuePair( $args, "suffix" );
$usesep = extractNameValuePair( $args, "separator" );
}
if( ! $usesep ) {
$usesep = " > ";
}
my %visited = ();
$visited{"$web.$topic"} = 1;
my $sep = "";
my $cWeb = $web;
while( 1 ) {
my %parent = $meta->findOne( "TOPICPARENT" );
if( %parent ) {
my $name = $parent{"name"};
my $pWeb = $cWeb;
my $pTopic = $name;
if( $name =~ /^(.*)\.(.*)$/ ) {
$pWeb = $1;
$pTopic = $2;
}
if( $noWebHome && ( $pTopic eq $mainTopicname ) ) {
last; # exclude "WebHome"
}
$text = "[[$pWeb.$pTopic][$pTopic]]$sep$text";
$sep = $usesep;
if( $dontRecurse || ! $name ) {
last;
} else {
my $dummy;
if( $visited{"$pWeb.$pTopic"} ) {
last;
} else {
$visited{"$pWeb.$pTopic"} = 1;
}
if( TWiki::Store::topicExists( $pWeb, $pTopic ) ) {
( $meta, $dummy ) = TWiki::Store::readTopMeta( $pWeb, $pTopic );
} else {
last;
}
$cWeb = $pWeb;
}
} else {
last;
}
}
if( $text && $prefix ) {
$text = "$prefix$text";
}
if( $text && $suffix ) {
$text .= $suffix;
}
if( $text ) {
$text = handleCommonTags( $text, $topic, $web );
$text = getRenderedVersion( $text, $web );
}
return $text;
}
# ========================
sub renderMoved
{
my( $web, $topic, $meta ) = @_;
my $text = "";
my %moved = $meta->findOne( "TOPICMOVED" );
if( %moved ) {
my $from = $moved{"from"};
$from =~ /(.*)\.(.*)/;
my $fromWeb = $1;
my $fromTopic = $2;
my $to = $moved{"to"};
$to =~ /(.*)\.(.*)/;
my $toWeb = $1;
my $toTopic = $2;
my $by = $moved{"by"};
$by = userToWikiName( $by );
my $date = $moved{"date"};
$date = formatGmTime( $date );
# Only allow put back, if current web and topic match stored to information
my $putBack = "";
if( $web eq $toWeb && $topic eq $toTopic ) {
$putBack = " - put it back";
}
$text = "$to moved from $from on $date by $by $putBack
";
}
$text = handleCommonTags( $text, $topic, $web );
$text = getRenderedVersion( $text, $web );
return $text;
}
# =========================
sub renderFormData
{
my( $web, $topic, $meta ) = @_;
my $metaText = "";
my %form = $meta->findOne( "FORM" );
if( %form ) {
my $name = $form{"name"};
$metaText = "\n\n ";
$metaText .= " $name \n";
my @fields = $meta->find( "FIELD" );
foreach my $field ( @fields ) {
my $title = $field->{"title"};
my $value = $field->{"value"};
$metaText .= " $title: $value \n";
}
$metaText .= "
\n";
$metaText = getRenderedVersion( $metaText, $web );
}
return $metaText;
}
# =========================
sub encodeSpecialChars
{
my( $text ) = @_;
$text =~ s/&/%_A_%/g;
$text =~ s/\"/%_Q_%/g;
$text =~ s/>/%_G_%/g;
$text =~ s/%_L_%/g;
# PTh, JoachimDurchholz 22 Nov 2001: Fix for Codev.OperaBrowserDoublesEndOfLines
$text =~ s/(\r*\n|\r)/%_N_%/g;
return $text;
}
sub decodeSpecialChars
{
my( $text ) = @_;
$text =~ s/%_N_%/\r\n/g;
$text =~ s/%_L_%//g;
$text =~ s/%_Q_%/\"/g;
$text =~ s/%_A_%/&/g;
return $text;
}
# =========================
sub emitList {
my( $theType, $theElement, $theDepth ) = @_;
my $olType = 0;
if ($_[3]) {
$olType = $_[3];
}
my $result = "";
$isList = 1;
if( @listTypes < $theDepth ) {
my $firstTime = 1;
while( @listTypes < $theDepth ) {
push( @listTypes, $theType );
push( @listElements, $theElement );
$result .= "<$theElement>\n" unless( $firstTime );
if ($olType) {
$result .= "<$theType type='$olType'>\n";
} else {
$result .= "<$theType>\n";
}
$firstTime = 0;
}
} elsif( @listTypes > $theDepth ) {
while( @listTypes > $theDepth ) {
local($_) = pop @listElements;
$result .= "$_>\n";
local($_) = pop @listTypes;
$result .= "$_>\n";
}
$result .= "$listElements[$#listElements]>\n" if( @listElements );
} elsif( @listElements ) {
$result = "$listElements[$#listElements]>\n";
}
if( ( @listTypes ) && ( $listTypes[$#listTypes] ne $theType ) ) {
$result .= "$listTypes[$#listTypes]>\n<$theType>\n";
$listTypes[$#listTypes] = $theType;
$listElements[$#listElements] = $theElement;
}
return $result;
}
# =========================
sub emitTR {
my ( $thePre, $theRow, $insideTABLE ) = @_;
my $text = "";
my $attr = "";
my $l1 = 0;
my $l2 = 0;
if( $insideTABLE ) {
$text = "$thePre";
} else {
$text = "$thePre $2<\/dt> /o && ( $result .= &emitList( "dl", "dd", length $1 ) );
s/^(\t+)\* / /o && ( $result .= &emitList( "ul", "li", length $1 ) );
s/^(\t+)\d+\.? ?/ /o && ( $result .= &emitList( "ol", "li", length $1 ) );
s/^(\t+)([1AaIi])\.? ?/ /o && ( $result .= &emitList( "ol", "li", length $1, $2 ) );
if( ! $isList ) {
$result .= &emitList( "", "", 0 );
$isList = 0;
}
# '#WikiName' anchors
s/^(\#)($wikiWordRegex)/ '<\/a>'/ge;
# enclose in white space for the regex that follow
s/(.*)/\n$1\n/;
# Emphasizing
# PTh 25 Sep 2000: More relaxed rules, allow leading '(' and trailing ',.;:!?)'
s/([\s\(])==([^\s]+?|[^\s].*?[^\s])==([\s\,\.\;\:\!\?\)])/$1 . &fixedFontText( $2, 1 ) . $3/ge;
s/([\s\(])__([^\s]+?|[^\s].*?[^\s])__([\s\,\.\;\:\!\?\)])/$1$2<\/em><\/strong>$3/g;
s/([\s\(])\*([^\s]+?|[^\s].*?[^\s])\*([\s\,\.\;\:\!\?\)])/$1$2<\/strong>$3/g;
s/([\s\(])_([^\s]+?|[^\s].*?[^\s])_([\s\,\.\;\:\!\?\)])/$1$2<\/em>$3/g;
s/([\s\(])=([^\s]+?|[^\s].*?[^\s])=([\s\,\.\;\:\!\?\)])/$1 . &fixedFontText( $2, 0 ) . $3/ge;
# Mailto
# Email addresses must always be 7-bit, even within I18N sites
# RD 27 Mar 02: Mailto improvements - FIXME: check security...
# Explicit [[mailto:... ]] link without an '@' - hence no
# anti-spam padding needed.
# '[[mailto:string display text]]' link (no '@' in 'string'):
s/\[\[mailto\:([^\s\@]+)\s+(.+?)\]\]/&mailtoLinkSimple( $1, $2 )/ge;
# Explicit [[mailto:... ]] link including '@', with anti-spam
# padding, so match name@subdom.dom.
# '[[mailto:string display text]]' link
s/\[\[mailto\:([a-zA-Z0-9\-\_\.\+]+)\@([a-zA-Z0-9\-\_\.]+)\.(.+?)(\s+|\]\[)(.*?)\]\]/&mailtoLinkFull( $1, $2, $3, $5 )/ge;
# Normal mailto:foo@example.com ('mailto:' part optional)
# FIXME: Should be '?' after the 'mailto:'...
s/([\s\(])(?:mailto\:)*([a-zA-Z0-9\-\_\.\+]+)\@([a-zA-Z0-9\-\_\.]+)\.([a-zA-Z0-9\-\_]+)(?=[\s\.\,\;\:\!\?\)])/$1 . &mailtoLink( $2, $3, $4 )/ge;
# Make internal links
# Spaced-out Wiki words with alternative link text
# '[[Web.odd wiki word#anchor][display text]]' link:
s/\[\[([^\]]+)\]\[([^\]]+)\]\]/&specificLink("",$theWeb,$theTopic,$2,$1)/ge;
# RD 25 Mar 02: Codev.EasierExternalLinking
# '[[URL#anchor display text]]' link:
s/\[\[([a-z]+\:\S+)\s+(.*?)\]\]/&specificLink("",$theWeb,$theTopic,$2,$1)/ge;
# Spaced-out Wiki words
# '[[Web.odd wiki word#anchor]]' link:
s/\[\[([^\]]+)\]\]/&specificLink("",$theWeb,$theTopic,$1,$1)/ge;
# do normal WikiWord link if not disabled by or NOAUTOLINK preferences variable
unless( $noAutoLink || $insideNoAutoLink ) {
# 'Web.TopicName#anchor' link:
s/([\s\(])($webNameRegex)\.($wikiWordRegex)($anchorRegex)/&internalLink($1,$2,$3,"$TranslationToken$3$4$TranslationToken",$4,1)/geo;
# 'Web.TopicName' link:
s/([\s\(])($webNameRegex)\.($wikiWordRegex)/&internalLink($1,$2,$3,"$TranslationToken$3$TranslationToken","",1)/geo;
# 'TopicName#anchor' link:
s/([\s\(])($wikiWordRegex)($anchorRegex)/&internalLink($1,$theWeb,$2,"$TranslationToken$2$3$TranslationToken",$3,1)/geo;
# 'TopicName' link:
s/([\s\(])($wikiWordRegex)/&internalLink($1,$theWeb,$2,$2,"",1)/geo;
# Handle acronyms/abbreviations of three or more letters
# 'Web.ABBREV' link:
s/([\s\(])($webNameRegex)\.($abbrevRegex)/&internalLink($1,$2,$3,$3,"",0)/geo;
# 'ABBREV' link:
s/([\s\(])($abbrevRegex)/&internalLink($1,$theWeb,$2,$2,"",0)/geo;
# (deprecated moved to DefaultPlugin)
s/$TranslationToken(\S.*?)$TranslationToken/$1/go;
}
s/^\n//;
s/\t/ /g;
$result .= $_;
} while( defined( $extraLines ) ); # extra lines produced by plugins
}
}
if( $insideTABLE ) {
$result .= "\n";
}
$result .= &emitList( "", "", 0 );
if( $insidePRE ) {
$result .= "\n";
}
# Wiki Plugin Hook
&TWiki::Plugins::endRenderingHandler( $result );
$result = putBackVerbatim( $result, "pre", @verbatim );
$result =~ s|\n?\n$||o; # clean up clutch
return "$head$result";
}
1;