# 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 = ""; } $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
$to moved from $putBack$from on $date by $by \n
\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"; $metaText .= " \n"; my @fields = $meta->find( "FIELD" ); foreach my $field ( @fields ) { my $title = $field->{"title"}; my $value = $field->{"value"}; $metaText .= "$name \n"; } $metaText .= " $title: $value "; } 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;