# See bottom of file for license and copyright information

 package TWiki;

 =pod

 ---+ package TWiki

 TWiki operates by creating a singleton object (known as the Session

 object) that acts as a point of reference for all the different

 modules in the system. This package is the class for this singleton,

 and also contains the vast bulk of the basic constants and the per-

 site configuration mechanisms.

 Global variables are avoided wherever possible to avoid problems

 with CGI accelerators such as mod_perl.

 ---++ Public Data members

    * =cgiQuery=         Pointer to the CGI::

    * =context=          Hash of context ids

    * moved: =loginManager=     TWiki::LoginManager singleton (moved to TWiki::Users)

    * =plugins=          TWiki::Plugins singleton

    * =prefs=            TWiki::Prefs singleton

    * =remoteUser=       Login ID when using ApacheLogin. Maintained for

                         compatibility only, do not use.

    * =requestedWebName= Name of web found in URL path or =web= URL parameter

    * =sandbox=          TWiki::Sandbox singleton

    * =scriptUrlPath=    URL path to the current script. May be dynamically

                         extracted from the URL path if {GetScriptUrlFromCgi}.

                         Only required to support {GetScriptUrlFromCgi} and

                         not consistently used. Avoid.

    * =security=         TWiki::Access singleton

    * =SESSION_TAGS=     Hash of TWiki variables whose value is specific to

                         the current CGI request.

    * =store=            TWiki::Store singleton

    * =topicName=        Name of topic found in URL path or =topic= URL

                         parameter

    * =urlHost=          Host part of the URL (including the protocol)

                         determined during intialisation and defaulting to

                         {DefaultUrlHost}

    * =user=             Unique user ID of logged-in user

    * =users=            TWiki::Users singleton

    * =webName=          Name of web found in URL path, or =web= URL parameter,

                         or {UsersWebName}

 =cut

 use strict;

 use Assert;

 use Error qw( :try );

 use CGI;             # Always required to get the CGI object

 require 5.005;       # For regex objects and internationalisation

 # Site configuration constants

 use vars qw( %cfg );

 # Uncomment this and the __END__ to enable AutoLoader

 #use AutoLoader 'AUTOLOAD';

 # You then need to autosplit TWiki.pm:

 # cd lib

 # perl -e 'use AutoSplit; autosplit("TWiki.pm", "auto")'

 # Other computed constants

 use vars qw(

             $TranslationToken

             $twikiLibDir

             %regex

             %functionTags

             %contextFreeSyntax

             %restDispatch

             $VERSION $RELEASE

             $TRUE

             $FALSE

             $sandbox

             $ifParser

            );

 # Token character that must not occur in any normal text - converted

 # to a flag character if it ever does occur (very unlikely)

 # TWiki uses $TranslationToken to mark points in the text. This is

 # normally \0, which is not a useful character in any 8-bit character

 # set we can find, nor in UTF-8. But if you *do* encounter problems

 # with it, the workaround is to change $TranslationToken to something

 # longer that is unlikely to occur in your text - for example

 # muRfleFli5ble8leep (do *not* use punctuation characters or whitspace

 # in the string!)

 # See Codev.NationalCharTokenClash for more.

 $TranslationToken= "\0";

 =pod

 ---++ StaticMethod getTWikiLibDir() -> $path

 Returns the full path of the directory containing TWiki.pm

 =cut

 sub getTWikiLibDir {

     if( $twikiLibDir ) {

         return $twikiLibDir;

     }

     # FIXME: Should just use $INC{"TWiki.pm"} to get path used to load this

     # module.

     my $dir = '';

     foreach $dir ( @INC ) {

         if( $dir && -e "$dir/TWiki.pm" ) {

             $twikiLibDir = $dir;

             last;

         }

     }

     # fix path relative to location of called script

     if( $twikiLibDir =~ /^\./ ) {

         print STDERR "WARNING: TWiki lib path $twikiLibDir is relative; you should make it absolute, otherwise some scripts may not run from the command line.";

         my $bin;

         if( $ENV{SCRIPT_FILENAME} &&

             $ENV{SCRIPT_FILENAME} =~ /^(.+)\/[^\/]+$/ ) {

             # CGI script name

             $bin = $1;

         } elsif ( $0 =~ /^(.*)\/.*?$/ ) {

             # program name

             $bin = $1;

         } else {

             # last ditch; relative to current directory.

             require Cwd;

             import Cwd qw( cwd );

             $bin = cwd();

         }

         $twikiLibDir = "$bin/$twikiLibDir/";

         # normalize "/../" and "/./"

         while ( $twikiLibDir =~ s|([\\/])[^\\/]+[\\/]\.\.[\\/]|$1| ) {

         };

         $twikiLibDir =~ s|([\\/])\.[\\/]|$1|g;

     }

     $twikiLibDir =~ s|([\\/])[\\/]*|$1|g; # reduce "//" to "/"

     $twikiLibDir =~ s|[\\/]$||;           # cut trailing "/"

     return $twikiLibDir;

 }

 BEGIN {

     require Monitor;

     require TWiki::Sandbox;            # system command sandbox

     require TWiki::Configure::Load;    # read configuration files

     $TRUE = 1;

     $FALSE = 0;

     if( DEBUG ) {

         # If ASSERTs are on, then warnings are errors. Paranoid,

         # but the only way to be sure we eliminate them all.

         # Look out also for $cfg{WarningsAreErrors}, below, which

         # is another way to install this handler without enabling

         # ASSERTs

         # ASSERTS are turned on by defining the environment variable

         # TWIKI_ASSERTS. If ASSERTs are off, this is assumed to be a

         # production environment, and no stack traces or paths are

         # output to the browser.

         $SIG{'__WARN__'} = sub { die @_ };

         $Error::Debug = 1; # verbose stack traces, please

     } else {

         $Error::Debug = 0; # no verbose stack traces

     }

     # DO NOT CHANGE THE FORMAT OF $VERSION

     # Automatically expanded on checkin of this module

     $VERSION = '$Date: 2008-08-06 09:54:52 +1000 (Wed, 06 Aug 2008) $ $Rev: 17396 (11 Aug 2008) $ ';

     $RELEASE = 'TWiki-4.2.2';

     $VERSION =~ s/^.*?\((.*)\).*: (\d+) .*?$/$RELEASE, $1, build $2/;

     # Default handlers for different %TAGS%

     %functionTags = (

         ALLVARIABLES      => \&ALLVARIABLES,

         ATTACHURL         => \&ATTACHURL,

         ATTACHURLPATH     => \&ATTACHURLPATH,

         DATE              => \&DATE,

         DISPLAYTIME       => \&DISPLAYTIME,

         ENCODE            => \&ENCODE,

         ENV               => \&ENV,

         FORMFIELD         => \&FORMFIELD,

         GMTIME            => \&GMTIME,

         GROUPS            => \&GROUPS,

         HTTP_HOST         => \&HTTP_HOST_deprecated,

         HTTP              => \&HTTP,

         HTTPS             => \&HTTPS,

         ICON              => \&ICON,

         ICONURL           => \&ICONURL,

         ICONURLPATH       => \&ICONURLPATH,

         IF                => \&IF,

         INCLUDE           => \&INCLUDE,

         INTURLENCODE      => \&INTURLENCODE_deprecated,

         LANGUAGES         => \&LANGUAGES,

         MAKETEXT          => \&MAKETEXT,

         META              => \&META,

         METASEARCH        => \&METASEARCH,

         NOP               => \&NOP,

         PLUGINVERSION     => \&PLUGINVERSION,

         PUBURL            => \&PUBURL,

         PUBURLPATH        => \&PUBURLPATH,

         QUERYPARAMS       => \&QUERYPARAMS,

         QUERYSTRING       => \&QUERYSTRING,

         RELATIVETOPICPATH => \&RELATIVETOPICPATH,

         REMOTE_ADDR       => \&REMOTE_ADDR_deprecated,

         REMOTE_PORT       => \&REMOTE_PORT_deprecated,

         REMOTE_USER       => \&REMOTE_USER_deprecated,

         REVINFO           => \&REVINFO,

         REVTITLE          => \&REVTITLE,

         REVARG            => \&REVARG,

         SCRIPTNAME        => \&SCRIPTNAME,

         SCRIPTURL         => \&SCRIPTURL,

         SCRIPTURLPATH     => \&SCRIPTURLPATH,

         SEARCH            => \&SEARCH,

         SEP               => \&SEP,

         SERVERTIME        => \&SERVERTIME,

         SPACEDTOPIC       => \&SPACEDTOPIC_deprecated,

         SPACEOUT          => \&SPACEOUT,

         'TMPL:P'          => \&TMPLP,

         TOPICLIST         => \&TOPICLIST,

         URLENCODE         => \&ENCODE,

         URLPARAM          => \&URLPARAM,

         LANGUAGE          => \&LANGUAGE,

         USERINFO          => \&USERINFO,

         USERNAME          => \&USERNAME_deprecated,

         VAR               => \&VAR,

         WEBLIST           => \&WEBLIST,

         WIKINAME          => \&WIKINAME_deprecated,

         WIKIUSERNAME      => \&WIKIUSERNAME_deprecated,

         # Constant tag strings _not_ dependent on config. These get nicely

         # optimised by the compiler.

         ENDSECTION        => sub { '' },

         WIKIVERSION       => sub { $VERSION },

         STARTSECTION      => sub { '' },

         STARTINCLUDE      => sub { '' },

         STOPINCLUDE       => sub { '' },

        );

     $contextFreeSyntax{IF} = 1;

     unless( ( $TWiki::cfg{DetailedOS} = $^O ) ) {

         require Config;

         $TWiki::cfg{DetailedOS} = $Config::Config{'osname'};

     }

     $TWiki::cfg{OS} = 'UNIX';

     if ($TWiki::cfg{DetailedOS} =~ /darwin/i) { # MacOS X

         $TWiki::cfg{OS} = 'UNIX';

     } elsif ($TWiki::cfg{DetailedOS} =~ /Win/i) {

         $TWiki::cfg{OS} = 'WINDOWS';

     } elsif ($TWiki::cfg{DetailedOS} =~ /vms/i) {

         $TWiki::cfg{OS} = 'VMS';

     } elsif ($TWiki::cfg{DetailedOS} =~ /bsdos/i) {

         $TWiki::cfg{OS} = 'UNIX';

     } elsif ($TWiki::cfg{DetailedOS} =~ /dos/i) {

         $TWiki::cfg{OS} = 'DOS';

     } elsif ($TWiki::cfg{DetailedOS} =~ /^MacOS$/i) { # MacOS 9 or earlier

         $TWiki::cfg{OS} = 'MACINTOSH';

     } elsif ($TWiki::cfg{DetailedOS} =~ /os2/i) {

         $TWiki::cfg{OS} = 'OS2';

     }

     # Validate and untaint Apache's SERVER_NAME Environment variable

     # for use in referencing virtualhost-based paths for separate data/ and templates/ instances, etc

     if ( $ENV{SERVER_NAME} &&

          $ENV{SERVER_NAME} =~ /^(([a-zA-Z0-9]([a-zA-Z0-9\-]{0,61}[a-zA-Z0-9])?\.)+[a-zA-Z]{2,6})$/ ) {

         $ENV{SERVER_NAME} =

           TWiki::Sandbox::untaintUnchecked( $ENV{SERVER_NAME} );

     }

     # readConfig is defined in TWiki::Configure::Load to allow overriding it

     TWiki::Configure::Load::readConfig();

     if( $TWiki::cfg{WarningsAreErrors} ) {

         # Note: Warnings are always errors if ASSERTs are enabled

         $SIG{'__WARN__'} = sub { die @_ };

     }

     if( $TWiki::cfg{UseLocale} ) {

         require locale;

         import locale();

     }

     # Constant tags dependent on the config

     $functionTags{ALLOWLOGINNAME}  =

       sub { $TWiki::cfg{Register}{AllowLoginName} || 0 };

     $functionTags{AUTHREALM}       = sub { $TWiki::cfg{AuthRealm} };

     $functionTags{DEFAULTURLHOST}  = sub { $TWiki::cfg{DefaultUrlHost} };

     $functionTags{HOMETOPIC}       = sub { $TWiki::cfg{HomeTopicName} };

     $functionTags{LOCALSITEPREFS}  = sub { $TWiki::cfg{LocalSitePreferences} };

     $functionTags{NOFOLLOW}        =

       sub { $TWiki::cfg{NoFollow} ? 'rel='.$TWiki::cfg{NoFollow} : '' };

     $functionTags{NOTIFYTOPIC}     = sub { $TWiki::cfg{NotifyTopicName} };

     $functionTags{SCRIPTSUFFIX}    = sub { $TWiki::cfg{ScriptSuffix} };

     $functionTags{STATISTICSTOPIC} = sub { $TWiki::cfg{Stats}{TopicName} };

     $functionTags{SYSTEMWEB}       = sub { $TWiki::cfg{SystemWebName} };

     $functionTags{TRASHWEB}        = sub { $TWiki::cfg{TrashWebName} };

     $functionTags{TWIKIADMINLOGIN} = sub { $TWiki::cfg{AdminUserLogin} };

     $functionTags{USERSWEB}        = sub { $TWiki::cfg{UsersWebName} };

     $functionTags{WEBPREFSTOPIC}   = sub { $TWiki::cfg{WebPrefsTopicName} };

     $functionTags{WIKIPREFSTOPIC}  = sub { $TWiki::cfg{SitePrefsTopicName} };

     $functionTags{WIKIUSERSTOPIC}  = sub { $TWiki::cfg{UsersTopicName} };

     $functionTags{WIKIWEBMASTER}   = sub { $TWiki::cfg{WebMasterEmail} };

     $functionTags{WIKIWEBMASTERNAME} = sub { $TWiki::cfg{WebMasterName} };

     # Compatibility synonyms, deprecated in 4.2 but still used throughout

     # the documentation.

     $functionTags{MAINWEB}         = $functionTags{USERSWEB};

     $functionTags{TWIKIWEB}        = $functionTags{SYSTEMWEB};

     # locale setup

     #

     #

     # Note that 'use locale' must be done in BEGIN block for regexes and

     # sorting to work properly, although regexes can still work without

     # this in 'non-locale regexes' mode.

     if ( $TWiki::cfg{UseLocale} ) {

         # Set environment variables for grep 

         $ENV{LC_CTYPE} = $TWiki::cfg{Site}{Locale};

         # Load POSIX for I18N support.

         require POSIX;

         import POSIX qw( locale_h LC_CTYPE LC_COLLATE );

         # SMELL: mod_perl compatibility note: If TWiki is running under Apache,

         # won't this play with the Apache process's locale settings too?

         # What effects would this have?

         setlocale(&LC_CTYPE, $TWiki::cfg{Site}{Locale});

         setlocale(&LC_COLLATE, $TWiki::cfg{Site}{Locale});

     }

     $functionTags{CHARSET}   = sub { $TWiki::cfg{Site}{CharSet} ||

                                        'iso-8859-1' };

     $functionTags{LANG} = sub { 

         $TWiki::cfg{Site}{Locale} =~ m/^([a-z]+_[a-z]+)/i ? $1 : 'en_US'; };

     # Set up pre-compiled regexes for use in rendering.  All regexes with

     # unchanging variables in match should use the '/o' option.

     # In the regex hash, all precompiled REs have "Regex" at the

     # end of the name. Anything else is a string, either intended

     # for use as a character class, or as a sub-expression in

     # another compiled RE.

     # Build up character class components for use in regexes.

     # Depends on locale mode and Perl version, and finally on

     # whether locale-based regexes are turned off.

     if ( not $TWiki::cfg{UseLocale} or $] < 5.006

          or not $TWiki::cfg{Site}{LocaleRegexes} ) {

         # No locales needed/working, or Perl 5.005, so just use

         # any additional national characters defined in TWiki.cfg

         $regex{upperAlpha} = 'A-Z'.$TWiki::cfg{UpperNational};

         $regex{lowerAlpha} = 'a-z'.$TWiki::cfg{LowerNational};

         $regex{numeric}    = '\d';

         $regex{mixedAlpha} = $regex{upperAlpha}.$regex{lowerAlpha};

     } else {

         # Perl 5.006 or higher with working locales

         $regex{upperAlpha} = '[:upper:]';

         $regex{lowerAlpha} = '[:lower:]';

         $regex{numeric}    = '[:digit:]';

         $regex{mixedAlpha} = '[:alpha:]';

     }

     $regex{mixedAlphaNum} = $regex{mixedAlpha}.$regex{numeric};

     $regex{lowerAlphaNum} = $regex{lowerAlpha}.$regex{numeric};

     $regex{upperAlphaNum} = $regex{upperAlpha}.$regex{numeric};

     # Compile regexes for efficiency and ease of use

     # Note: qr// locks in regex modes (i.e. '-xism' here) - see Friedl

     # book at http://regex.info/. 

     $regex{linkProtocolPattern} =

       $TWiki::cfg{LinkProtocolPattern};

     # Header patterns based on '+++'. The '###' are reserved for numbered

     # headers

     # '---++ Header', '---## Header'

     $regex{headerPatternDa} = qr/^---+(\++|\#+)(.*)$/m;

     # '<h6>Header</h6>

     $regex{headerPatternHt} = qr/^<h([1-6])>(.+?)<\/h\1>/mi;

     # '---++!! Header' or '---++ Header %NOTOC% ^top'

     $regex{headerPatternNoTOC} = '(\!\!+|%NOTOC%)';

     # TWiki concept regexes

     $regex{wikiWordRegex} = qr/[$regex{upperAlpha}]+[$regex{lowerAlphaNum}]+[$regex{upperAlpha}]+[$regex{mixedAlphaNum}]*/o;

     $regex{webNameBaseRegex} = qr/[$regex{upperAlpha}]+[$regex{mixedAlphaNum}_]*/o;

     if ($TWiki::cfg{EnableHierarchicalWebs}) {

         $regex{webNameRegex} = qr/$regex{webNameBaseRegex}(?:(?:[\.\/]$regex{webNameBaseRegex})+)*/o;

     } else {

         $regex{webNameRegex} = $regex{webNameBaseRegex};

     }

     $regex{defaultWebNameRegex} = qr/_[$regex{mixedAlphaNum}_]+/o;

     $regex{anchorRegex} = qr/\#[$regex{mixedAlphaNum}_]+/o;

     $regex{abbrevRegex} = qr/[$regex{upperAlpha}]{3,}s?\b/o;

     # Simplistic email regex, e.g. for WebNotify processing - no i18n

     # characters allowed

     $regex{emailAddrRegex} = qr/([A-Za-z0-9\.\+\-\_]+\@[A-Za-z0-9\.\-]+)/;

     # Filename regex to used to match invalid characters in attachments - allow

     # alphanumeric characters, spaces, underscores, etc.

     # TODO: Get this to work with I18N chars - currently used only with UseLocale off

     $regex{filenameInvalidCharRegex} = qr/[^$regex{mixedAlphaNum}\. _-]/o;

     # Multi-character alpha-based regexes

     $regex{mixedAlphaNumRegex} = qr/[$regex{mixedAlphaNum}]*/o;

     # %TAG% name

     $regex{tagNameRegex} = '['.$regex{mixedAlpha}.']['.$regex{mixedAlphaNum}.'_:]*';

     # Set statement in a topic

     $regex{bulletRegex} = '^(?:\t|   )+\*';

     $regex{setRegex} = $regex{bulletRegex}.'\s+(Set|Local)\s+';

     $regex{setVarRegex} = $regex{setRegex}.'('.$regex{tagNameRegex}.')\s*=\s*(.*)$';

     # Character encoding regexes

     # 7-bit ASCII only

     $regex{validAsciiStringRegex} = qr/^[\x00-\x7F]+$/o;

     # Regex to match only a valid UTF-8 character, taking care to avoid

     # security holes due to overlong encodings by excluding the relevant

     # gaps in UTF-8 encoding space - see 'perldoc perlunicode', Unicode

     # Encodings section.  Tested against Markus Kuhn's UTF-8 test file

     # at http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt.

     $regex{validUtf8CharRegex} = qr{

                 # Single byte - ASCII

                 [\x00-\x7F] 

                 |

                 # 2 bytes

                 [\xC2-\xDF][\x80-\xBF] 

                 |

                 # 3 bytes

                     # Avoid illegal codepoints - negative lookahead

                     (?!\xEF\xBF[\xBE\xBF])    

                     # Match valid codepoints

                     (?:

                     ([\xE0][\xA0-\xBF])|

                     ([\xE1-\xEC\xEE-\xEF][\x80-\xBF])|

                     ([\xED][\x80-\x9F])

                     )

                     [\x80-\xBF]

                 |

                 # 4 bytes 

                     (?:

                     ([\xF0][\x90-\xBF])|

                     ([\xF1-\xF3][\x80-\xBF])|

                     ([\xF4][\x80-\x8F])

                     )

                     [\x80-\xBF][\x80-\xBF]

                 }xo;

     $regex{validUtf8StringRegex} =

       qr/^ (?: $regex{validUtf8CharRegex} )+ $/xo;

     # Check for unsafe search regex mode (affects filtering in) - default

     # to safe mode

     $TWiki::cfg{ForceUnsafeRegexes} = 0 unless defined $TWiki::cfg{ForceUnsafeRegexes};

     # initialize lib directory early because of later 'cd's

     getTWikiLibDir();

     Monitor::MARK('Static configuration loaded');

 };

 =pod

 ---++ StaticMethod UTF82SiteCharSet( $utf8 ) -> $ascii

 Auto-detect UTF-8 vs. site charset in string, and convert UTF-8 into site

 charset.

 =cut

 sub UTF82SiteCharSet {

     my $text = shift;

     return $text unless( defined $TWiki::cfg{Site}{CharSet} );

     # Detect character encoding of the full topic name from URL

     return undef if( $text =~ $regex{validAsciiStringRegex} );

     # If not UTF-8 - assume in site character set, no conversion required

     return undef unless( $text =~ $regex{validUtf8StringRegex} );

     # If site charset is already UTF-8, there is no need to convert anything:

     if ( $TWiki::cfg{Site}{CharSet} =~ /^utf-?8$/i ) {

         # warn if using Perl older than 5.8

         if( $] <  5.008 ) {

             print STDERR 'UTF-8 not remotely supported on Perl ', $],

               ' - use Perl 5.8 or higher..' ;

         }

         # We still don't have Codev.UnicodeSupport

         print STDERR 'UTF-8 not yet supported as site charset -',

           'TWiki is likely to have problems';

         return $text;

     }

     # Convert into ISO-8859-1 if it is the site charset.  This conversion

     # is *not valid for ISO-8859-15*.

     if ( $TWiki::cfg{Site}{CharSet} =~ /^iso-?8859-?1$/i ) {

         # ISO-8859-1 maps onto first 256 codepoints of Unicode

         # (conversion from 'perldoc perluniintro')

         $text =~ s/ ([\xC2\xC3]) ([\x80-\xBF]) / 

           chr( ord($1) << 6 & 0xC0 | ord($2) & 0x3F )

             /egx;

     } else {

         # Convert from UTF-8 into some other site charset

         if( $] >= 5.008 ) {

             require Encode;

             import Encode qw(:fallbacks);

             # Map $TWiki::cfg{Site}{CharSet} into real encoding name

             my $charEncoding =

               Encode::resolve_alias( $TWiki::cfg{Site}{CharSet} );

             if( not $charEncoding ) {

                 print STDERR

                   'Conversion to "',$TWiki::cfg{Site}{CharSet},

                     '" not supported, or name not recognised - check ',

                       '"perldoc Encode::Supported"';

             } else {

                 # Convert text using Encode:

                 # - first, convert from UTF8 bytes into internal

                 # (UTF-8) characters

                 $text = Encode::decode('utf8', $text);    

                 # - then convert into site charset from internal UTF-8,

                 # inserting \x{NNNN} for characters that can't be converted

                 $text =

                   Encode::encode( $charEncoding, $text,

                                   &FB_PERLQQ() );

             }

         } else {

             require Unicode::MapUTF8;    # Pre-5.8 Perl versions

             my $charEncoding = $TWiki::cfg{Site}{CharSet};

             if( not Unicode::MapUTF8::utf8_supported_charset($charEncoding) ) {

                 print STDERR 'Conversion to "',$TWiki::cfg{Site}{CharSet},

                   '" not supported, or name not recognised - check ',

                     '"perldoc Unicode::MapUTF8"';

             } else {

                 # Convert text

                 $text =

                   Unicode::MapUTF8::from_utf8({

                                                -string => $text,

                                                -charset => $charEncoding

                                               });

                 # FIXME: Check for failed conversion?

             }

         }

     }

     return $text;

 }

 =pod

 ---++ ObjectMethod writeCompletePage( $text, $pageType, $contentType )

 Write a complete HTML page with basic header to the browser.

    * =$text= is the text of the page body (<html> to </html> if it's HTML)

    * =$pageType= - May be "edit", which will cause headers to be generated that force

      caching for 24 hours, to prevent Codev.BackFromPreviewLosesText bug, which caused

      data loss with IE5 and IE6.

    * =$contentType= - page content type | text/html

 This method removes noautolink and nop tags before outputting the page unless

 $contentType is text/plain.

 =cut

 sub writeCompletePage {

     my ( $this, $text, $pageType, $contentType ) = @_;

     $contentType ||= 'text/html';

     if( $contentType ne 'text/plain' ) {

         # Remove <nop> and <noautolink> tags

         $text =~ s/([\t ]?)[ \t]*<\/?(nop|noautolink)\/?>/$1/gis;

         $text .= "\n" unless $text =~ /\n$/s;

         my $htmlHeader = join(

             "\n",

             map { '<!--'.$_.'-->'.$this->{_HTMLHEADERS}{$_} }

               keys %{$this->{_HTMLHEADERS}} );

         $text =~ s!(</head>)!$htmlHeader$1!i if $htmlHeader;

         chomp($text);

     }

     my $hdr = $this->generateHTTPHeaders( undef, $pageType, $contentType );

     # Call final handler

     $this->{plugins}->completePageHandler($text, $hdr);

     # HTTP1.1 says a content-length should _not_ be specified unless

     # the length is known. There is a bug in Netscape such that it

     # interprets a 0 content-length as "download until disconnect"

     # but that is a bug. The correct way is to not set a content-length.

     unless( $this->inContext('command_line') ) {

         # FIXME: Defer next line until we have Codev.UnicodeSupport

         # - too 5.8 dependent

         # my $len = do { use bytes; length( $text ); };

         my $len = length($text);

         $hdr =~ s/\n$/Content-Length: $len\n\n/s if $len;

     } else {

         $hdr = '';

     }

     print $hdr.$text;

 }

 =pod

 ---++ ObjectMethod generateHTTPHeaders( $query, $pageType, $contentType, $contentLength ) -> $header

 All parameters are optional.

    * =$query= CGI query object | Session CGI query (there is no good reason to set this)

    * =$pageType= - May be "edit", which will cause headers to be generated that force caching for 24 hours, to prevent Codev.BackFromPreviewLosesText bug, which caused data loss with IE5 and IE6.

    * =$contentType= - page content type | text/html

    * =$contentLength= - content-length | no content-length will be set if this is undefined, as required by HTTP1.1

 Implements the post-Dec2001 release plugin API, which requires the

 writeHeaderHandler in plugin to return a string of HTTP headers, CR/LF

 delimited. Filters any illegal headers. Plugin headers will override

 core settings.

 Does *not* add a =Content-length= header.

 =cut

 sub generateHTTPHeaders {

     my( $this, $query, $pageType, $contentType ) = @_;

     $query = $this->{cgiQuery} unless $query;

     # Handle Edit pages - future versions will extend to caching

     # of other types of page, with expiry time driven by page type.

     my( $pluginHeaders, $coreHeaders );

     my $hopts = {};

     if ($pageType && $pageType eq 'edit') {

         # Get time now in HTTP header format

         require TWiki::Time;

         my $lastModifiedString =

           TWiki::Time::formatTime(time, '$http', 'gmtime');

         # Expiry time is set high to avoid any data loss.  Each instance of 

         # Edit page has a unique URL with time-string suffix (fix for 

         # RefreshEditPage), so this long expiry time simply means that the 

         # browser Back button always works.  The next Edit on this page 

         # will use another URL and therefore won't use any cached 

         # version of this Edit page.

         my $expireHours = 24;

         my $expireSeconds = $expireHours * 60 * 60;

         # and cache control headers, to ensure edit page 

         # is cached until required expiry time.

         $hopts->{'last-modified'} = $lastModifiedString;

         $hopts->{expires} = "+${expireHours}h";

         $hopts->{'cache-control'} = "max-age=$expireSeconds";

     }

     # DEPRECATED plugins header handler. Plugins should use

     # modifyHeaderHandler instead.

     $pluginHeaders = $this->{plugins}->writeHeaderHandler( $query ) || '';

     if( $pluginHeaders ) {

         foreach ( split /\r?\n/, $pluginHeaders ) {

             if ( m/^([\-a-z]+): (.*)$/i ) {

                 $hopts->{$1} = $2;

             }

         }

     }

     $contentType = 'text/html' unless $contentType;

     if( defined( $TWiki::cfg{Site}{CharSet} )) {

       $contentType .= '; charset='.$TWiki::cfg{Site}{CharSet};

     }

     # use our version of the content type

     $hopts->{'Content-Type'} = $contentType;

     # New (since 1.026)

     $this->{plugins}->modifyHeaderHandler( $hopts, $this->{cgiQuery} );

     # add cookie(s)

     $this->{users}->{loginManager}->modifyHeader( $hopts );

     return CGI::header( $hopts );

 }

 =pod

 ---++ StaticMethod isRedirectSafe($redirect) => $ok

 tests if the $redirect is an external URL, returning false if AllowRedirectUrl is denied

 =cut

 sub isRedirectSafe {

     my $redirect = shift;

     #TODO: this should really use URI

     if ((!$TWiki::cfg{AllowRedirectUrl}) && ( $redirect =~ m!^([^:]*://[^/]*)/*(.*)?$! )) {

         my $host = $1;

         #remove trailing /'s to match

         $TWiki::cfg{DefaultUrlHost} =~ m!^([^:]*://[^/]*)/*(.*)?$!;

         my $expected = $1;

         if (defined($TWiki::cfg{PermittedRedirectHostUrls} ) && $TWiki::cfg{PermittedRedirectHostUrls}  ne '') {

             my @permitted =

                 map { s!^([^:]*://[^/]*)/*(.*)?$!$1!; $1 }

                         split(/,\s*/, $TWiki::cfg{PermittedRedirectHostUrls});

             return 1 if ( grep ( { uc($host) eq uc($_) } @permitted));

         }

         return (uc($host) eq uc($expected));

     }

     return 1;

 }

 # _getRedirectUrl() => redirectURL set from the parameter

 # Reads a redirect url from CGI parameter 'redirectto'.

 # This function is used to get and test the 'redirectto' cgi parameter, 

 # and then the calling function can set its own reporting if there is a

 # problem.

 sub _getRedirectUrl {

     my $session = shift;

     my $query = $session->{cgiQuery};

     my $redirecturl = $query->param( 'redirectto' );

     return '' unless $redirecturl;

     if( $redirecturl =~ m#^$regex{linkProtocolPattern}://#o ) {

         # assuming URL

         if (isRedirectSafe($redirecturl)) {

             return $redirecturl;

         } else {

             return '';

         }

     }

     # assuming 'web.topic' or 'topic'

     my ( $w, $t ) = $session->normalizeWebTopicName( $session->{webName}, $redirecturl );

     $redirecturl = $session->getScriptUrl( 1, 'view', $w, $t );

     return $redirecturl;

 }

 =pod

 ---++ ObjectMethod redirect( $url, $passthrough, $action_redirectto )

    * $url - url or twikitopic to redirect to

    * $passthrough - (optional) parameter to **FILLMEIN**

    * $action_redirectto - (optional) redirect to where ?redirectto=

      points to (if it's valid)

 Redirects the request to =$url=, *unless*

    1 It is overridden by a plugin declaring a =redirectCgiQueryHandler=.

    1 =$session->{cgiQuery}= is =undef= or

    1 $query->param('noredirect') is set to a true value.

 Thus a redirect is only generated when in a CGI context.

 Normally this method will ignore parameters to the current query. Sometimes,

 for example when redirecting to a login page during authentication (and then

 again from the login page to the original requested URL), you want to make

 sure all parameters are passed on, and for this $passthrough should be set to

 true. In this case it will pass all parameters that were passed to the

 current query on to the redirect target. If the request_method for the

 current query was GET, then all parameters will be passed by encoding them

 in the URL (after ?). If the request_method was POST, then there is a risk the

 URL would be too big for the receiver, so it caches the form data and passes

 over a cache reference in the redirect GET.

 NOTE: Passthrough is only meaningful if the redirect target is on the same

 server.

 =cut

 sub redirect {

     my( $this, $url, $passthru, $action_redirectto ) = @_;

     my $query = $this->{cgiQuery};

     # if we got here without a query, there's not much more we can do

     return unless $query;

     # SMELL: if noredirect is set, don't generate the redirect, throw an

     # exception instead. This is a HACK used to support TWikiDrawPlugin.

     # It is deprecated and must be replaced by REST handlers in the plugin.

     if( $query->param( 'noredirect' )) {

         die "ERROR: $url";

         return;

     }

     if ($action_redirectto) {

         my $redir = _getRedirectUrl($this);

         $url = $redir if ($redir);

     }

     if ($passthru && defined $ENV{REQUEST_METHOD}) {

         my $existing = '';

         if ($url =~ s/\?(.*)$//) {

             $existing = $1;

         }

         if ($ENV{REQUEST_METHOD} eq 'POST') {

             # Redirecting from a post to a get

             my $cache = $this->cacheQuery();

             if ($cache) {

                 $url .= "?$cache";

             }

         } else {

             if ($query->query_string()) {

                 $url .= '?'.$query->query_string();

             }

             if ($existing) {

                 if ($url =~ /\?/) {

                     $url .= ';';

                 } else {

                     $url .= '?';

                 }

                 $url .= $existing;

             }

         }

     }

     # prevent phishing by only allowing redirect to configured host

     # do this check as late as possible to catch _any_ last minute hacks

     # TODO: this should really use URI

     if (!isRedirectSafe($url)) {

          # goto oops if URL is trying to take us somewhere dangerous

          $url = $this->getScriptUrl(

              1, 'oops',

              $this->{web} || $TWiki::cfg{UsersWebName},

              $this->{topic} || $TWiki::cfg{HomeTopicName},

              template => 'oopsaccessdenied',

              def => 'topic_access',

              param1 => 'redirect',

              param2 => 'unsafe redirect to '.$url.

                ': host does not match {DefaultUrlHost} , and is not in {PermittedRedirectHostUrls}"'.

                  $TWiki::cfg{DefaultUrlHost}.'"'

             );

     }

     return if( $this->{plugins}->redirectCgiQueryHandler( $query, $url ));

     # SMELL: this is a bad breaking of encapsulation: the loginManager

     # should just modify the url, then the redirect should only happen here.

     return if( $this->{users}->{loginManager}->redirectCgiQuery( $query, $url ) );

     die "Login manager returned 0 from redirectCgiQuery";

 }

 =pod

 ---++ ObjectMethod cacheQuery() -> $queryString

 Caches the current query in the params cache, and returns a rewritten

 query string for the cache to be picked up again on the other side of a

 redirect.

 We can't encode post params into a redirect, because they may exceed the

 size of the GET request. So we cache the params, and reload them when the

 redirect target is reached.

 =cut

 sub cacheQuery {

     my $this = shift;

     my $query = $this->{cgiQuery};

     return '' unless (scalar($query->param()));

     # Don't double-cache

     return '' if ($query->param('twiki_redirect_cache'));

     require Digest::MD5;

     my $md5 = new Digest::MD5();

     $md5->add($$, time(), rand(time));

     my $uid = $md5->hexdigest();

     my $passthruFilename = "$TWiki::cfg{WorkingDir}/tmp/passthru_$uid";

     use Fcntl;

     #passthrough file is only written to once, so if it already exists, suspect a security hack (O_EXCL)

     sysopen(F, "$passthruFilename", O_RDWR|O_EXCL|O_CREAT, 0600) ||

       die "Unable to open $TWiki::cfg{WorkingDir}/tmp for write; check the setting of {WorkingDir} in configure, and check file permissions: $!";

     $query->save(\*F);

     close(F);

     return 'twiki_redirect_cache='.$uid;

 }

 =pod

 ---++ StaticMethod isValidWikiWord( $name ) -> $boolean

 Check for a valid WikiWord or WikiName

 =cut

 sub isValidWikiWord {

     my $name  = shift || '';

     return ( $name =~ m/^$regex{wikiWordRegex}$/o )

 }

 =pod

 ---++ StaticMethod isValidTopicName( $name ) -> $boolean

 Check for a valid topic name

 =cut

 sub isValidTopicName {

     my( $name ) = @_;

     return isValidWikiWord( @_ ) || isValidAbbrev( @_ );

 }

 =pod

 ---++ StaticMethod isValidAbbrev( $name ) -> $boolean

 Check for a valid ABBREV (acronym)

 =cut

 sub isValidAbbrev {

     my $name = shift || '';

     return ( $name =~ m/^$regex{abbrevRegex}$/o )

 }

 =pod

 ---++ StaticMethod isValidWebName( $name, $system ) -> $boolean

 STATIC Check for a valid web name. If $system is true, then

 system web names are considered valid (names starting with _)

 otherwise only user web names are valid

 If $TWiki::cfg{EnableHierarchicalWebs} is off, it will also return false

 when a nested web name is passed to it.

 =cut

 sub isValidWebName {

     my $name = shift || '';

     my $sys = shift;

     return 1 if ( $sys && $name =~ m/^$regex{defaultWebNameRegex}$/o );

     return ( $name =~ m/^$regex{webNameRegex}$/o )

 }

 =pod

 ---++ ObjectMethod readOnlyMirrorWeb( $theWeb ) -> ( $mirrorSiteName, $mirrorViewURL, $mirrorLink, $mirrorNote )

 If this is a mirrored web, return information about the mirror. The info

 is returned in a quadruple:

 | site name | URL | link | note |

 =cut

 sub readOnlyMirrorWeb {

     my( $this, $theWeb ) = @_;

     my @mirrorInfo = ( '', '', '', '' );

     if( $TWiki::cfg{SiteWebTopicName} ) {

         my $mirrorSiteName =

           $this->{prefs}->getWebPreferencesValue( 'MIRRORSITENAME', $theWeb );

         if( $mirrorSiteName && $mirrorSiteName ne $TWiki::cfg{SiteWebTopicName} ) {

             my $mirrorViewURL  =

               $this->{prefs}->getWebPreferencesValue( 'MIRRORVIEWURL', $theWeb );

             my $mirrorLink = $this->templates->readTemplate( 'mirrorlink' );

             $mirrorLink =~ s/%MIRRORSITENAME%/$mirrorSiteName/g;

             $mirrorLink =~ s/%MIRRORVIEWURL%/$mirrorViewURL/g;

             $mirrorLink =~ s/\s*$//g;

             my $mirrorNote = $this->templates->readTemplate( 'mirrornote' );

             $mirrorNote =~ s/%MIRRORSITENAME%/$mirrorSiteName/g;

             $mirrorNote =~ s/%MIRRORVIEWURL%/$mirrorViewURL/g;

             $mirrorNote = $this->renderer->getRenderedVersion

               ( $mirrorNote, $theWeb, $TWiki::cfg{HomeTopic} );

             $mirrorNote =~ s/\s*$//g;

             @mirrorInfo = ( $mirrorSiteName, $mirrorViewURL, $mirrorLink, $mirrorNote );

         }

     }

     return @mirrorInfo;

 }

 =pod

 ---++ ObjectMethod getSkin () -> $string

 Get the currently requested skin path

 =cut

 sub getSkin {

     my $this = shift;

     my $skinpath = $this->{prefs}->getPreferencesValue( 'SKIN' ) || '';

     if( $this->{cgiQuery} ) {

         my $resurface = $this->{cgiQuery}->param( 'skin' );

         $skinpath = $resurface if $resurface;

     }

     my $epidermis = $this->{prefs}->getPreferencesValue( 'COVER' );

     $skinpath = $epidermis.','.$skinpath if $epidermis;

     if( $this->{cgiQuery} ) {

         $epidermis = $this->{cgiQuery}->param( 'cover' );

         $skinpath = $epidermis.','.$skinpath if $epidermis;

     }

     return $skinpath;

 }

 =pod

 ---++ ObjectMethod getScriptUrl( $absolute, $script, $web, $topic, ... ) -> $scriptURL

 Returns the URL to a TWiki script, providing the web and topic as

 "path info" parameters.  The result looks something like this:

 "http://host/twiki/bin/$script/$web/$topic".

    * =...= - an arbitrary number of name,value parameter pairs that will be url-encoded and added to the url. The special parameter name '#' is reserved for specifying an anchor. e.g. <tt>getScriptUrl('x','y','view','#'=>'XXX',a=>1,b=>2)</tt> will give <tt>.../view/x/y?a=1&b=2#XXX</tt>

 If $absolute is set, generates an absolute URL. $absolute is advisory only;

 TWiki can decide to generate absolute URLs (for example when run from the

 command-line) even when relative URLs have been requested.

 The default script url is taken from {ScriptUrlPath}, unless there is

 an exception defined for the given script in {ScriptUrlPaths}. Both

 {ScriptUrlPath} and {ScriptUrlPaths} may be absolute or relative URIs. If

 they are absolute, then they will always generate absolute URLs. if they

 are relative, then they will be converted to absolute when required (e.g.

 when running from the command line, or when generating rss). If

 $script is not given, absolute URLs will always be generated.

 If either the web or the topic is defined, will generate a full url (including web and topic). Otherwise will generate only up to the script name. An undefined web will default to the main web name.

 =cut

 sub getScriptUrl {

     my( $this, $absolute, $script, $web, $topic, @params ) = @_;

     $absolute ||= ($this->inContext( 'command_line' ) ||

                      $this->inContext( 'rss' ) ||

                        $this->inContext( 'absolute_urls' ));

     # SMELL: topics and webs that contain spaces?

     my $url;

     if( defined $TWiki::cfg{ScriptUrlPaths} && $script) {

         $url = $TWiki::cfg{ScriptUrlPaths}{$script};

     }

     unless( defined( $url )) {

         $url = $TWiki::cfg{ScriptUrlPath};

         if( $script ) {

             $url .= '/' unless $url =~ /\/$/;

             $url .= $script;

             $url .= $TWiki::cfg{ScriptSuffix} if $script;

         }

     }

     if( $absolute && $url !~ /^[a-z]+:/ ) {

         # See http://www.ietf.org/rfc/rfc2396.txt for the definition of

         # "absolute URI". TWiki bastardises this definition by assuming

         # that all relative URLs lack the <authority> component as well.

         $url = $this->{urlHost}.$url;

     }

     if( $web || $topic ) {

         ( $web, $topic ) =

           $this->normalizeWebTopicName( $web, $topic );

         $url .= urlEncode( '/'.$web.'/'.$topic );

 	$url .= _make_params(0, @params);

     }

     return $url;

 }

 sub _make_params {

   my ( $notfirst, @args ) = @_;

   my $url = '';

   my $ps = '';

   my $anchor = '';

   while( my $p = shift @args ) {

     if( $p eq '#' ) {

       $anchor .= '#' . shift( @args );

     } else {

       $ps .= ';' . $p.'='.urlEncode(shift( @args )||'');

     }

   }

   if( $ps ) {

     $ps =~ s/^;/?/ unless $notfirst;

     $url .= $ps;

   }

   $url .= $anchor;

   return $url;

 }

 =pod

 ---++ ObjectMethod getPubUrl($absolute, $web, $topic, $attachment) -> $url

 Composes a pub url. If $absolute is set, returns an absolute URL.

 If $absolute is set, generates an absolute URL. $absolute is advisory only;

 TWiki can decide to generate absolute URLs (for example when run from the

 command-line) even when relative URLs have been requested.

 $web, $topic and $attachment are optional. A partial URL path will be

 generated if one or all is not given.

 =cut

 sub getPubUrl {

     my( $this, $absolute, $web, $topic, $attachment ) = @_;

     $absolute ||= ($this->inContext( 'command_line' ) ||

                      $this->inContext( 'rss' ) ||

                        $this->inContext( 'absolute_urls' ));

     my $url = '';

     $url .= $TWiki::cfg{PubUrlPath};

     if( $absolute && $url !~ /^[a-z]+:/ ) {

         # See http://www.ietf.org/rfc/rfc2396.txt for the definition of

         # "absolute URI". TWiki bastardises this definition by assuming

         # that all relative URLs lack the <authority> component as well.

         $url = $this->{urlHost}.$url;

     }

     if( $web || $topic || $attachment ) {

         ( $web, $topic ) =

           $this->normalizeWebTopicName( $web, $topic );

         my $path = '/'.$web.'/'.$topic;

 	if( $attachment ) {

 	    $path .= '/'.$attachment;

 	    # Attachments are served directly by web server, need to handle

 	    # URL encoding specially

 	    $url .= urlEncodeAttachment ( $path );

 	} else {

 	    $url .= urlEncode( $path );

 	}

     }

     return $url;

 }

 =pod

 ---++ ObjectMethod getIconUrl( $absolute, $iconName ) -> $iconURL

 Map an icon name to a URL path.

 =cut

 sub getIconUrl {

     my( $this, $absolute, $iconName ) = @_;

     my $iconTopic = $this->{prefs}->getPreferencesValue( 'ICONTOPIC' );

     my( $web, $topic) = $this->normalizeWebTopicName(

         $this->{webName}, $iconTopic );

     $iconName =~ s/^.*\.(.*?)$/$1/;

     return $this->getPubUrl( $absolute, $web, $topic, $iconName.'.gif' );

 }

 =pod

 ---++ ObjectMethod mapToIconFileName( $fileName, $default ) -> $fileName

 Maps from a filename (or just the extension) to the name of the

 file that contains the image for that file type.

 =cut

 sub mapToIconFileName {

     my( $this, $fileName, $default ) = @_;

     my @bits = ( split( /\./, $fileName ) );

     my $fileExt = lc $bits[$#bits];

     unless( $this->{_ICONMAP} ) {

         my $iconTopic = $this->{prefs}->getPreferencesValue( 'ICONTOPIC' );

         my( $web, $topic) = $this->normalizeWebTopicName(

             $this->{webName}, $iconTopic );

         local $/ = undef;

         try {

             my $icons = $this->{store}->getAttachmentStream(

                 undef, $web, $topic, '_filetypes.txt' );

             %{$this->{_ICONMAP}} = split( /\s+/, <$icons> );

             close( $icons );

         } catch Error::Simple with {

             %{$this->{_ICONMAP}} = ();

         };

     }

     return $this->{_ICONMAP}->{$fileExt} || $default || 'else';

 }

 =pod

 ---++ ObjectMethod normalizeWebTopicName( $theWeb, $theTopic ) -> ( $theWeb, $theTopic )

 Normalize a Web<nop>.<nop>TopicName

 See TWikiFuncDotPm for a full specification of the expansion (not duplicated

 here)

 *WARNING* if there is no web specification (in the web or topic parameters)

 the web defaults to $TWiki::cfg{UsersWebName}. If there is no topic

 specification, or the topic is '0', the topic defaults to the web home topic

 name.

 =cut

 sub normalizeWebTopicName {

     my( $this, $web, $topic ) = @_;

     ASSERT(defined $topic) if DEBUG;

     if( $topic =~ m|^(.*)[./](.*?)$| ) {

         $web = $1;

         $topic = $2;

     }

     $web ||= $cfg{UsersWebName};

     $topic ||= $cfg{HomeTopicName};

     while( $web =~ s/%((MAIN|TWIKI|USERS|SYSTEM|DOC)WEB)%/_expandTagOnTopicRendering( $this,$1)||''/e ) {

     }

     $web =~ s#\.#/#go;

     return( $web, $topic );

 }

 =pod

 ---++ ClassMethod new( $loginName, $query, \%initialContext )

 Constructs a new TWiki object. Parameters are taken from the query object.

    * =$loginName= is the login username (*not* the wikiname) of the user you

      want to be logged-in if none is available from a session or browser.

      Used mainly for side scripts and debugging.

    * =$query= the CGI query (may be undef, in which case an empty query

      is used)

    * =\%initialContext= - reference to a hash containing context

      name=value pairs to be pre-installed in the context hash

 =cut

 sub new {

     my( $class, $login, $query, $initialContext ) = @_;

     Monitor::MARK("Static compilation complete");

     # Compatibility; not used except maybe in plugins

     $TWiki::cfg{TempfileDir} = "$TWiki::cfg{WorkingDir}/tmp"

       unless defined($TWiki::cfg{TempfileDir});

     # Set command_line context if there is no query

     $initialContext ||= defined( $query ) ? {} : { command_line => 1 };

     $query ||= new CGI( {} );

     my $this = bless( {}, $class );

     # Tell CGI.pm which charset we are using if not default

     if( defined $TWiki::cfg{Site}{CharSet} &&

           $TWiki::cfg{Site}{CharSet} !~ /^iso-?8859-?1$/io ) {

         # Item5710: A bug in CGI::charset means we cannot use $query->charset

         CGI::charset( $TWiki::cfg{Site}{CharSet} );

     }

     $this->{_HTMLHEADERS} = {};

     $this->{context} = $initialContext;

     # create the various sub-objects

     unless ($sandbox) {

         # "shared" between mod_perl instances

         $sandbox = new TWiki::Sandbox(

             $TWiki::cfg{OS}, $TWiki::cfg{DetailedOS} );

     }

     require TWiki::Plugins;

     $this->{plugins} = new TWiki::Plugins( $this );

     require TWiki::Store;

     $this->{store} = new TWiki::Store( $this );

     # cache CGI information in the session object

     $this->{cgiQuery} = $query;

     $this->{remoteUser} = $login;	#use login as a default (set when running from cmd line)

     require TWiki::Users;

     $this->{users} = new TWiki::Users( $this );

 	$this->{remoteUser} = $this->{users}->{remoteUser};

     # Make %ENV safer, preventing hijack of the search path

     # SMELL: can this be done in a BEGIN block? Or is the environment

     # set per-query?

     # Item4382: Default $ENV{PATH} must be untainted because TWiki runs

     # with use strict and calling external programs that writes on the disk

     # will fail unless Perl seens it as set to safe value.

     if( $TWiki::cfg{SafeEnvPath} ) {

         $ENV{PATH} = $TWiki::cfg{SafeEnvPath};

     } else {

         $ENV{PATH} = TWiki::Sandbox::untaintUnchecked( $ENV{PATH} );

     }

     delete @ENV{ qw( IFS CDPATH ENV BASH_ENV ) };

     my $url = $query->url();

     if( $url && $url =~ m{^([^:]*://[^/]*).*$} ) {

         $this->{urlHost} = $1;

         # If the urlHost in the url is localhost, this is a lot less

         # useful than the default url host. This is because new CGI("")

         # assigns this host by default - it's a default setting, used

         # when there is nothing better available.

         if( $this->{urlHost} eq 'http://localhost' ) {

             $this->{urlHost} = $TWiki::cfg{DefaultUrlHost};

         } elsif( $TWiki::cfg{RemovePortNumber} ) {

             $this->{urlHost} =~ s/\:[0-9]+$//;

         }

     } else {

         $this->{urlHost} = $TWiki::cfg{DefaultUrlHost};

     }

     if (   $TWiki::cfg{GetScriptUrlFromCgi}

         && $url

         && $url =~ m{^[^:]*://[^/]*(.*)/.*$}

         && $1 )

     {

         # SMELL: this is a really dangerous hack. It will fail

         # spectacularly with mod_perl.

         # SMELL: why not just use $query->script_name?

         $this->{scriptUrlPath} = $1;

     }

     my $web = '';

     my $topic = $query->param( 'topic' );

     if( $topic ) {

         if( $topic =~ m#^$regex{linkProtocolPattern}://#o &&

             $this->{cgiQuery} ) {

             # redirect to URI

                 print $this->redirect( $topic );

                 exit;   #we seriously don't want to go through normal TWiki operations if we're redirecting..

         } elsif( $topic =~ /((?:.*[\.\/])+)(.*)/ ) {

             # is 'bin/script?topic=Webname.SomeTopic'

             $web   = $1;

             $topic = $2;

             $web =~ s/\./\//go;

             $web =~ s/\/$//o;

             # jump to WebHome if 'bin/script?topic=Webname.'

             $topic = $TWiki::cfg{HomeTopicName} if( $web && ! $topic );

         }

         # otherwise assume 'bin/script/Webname?topic=SomeTopic'

     } else {

         $topic = '';

     }

     # SMELL: "The Microsoft Internet Information Server is broken with

     # respect to additional path information. If you use the Perl DLL

     # library, the IIS server will attempt to execute the additional

     # path information as a Perl script. If you use the ordinary file

     # associations mapping, the path information will be present in the

     # environment, but incorrect. The best thing to do is to avoid using

     # additional path information."

     # Clean up PATH_INFO problems, e.g.  Support.CobaltRaqInstall.  A valid

     # PATH_INFO is '/Main/WebHome', i.e. the text after the script name;

     # invalid PATH_INFO is often a full path starting with '/cgi-bin/...'.

     my $pathInfo = $query->path_info();

     my $cgiScriptName = $ENV{SCRIPT_NAME} || '';

     $pathInfo =~ s!$cgiScriptName/!/!i;

     # Get the web and topic names from PATH_INFO

     if( $pathInfo =~ /\/((?:.*[\.\/])+)(.*)/ ) {

         # is 'bin/script/Webname/SomeTopic' or 'bin/script/Webname/'

         $web   = $1 unless $web;

         $topic = $2 unless $topic;

         $web =~ s/\./\//go;

         $web =~ s/\/$//o;

     } elsif( $pathInfo =~ /\/(.*)/ ) {

         # is 'bin/script/Webname' or 'bin/script/'

         $web = $1 unless $web;

     }

     # All roads lead to WebHome

     $topic = $TWiki::cfg{HomeTopicName} if ( $topic =~ /\.\./ );

     $topic =~ s/$TWiki::cfg{NameFilter}//go;

     $topic = $TWiki::cfg{HomeTopicName} unless $topic;

     $this->{topicName} = TWiki::Sandbox::untaintUnchecked( $topic );

     $web   =~ s/$TWiki::cfg{NameFilter}//go;

     $this->{requestedWebName} = TWiki::Sandbox::untaintUnchecked( $web ); #can be an empty string

     $web = $TWiki::cfg{UsersWebName} unless $web;

     $this->{webName} = TWiki::Sandbox::untaintUnchecked( $web );

     # Convert UTF-8 web and topic name from URL into site charset if necessary 

     # SMELL: merge these two cases, browsers just don't mix two encodings in one URL

     # - can also simplify into 2 lines by making function return unprocessed text if no conversion

     my $webNameTemp = UTF82SiteCharSet( $this->{webName} );

     if ( $webNameTemp ) {

         $this->{webName} = $webNameTemp;

     }

     my $topicNameTemp = UTF82SiteCharSet( $this->{topicName} );

     if ( $topicNameTemp ) {

         $this->{topicName} = $topicNameTemp;

     }

     # Item3270 - here's the appropriate place to enforce TWiki spec:

     # All topic name sources are evaluated, site charset applied

     # SMELL: This untaint unchecked is duplicate of one just above

     $this->{topicName}  =

         TWiki::Sandbox::untaintUnchecked(ucfirst $this->{topicName});

     $this->{scriptUrlPath} = $TWiki::cfg{ScriptUrlPath};

     require TWiki::Prefs;

     my $prefs = new TWiki::Prefs( $this );

     $this->{prefs} = $prefs;

     # Form definition cache

     $this->{forms} = {};

     # Push global preferences from TWiki.TWikiPreferences

     $prefs->pushGlobalPreferences();

 #TODO: what happens if we move this into the TWiki::User::new?

     $this->{user} = $this->{users}->initialiseUser($this->{remoteUser});

     # Static session variables that can be expanded in topics when they

     # are enclosed in % signs

     # SMELL: should collapse these into one. The duplication is pretty

     # pointless. Could get rid of the SESSION_TAGS hash, might be

     # the easiest thing to do, but then that would allow other

     # upper-case named fields in the object to be accessed as well...

     $this->{SESSION_TAGS}{BASEWEB}        = $this->{webName};

     $this->{SESSION_TAGS}{BASETOPIC}      = $this->{topicName};

     $this->{SESSION_TAGS}{INCLUDINGTOPIC} = $this->{topicName};

     $this->{SESSION_TAGS}{INCLUDINGWEB}   = $this->{webName};

     # Push plugin settings

     $this->{plugins}->settings();

     # Now the rest of the preferences

     $prefs->pushGlobalPreferencesSiteSpecific();

     # User preferences only available if we can get to a valid wikiname,

     # which depends on the user mapper.

     my $wn = $this->{users}->getWikiName( $this->{user} );

     if( $wn ) {

         $prefs->pushPreferences(

             $TWiki::cfg{UsersWebName}, $wn,

             'USER ' . $wn );

     }

     $prefs->pushWebPreferences( $this->{webName} );

     $prefs->pushPreferences(

         $this->{webName}, $this->{topicName}, 'TOPIC' );

     $prefs->pushPreferenceValues( 'SESSION',

                                   $this->{users}->{loginManager}->getSessionValues() );

     # Finish plugin initialization - register handlers

     $this->{plugins}->enable();

     $TWiki::Plugins::SESSION = $this;

     Monitor::MARK("TWiki session created");

     return $this;

 }

 =begin twiki

 ---++ ObjectMethod renderer()

 Get a reference to the renderer object. Done lazily because not everyone

 needs the renderer.

 =cut

 sub renderer {

     my( $this ) = @_;

     unless( $this->{renderer} ) {

         require TWiki::Render;

         # requires preferences (such as LINKTOOLTIPINFO)

         $this->{renderer} = new TWiki::Render( $this );

     }

     return $this->{renderer};

 }

 =begin twiki

 ---++ ObjectMethod attach()

 Get a reference to the attach object. Done lazily because not everyone

 needs the attach.

 =cut

 sub attach {

     my( $this ) = @_;

     unless( $this->{attach} ) {

         require TWiki::Attach;

         $this->{attach} = new TWiki::Attach( $this );

     }

     return $this->{attach};

 }

 =begin twiki

 ---++ ObjectMethod templates()

 Get a reference to the templates object. Done lazily because not everyone

 needs the templates.

 =cut

 sub templates {

     my( $this ) = @_;

     unless( $this->{templates} ) {

         require TWiki::Templates;

         $this->{templates} = new TWiki::Templates( $this );

     }

     return $this->{templates};

 }

 =begin twiki

 ---++ ObjectMethod i18n()

 Get a reference to the i18n object. Done lazily because not everyone

 needs the i18ner.

 =cut

 sub i18n {

     my( $this ) = @_;

     unless( $this->{i18n} ) {

         require TWiki::I18N;

         # language information; must be loaded after

         # *all possible preferences sources* are available

         $this->{i18n} = new TWiki::I18N( $this );

     }

     return $this->{i18n};

 }

 =begin twiki

 ---++ ObjectMethod search()

 Get a reference to the search object. Done lazily because not everyone

 needs the searcher.

 =cut

 sub search {

     my( $this ) = @_;

     unless( $this->{search} ) {

         require TWiki::Search;

         $this->{search} = new TWiki::Search( $this );

     }

     return $this->{search};

 }

 =begin twiki

 ---++ ObjectMethod security()

 Get a reference to the security object. Done lazily because not everyone

 needs the security.

 =cut

 sub security {

     my( $this ) = @_;

     unless( $this->{security} ) {

         require TWiki::Access;

         $this->{security} = new TWiki::Access( $this );

     }

     return $this->{security};

 }

 =begin twiki

 ---++ ObjectMethod net()

 Get a reference to the net object. Done lazily because not everyone

 needs the net.

 =cut

 sub net {

     my( $this ) = @_;

     unless( $this->{net} ) {

         require TWiki::Net;

         $this->{net} = new TWiki::Net( $this );

     }

     return $this->{net};

 }

 =begin twiki

 ---++ ObjectMethod finish()

 Break circular references.

 =cut

 # Note to developers; please undef *all* fields in the object explicitly,

 # whether they are references or not. That way this method is "golden

 # documentation" of the live fields in the object.

 sub finish {

     my $this = shift;

     map { $_->finish() } values %{$this->{forms}};

     $this->{plugins}->finish() if $this->{plugins};

     $this->{users}->finish() if $this->{users};

     $this->{prefs}->finish() if $this->{prefs};

     $this->{templates}->finish() if $this->{templates};

     $this->{renderer}->finish() if $this->{renderer};

     $this->{net}->finish() if $this->{net};

     $this->{store}->finish() if $this->{store};

     $this->{search}->finish() if $this->{search};

     $this->{attach}->finish() if $this->{attach};

     $this->{security}->finish() if $this->{security};

     $this->{i18n}->finish() if $this->{i18n};

     undef $this->{_HTMLHEADERS};

     undef $this->{cgiQuery};

     undef $this->{urlHost};

     undef $this->{web};

     undef $this->{topic};

     undef $this->{webName};

     undef $this->{topicName};

     undef $this->{_ICONMAP};

     undef $this->{context};

     undef $this->{remoteUser};

     undef $this->{requestedWebName}; # Web name before renaming

     undef $this->{scriptUrlPath};

     undef $this->{user};

     undef $this->{SESSION_TAGS};

     undef $this->{_INCLUDES};

     undef $this->{evaluating_if};

 }

 =pod

 ---++ ObjectMethod writeLog( $action, $webTopic, $extra, $user )

    * =$action= - what happened, e.g. view, save, rename

    * =$wbTopic= - what it happened to

    * =$extra= - extra info, such as minor flag

    * =$user= - user who did the saving (user id)

 Write the log for an event to the logfile

 =cut

 sub writeLog {

     my $this = shift;

     my $action = shift || '';

     my $webTopic = shift || '';

     my $extra = shift || '';

     my $user = shift;

     $user ||= $this->{user};

     $user = ($this->{users}->getLoginName( $user ) || 'unknown')

       if ($this->{users});

     if( $user eq $cfg{DefaultUserLogin} ) {

        my $cgiQuery = $this->{cgiQuery};

        if( $cgiQuery ) {

            my $agent = $cgiQuery->user_agent();

            if( $agent ) {

                $agent =~ m/([\w]+)/;

                $extra .= ' '.$1;

            }

        }

     }

     my $remoteAddr = $ENV{REMOTE_ADDR} || '';

     my $text = "$user | $action | $webTopic | $extra | $remoteAddr |";

     _writeReport( $this, $TWiki::cfg{LogFileName}, $text );

 }

 =pod

 ---++ ObjectMethod writeWarning( $text )

 Prints date, time, and contents $text to $TWiki::cfg{WarningFileName}, typically

 'warnings.txt'. Use for warnings and errors that may require admin

 intervention. Use this for defensive programming warnings (e.g. assertions).

 =cut

 sub writeWarning {

     my $this = shift;

     _writeReport( $this, $TWiki::cfg{WarningFileName}, @_ );

 }

 =pod

 ---++ ObjectMethod writeDebug( $text )

 Prints date, time, and contents of $text to $TWiki::cfg{DebugFileName}, typically

 'debug.txt'.  Use for debugging messages.

 =cut

 sub writeDebug {

     my $this = shift;

     _writeReport( $this, $TWiki::cfg{DebugFileName}, @_ );

 }

 # Concatenates date, time, and $text to a log file.

 # The logfilename can optionally use a %DATE% variable to support

 # logs that are rotated once a month.

 # | =$log= | Base filename for log file |

 # | =$message= | Message to print |

 sub _writeReport {

     my ( $this, $log, $message ) = @_;

     if ( $log ) {

         require TWiki::Time;

         my $time =

           TWiki::Time::formatTime( time(), '$year$mo', 'servertime');

         $log =~ s/%DATE%/$time/go;

         $time = TWiki::Time::formatTime( time(), undef, 'servertime' );

         if( open( FILE, ">>$log" ) ) {

             print FILE "| $time | $message\n";

             close( FILE );

         } else {

             print STDERR 'Could not write "'.$message.'" to '."$log: $!\n";

         }

     }

 }

 sub _removeNewlines {

     my( $theTag ) = @_;

     $theTag =~ s/[\r\n]+/ /gs;

     return $theTag;

 }

 # Convert relative URLs to absolute URIs

 sub _rewriteURLInInclude {

     my( $theHost, $theAbsPath, $url ) = @_;

     # leave out an eventual final non-directory component from the absolute path

     $theAbsPath =~ s/(.*?)[^\/]*$/$1/;

     if( $url =~ /^\// ) {

         # fix absolute URL

         $url = $theHost.$url;

     } elsif( $url =~ /^\./ ) {

         # fix relative URL

         $url = $theHost.$theAbsPath.'/'.$url;

     } elsif( $url =~ /^$regex{linkProtocolPattern}:/o ) {

         # full qualified URL, do nothing

     } elsif( $url =~ /^#/ ) {

         # anchor. This needs to be left relative to the including topic

         # so do nothing

     } elsif( $url ) {

         # FIXME: is this test enough to detect relative URLs?

         $url = $theHost.$theAbsPath.'/'.$url;

     }

     return $url;

 }

 # Add a web reference to a [[...][...]] link in an included topic

 sub _fixIncludeLink {

     my( $web, $link, $label ) = @_;

     # Detect absolute and relative URLs and web-qualified wikinames

     if( $link =~ m#^($regex{webNameRegex}\.|$regex{defaultWebNameRegex}\.|$regex{linkProtocolPattern}:|/)#o ) {

         if( $label ) {

             return "[[$link][$label]]";

         } else {

             return "[[$link]]";

         }

     } elsif( !$label ) {

         # Must be wikiword or spaced-out wikiword (or illegal link :-/)

         $label = $link;

     }

     return "[[$web.$link][$label]]";

 }

 # Replace web references in a topic. Called from forEachLine, applying to

 # each non-verbatim and non-literal line.

 sub _fixupIncludedTopic {

     my( $text, $options ) = @_;

     my $fromWeb = $options->{web};

     unless( $options->{in_noautolink} ) {

         # 'TopicName' to 'Web.TopicName'

         $text =~ s#(?:^|(?<=[\s(]))($regex{wikiWordRegex})(?=\s|\)|$)#$fromWeb.$1#go;

     }

     # Handle explicit [[]] everywhere

     # '[[TopicName][...]]' to '[[Web.TopicName][...]]'

     $text =~ s/\[\[([^]]+)\](?:\[([^]]+)\])?\]/

       _fixIncludeLink( $fromWeb, $1, $2 )/geo;

     return $text;

 }

 # Clean-up HTML text so that it can be shown embedded in a topic

 sub _cleanupIncludedHTML {

     my( $text, $host, $path, $options ) = @_;

     # FIXME: Make aware of <base> tag

     $text =~ s/^.*?<\/head>//is

       unless ( $options->{disableremoveheaders} );   # remove all HEAD

     $text =~ s/<script.*?<\/script>//gis

       unless ( $options->{disableremovescript} );    # remove all SCRIPTs

     $text =~ s/^.*?<body[^>]*>//is

       unless ( $options->{disableremovebody} );      # remove all to <BODY>

     $text =~ s/(?:\n)<\/body>.*//is

       unless ( $options->{disableremovebody} );      # remove </BODY>

     $text =~ s/(?:\n)<\/html>.*//is

       unless ( $options->{disableremoveheaders} );   # remove </HTML>

     $text =~ s/(<[^>]*>)/_removeNewlines($1)/ges

       unless ( $options->{disablecompresstags} );    # replace newlines in html tags with space

     $text =~ s/(\s(?:href|src|action)=(["']))(.*?)\2/$1._rewriteURLInInclude( $host, $path, $3 ).$2/geois

       unless ( $options->{disablerewriteurls} );

     return $text;

 }

 =pod

 ---++ StaticMethod applyPatternToIncludedText( $text, $pattern ) -> $text

 Apply a pattern on included text to extract a subset

 =cut

 sub applyPatternToIncludedText {

     my( $theText, $thePattern ) = @_;

     $thePattern =~ s/([^\\])([\$\@\%\&\#\'\`\/])/$1\\$2/g;  # escape some special chars

     $thePattern = TWiki::Sandbox::untaintUnchecked( $thePattern );

     $theText = '' unless( $theText =~ s/$thePattern/$1/is );

     return $theText;

 }

 # Fetch content from a URL for inclusion by an INCLUDE

 sub _includeUrl {

     my( $this, $url, $pattern, $web, $topic, $raw, $options, $warn ) = @_;

     my $text = '';

     # For speed, read file directly if URL matches an attachment directory

     if( $url =~ /^$this->{urlHost}$TWiki::cfg{PubUrlPath}\/($regex{webNameRegex})\/([^\/\.]+)\/([^\/]+)$/ ) {

         my $incWeb = $1;

         my $incTopic = $2;

         my $incAtt = $3;

         # FIXME: Check for MIME type, not file suffix

         if( $incAtt =~ m/\.(txt|html?)$/i ) {

             unless( $this->{store}->attachmentExists(

                 $incWeb, $incTopic, $incAtt )) {

                 return _includeWarning( $this, $warn, 'bad_attachment', $url );

             }

             if( $incWeb ne $web || $incTopic ne $topic ) {

                 # CODE_SMELL: Does not account for not yet authenticated user

                 unless( $this->security->checkAccessPermission(

                     'VIEW', $this->{user}, undef, undef, $incTopic, $incWeb ) ) {

                     return _includeWarning( $this, $warn, 'access_denied',

                                                    "$incWeb.$incTopic" );

                 }

             }

             $text = $this->{store}->readAttachment( undef, $incWeb, $incTopic,

                                                     $incAtt );

             $text = _cleanupIncludedHTML( $text, $this->{urlHost},

                                           $TWiki::cfg{PubUrlPath}, $options )

               unless $raw;

             $text = applyPatternToIncludedText( $text, $pattern )

               if( $pattern );

             $text = "<literal>\n" . $text . "\n</literal>" if ( $options->{literal} );

             return $text;

         }

         # fall through; try to include file over http based on MIME setting

     }

     return _includeWarning( $this, $warn, 'urls_not_allowed' )

       unless $TWiki::cfg{INCLUDE}{AllowURLs};

     # SMELL: should use the URI module from CPAN to parse the URL

     # SMELL: but additional CPAN adds to code bloat

     unless ($url =~ m!^https?:!) {

         $text = _includeWarning( $this, $warn, 'bad_protocol', $url );

         return $text;

     }

     my $response = $this->net->getExternalResource( $url );

     if( !$response->is_error()) {

         my $contentType = $response->header('content-type');

         $text = $response->content();

         if( $contentType =~ /^text\/html/ ) {

             if (!$raw) {

                 $url =~ m!^([a-z]+:/*[^/]*)(/[^#?]*)!;

                 $text = _cleanupIncludedHTML( $text, $1, $2, $options );

             }

         } elsif( $contentType =~ /^text\/(plain|css)/ ) {

             # do nothing

         } else {

             $text = _includeWarning(

                 $this, $warn, 'bad_content', $contentType );

         }

         $text = applyPatternToIncludedText( $text, $pattern ) if( $pattern );

         $text = "<literal>\n" . $text . "\n</literal>" if ( $options->{literal} );

     } else {

         $text = _includeWarning( $this, $warn, 'geturl_failed',

                                  $url.' '.$response->message() );

     }

     return $text;

 }

 #

 # SMELL: this is _not_ a tag handler in the sense of other builtin tags,

 # because it requires far more context information (the text of the topic)

 # than any handler.

 # SMELL: as a tag handler that also semi-renders the topic to extract the

 # headings, this handler would be much better as a preRenderingHandler in

 # a plugin (where head, script and verbatim sections are already protected)

 #

 #    * $text  : ref to the text of the current topic

 #    * $topic : the topic we are in

 #    * $web   : the web we are in

 #    * $args  : 'Topic' [web='Web'] [depth='N']

 # Return value: $tableOfContents

 # Handles %<nop>TOC{...}% syntax.  Creates a table of contents

 # using TWiki bulleted

 # list markup, linked to the section headings of a topic. A section heading is

 # entered in one of the following forms:

 #    * $headingPatternSp : \t++... spaces section heading

 #    * $headingPatternDa : ---++... dashes section heading

 #    * $headingPatternHt : <h[1-6]> HTML section heading </h[1-6]>

 sub _TOC {

     my ( $this, $text, $defaultTopic, $defaultWeb, $args ) = @_;

     require TWiki::Attrs;

     my $params = new TWiki::Attrs( $args );

     # get the topic name attribute

     my $topic = $params->{_DEFAULT} || $defaultTopic;

     # get the web name attribute

     $defaultWeb =~ s#/#.#g;

     my $web = $params->{web} || $defaultWeb;

     my $isSameTopic = $web eq $defaultWeb  &&  $topic eq $defaultTopic;

     $web =~ s#/#\.#g;

     my $webPath = $web;

     $webPath =~ s/\./\//g;

     # get the depth limit attribute

     my $maxDepth = $params->{depth} || $this->{prefs}->getPreferencesValue('TOC_MAX_DEPTH') || 6;

     my $minDepth = $this->{prefs}->getPreferencesValue('TOC_MIN_DEPTH') || 1;

     # get the title attribute

     my $title = $params->{title} || $this->{prefs}->getPreferencesValue('TOC_TITLE') || '';

     $title = CGI::span( { class => 'twikiTocTitle' }, $title ) if( $title );

     if( $web ne $defaultWeb || $topic ne $defaultTopic ) {

         unless( $this->security->checkAccessPermission

                 ( 'VIEW', $this->{user}, undef, undef, $topic, $web ) ) {

             return $this->inlineAlert( 'alerts', 'access_denied',

                                        $web, $topic );

         }

         my $meta;

         ( $meta, $text ) =

           $this->{store}->readTopic( $this->{user}, $web, $topic );

     }

     my $insidePre = 0;

     my $insideVerbatim = 0;

     my $highest = 99;

     my $result  = '';

     my $verbatim = {};

     $text = $this->renderer->takeOutBlocks( $text, 'verbatim',

                                                $verbatim);

     $text = $this->renderer->takeOutBlocks( $text, 'pre',

                                                $verbatim);

     # Find URL parameters

     my $query = $this->{cgiQuery};

     my @qparams = ();

     foreach my $name ( $query->param ) {

       next if ($name eq 'keywords');

       next if ($name eq 'topic');

       next if ($name eq 'text');

       push @qparams, $name => $query->param($name);

     }

     # SMELL: this handling of <pre> is archaic.

     # SMELL: use forEachLine

     foreach my $line ( split( /\r?\n/, $text ) ) {

         my $level;

         if ( $line =~ m/$regex{headerPatternDa}/o ) {

             $line = $2;

             $level = length $1;

         } elsif ( $line =~ m/$regex{headerPatternHt}/io ) {

             $line = $2;

             $level = $1;

         } else {

             next;

         }

         if( $line && ($level >= $minDepth) && ($level <= $maxDepth) ) {

             # cut TOC exclude '---+ heading !! exclude this bit'

             $line =~ s/\s*$regex{headerPatternNoTOC}.+$//go;

             next unless $line;

             my $anchor = $this->renderer->makeAnchorName( $line );

             $highest = $level if( $level < $highest );

             my $tabs = "\t" x $level;

             # Remove *bold*, _italic_ and =fixed= formatting

             $line =~ s/(^|[\s\(])\*([^\s]+?|[^\s].*?[^\s])\*($|[\s\,\.\;\:\!\?\)])/$1$2$3/g;

             $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\(])($regex{webNameRegex})\.($regex{wikiWordRegex})/$1<nop>$3/go;  # 'Web.TopicName'

             $line =~ s/([\s\(])($regex{wikiWordRegex})/$1<nop>$2/go;  # 'TopicName'

             $line =~ s/([\s\(])($regex{abbrevRegex})/$1<nop>$2/go;    # 'TLA'

             $line =~ s/([\s\-\*\(])([$regex{mixedAlphaNum}]+\:)/$1<nop>$2/go; # 'Site:page' Interwiki link

             # Prevent manual links

             $line =~ s/<[\/]?a\b[^>]*>//gi;

             # create linked bullet item, using a relative link to anchor

             my $target = $isSameTopic ?

                          _make_params(0, '#'=>$anchor,@qparams) :

                          $this->getScriptUrl(0,'view',$web,$topic,'#'=>$anchor,@qparams);

             $line = $tabs.'* ' .  CGI::a({href=>$target},$line);

             $result .= "\n".$line;

         }

     }

     if( $result ) {

         if( $highest > 1 ) {

             # left shift TOC

             $highest--;

             $result =~ s/^\t{$highest}//gm;

         }

         return CGI::div( { class=>'twikiToc' }, "$title$result\n" );

     } else {

         return '';

     }

 }

 =pod

 ---++ ObjectMethod inlineAlert($template, $def, ... ) -> $string

 Format an error for inline inclusion in rendered output. The message string

 is obtained from the template 'oops'.$template, and the DEF $def is

 selected. The parameters (...) are used to populate %PARAM1%..%PARAMn%

 =cut

 sub inlineAlert {

     my $this = shift;

     my $template = shift;

     my $def = shift;

     my $text = $this->templates->readTemplate( 'oops'.$template,

                                                  $this->getSkin() );

     if( $text ) {

         my $blah = $this->templates->expandTemplate( $def );

         $text =~ s/%INSTANTIATE%/$blah/;

         # web and topic can be anything; they are not used

         $text = $this->handleCommonTags( $text, $this->{webName},

                                          $this->{topicName} );

         my $n = 1;

         while( defined( my $param = shift )) {

             $text =~ s/%PARAM$n%/$param/g;

             $n++;

         }

     } else {

         $text = CGI::h1('TWiki Installation Error')

           . 'Template "'.$template.'" not found.'.CGI::p()

             . 'Check your configuration settings for {TemplateDir} and {TemplatePath}';

     }

     return $text;

 }

 =pod

 ---++ StaticMethod parseSections($text) -> ($string,$sectionlistref)

 Generic parser for sections within a topic. Sections are delimited

 by STARTSECTION and ENDSECTION, which may be nested, overlapped or

 otherwise abused. The parser builds an array of sections, which is

 ordered by the order of the STARTSECTION within the topic. It also

 removes all the SECTION tags from the text, and returns the text

 and the array of sections.

 Each section is a =TWiki::Attrs= object, which contains the attributes

 {type, name, start, end}

 where start and end are character offsets in the

 string *after all section tags have been removed*. All sections

 are required to be uniquely named; if a section is unnamed, it

 will be given a generated name. Sections may overlap or nest.

 See test/unit/Fn_SECTION.pm for detailed testcases that

 round out the spec.

 =cut

 sub parseSections {

     #my( $text _ = @_;

     my %sections;

     my @list = ();

     my $seq = 0;

     my $ntext = '';

     my $offset = 0;

     foreach my $bit (split(/(%(?:START|END)SECTION(?:{.*?})?%)/, $_[0] )) {

         if( $bit =~ /^%STARTSECTION(?:{(.*)})?%$/) {

             require TWiki::Attrs;

             my $attrs = new TWiki::Attrs( $1 );

             $attrs->{type} ||= 'section';

             $attrs->{name} = $attrs->{_DEFAULT} || $attrs->{name} ||

               '_SECTION'.$seq++;

             delete $attrs->{_DEFAULT};

             my $id = $attrs->{type}.':'.$attrs->{name};

             if( $sections{$id} ) {

                 # error, this named section already defined, ignore

                 next;

             }

             # close open unnamed sections of the same type

             foreach my $s ( @list ) {

                 if( $s->{end} < 0 && $s->{type} eq $attrs->{type} &&

                       $s->{name} =~ /^_SECTION\d+$/ ) {

                     $s->{end} = $offset;

                 }

             }

             $attrs->{start} = $offset;

             $attrs->{end} = -1; # open section

             $sections{$id} = $attrs;

             push( @list, $attrs );

         } elsif( $bit =~ /^%ENDSECTION(?:{(.*)})?%$/ ) {

             require TWiki::Attrs;

             my $attrs = new TWiki::Attrs( $1 );

             $attrs->{type} ||= 'section';

             $attrs->{name} = $attrs->{_DEFAULT} || $attrs->{name} || '';

             delete $attrs->{_DEFAULT};

             unless( $attrs->{name} ) {

                 # find the last open unnamed section of this type

                 foreach my $s ( reverse @list ) {

                     if( $s->{end} == -1 &&

                           $s->{type} eq $attrs->{type} &&

                          $s->{name} =~ /^_SECTION\d+$/ ) {

                         $attrs->{name} = $s->{name};

                         last;

                     }

                 }

                 # ignore it if no matching START found

                 next unless $attrs->{name};

             }

             my $id = $attrs->{type}.':'.$attrs->{name};

             if( !$sections{$id} || $sections{$id}->{end} >= 0 ) {

                 # error, no such open section, ignore

                 next;

             }

             $sections{$id}->{end} = $offset;

         } else {

             $ntext .= $bit;

             $offset = length( $ntext );

         }

     }

     # close open sections

     foreach my $s ( @list ) {

         $s->{end} = $offset if $s->{end} < 0;

     }

     return( $ntext, \@list );

 }

 =pod

 ---++ ObjectMethod expandVariablesOnTopicCreation ( $text, $user, $web, $topic ) -> $text

    * =$text= - text to expand

    * =$user= - This is the user expanded in e.g. %USERNAME. Optional, defaults to logged-in user.

 Expand limited set of variables during topic creation. These are variables

 expected in templates that must be statically expanded in new content.

    * =$web= - name of web

    * =$topic= - name of topic

 # SMELL: no plugin handler

 =cut

 sub expandVariablesOnTopicCreation {

     my ( $this, $text, $user, $theWeb, $theTopic ) = @_;

     $user ||= $this->{user};

     # Chop out templateonly sections

     my( $ntext, $sections ) = parseSections( $text );

     if( scalar( @$sections )) {

         # Note that if named templateonly sections overlap, the behaviour is undefined.

         foreach my $s ( reverse @$sections ) {

             if( $s->{type} eq 'templateonly' ) {

                 $ntext = substr($ntext, 0, $s->{start})

                        . substr($ntext, $s->{end}, length($ntext));

             } else {

                 # put back non-templateonly sections

                 my $start = $s->remove('start');

                 my $end = $s->remove('end');

                 $ntext = substr($ntext, 0, $start).

                   '%STARTSECTION{'.$s->stringify().'}%'.

                     substr($ntext, $start, $end - $start).

                       '%ENDSECTION{'.$s->stringify().'}%'.

                         substr($ntext, $end, length($ntext));

             }

         }

         $text = $ntext;

     }

     # Make sure func works, for registered tag handlers

     $TWiki::Plugins::SESSION = $this;

     # Note: it may look dangerous to override the user this way, but

     # it's actually quite safe, because only a subset of tags are

     # expanded during topic creation. if the set of tags expanded is

     # extended, then the impact has to be considered.

     my $safe = $this->{user};

     $this->{user} = $user;

     $text = _processTags( $this, $text, \&_expandTagOnTopicCreation, 16 );

     # expand all variables for type="expandvariables" sections

     ( $ntext, $sections ) = parseSections( $text );

     if( scalar( @$sections )) {

         $theWeb   ||= $this->{session}->{webName};

         $theTopic ||= $this->{session}->{topicName};

         foreach my $s ( reverse @$sections ) {

             if( $s->{type} eq 'expandvariables' ) {

                 my $etext = substr( $ntext, $s->{start}, $s->{end} - $s->{start} );

                 expandAllTags( $this, \$etext, $theTopic, $theWeb );

                 $ntext = substr( $ntext, 0, $s->{start})

                        . $etext

                        . substr( $ntext, $s->{end}, length($ntext) );

             } else {

                 # put back non-expandvariables sections

                 my $start = $s->remove('start');

                 my $end = $s->remove('end');

                 $ntext = substr($ntext, 0, $start).

                   '%STARTSECTION{'.$s->stringify().'}%'.

                     substr($ntext, $start, $end - $start).

                       '%ENDSECTION{'.$s->stringify().'}%'.

                         substr($ntext, $end, length($ntext));

             }

         }

         $text = $ntext;

     }

     # kill markers used to prevent variable expansion

     $text =~ s/%NOP%//g;

     $this->{user} = $safe;

     return $text;

 }

 =pod

 ---++ StaticMethod entityEncode( $text, $extras ) -> $encodedText

 Escape special characters to HTML numeric entities. This is *not* a generic

 encoding, it is tuned specifically for use in TWiki.

 HTML4.0 spec:

 "Certain characters in HTML are reserved for use as markup and must be

 escaped to appear literally. The "<" character may be represented with

 an <em>entity</em>, <strong class=html>&amp;lt;</strong>. Similarly, "&gt;"

 is escaped as <strong class=html>&amp;gt;</strong>, and "&amp;" is escaped

 as <strong class=html>&amp;amp;</strong>. If an attribute value contains a

 double quotation mark and is delimited by double quotation marks, then the

 quote should be escaped as <strong class=html>&amp;quot;</strong>.</p>

 Other entities exist for special characters that cannot easily be entered

 with some keyboards..."

 This method encodes HTML special and any non-printable ascii

 characters (except for \n and \r) using numeric entities.

 FURTHER this method also encodes characters that are special in TWiki

 meta-language.

 $extras is an optional param that may be used to include *additional*

 characters in the set of encoded characters. It should be a string

 containing the additional chars.

 =cut

 sub entityEncode {

     my( $text, $extra) = @_;

     $extra ||= '';

     # encode all non-printable 7-bit chars (< \x1f),

     # except \n (\xa) and \r (\xd)

     # encode HTML special characters '>', '<', '&', ''' and '"'.

     # encode TML special characters '%', '|', '[', ']', '@', '_',

     # '*', and '='

     $text =~ s/([[\x01-\x09\x0b\x0c\x0e-\x1f"%&'*<=>@[_\|$extra])/'&#'.ord($1).';'/ge;

     return $text;

 }

 =pod

 ---++ StaticMethod entityDecode ( $encodedText ) -> $text

 Decodes all numeric entities (e.g. {). _Does not_ decode

 named entities such as & (use HTML::Entities for that)

 =cut

 sub entityDecode {

     my $text = shift;

     $text =~ s/&#(\d+);/chr($1)/ge;

     return $text;

 }

 =pod

 ---++ StaticMethod urlEncodeAttachment ( $text )

 For attachments, URL-encode specially to 'freeze' any characters >127 in the

 site charset (e.g. ISO-8859-1 or KOI8-R), by doing URL encoding into native

 charset ($siteCharset) - used when generating attachment URLs, to enable the

 web server to serve attachments, including images, directly.  

 This encoding is required to handle the cases of:

     - browsers that generate UTF-8 URLs automatically from site charset URLs - now quite common

     - web servers that directly serve attachments, using the site charset for

       filenames, and cannot convert UTF-8 URLs into site charset filenames

 The aim is to prevent the browser from converting a site charset URL in the web

 page to a UTF-8 URL, which is the default.  Hence we 'freeze' the URL into the

 site character set through URL encoding. 

 In two cases, no URL encoding is needed:  For EBCDIC mainframes, we assume that 

 site charset URLs will be translated (outbound and inbound) by the web server to/from an

 EBCDIC character set. For sites running in UTF-8, there's no need for TWiki to

 do anything since all URLs and attachment filenames are already in UTF-8.

 =cut

 sub urlEncodeAttachment {

     my( $text ) = @_;

     my $usingEBCDIC = ( 'A' eq chr(193) ); 	# Only true on EBCDIC mainframes

     if( (defined($TWiki::cfg{Site}{CharSet}) and $TWiki::cfg{Site}{CharSet} =~ /^utf-?8$/i ) or $usingEBCDIC ) {

 	# Just let browser do UTF-8 URL encoding 

 	return $text;

     }

     # Freeze into site charset through URL encoding

     return urlEncode( $text );

 }

 =pod

 ---++ StaticMethod urlEncode( $string ) -> encoded string

 Encode by converting characters that are illegal in URLs to

 their %NN equivalents. This method is used for encoding

 strings that must be embedded _verbatim_ in URLs; it cannot

 be applied to URLs themselves, as it escapes reserved

 characters such as = and ?.

 RFC 1738, Dec. '94:

     <verbatim>

     ...Only alphanumerics [0-9a-zA-Z], the special

     characters $-_.+!*'(), and reserved characters used for their

     reserved purposes may be used unencoded within a URL.

     </verbatim>

 Reserved characters are $&+,/:;=?@ - these are _also_ encoded by

 this method.

 This URL-encoding handles all character encodings including ISO-8859-*,

 KOI8-R, EUC-* and UTF-8. 

 This may not handle EBCDIC properly, as it generates an EBCDIC URL-encoded

 URL, but mainframe web servers seem to translate this outbound before it hits browser

 - see CGI::Util::escape for another approach.

 =cut

 sub urlEncode {

     my $text = shift;

     $text =~ s/([^0-9a-zA-Z-_.:~!*'\/%])/'%'.sprintf('%02x',ord($1))/ge;

     return $text;

 }

 =pod

 ---++ StaticMethod urlDecode( $string ) -> decoded string

 Reverses the encoding done in urlEncode.

 =cut

 sub urlDecode {

     my $text = shift;

     $text =~ s/%([\da-f]{2})/chr(hex($1))/gei;

     return $text;

 }

 =pod

 ---++ StaticMethod isTrue( $value, $default ) -> $boolean

 Returns 1 if =$value= is true, and 0 otherwise. "true" means set to

 something with a Perl true value, with the special cases that "off",

 "false" and "no" (case insensitive) are forced to false. Leading and

 trailing spaces in =$value= are ignored.

 If the value is undef, then =$default= is returned. If =$default= is

 not specified it is taken as 0.

 =cut

 sub isTrue {

     my( $value, $default ) = @_;

     $default ||= 0;

     return $default unless defined( $value );

     $value =~ s/^\s*(.*?)\s*$/$1/gi;

     $value =~ s/off//gi;

     $value =~ s/no//gi;

     $value =~ s/false//gi;

     return ( $value ) ? 1 : 0;

 }

 =pod

 ---++ StaticMethod spaceOutWikiWord( $word, $sep ) -> $string

 Spaces out a wiki word by inserting a string (default: one space) between each word component.

 With parameter $sep any string may be used as separator between the word components; if $sep is undefined it defaults to a space.

 =cut

 sub spaceOutWikiWord {

     my $word = shift || '';

     my $sep = shift || ' ';

     $word =~ s/([$regex{lowerAlpha}])([$regex{upperAlpha}$regex{numeric}]+)/$1$sep$2/go;

     $word =~ s/([$regex{numeric}])([$regex{upperAlpha}])/$1$sep$2/go;

     return $word;

 }

 =pod

 ---++ ObjectMethod expandAllTags(\$text, $topic, $web, $meta)

 Expands variables by replacing the variables with their

 values. Some example variables: %<nop>TOPIC%, %<nop>SCRIPTURL%,

 %<nop>WIKINAME%, etc.

 $web and $incs are passed in for recursive include expansion. They can

 safely be undef.

 The rules for tag expansion are:

    1 Tags are expanded left to right, in the order they are encountered.

    1 Tags are recursively expanded as soon as they are encountered -

      the algorithm is inherently single-pass

    1 A tag is not "encountered" until the matching }% has been seen, by

      which time all tags in parameters will have been expanded

    1 Tag expansions that create new tags recursively are limited to a

      set number of hierarchical levels of expansion

 =cut

 sub expandAllTags {

     my $this = shift;

     my $text = shift; # reference

     my ( $topic, $web, $meta ) = @_;

     $web =~ s#\.#/#go;

     # push current context

     my $memTopic = $this->{SESSION_TAGS}{TOPIC};

     my $memWeb   = $this->{SESSION_TAGS}{WEB};

     $this->{SESSION_TAGS}{TOPIC}   = $topic;

     $this->{SESSION_TAGS}{WEB}     = $web;

     # Escape ' !%VARIABLE%'

     $$text =~ s/(?<=\s)!%($regex{tagNameRegex})/&#37;$1/g;

     # Make sure func works, for registered tag handlers

     $TWiki::Plugins::SESSION = $this;

     # NOTE TO DEBUGGERS

     # The depth parameter in the following call controls the maximum number

     # of levels of expansion. If it is set to 1 then only tags in the

     # topic will be expanded; tags that they in turn generate will be

     # left unexpanded. If it is set to 2 then the expansion will stop after

     # the first recursive inclusion, and so on. This is incredible useful

     # when debugging. The default is set to 16

     # to match the original limit on search expansion, though this of

     # course applies to _all_ tags and not just search.

     $$text = _processTags( $this, $$text, \&_expandTagOnTopicRendering,

                                   16, @_ );

     # restore previous context

     $this->{SESSION_TAGS}{TOPIC}   = $memTopic;

     $this->{SESSION_TAGS}{WEB}     = $memWeb;

 }

 # Process TWiki %TAGS{}% by parsing the input tokenised into

 # % separated sections. The parser is a simple stack-based parse,

 # sufficient to ensure nesting of tags is correct, but no more

 # than that.

 # $depth limits the number of recursive expansion steps that

 # can be performed on expanded tags.

 sub _processTags {

     my $this = shift;

     my $text = shift;

     my $tagf = shift;

     my $tell = 0;

     return '' if (

         (!defined( $text )) || 

         ($text eq ''));

     #no tags to process

     return $text unless ($text =~ /(%)/);

     my $depth = shift;

     unless ( $depth ) {

         my $mess = "Max recursive depth reached: $text";

         $this->writeWarning( $mess );

         # prevent recursive expansion that just has been detected

         # from happening in the error message

         $text =~ s/%(.*?)%/$1/go;

         return $text;

     }

     my $verbatim = {};

     $text = $this->renderer->takeOutBlocks( $text, 'verbatim',

                                                $verbatim);

     # See Item1442

     #my $percent = ($TranslationToken x 3).'%'.($TranslationToken x 3);

     my @queue = split( /(%)/, $text );

     my @stack;

     my $stackTop = ''; # the top stack entry. Done this way instead of

     # referring to the top of the stack for efficiency. This var

     # should be considered to be $stack[$#stack]

     while ( scalar( @queue )) {

         my $token = shift( @queue );

         #print STDERR ' ' x $tell,"PROCESSING $token \n";

         # each % sign either closes an existing stacked context, or

         # opens a new context.

         if ( $token eq '%' ) {

             #print STDERR ' ' x $tell,"CONSIDER $stackTop\n";

             # If this is a closing }%, try to rejoin the previous

             # tokens until we get to a valid tag construct. This is

             # a bit of a hack, but it's hard to think of a better

             # way to do this without a full parse that takes % signs

             # in tag parameters into account.

             if ( $stackTop =~ /}$/s ) {

                 while ( scalar( @stack) &&

                         $stackTop !~ /^%($regex{tagNameRegex}){.*}$/so ) {

                     my $top = $stackTop;

                     #print STDERR ' ' x $tell,"COLLAPSE $top \n";

                     $stackTop = pop( @stack ) . $top;

                 }

             }

             # /s so you can have newlines in parameters

             if ( $stackTop =~ m/^%(($regex{tagNameRegex})(?:{(.*)})?)$/so ) {

                 my( $expr, $tag, $args ) = ( $1, $2, $3 );

                 #print STDERR ' ' x $tell,"POP $tag\n";

                 my $e = &$tagf( $this, $tag, $args, @_ );

                 if ( defined( $e )) {

                     #print STDERR ' ' x $tell--,"EXPANDED $tag -> $e\n";

                     $stackTop = pop( @stack );

                     unless ($e =~ /(%)/) {

                         #SMELL: this is a profiler speedup found by Sven on the last day of 4.2.1

                         #TODO: I don't think this parser should be in this section - re-analysis desired.

                         #print STDERR "no tags to recurse\n";

                         $stackTop .= $e;

                         next;

                     }

                     # Recursively expand tags in the expansion of $tag

                     $stackTop .= _processTags($this, $e, $tagf, $depth-1, @_ );

                 } else { # expansion failed

                     #print STDERR ' ' x $tell++,"EXPAND $tag FAILED\n";

                     # To handle %NOP

                     # correctly, we have to handle the %VAR% case differently

                     # to the %VAR{}% case when a variable expansion fails.

                     # This is so that recursively define variables e.g.

                     # %A%B%D% expand correctly, but at the same time we ensure

                     # that a mismatched }% can't accidentally close a context

                     # that was left open when a tag expansion failed.

                     # However Cairo didn't do this, so for compatibility

                     # we have to accept that %NOP can never be fixed. if it

                     # could, then we could uncomment the following:

                     #if( $stackTop =~ /}$/ ) {

                     #    # %VAR{...}% case

                     #    # We need to push the unexpanded expression back

                     #    # onto the stack, but we don't want it to match the

                     #    # tag expression again. So we protect the %'s

                     #    $stackTop = $percent.$expr.$percent;

                     #} else

                     {

                         # %VAR% case.

                         # In this case we *do* want to match the tag expression

                         # again, as an embedded %VAR% may have expanded to

                         # create a valid outer expression. This is directly

                         # at odds with the %VAR{...}% case.

                         push( @stack, $stackTop );

                         $stackTop = '%'; # open new context

                     }

                 }

             } else {

                 push( @stack, $stackTop );

                 $stackTop = '%'; # push a new context

                 #$tell++;

             }

         } else {

             $stackTop .= $token;

         }

     }

     # Run out of input. Gather up everything in the stack.

     while ( scalar( @stack )) {

         my $expr = $stackTop;

         $stackTop = pop( @stack );

         $stackTop .= $expr;

     }