Context Navigation

Foswiki.pm @ 14686

Revision 14686, 120.2 KB checked in by OlivierRaginel, 13 days ago (diff)
Item11808: perltidy them all, so people are not accidentally impacted by the new enforced rule -- Sorry Micha, could not find a way to define specific values within the file
Property LASTBUILD set to `BUILD Foswiki-1.0.2 at Wed Feb 25 20:16:31 2009 GMT` Property svn:keywords set to `Revision Date`

Line
1	# See bottom of file for license and copyright information
2	package Foswiki;
3
4	=begin TML
5
6	---+ package Foswiki
7
8	Foswiki operates by creating a singleton object (known as the Session
9	object) that acts as a point of reference for all the different
10	modules in the system. This package is the class for this singleton,
11	and also contains the vast bulk of the basic constants and the per-
12	site configuration mechanisms.
13
14	Global variables are avoided wherever possible to avoid problems
15	with CGI accelerators such as mod_perl.
16
17	---++ Public Data members
18	* =request= Pointer to the Foswiki::Request
19	* =response= Pointer to the Foswiki::Response
20	* =context= Hash of context ids
21	* =plugins= Foswiki::Plugins singleton
22	* =prefs= Foswiki::Prefs singleton
23	* =remoteUser= Login ID when using ApacheLogin. Maintained for
24	compatibility only, do not use.
25	* =requestedWebName= Name of web found in URL path or =web= URL parameter
26	* =scriptUrlPath= URL path to the current script. May be dynamically
27	extracted from the URL path if {GetScriptUrlFromCgi}.
28	Only required to support {GetScriptUrlFromCgi} and
29	not consistently used. Avoid.
30	* =access= Foswiki::Access singleton
31	* =store= Foswiki::Store singleton
32	* =topicName= Name of topic found in URL path or =topic= URL
33	parameter
34	* =urlHost= Host part of the URL (including the protocol)
35	determined during intialisation and defaulting to
36	{DefaultUrlHost}
37	* =user= Unique user ID of logged-in user
38	* =users= Foswiki::Users singleton
39	* =webName= Name of web found in URL path, or =web= URL parameter,
40	or {UsersWebName}
41
42	=cut
43
44	use strict;
45	use warnings;
46	use Assert;
47	use Error qw( :try );
48	use Monitor ();
49	use CGI (); # Always required to get html generation tags;
50	use Digest::MD5 (); # For passthru and validation
51	use Foswiki::Configure::Load ();
52
53	require 5.005; # For regex objects and internationalisation
54
55	# Site configuration constants
56	our %cfg;
57
58	# Other computed constants
59	our $foswikiLibDir;
60	our %regex;
61	our %macros;
62	our %contextFreeSyntax;
63	our $VERSION;
64	our $RELEASE;
65	our $TRUE = 1;
66	our $FALSE = 0;
67	our $engine;
68	our $TranslationToken = "\0"; # Do not deprecate - used in many plugins
69
70	# Note: the following marker is used in text to mark RENDERZONE
71	# macros that have been hoisted from the source text of a page. It is
72	# carefully chosen so that it is (1) not normally present in written
73	# text (2) does not combine with other characters to form valid
74	# wide-byte characters and (3) does not conflict with other markers used
75	# by Foswiki/Render.pm
76	our $RENDERZONE_MARKER = "\3";
77
78	# Used by takeOut/putBack blocks
79	our $BLOCKID = 0;
80	our $OC = "<!--\0";
81	our $CC = "\0-->";
82
83	# This variable is set if Foswiki is running in unit test mode.
84	# It is provided so that modules can detect unit test mode to avoid
85	# corrupting data spaces.
86	our $inUnitTestMode = 0;
87
88	sub SINGLE_SINGLETONS { 0 }
89	sub SINGLE_SINGLETONS_TRACE { 0 }
90
91	# Returns the full path of the directory containing Foswiki.pm
92	sub _getLibDir {
93	return $foswikiLibDir if $foswikiLibDir;
94
95	$foswikiLibDir = $INC{'Foswiki.pm'};
96
97	# fix path relative to location of called script
98	if ( $foswikiLibDir =~ /^\./ ) {
99	print STDERR
100	"WARNING: Foswiki lib path $foswikiLibDir is relative; you should make it absolute, otherwise some scripts may not run from the command line.";
101	my $bin;
102
103	# SMELL : Should not assume environment variables; get data from request
104	if ( $ENV{SCRIPT_FILENAME}
105	&& $ENV{SCRIPT_FILENAME} =~ m#^(.+)/.+?$# )
106	{
107
108	# CGI script name
109	# implicit untaint OK, because of use of $SCRIPT_FILENAME
110	$bin = $1;
111	}
112	elsif ( $0 =~ m#^(.)/.?$# ) {
113
114	# program name
115	# implicit untaint OK, because of use of $PROGRAM_NAME ($0)
116	$bin = $1;
117	}
118	else {
119
120	# last ditch; relative to current directory.
121	require Cwd;
122	$bin = Cwd::cwd();
123	}
124	$foswikiLibDir = "$bin/$foswikiLibDir/";
125
126	# normalize "/../" and "/./"
127	while ( $foswikiLibDir =~ s\|([\\/])[^\\/]+[\\/]\.\.[\\/]\|$1\| ) {
128	}
129	$foswikiLibDir =~ s\|([\\/])\.[\\/]\|$1\|g;
130	}
131	$foswikiLibDir =~ s\|([\\/])[\\/]*\|$1\|g; # reduce "//" to "/"
132	$foswikiLibDir =~ s\|[\\/]$\|\|; # cut trailing "/"
133
134	return $foswikiLibDir;
135	}
136
137	BEGIN {
138
139	#Monitor::MARK("Start of BEGIN block in Foswiki.pm");
140	if (DEBUG) {
141	if ( not $Assert::soft ) {
142
143	# If ASSERTs are on (and not soft), then warnings are errors.
144	# Paranoid, but the only way to be sure we eliminate them all.
145	# Look out also for $cfg{WarningsAreErrors}, below, which
146	# is another way to install this handler without enabling
147	# ASSERTs
148	# ASSERTS are turned on by defining the environment variable
149	# FOSWIKI_ASSERTS. If ASSERTs are off, this is assumed to be a
150	# production environment, and no stack traces or paths are
151	# output to the browser.
152	$SIG{'__WARN__'} = sub { die @_ };
153	$Error::Debug = 1; # verbose stack traces, please
154	}
155	else {
156
157	# ASSERTs are soft, so warnings are not errors
158	# but ASSERTs are enabled. This is useful for tracking down
159	# problems that only manifest on production servers.
160	# Consequently, this is only useful when
161	# $cfg{WarningsAreErrors} is NOT enabled
162	$Error::Debug = 0; # no verbose stack traces
163	}
164	}
165	else {
166	$Error::Debug = 0; # no verbose stack traces
167	}
168
169	# DO NOT CHANGE THE FORMAT OF $VERSION
170	# Automatically expanded on checkin of this module
171	$VERSION = '$Date$ $Rev$ ';
172	$RELEASE = 'Foswiki-1.2.0-alpha';
173	$VERSION =~ s/^.?$(.)$.: (\d+) .?$/$RELEASE, $1, build $2/;
174
175	# Default handlers for different %TAGS%
176	# Where an entry is set as 'undef', the tag will be demand-loaded
177	# from Foswiki::Macros, if it is used. This tactic is used to reduce
178	# the load time of this module, especially when it is used from
179	# REST handlers.
180	%macros = (
181	ADDTOHEAD => undef,
182
183	# deprecated, use ADDTOZONE instead
184	ADDTOZONE => undef,
185	ALLVARIABLES => sub { $_[0]->{prefs}->stringify() },
186	ATTACHURL =>
187	sub { return $_[0]->getPubUrl( 1, $_[2]->web, $_[2]->topic ); },
188	ATTACHURLPATH =>
189	sub { return $_[0]->getPubUrl( 0, $_[2]->web, $_[2]->topic ); },
190	DATE => sub {
191	Foswiki::Time::formatTime(
192	time(),
193	$Foswiki::cfg{DefaultDateFormat},
194	$Foswiki::cfg{DisplayTimeValues}
195	);
196	},
197	DISPLAYTIME => sub {
198	Foswiki::Time::formatTime(
199	time(),
200	$_[1]->{_DEFAULT} \|\| '',
201	$Foswiki::cfg{DisplayTimeValues}
202	);
203	},
204	ENCODE => undef,
205	ENV => undef,
206	EXPAND => undef,
207	FORMAT => undef,
208	FORMFIELD => undef,
209	GMTIME => sub {
210	Foswiki::Time::formatTime( time(), $_[1]->{_DEFAULT} \|\| '',
211	'gmtime' );
212	},
213	GROUPINFO => undef,
214	GROUPS => undef,
215	HTTP_HOST =>
216
217	#deprecated functionality, now implemented using %ENV%
218	sub { $_[0]->{request}->header('Host') \|\| '' },
219	HTTP => undef,
220	HTTPS => undef,
221	ICON => undef,
222	ICONURL => undef,
223	ICONURLPATH => undef,
224	IF => undef,
225	INCLUDE => undef,
226	INTURLENCODE => undef,
227	LANGUAGE => sub { $_[0]->i18n->language(); },
228	LANGUAGES => undef,
229	MAKETEXT => undef,
230	META => undef, # deprecated
231	METASEARCH => undef, # deprecated
232	NOP =>
233
234	# Remove NOP tag in template topics but show content.
235	# Used in template _topics_ (not templates, per se, but
236	# topics used as templates for new topics)
237	sub { $_[1]->{_RAW} ? $_[1]->{_RAW} : '<nop>' },
238	PLUGINVERSION => sub {
239	$_[0]->{plugins}->getPluginVersion( $_[1]->{_DEFAULT} );
240	},
241	PUBURL => sub { $_[0]->getPubUrl(1) },
242	PUBURLPATH => sub { $_[0]->getPubUrl(0) },
243	QUERY => undef,
244	QUERYPARAMS => undef,
245	QUERYSTRING => sub { $_[0]->{request}->queryString() },
246	RELATIVETOPICPATH => undef,
247	REMOTE_ADDR =>
248
249	# DEPRECATED, now implemented using %ENV%
250	#move to compatibility plugin in Foswiki 2.0
251	sub { $_[0]->{request}->remoteAddress() \|\| ''; },
252	REMOTE_PORT =>
253
254	# DEPRECATED
255	# CGI/1.1 (RFC 3875) doesn't specify REMOTE_PORT,
256	# but some webservers implement it. However, since
257	# it's not RFC compliant, Foswiki should not rely on
258	# it. So we get more portability.
259	sub { '' },
260	REMOTE_USER =>
261
262	# DEPRECATED
263	sub { $_[0]->{request}->remoteUser() \|\| '' },
264	RENDERZONE => undef,
265	REVINFO => undef,
266	REVTITLE => undef,
267	REVARG => undef,
268	SCRIPTNAME => sub { $_[0]->{request}->action() },
269	SCRIPTURL => sub { $_[0]->getScriptUrl( 1, $_[1]->{_DEFAULT} \|\| '' ) },
270	SCRIPTURLPATH =>
271	sub { $_[0]->getScriptUrl( 0, $_[1]->{_DEFAULT} \|\| '' ) },
272	SEARCH => undef,
273	SEP =>
274
275	# Shortcut to %TMPL:P{"sep"}%
276	sub { $_[0]->templates->expandTemplate('sep') },
277	SERVERTIME => sub {
278	Foswiki::Time::formatTime( time(), $_[1]->{_DEFAULT} \|\| '',
279	'servertime' );
280	},
281	SHOWPREFERENCE => undef,
282	SPACEDTOPIC => undef,
283	SPACEOUT => undef,
284	'TMPL:P' => sub { $_[0]->templates->tmplP( $_[1] ) },
285	TOPICLIST => undef,
286	URLENCODE => undef,
287	URLPARAM => undef,
288	USERINFO => undef,
289	USERNAME => undef,
290	VAR => undef,
291	WEBLIST => undef,
292	WIKINAME => undef,
293	WIKIUSERNAME => undef,
294	DISPLAYDEPENDENCIES => undef,
295
296	# Constant tag strings _not_ dependent on config. These get nicely
297	# optimised by the compiler.
298	ENDSECTION => sub { '' },
299	WIKIVERSION => sub { $VERSION },
300	STARTSECTION => sub { '' },
301	STARTINCLUDE => sub { '' },
302	STOPINCLUDE => sub { '' },
303	);
304	$contextFreeSyntax{IF} = 1;
305
306	unless ( ( $Foswiki::cfg{DetailedOS} = $^O ) ) {
307	require Config;
308	$Foswiki::cfg{DetailedOS} = $Config::Config{'osname'};
309	}
310	$Foswiki::cfg{OS} = 'UNIX';
311	if ( $Foswiki::cfg{DetailedOS} =~ /darwin/i ) { # MacOS X
312	$Foswiki::cfg{OS} = 'UNIX';
313	}
314	elsif ( $Foswiki::cfg{DetailedOS} =~ /Win/i ) {
315	$Foswiki::cfg{OS} = 'WINDOWS';
316	}
317	elsif ( $Foswiki::cfg{DetailedOS} =~ /vms/i ) {
318	$Foswiki::cfg{OS} = 'VMS';
319	}
320	elsif ( $Foswiki::cfg{DetailedOS} =~ /bsdos/i ) {
321	$Foswiki::cfg{OS} = 'UNIX';
322	}
323	elsif ( $Foswiki::cfg{DetailedOS} =~ /dos/i ) {
324	$Foswiki::cfg{OS} = 'DOS';
325	}
326	elsif ( $Foswiki::cfg{DetailedOS} =~ /^MacOS$/i ) { # MacOS 9 or earlier
327	$Foswiki::cfg{OS} = 'MACINTOSH';
328	}
329	elsif ( $Foswiki::cfg{DetailedOS} =~ /os2/i ) {
330	$Foswiki::cfg{OS} = 'OS2';
331	}
332
333	# readConfig is defined in Foswiki::Configure::Load to allow overriding it
334	if ( Foswiki::Configure::Load::readConfig() ) {
335	$Foswiki::cfg{isVALID} = 1;
336	}
337
338	if ( $Foswiki::cfg{UseLocale} ) {
339	require locale;
340	import locale();
341	}
342
343	# If not set, default to strikeone validation
344	$Foswiki::cfg{Validation}{Method} \|\|= 'strikeone';
345	$Foswiki::cfg{Validation}{ValidForTime} = $Foswiki::cfg{LeaseLength}
346	unless defined $Foswiki::cfg{Validation}{ValidForTime};
347	$Foswiki::cfg{Validation}{MaxKeys} = 1000
348	unless defined $Foswiki::cfg{Validation}{MaxKeys};
349
350	# Constant tags dependent on the config
351	$macros{ALLOWLOGINNAME} =
352	sub { $Foswiki::cfg{Register}{AllowLoginName} \|\| 0 };
353	$macros{AUTHREALM} = sub { $Foswiki::cfg{AuthRealm} };
354	$macros{DEFAULTURLHOST} = sub { $Foswiki::cfg{DefaultUrlHost} };
355	$macros{HOMETOPIC} = sub { $Foswiki::cfg{HomeTopicName} };
356	$macros{LOCALSITEPREFS} = sub { $Foswiki::cfg{LocalSitePreferences} };
357	$macros{NOFOLLOW} =
358	sub { $Foswiki::cfg{NoFollow} ? 'rel=' . $Foswiki::cfg{NoFollow} : '' };
359	$macros{NOTIFYTOPIC} = sub { $Foswiki::cfg{NotifyTopicName} };
360	$macros{SCRIPTSUFFIX} = sub { $Foswiki::cfg{ScriptSuffix} };
361	$macros{STATISTICSTOPIC} = sub { $Foswiki::cfg{Stats}{TopicName} };
362	$macros{SYSTEMWEB} = sub { $Foswiki::cfg{SystemWebName} };
363	$macros{TRASHWEB} = sub { $Foswiki::cfg{TrashWebName} };
364	$macros{SANDBOXWEB} = sub { $Foswiki::cfg{SandboxWebName} };
365	$macros{WIKIADMINLOGIN} = sub { $Foswiki::cfg{AdminUserLogin} };
366	$macros{USERSWEB} = sub { $Foswiki::cfg{UsersWebName} };
367	$macros{WEBPREFSTOPIC} = sub { $Foswiki::cfg{WebPrefsTopicName} };
368	$macros{WIKIPREFSTOPIC} = sub { $Foswiki::cfg{SitePrefsTopicName} };
369	$macros{WIKIUSERSTOPIC} = sub { $Foswiki::cfg{UsersTopicName} };
370	$macros{WIKIWEBMASTER} = sub { $Foswiki::cfg{WebMasterEmail} };
371	$macros{WIKIWEBMASTERNAME} = sub { $Foswiki::cfg{WebMasterName} };
372
373	# locale setup
374	#
375	#
376	# Note that 'use locale' must be done in BEGIN block for regexes and
377	# sorting to work properly, although regexes can still work without
378	# this in 'non-locale regexes' mode.
379
380	if ( $Foswiki::cfg{UseLocale} ) {
381
382	# Set environment variables for grep
383	$ENV{LC_CTYPE} = $Foswiki::cfg{Site}{Locale};
384
385	# Load POSIX for I18N support.
386	require POSIX;
387	import POSIX qw( locale_h LC_CTYPE LC_COLLATE );
388
389	# SMELL: mod_perl compatibility note: If Foswiki is running under Apache,
390	# won't this play with the Apache process's locale settings too?
391	# What effects would this have?
392	setlocale( &LC_CTYPE, $Foswiki::cfg{Site}{Locale} );
393	setlocale( &LC_COLLATE, $Foswiki::cfg{Site}{Locale} );
394	}
395
396	$macros{CHARSET} = sub {
397	$Foswiki::cfg{Site}{CharSet};
398	};
399
400	$macros{LANG} = sub {
401	$Foswiki::cfg{Site}{Locale} =~ m/^([a-z]+_[a-z]+)/i ? $1 : 'en_US';
402	};
403
404	# Set up pre-compiled regexes for use in rendering. All regexes with
405	# unchanging variables in match should use the '/o' option.
406	# In the regex hash, all precompiled REs have "Regex" at the
407	# end of the name. Anything else is a string, either intended
408	# for use as a character class, or as a sub-expression in
409	# another compiled RE.
410
411	# Build up character class components for use in regexes.
412	# Depends on locale mode and Perl version, and finally on
413	# whether locale-based regexes are turned off.
414	if ( $] < 5.006 or not $Foswiki::cfg{Site}{LocaleRegexes} ) {
415
416	# No locales needed/working, or Perl 5.005, so just use
417	# any additional national characters defined in LocalSite.cfg
418	$regex{upperAlpha} = 'A-Z' . $Foswiki::cfg{UpperNational};
419	$regex{lowerAlpha} = 'a-z' . $Foswiki::cfg{LowerNational};
420	$regex{numeric} = '\d';
421	$regex{mixedAlpha} = $regex{upperAlpha} . $regex{lowerAlpha};
422	}
423	else {
424
425	# Perl 5.006 or higher with working locales
426	$regex{upperAlpha} = '[:upper:]';
427	$regex{lowerAlpha} = '[:lower:]';
428	$regex{numeric} = '[:digit:]';
429	$regex{mixedAlpha} = '[:alpha:]';
430	}
431	$regex{mixedAlphaNum} = $regex{mixedAlpha} . $regex{numeric};
432	$regex{lowerAlphaNum} = $regex{lowerAlpha} . $regex{numeric};
433	$regex{upperAlphaNum} = $regex{upperAlpha} . $regex{numeric};
434
435	# Compile regexes for efficiency and ease of use
436	# Note: qr// locks in regex modes (i.e. '-xism' here) - see Friedl
437	# book at http://regex.info/.
438
439	$regex{linkProtocolPattern} = $Foswiki::cfg{LinkProtocolPattern};
440
441	# Header patterns based on '+++'. The '###' are reserved for numbered
442	# headers
443	# '---++ Header', '---## Header'
444	$regex{headerPatternDa} = qr/^---+(\++\|\#+)(.*)$/m;
445
446	# '<h6>Header</h6>
447	$regex{headerPatternHt} = qr/^<h([1-6])>(.+?)<\/h\1>/mi;
448
449	# '---++!! Header' or '---++ Header %NOTOC% ^top'
450	$regex{headerPatternNoTOC} = '(\!\!+\|%NOTOC%)';
451
452	# Foswiki concept regexes
453	$regex{wikiWordRegex} = qr(
454	[$regex{upperAlpha}]+
455	[$regex{lowerAlphaNum}]+
456	[$regex{upperAlpha}]+
457	[$regex{mixedAlphaNum}]*
458	)xo;
459	$regex{webNameBaseRegex} =
460	qr/[$regex{upperAlpha}]+[$regex{mixedAlphaNum}_]*/o;
461	if ( $Foswiki::cfg{EnableHierarchicalWebs} ) {
462	$regex{webNameRegex} = qr(
463	$regex{webNameBaseRegex}
464	(?:(?:[\.\/]$regex{webNameBaseRegex})+)*
465	)xo;
466	}
467	else {
468	$regex{webNameRegex} = $regex{webNameBaseRegex};
469	}
470	$regex{defaultWebNameRegex} = qr/_[$regex{mixedAlphaNum}_]+/o;
471	$regex{anchorRegex} = qr/\#[$regex{mixedAlphaNum}_]+/o;
472	$regex{abbrevRegex} = qr/[$regex{upperAlpha}]{3,}s?\b/o;
473
474	$regex{topicNameRegex} =
475	qr/(?:(?:$regex{wikiWordRegex})\|(?:$regex{abbrevRegex}))/o;
476
477	# Email regex, e.g. for WebNotify processing and email matching
478	# during rendering.
479
480	my $emailAtom = qr([A-Z0-9\Q!#\$%&'*+-/=?^_`{\|}~\E])i; # Per RFC 5322
481
482	# Valid TLD's at http://data.iana.org/TLD/tlds-alpha-by-domain.txt
483	# Version 2012022300, Last Updated Thu Feb 23 15:07:02 2012 UTC
484	my $validTLD = $Foswiki::cfg{Email}{ValidTLD}
485	\|\| qr(AERO\|ARPA\|ASIA\|BIZ\|CAT\|COM\|COOP\|EDU\|GOV\|INFO\|INT\|JOBS\|MIL\|MOBI\|MUSEUM\|NAME\|NET\|ORG\|PRO\|TEL\|TRAVEL\|XXX)i;
486
487	$regex{emailAddrRegex} = qr(
488	(?: # LEFT Side of Email address
489	(?:$emailAtom+ # Valid characters left side of email address
490	(?:\.$emailAtom+)* # And 0 or more dotted atoms
491	)
492	\|
493	(?:"[\x21\x23-\x5B\x5D-\x7E\s]+?") # or a quoted string per RFC 5322
494	)
495	@
496	(?: # RIGHT side of Email address
497	(?: # FQDN
498	[a-z0-9-]+ # hostname part
499	(?:\.[a-z0-9-]+)* # 0 or more alphanumeric domains following a dot.
500	\.(?: # TLD
501	(?:[a-z]{2,2}) # 2 character TLD
502	\|
503	$validTLD # TLD's longer than 2 characters
504	)
505	)
506	\|
507	(?:\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\]) # dotted triplets IP Address
508	)
509	)oxi;
510
511	# Item11185: This is how things were before we began Operation Unicode:
512	#
513	# $regex{filenameInvalidCharRegex} = qr/[^$regex{mixedAlphaNum}\. _-]/o;
514	#
515	# It was only used in Foswiki::Sandbox::sanitizeAttachmentName(), which now
516	# uses $Foswiki::cfg{NameFilter} instead.
517	# See RobustnessTests::test_sanitizeAttachmentName
518	#
519	# Actually, this is used in GenPDFPrincePlugin; let's copy NameFilter
520	$regex{filenameInvalidCharRegex} = $Foswiki::cfg{NameFilter};
521
522	# Multi-character alpha-based regexes
523	$regex{mixedAlphaNumRegex} = qr/[$regex{mixedAlphaNum}]*/o;
524
525	# %TAG% name
526	$regex{tagNameRegex} =
527	'[' . $regex{mixedAlpha} . '][' . $regex{mixedAlphaNum} . '_:]*';
528
529	# Set statement in a topic
530	$regex{bulletRegex} = '^(?:\t\| )+\*';
531	$regex{setRegex} = $regex{bulletRegex} . '\s+(Set\|Local)\s+';
532	$regex{setVarRegex} =
533	$regex{setRegex} . '(' . $regex{tagNameRegex} . ')\s=\s(.*)$';
534
535	# Character encoding regexes
536
537	# 7-bit ASCII only
538	$regex{validAsciiStringRegex} = qr/^[\x00-\x7F]+$/o;
539
540	# Regex to match only a valid UTF-8 character, taking care to avoid
541	# security holes due to overlong encodings by excluding the relevant
542	# gaps in UTF-8 encoding space - see 'perldoc perlunicode', Unicode
543	# Encodings section. Tested against Markus Kuhn's UTF-8 test file
544	# at http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt.
545	$regex{validUtf8CharRegex} = qr{
546	# Single byte - ASCII
547	[\x00-\x7F]
548	\|
549
550	# 2 bytes
551	[\xC2-\xDF][\x80-\xBF]
552	\|
553
554	# 3 bytes
555
556	# Avoid illegal codepoints - negative lookahead
557	(?!\xEF\xBF[\xBE\xBF])
558
559	# Match valid codepoints
560	(?:
561	([\xE0][\xA0-\xBF])\|
562	([\xE1-\xEC\xEE-\xEF][\x80-\xBF])\|
563	([\xED][\x80-\x9F])
564	)
565	[\x80-\xBF]
566	\|
567
568	# 4 bytes
569	(?:
570	([\xF0][\x90-\xBF])\|
571	([\xF1-\xF3][\x80-\xBF])\|
572	([\xF4][\x80-\x8F])
573	)
574	[\x80-\xBF][\x80-\xBF]
575	}xo;
576
577	$regex{validUtf8StringRegex} = qr/^(?:$regex{validUtf8CharRegex})+$/o;
578
579	# Check for unsafe search regex mode (affects filtering in) - default
580	# to safe mode
581	$Foswiki::cfg{ForceUnsafeRegexes} = 0
582	unless defined $Foswiki::cfg{ForceUnsafeRegexes};
583
584	# initialize lib directory early because of later 'cd's
585	_getLibDir();
586
587	# initialize the runtime engine
588	if ( !defined $Foswiki::cfg{Engine} ) {
589
590	# Caller did not define an engine; try and work it out (mainly for
591	# the benefit of pre-1.0 CGI scripts)
592	$Foswiki::cfg{Engine} = 'Foswiki::Engine::Legacy';
593	}
594	$engine = eval qq(use $Foswiki::cfg{Engine}; $Foswiki::cfg{Engine}->new);
595	die $@ if $@;
596
597	#Monitor::MARK('End of BEGIN block in Foswiki.pm');
598	}
599
600	# Components that all requests need
601	use Foswiki::Response ();
602	use Foswiki::Request ();
603	use Foswiki::Logger ();
604	use Foswiki::Meta ();
605	use Foswiki::Sandbox ();
606	use Foswiki::Time ();
607	use Foswiki::Prefs ();
608	use Foswiki::Plugins ();
609	use Foswiki::Store ();
610	use Foswiki::Users ();
611
612	sub UTF82SiteCharSet {
613	my ( $this, $text ) = @_;
614
615	# Detect character encoding of the full topic name from URL
616	return if ( $text =~ $regex{validAsciiStringRegex} );
617
618	# SMELL: all this regex stuff should go away.
619	# If not UTF-8 - assume in site character set, no conversion required
620	if ( $^O eq 'darwin' ) {
621
622	#this is a gross over-generalisation - as not all darwins are apple's
623	# and not all darwins use apple's perl
624	my $trial = $text;
625	$trial =~ s/$regex{validUtf8CharRegex}//g;
626	return unless ( length($trial) == 0 );
627	}
628	else {
629
630	#SMELL: this seg faults on OSX leopard. (and possibly others)
631	return unless ( $text =~ $regex{validUtf8StringRegex} );
632	}
633
634	# If site charset is already UTF-8, there is no need to convert anything:
635	if ( $Foswiki::cfg{Site}{CharSet} =~ /^utf-?8$/i ) {
636
637	# warn if using Perl older than 5.8
638	if ( $] < 5.008 ) {
639	$this->logger->log( 'warning',
640	'UTF-8 not remotely supported on Perl '
641	. $]
642	. ' - use Perl 5.8 or higher..' );
643	}
644
645	return $text;
646	}
647
648	# Convert into ISO-8859-1 if it is the site charset. This conversion
649	# is not valid for ISO-8859-15.
650	if ( $Foswiki::cfg{Site}{CharSet} =~ /^iso-?8859-?1$/i ) {
651
652	# ISO-8859-1 maps onto first 256 codepoints of Unicode
653	# (conversion from 'perldoc perluniintro')
654	$text =~ s/ ([\xC2\xC3]) ([\x80-\xBF]) /
655	chr( ord($1) << 6 & 0xC0 \| ord($2) & 0x3F )
656	/egx;
657	}
658	else {
659
660	# Convert from UTF-8 into some other site charset
661	if ( $] >= 5.008 ) {
662	require Encode;
663	import Encode qw(:fallbacks);
664
665	# Map $Foswiki::cfg{Site}{CharSet} into real encoding name
666	my $charEncoding =
667	Encode::resolve_alias( $Foswiki::cfg{Site}{CharSet} );
668	if ( not $charEncoding ) {
669	$this->logger->log( 'warning',
670	'Conversion to "'
671	. $Foswiki::cfg{Site}{CharSet}
672	. '" not supported, or name not recognised - check '
673	. '"perldoc Encode::Supported"' );
674	}
675	else {
676
677	# Convert text using Encode:
678	# - first, convert from UTF8 bytes into internal
679	# (UTF-8) characters
680	$text = Encode::decode( 'utf8', $text );
681
682	# - then convert into site charset from internal UTF-8,
683	# inserting \x{NNNN} for characters that can't be converted
684	$text = Encode::encode( $charEncoding, $text, &FB_PERLQQ() );
685	}
686	}
687	else {
688	require Unicode::MapUTF8; # Pre-5.8 Perl versions
689	my $charEncoding = $Foswiki::cfg{Site}{CharSet};
690	if ( not Unicode::MapUTF8::utf8_supported_charset($charEncoding) ) {
691	$this->logger->log( 'warning',
692	'Conversion to "'
693	. $Foswiki::cfg{Site}{CharSet}
694	. '" not supported, or name not recognised - check '
695	. '"perldoc Unicode::MapUTF8"' );
696	}
697	else {
698
699	# Convert text
700	$text = Unicode::MapUTF8::from_utf8(
701	{
702	-string => $text,
703	-charset => $charEncoding
704	}
705	);
706
707	# FIXME: Check for failed conversion?
708	}
709	}
710	}
711	return $text;
712	}
713
714	=begin TML
715
716	---++ ObjectMethod writeCompletePage( $text, $pageType, $contentType )
717
718	Write a complete HTML page with basic header to the browser.
719	* =$text= is the text of the page script (<html> to </html> if it's HTML)
720	* =$pageType= - May be "edit", which will cause headers to be generated that force
721	caching for 24 hours, to prevent Codev.BackFromPreviewLosesText bug, which caused
722	data loss with IE5 and IE6.
723	* =$contentType= - page content type \| text/html
724
725	This method removes noautolink and nop tags before outputting the page unless
726	$contentType is text/plain.
727
728	=cut
729
730	sub writeCompletePage {
731	my ( $this, $text, $pageType, $contentType ) = @_;
732	$contentType \|\|= 'text/html';
733
734	my $cgis = $this->getCGISession();
735	if ( $cgis
736	&& $contentType eq 'text/html'
737	&& $Foswiki::cfg{Validation}{Method} ne 'none' )
738	{
739
740	# Don't expire the validation key through login, or when
741	# endpoint is an error.
742	Foswiki::Validation::expireValidationKeys($cgis)
743	unless ( $this->{request}->action() eq 'login'
744	or ( $ENV{REDIRECT_STATUS} \|\| 0 ) >= 400 );
745
746	my $usingStrikeOne = 0;
747	if (
748	$Foswiki::cfg{Validation}{Method} eq 'strikeone'
749
750	# Add the onsubmit handler to the form
751	&& $text =~ s/(<form[^>]method=['"]POST['"][^>]>)/
752	Foswiki::Validation::addOnSubmit($1)/gei
753	)
754	{
755
756	# At least one form has been touched; add the validation
757	# cookie
758	my $valCookie = Foswiki::Validation::getCookie($cgis);
759	$valCookie->secure( $this->{request}->secure );
760	$this->{response}
761	->cookies( [ $this->{response}->cookies, $valCookie ] );
762
763	# Add the JS module to the page. Note that this is not
764	# incorporated into the foswikilib.js because that module
765	# is conditionally loaded under the control of the
766	# templates, and we have to be sure it gets loaded.
767	my $src = $this->{prefs}->getPreference('FWSRC') \|\| '';
768	$this->addToZone( 'script', 'JavascriptFiles/strikeone', <<JS );
769	<script type="text/javascript" src="$Foswiki::cfg{PubUrlPath}/$Foswiki::cfg{SystemWebName}/JavascriptFiles/strikeone$src.js"></script>
770	JS
771	$usingStrikeOne = 1;
772	}
773
774	# Inject validation key in HTML forms
775	my $context =
776	$this->{request}->url( -full => 1, -path => 1, -query => 1 ) . time();
777	$text =~ s/(<form[^>]method=['"]POST['"][^>]>)/
778	$1 . Foswiki::Validation::addValidationKey(
779	$cgis, $context, $usingStrikeOne )/gei;
780	}
781
782	if ( $contentType ne 'text/plain' ) {
783
784	$text = $this->_renderZones($text);
785	}
786
787	# SMELL: can't compute; faking content-type for backwards compatibility;
788	# any other information might become bogus later anyway
789	# Validate format of content-type (defined in rfc2616)
790	my $tch = qr/[^\[\]()<>@,;:\\"\/?={}\s]/o;
791	if ( $contentType =~ /($tch+\/$tch+(\s;\s$tch+=($tch+\|"[^"]")))$/oi ) {
792	$contentType = $1;
793	}
794	else {
795	$contentType = "text/plain;contenttype=invalid";
796	}
797	my $hdr = "Content-type: " . $1 . "\r\n";
798
799	# Call final handler
800	$this->{plugins}->dispatch( 'completePageHandler', $text, $hdr );
801
802	# cache final page, but only view
803	my $cachedPage;
804	if ( $contentType ne 'text/plain' ) {
805	if ( $Foswiki::cfg{Cache}{Enabled}
806	&& ( $this->inContext('view') \|\| $this->inContext('rest') ) )
807	{
808	$cachedPage = $this->{cache}->cachePage( $contentType, $text );
809	$this->{cache}->renderDirtyAreas( \$text )
810	if $cachedPage && $cachedPage->{isdirty};
811	}
812	else {
813
814	# remove <dirtyarea> tags
815	$text =~ s/<\/?dirtyarea[^>]*>//go;
816	}
817
818	# Remove <nop> and <noautolink> tags
819	$text =~ s/([\t ]?)[ \t]*<\/?(nop\|noautolink)\/?>/$1/gis;
820
821	# Check that the templates specified clean HTML
822	if (DEBUG) {
823
824	# When tracing is enabled in Foswiki::Templates, then there will
825	# always be a <!--bodyend--> after </html>. So we need to disable
826	# this check.
827	require Foswiki::Templates;
828	if ( !Foswiki::Templates->TRACE
829	&& $contentType =~ m#text/html#
830	&& $text =~ m#</html>(.?\S.)$#s )
831	{
832	ASSERT( 0, <<BOGUS );
833	Junk after </html>: $1. Templates may be bogus
834	- Check for excess blank lines at ends of .tmpl files
835	- or newlines after %TMPL:INCLUDE
836	- You can enable TRACE in Foswiki::Templates to help debug
837	BOGUS
838	}
839	}
840	}
841
842	$this->generateHTTPHeaders( $pageType, $contentType, $text, $cachedPage );
843
844	# SMELL: null operation. the http headers are written out
845	# during Foswiki::Engine::finalize
846	# $hdr = $this->{response}->printHeaders;
847
848	$this->{response}->print($text);
849	}
850
851	=begin TML
852
853	---++ ObjectMethod generateHTTPHeaders( $pageType, $contentType, $text, $cachedPage )
854
855	All parameters are optional.
856
857	* =$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.
858	* =$contentType= - page content type \| text/html
859	* =$text= - page content
860	* =$cachedPage= - a pointer to the page container as fetched from the page cache
861
862	=cut
863
864	sub generateHTTPHeaders {
865	my ( $this, $pageType, $contentType, $text, $cachedPage ) = @_;
866
867	my $hopts = {};
868
869	# Handle Edit pages - future versions will extend to caching
870	# of other types of page, with expiry time driven by page type.
871	if ( $pageType && $pageType eq 'edit' ) {
872
873	# Get time now in HTTP header format
874	my $lastModifiedString =
875	Foswiki::Time::formatTime( time, '$http', 'gmtime' );
876
877	# Expiry time is set high to avoid any data loss. Each instance of
878	# Edit page has a unique URL with time-string suffix (fix for
879	# RefreshEditPage), so this long expiry time simply means that the
880	# browser Back button always works. The next Edit on this page
881	# will use another URL and therefore won't use any cached
882	# version of this Edit page.
883	my $expireHours = 24;
884	my $expireSeconds = $expireHours * 60 * 60;
885
886	# and cache control headers, to ensure edit page
887	# is cached until required expiry time.
888	$hopts->{'last-modified'} = $lastModifiedString;
889	$hopts->{expires} = "+${expireHours}h";
890	$hopts->{'cache-control'} = "max-age=$expireSeconds";
891	}
892
893	# DEPRECATED plugins header handler. Plugins should use
894	# modifyHeaderHandler instead.
895	my $pluginHeaders =
896	$this->{plugins}->dispatch( 'writeHeaderHandler', $this->{request} )
897	\|\| '';
898	if ($pluginHeaders) {
899	foreach ( split /\r?\n/, $pluginHeaders ) {
900
901	# Implicit untaint OK; data from plugin handler
902	if (m/^([\-a-z]+): (.*)$/i) {
903	$hopts->{$1} = $2;
904	}
905	}
906	}
907
908	$contentType = 'text/html' unless $contentType;
909	$contentType .= '; charset=' . $Foswiki::cfg{Site}{CharSet}
910	if $contentType ne ''
911	&& $contentType =~ m!^text/!
912	&& $contentType !~ /\bcharset\b/
913	&& $Foswiki::cfg{Site}{CharSet};
914
915	# use our version of the content type
916	$hopts->{'Content-Type'} = $contentType;
917
918	# New (since 1.026)
919	$this->{plugins}
920	->dispatch( 'modifyHeaderHandler', $hopts, $this->{request} );
921
922	# add http compression and conditional cache controls
923	if ( !$this->inContext('command_line') && $text ) {
924
925	if ( $Foswiki::cfg{HttpCompress}
926	&& $ENV{'HTTP_ACCEPT_ENCODING'}
927	&& $ENV{'HTTP_ACCEPT_ENCODING'} =~ /(x-gzip\|gzip)/i )
928	{
929	my $encoding = $1;
930	$hopts->{'Content-Encoding'} = $encoding;
931	$hopts->{'Vary'} = 'Accept-Encoding';
932
933	# check if we take the version from the cache
934	if ( $cachedPage && !$cachedPage->{isdirty} ) {
935	$text = $cachedPage->{data};
936	}
937	else {
938	require Compress::Zlib;
939	$text = Compress::Zlib::memGzip($text);
940	}
941	}
942	elsif ($cachedPage
943	&& !$cachedPage->{isdirty}
944	&& $Foswiki::cfg{HttpCompress} )
945	{
946
947	# Outch, we need to uncompressed pages from cache again
948	# Note, this is effort to avoid under any circumstances as
949	# the page has been compressed when it has been created and now
950	# is uncompressed again to get back the original. For now the
951	# only know situation this can happen is for older browsers like IE6
952	# which does not understand gzip'ed http encodings
953	require Compress::Zlib;
954	$text = Compress::Zlib::memGunzip($text);
955	}
956
957	# we need to force the browser into a check on every
958	# request; let the server decide on an 304 as below
959	$hopts->{'Cache-Control'} = 'max-age=0';
960
961	# check etag and last modification time
962	# if we have a cached page on the server side
963	if ($cachedPage) {
964	my $etag = $cachedPage->{etag};
965	my $lastModified = $cachedPage->{lastmodified};
966
967	$hopts->{'ETag'} = $etag if $etag;
968	$hopts->{'Last-Modified'} = $lastModified if $lastModified;
969
970	# only send a 304 if both criteria are true
971	my $etagFlag = 1;
972	my $lastModifiedFlag = 1;
973
974	# check etag
975	unless ( $ENV{'HTTP_IF_NONE_MATCH'}
976	&& $etag eq $ENV{'HTTP_IF_NONE_MATCH'} )
977	{
978	$etagFlag = 0;
979	}
980
981	# check last-modified
982	unless ( $ENV{'HTTP_IF_MODIFIED_SINCE'}
983	&& $lastModified eq $ENV{'HTTP_IF_MODIFIED_SINCE'} )
984	{
985	$lastModifiedFlag = 0;
986	}
987
988	# finally decide on a 304 reply
989	if ( $etagFlag && $lastModified ) {
990	$hopts->{'Status'} = '304 Not Modified';
991	$text = '';
992
993	#print STDERR "NOT modified\n";
994	}
995	}
996
997	# write back to text
998	$_[3] = $text;
999	}
1000
1001	$hopts->{"X-FoswikiAction"} = $this->{request}->action;
1002	$hopts->{"X-FoswikiURI"} = $this->{request}->uri;
1003
1004	# The headers method resets all headers to what we pass
1005	# what we want is simply ensure our headers are there
1006	$this->{response}->setDefaultHeaders($hopts);
1007	}
1008
1009	# Tests if the $redirect is an external URL, returning false if
1010	# AllowRedirectUrl is denied
1011	sub _isRedirectSafe {
1012	my $redirect = shift;
1013
1014	return 1 if ( $Foswiki::cfg{AllowRedirectUrl} );
1015	return 1 if $redirect =~ m#^/#; # relative URL - OK
1016
1017	#TODO: this should really use URI
1018	# Compare protocol, host name and port number
1019	if ( $redirect =~ m!^(.?://[^/?#])! ) {
1020
1021	# implicit untaints OK because result not used. uc retaints
1022	# if use locale anyway.
1023	my $target = uc($1);
1024
1025	$Foswiki::cfg{DefaultUrlHost} =~ m!^(.?://[^/])!;
1026	return 1 if ( $target eq uc($1) );
1027
1028	if ( $Foswiki::cfg{PermittedRedirectHostUrls} ) {
1029	foreach my $red (
1030	split( /\s,\s/, $Foswiki::cfg{PermittedRedirectHostUrls} ) )
1031	{
1032	$red =~ m!^(.?://[^/])!;
1033	return 1 if ( $target eq uc($1) );
1034	}
1035	}
1036	}
1037	return 0;
1038	}
1039
1040	=begin TML
1041
1042	---++ ObjectMethod redirectto($url) -> $url
1043
1044	If the CGI parameter 'redirectto' is present on the query, then will validate
1045	that it is a legal redirection target (url or topic name). If 'redirectto'
1046	is not present on the query, performs the same steps on $url.
1047
1048	Returns undef if the target is not valid, and the target URL otherwise.
1049
1050	=cut
1051
1052	sub redirectto {
1053	my ( $this, $url ) = @_;
1054
1055	my $redirecturl = $this->{request}->param('redirectto');
1056	$redirecturl = $url unless $redirecturl;
1057
1058	return unless $redirecturl;
1059
1060	if ( $redirecturl =~ m#^$regex{linkProtocolPattern}://#o ) {
1061
1062	# assuming URL
1063	return $redirecturl if _isRedirectSafe($redirecturl);
1064	return;
1065	}
1066
1067	# assuming 'web.topic' or 'topic'
1068	my ( $w, $t ) =
1069	$this->normalizeWebTopicName( $this->{webName}, $redirecturl );
1070
1071	# capture anchor
1072	my ( $topic, $anchor ) = split( '#', $t, 2 );
1073	$t = $topic if $topic;
1074	my @attrs = ();
1075	push( @attrs, '#' => $anchor ) if $anchor;
1076
1077	return $this->getScriptUrl( 0, 'view', $w, $t, @attrs );
1078	}
1079
1080	=begin TML
1081
1082	---++ StaticMethod splitAnchorFromUrl( $url ) -> ( $url, $anchor )
1083
1084	Takes a full url (including possible query string) and splits off the anchor.
1085	The anchor includes the # sign. Returns an empty string if not found in the url.
1086
1087	=cut
1088
1089	sub splitAnchorFromUrl {
1090	my ($url) = @_;
1091
1092	( $url, my $anchor ) = $url =~ m/^(.?)(#(.?))*$/;
1093	return ( $url, $anchor );
1094	}
1095
1096	=begin TML
1097
1098	---++ ObjectMethod redirect( $url, $passthrough, $status )
1099
1100	* $url - url or topic to redirect to
1101	* $passthrough - (optional) parameter to pass through current query
1102	parameters (see below)
1103	* $status - HTTP status code (30x) to redirect with. Defaults to 302.
1104
1105	Redirects the request to =$url=, unless
1106	1 It is overridden by a plugin declaring a =redirectCgiQueryHandler=
1107	(a dangerous, deprecated handler!)
1108	1 =$session->{request}= is =undef=
1109	Thus a redirect is only generated when in a CGI context.
1110
1111	Normally this method will ignore parameters to the current query. Sometimes,
1112	for example when redirecting to a login page during authentication (and then
1113	again from the login page to the original requested URL), you want to make
1114	sure all parameters are passed on, and for this $passthrough should be set to
1115	true. In this case it will pass all parameters that were passed to the
1116	current query on to the redirect target. If the request_method for the
1117	current query was GET, then all parameters will be passed by encoding them
1118	in the URL (after ?). If the request_method was POST, then there is a risk the
1119	URL would be too big for the receiver, so it caches the form data and passes
1120	over a cache reference in the redirect GET.
1121
1122	NOTE: Passthrough is only meaningful if the redirect target is on the same
1123	server.
1124
1125	=cut
1126
1127	sub redirect {
1128	my ( $this, $url, $passthru, $status ) = @_;
1129	ASSERT( defined $url ) if DEBUG;
1130
1131	return unless $this->{request};
1132
1133	( $url, my $anchor ) = splitAnchorFromUrl($url);
1134
1135	if ( $passthru && defined $this->{request}->method() ) {
1136	my $existing = '';
1137	if ( $url =~ s/\?(.*)$// ) {
1138	$existing = $1; # implicit untaint OK; recombined later
1139	}
1140	if ( uc( $this->{request}->method() ) eq 'POST' ) {
1141
1142	# Redirecting from a post to a get
1143	my $cache = $this->cacheQuery();
1144	if ($cache) {
1145	if ( $url eq '/' ) {
1146	$url = $this->getScriptUrl( 1, 'view' );
1147	}
1148	$url .= $cache;
1149	}
1150	}
1151	else {
1152
1153	# Redirecting a get to a get; no need to use passthru
1154	if ( $this->{request}->query_string() ) {
1155	$url .= '?' . $this->{request}->query_string();
1156	}
1157	if ($existing) {
1158	if ( $url =~ /\?/ ) {
1159	$url .= ';';
1160	}
1161	else {
1162	$url .= '?';
1163	}
1164	$url .= $existing;
1165	}
1166	}
1167	}
1168
1169	# prevent phishing by only allowing redirect to configured host
1170	# do this check as late as possible to catch _any_ last minute hacks
1171	# TODO: this should really use URI
1172	if ( !_isRedirectSafe($url) ) {
1173
1174	# goto oops if URL is trying to take us somewhere dangerous
1175	$url = $this->getScriptUrl(
1176	1, 'oops',
1177	$this->{webName} \|\| $Foswiki::cfg{UsersWebName},
1178	$this->{topicName} \|\| $Foswiki::cfg{HomeTopicName},
1179	template => 'oopsredirectdenied',
1180	def => 'redirect_denied',
1181	param1 => "$url",
1182	param2 => "$Foswiki::cfg{DefaultUrlHost}",
1183	);
1184	}
1185
1186	$url .= $anchor if $anchor;
1187
1188	# Dangerous, deprecated handler! Might work, probably won't.
1189	return
1190	if ( $this->{plugins}
1191	->dispatch( 'redirectCgiQueryHandler', $this->{response}, $url ) );
1192
1193	$url = $this->getLoginManager()->rewriteRedirectUrl($url);
1194
1195	# Foswiki::Response::redirect doesn't automatically pass on the cookies
1196	# for us, so we have to do it explicitly; otherwise the session cookie
1197	# won't get passed on.
1198	$this->{response}->redirect(
1199	-url => $url,
1200	-cookies => $this->{response}->cookies(),
1201	-status => $status,
1202	);
1203	}
1204
1205	=begin TML
1206
1207	---++ ObjectMethod cacheQuery() -> $queryString
1208
1209	Caches the current query in the params cache, and returns a rewritten
1210	query string for the cache to be picked up again on the other side of a
1211	redirect.
1212
1213	We can't encode post params into a redirect, because they may exceed the
1214	size of the GET request. So we cache the params, and reload them when the
1215	redirect target is reached.
1216
1217	=cut
1218
1219	sub cacheQuery {
1220	my $this = shift;
1221	my $query = $this->{request};
1222
1223	return '' unless ( scalar( $query->param() ) );
1224
1225	# Don't double-cache
1226	return '' if ( $query->param('foswiki_redirect_cache') );
1227
1228	require Foswiki::Request::Cache;
1229	my $uid = Foswiki::Request::Cache->new()->save($query);
1230	if ( $Foswiki::cfg{UsePathForRedirectCache} ) {
1231	return '/foswiki_redirect_cache/' . $uid;
1232	}
1233	else {
1234	return '?foswiki_redirect_cache=' . $uid;
1235	}
1236	}
1237
1238	=begin TML
1239
1240	---++ ObjectMethod getCGISession() -> $cgisession
1241
1242	Get the CGI::Session object associated with this session, if there is
1243	one. May return undef.
1244
1245	=cut
1246
1247	sub getCGISession {
1248	$_[0]->{users}->getCGISession();
1249	}
1250
1251	=begin TML
1252
1253	---++ ObjectMethod getLoginManager() -> $loginManager
1254
1255	Get the Foswiki::LoginManager object associated with this session, if there is
1256	one. May return undef.
1257
1258	=cut
1259
1260	sub getLoginManager {
1261	$_[0]->{users}->getLoginManager();
1262	}
1263
1264	=begin TML
1265
1266	---++ StaticMethod isValidWikiWord( $name ) -> $boolean
1267
1268	Check for a valid WikiWord or WikiName
1269
1270	=cut
1271
1272	sub isValidWikiWord {
1273	my $name = shift \|\| '';
1274	return ( $name =~ m/^$regex{wikiWordRegex}$/o );
1275	}
1276
1277	=begin TML
1278
1279	---++ StaticMethod isValidTopicName( $name [, $nonww] ) -> $boolean
1280
1281	Check for a valid topic =$name=. If =$nonww=, then accept non wiki-words
1282	(though they must still be composed of only valid, unfiltered characters)
1283
1284	=cut
1285
1286	# Note: must work on tainted names.
1287	sub isValidTopicName {
1288	my ( $name, $nonww ) = @_;
1289
1290	return 0 unless defined $name && $name ne '';
1291	return 1 if ( $name =~ m/^$regex{topicNameRegex}$/o );
1292	return 0 unless $nonww;
1293	return 0 if $name =~ /$cfg{NameFilter}/o;
1294	return 1;
1295	}
1296
1297	=begin TML
1298
1299	---++ StaticMethod isValidWebName( $name, $system ) -> $boolean
1300
1301	STATIC Check for a valid web name. If $system is true, then
1302	system web names are considered valid (names starting with _)
1303	otherwise only user web names are valid
1304
1305	If $Foswiki::cfg{EnableHierarchicalWebs} is off, it will also return false
1306	when a nested web name is passed to it.
1307
1308	=cut
1309
1310	# Note: must work on tainted names.
1311	sub isValidWebName {
1312	my $name = shift \|\| '';
1313	my $sys = shift;
1314	return 1 if ( $sys && $name =~ m/^$regex{defaultWebNameRegex}$/o );
1315	return ( $name =~ m/^$regex{webNameRegex}$/o );
1316	}
1317
1318	=begin TML
1319
1320	---++ StaticMethod isValidEmailAddress( $name ) -> $boolean
1321
1322	STATIC Check for a valid email address name.
1323
1324	=cut
1325
1326	# Note: must work on tainted names.
1327	sub isValidEmailAddress {
1328	my $name = shift \|\| '';
1329	return $name =~ /^$regex{emailAddrRegex}$/o;
1330	}
1331
1332	=begin TML
1333
1334	---++ ObjectMethod getSkin () -> $string
1335
1336	Get the currently requested skin path
1337
1338	=cut
1339
1340	sub getSkin {
1341	my $this = shift;
1342
1343	my @skinpath;
1344	my $skins;
1345
1346	if ( $this->{request} ) {
1347	$skins = $this->{request}->param('cover');
1348	if ( defined $skins
1349	&& $skins =~ /([$regex{mixedAlphaNum}.,\s]+)/o )
1350	{
1351
1352	# Implicit untaint ok - validated
1353	$skins = $1;
1354	push( @skinpath, split( /,\s]+/, $skins ) );
1355	}
1356	}
1357
1358	$skins = $this->{prefs}->getPreference('COVER');
1359	if ( defined $skins
1360	&& $skins =~ /([$regex{mixedAlphaNum}.,\s]+)/o )
1361	{
1362
1363	# Implicit untaint ok - validated
1364	$skins = $1;
1365	push( @skinpath, split( /[,\s]+/, $skins ) );
1366	}
1367
1368	$skins = $this->{request} ? $this->{request}->param('skin') : undef;
1369	$skins = $this->{prefs}->getPreference('SKIN') unless $skins;
1370
1371	if ( defined $skins && $skins =~ /([$regex{mixedAlphaNum}.,\s]+)/o ) {
1372
1373	# Implicit untaint ok - validated
1374	$skins = $1;
1375	push( @skinpath, split( /[,\s]+/, $skins ) );
1376	}
1377
1378	return join( ',', @skinpath );
1379	}
1380
1381	=begin TML
1382
1383	---++ ObjectMethod getScriptUrl( $absolute, $script, $web, $topic, ... ) -> $scriptURL
1384
1385	Returns the URL to a Foswiki script, providing the web and topic as
1386	"path info" parameters. The result looks something like this:
1387	"http://host/foswiki/bin/$script/$web/$topic".
1388	* =...= - 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>
1389
1390	If $absolute is set, generates an absolute URL. $absolute is advisory only;
1391	Foswiki can decide to generate absolute URLs (for example when run from the
1392	command-line) even when relative URLs have been requested.
1393
1394	The default script url is taken from {ScriptUrlPath}, unless there is
1395	an exception defined for the given script in {ScriptUrlPaths}. Both
1396	{ScriptUrlPath} and {ScriptUrlPaths} may be absolute or relative URIs. If
1397	they are absolute, then they will always generate absolute URLs. if they
1398	are relative, then they will be converted to absolute when required (e.g.
1399	when running from the command line, or when generating rss). If
1400	$script is not given, absolute URLs will always be generated.
1401
1402	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.
1403
1404	=cut
1405
1406	sub getScriptUrl {
1407	my ( $this, $absolute, $script, $web, $topic, @params ) = @_;
1408
1409	$absolute \|\|=
1410	( $this->inContext('command_line')
1411	\|\| $this->inContext('rss')
1412	\|\| $this->inContext('absolute_urls') );
1413
1414	# SMELL: topics and webs that contain spaces?
1415
1416	my $url;
1417	if ( defined $Foswiki::cfg{ScriptUrlPaths} && $script ) {
1418	$url = $Foswiki::cfg{ScriptUrlPaths}{$script};
1419	}
1420	unless ( defined($url) ) {
1421	$url = $Foswiki::cfg{ScriptUrlPath};
1422	if ($script) {
1423	$url .= '/' unless $url =~ /\/$/;
1424	$url .= $script;
1425	if (
1426	rindex( $url, $Foswiki::cfg{ScriptSuffix} ) !=
1427	( length($url) - length( $Foswiki::cfg{ScriptSuffix} ) ) )
1428	{
1429	$url .= $Foswiki::cfg{ScriptSuffix} if $script;
1430	}
1431	}
1432	}
1433
1434	if ( $absolute && $url !~ /^[a-z]+:/ ) {
1435
1436	# See http://www.ietf.org/rfc/rfc2396.txt for the definition of
1437	# "absolute URI". Foswiki bastardises this definition by assuming
1438	# that all relative URLs lack the <authority> component as well.
1439	$url = $this->{urlHost} . $url;
1440	}
1441
1442	if ( $web \|\| $topic ) {
1443	( $web, $topic ) = $this->normalizeWebTopicName( $web, $topic );
1444
1445	$url .= urlEncode( '/' . $web . '/' . $topic );
1446
1447	$url .= make_params(@params);
1448	}
1449
1450	return $url;
1451	}
1452
1453	=begin TML
1454
1455	---++ StaticMethod make_params(...)
1456	Generate a URL parameters string from parameters given. A parameter named '#' will
1457	generate an anchor.
1458
1459	=cut
1460
1461	sub make_params {
1462	my $url = '';
1463	my @ps;
1464	my $anchor = '';
1465	while ( my $p = shift @_ ) {
1466	if ( $p eq '#' ) {
1467	$anchor = '#' . urlEncode( shift(@_) );
1468	}
1469	else {
1470	my $v = shift(@_);
1471	$v = '' unless defined $v;
1472	push( @ps, urlEncode($p) . '=' . urlEncode($v) );
1473	}
1474	}
1475	if ( scalar(@ps) ) {
1476	$url .= '?' . join( ';', @ps );
1477	}
1478	return $url . $anchor;
1479	}
1480
1481	=begin TML
1482
1483	---++ ObjectMethod getPubUrl($absolute, $web, $topic, $attachment) -> $url
1484
1485	Composes a pub url. If $absolute is set, returns an absolute URL.
1486	If $absolute is set, generates an absolute URL. $absolute is advisory only;
1487	Foswiki can decide to generate absolute URLs (for example when run from the
1488	command-line) even when relative URLs have been requested.
1489
1490	$web, $topic and $attachment are optional. A partial URL path will be
1491	generated if one or all is not given.
1492
1493	=cut
1494
1495	sub getPubUrl {
1496	my ( $this, $absolute, $web, $topic, $attachment ) = @_;
1497
1498	$absolute \|\|=
1499	( $this->inContext('command_line')
1500	\|\| $this->inContext('rss')
1501	\|\| $this->inContext('absolute_urls') );
1502
1503	my $url = '';
1504	$url .= $Foswiki::cfg{PubUrlPath};
1505	if ( $absolute && $url !~ /^[a-z]+:/ ) {
1506
1507	# See http://www.ietf.org/rfc/rfc2396.txt for the definition of
1508	# "absolute URI". Foswiki bastardises this definition by assuming
1509	# that all relative URLs lack the <authority> component as well.
1510	$url = $this->{urlHost} . $url;
1511	}
1512	if ( $web \|\| $topic \|\| $attachment ) {
1513	( $web, $topic ) = $this->normalizeWebTopicName( $web, $topic );
1514
1515	my $path = '/' . $web . '/' . $topic;
1516	if ($attachment) {
1517	$path .= '/' . $attachment;
1518
1519	# Attachments are served directly by web server, need to handle
1520	# URL encoding specially
1521	$url .= urlEncodeAttachment($path);
1522	}
1523	else {
1524	$url .= urlEncode($path);
1525	}
1526	}
1527
1528	return $url;
1529	}
1530
1531	=begin TML
1532
1533	---++ ObjectMethod deepWebList($filter, $web) -> @list
1534
1535	Deep list subwebs of the named web. $filter is a Foswiki::WebFilter
1536	object that is used to filter the list. The listing of subwebs is
1537	dependent on $Foswiki::cfg{EnableHierarchicalWebs} being true.
1538
1539	Webs are returned as absolute web pathnames.
1540
1541	=cut
1542
1543	sub deepWebList {
1544	my ( $this, $filter, $rootWeb ) = @_;
1545	my @list;
1546	my $webObject = new Foswiki::Meta( $this, $rootWeb );
1547	my $it = $webObject->eachWeb( $Foswiki::cfg{EnableHierarchicalWebs} );
1548	return $it->all() unless $filter;
1549	while ( $it->hasNext() ) {
1550	my $w = $rootWeb \|\| '';
1551	$w .= '/' if $w;
1552	$w .= $it->next();
1553	if ( $filter->ok( $this, $w ) ) {
1554	push( @list, $w );
1555	}
1556	}
1557	return @list;
1558	}
1559
1560	=begin TML
1561
1562	---++ ObjectMethod normalizeWebTopicName( $web, $topic ) -> ( $web, $topic )
1563
1564	Normalize a Web<nop>.<nop>TopicName
1565
1566	See =Foswiki::Func= for a full specification of the expansion (not duplicated
1567	here)
1568
1569	WARNING if there is no web specification (in the web or topic parameters)
1570	the web defaults to $Foswiki::cfg{UsersWebName}. If there is no topic
1571	specification, or the topic is '0', the topic defaults to the web home topic
1572	name.
1573
1574	WARNING if the input topic name is tainted, then the output web and
1575	topic names will be tainted.
1576
1577	=cut
1578
1579	sub normalizeWebTopicName {
1580	my ( $this, $web, $topic ) = @_;
1581
1582	ASSERT( defined $topic ) if DEBUG;
1583
1584	if ( $topic =~ m\|^(.)[./](.?)$\| ) {
1585	$web = $1;
1586	$topic = $2;
1587
1588	if ( DEBUG && !UNTAINTED( $_[2] ) ) {
1589
1590	# retaint data untainted by RE above
1591	$web = TAINT($web);
1592	$topic = TAINT($topic);
1593	}
1594	}
1595	$web \|\|= $cfg{UsersWebName};
1596	$topic \|\|= $cfg{HomeTopicName};
1597
1598	# MAINWEB and TWIKIWEB expanded for compatibility reasons
1599	while (
1600	$web =~ s/%((MAIN\|TWIKI\|USERS\|SYSTEM\|DOC)WEB)%/
1601	$this->_expandMacroOnTopicRendering( $1 ) \|\| ''/e
1602	)
1603	{
1604	}
1605
1606	# Normalize web name to use / and not . as a subweb separator
1607	$web =~ s#\.#/#g;
1608
1609	return ( $web, $topic );
1610	}
1611
1612	=begin TML
1613
1614	---++ ClassMethod new( $defaultUser, $query, \%initialContext )
1615
1616	Constructs a new Foswiki session object. A unique session object exists for
1617	ever transaction with Foswiki, for example every browser request, or every
1618	script run. Session objects do not persist between mod_perl runs.
1619
1620	* =$defaultUser= is the username (not the wikiname) of the default
1621	user you want to be logged-in, if none is available from a session
1622	or browser. Used mainly for unit tests and debugging, it is typically
1623	undef, in which case the default user is taken from
1624	$Foswiki::cfg{DefaultUserName}.
1625	* =$query= the Foswiki::Request query (may be undef, in which case an
1626	empty query is used)
1627	* =\%initialContext= - reference to a hash containing context
1628	name=value pairs to be pre-installed in the context hash. May be undef.
1629
1630	=cut
1631
1632	sub new {
1633	my ( $class, $defaultUser, $query, $initialContext ) = @_;
1634
1635	Monitor::MARK("Static init over; make Foswiki object");
1636	ASSERT( !$query \|\| UNIVERSAL::isa( $query, 'Foswiki::Request' ) )
1637	if DEBUG;
1638
1639	# Compatibility; not used except maybe in plugins
1640	$Foswiki::cfg{TempfileDir} = "$Foswiki::cfg{WorkingDir}/tmp"
1641	unless defined( $Foswiki::cfg{TempfileDir} );
1642	if ( defined $Foswiki::cfg{WarningFileName}
1643	&& $Foswiki::cfg{Log}{Implementation} eq 'Foswiki::Logger::PlainFile' )
1644	{
1645
1646	# Admin has already expressed a preference for where they want their
1647	# logfiles to go, and has obviously not re-run configure yet.
1648	$Foswiki::cfg{Log}{Implementation} = 'Foswiki::Logger::Compatibility';
1649
1650	#print STDERR "WARNING: Foswiki is using the compatibility logger. Please re-run configure and check your logfiles settings\n";
1651	}
1652	else {
1653
1654	# Otherwise make sure it is defined for use in plugins,
1655	# but don't overwrite the setting from configure, if there is one.
1656	# This is especially important when the admin has chosen
1657	# to use the compatibility logger.
1658	if ( not defined $Foswiki::cfg{LogFileName} ) {
1659	$Foswiki::cfg{LogFileName} = "$Foswiki::cfg{Log}{Dir}/events.log";
1660	}
1661	}
1662
1663	# Set command_line context if there is no query
1664	$initialContext \|\|= defined($query) ? {} : { command_line => 1 };
1665
1666	# This foswiki supports : paragraph indent
1667	$initialContext->{SUPPORTS_PARA_INDENT} = 1;
1668
1669	$query \|\|= new Foswiki::Request();
1670	my $this = bless( { sandbox => 'Foswiki::Sandbox' }, $class );
1671
1672	if (SINGLE_SINGLETONS_TRACE) {
1673	require Data::Dumper;
1674	print STDERR "new $this: "
1675	. Data::Dumper->Dump( [ [caller], [ caller(1) ] ] );
1676	}
1677
1678	# Tell Foswiki::Response which charset we are using if not default
1679	$Foswiki::cfg{Site}{CharSet} \|\|= 'iso-8859-1';
1680
1681	$this->{request} = $query;
1682	$this->{cgiQuery} = $query; # for backwards compatibility in contribs
1683	$this->{response} = new Foswiki::Response();
1684	$this->{digester} = new Digest::MD5();
1685
1686	# This is required in case we get an exception during
1687	# initialisation, so that we have a session to handle it with.
1688	ASSERT( !$Foswiki::Plugins::SESSION ) if SINGLE_SINGLETONS;
1689	$Foswiki::Plugins::SESSION = $this;
1690	ASSERT( $Foswiki::Plugins::SESSION->isa('Foswiki') ) if DEBUG;
1691
1692	# hash of zone records
1693	$this->{_zones} = ();
1694
1695	# hash of occurences of RENDERZONE
1696	$this->{_renderZonePlaceholder} = ();
1697
1698	$this->{context} = $initialContext;
1699
1700	if ( $Foswiki::cfg{Cache}{Enabled} && $Foswiki::cfg{Cache}{Implementation} )
1701	{
1702	eval "require $Foswiki::cfg{Cache}{Implementation}";
1703	ASSERT( !$@, $@ ) if DEBUG;
1704	$this->{cache} = $Foswiki::cfg{Cache}{Implementation}->new();
1705	}
1706
1707	my $prefs = new Foswiki::Prefs($this);
1708	$this->{prefs} = $prefs;
1709	$this->{plugins} = new Foswiki::Plugins($this);
1710
1711	eval "require $Foswiki::cfg{Store}{Implementation}";
1712	ASSERT( !$@, $@ ) if DEBUG;
1713	$this->{store} = $Foswiki::cfg{Store}{Implementation}->new();
1714
1715	#Monitor::MARK("Created store");
1716
1717	$this->{users} = new Foswiki::Users($this);
1718
1719	#Monitor::MARK("Created users object");
1720
1721	#{urlHost} is needed by loadSession..
1722	my $url = $query->url();
1723	if ( $url && $url =~ m{^([^:]://[^/]).*$} ) {
1724	$this->{urlHost} = $1;
1725
1726	if ( $Foswiki::cfg{RemovePortNumber} ) {
1727	$this->{urlHost} =~ s/\:[0-9]+$//;
1728	}
1729
1730	# If the urlHost in the url is localhost, this is a lot less
1731	# useful than the default url host. This is because new CGI("")
1732	# assigns this host by default - it's a default setting, used
1733	# when there is nothing better available.
1734	if ( $this->{urlHost} =~ /^(https?:\/\/)localhost$/i ) {
1735	my $protocol = $1;
1736
1737	#only replace localhost _if_ the protocol matches the one specified in the DefaultUrlHost
1738	if ( $Foswiki::cfg{DefaultUrlHost} =~ /^$protocol/i ) {
1739	$this->{urlHost} = $Foswiki::cfg{DefaultUrlHost};
1740	}
1741	}
1742	}
1743	else {
1744	$this->{urlHost} = $Foswiki::cfg{DefaultUrlHost};
1745	}
1746	ASSERT( $this->{urlHost} ) if DEBUG;
1747
1748	# Load (or create) the CGI session
1749	$this->{remoteUser} = $this->{users}->loadSession($defaultUser);
1750
1751	# Make %ENV safer, preventing hijack of the search path. The
1752	# environment is set per-query, so this can't be done in a BEGIN.
1753	# TWikibug:Item4382: Default $ENV{PATH} must be untainted because
1754	# Foswiki runs with use strict and calling external programs that
1755	# writes on the disk will fail unless Perl seens it as set to safe value.
1756	if ( $Foswiki::cfg{SafeEnvPath} ) {
1757	$ENV{PATH} = $Foswiki::cfg{SafeEnvPath};
1758	}
1759	else {
1760
1761	# SMELL: how can we validate the PATH?
1762	$ENV{PATH} = Foswiki::Sandbox::untaintUnchecked( $ENV{PATH} );
1763	}
1764	delete @ENV{qw( IFS CDPATH ENV BASH_ENV )};
1765
1766	if ( $Foswiki::cfg{GetScriptUrlFromCgi}
1767	&& $url
1768	&& $url =~ m{^[^:]://[^/](.)/.$}
1769	&& $1 )
1770	{
1771
1772	# SMELL: this is a really dangerous hack. It will fail
1773	# spectacularly with mod_perl.
1774	# SMELL: why not just use $query->script_name?
1775	# SMELL: unchecked implicit untaint?
1776	$this->{scriptUrlPath} = $1;
1777	}
1778
1779	my $web = '';
1780	my $topic = $query->param('topic');
1781	if ($topic) {
1782	if ( $topic =~ m#^$regex{linkProtocolPattern}://#o
1783	&& $this->{request} )
1784	{
1785
1786	# SMELL: this is a result of Codev.GoBoxUnderstandsURLs,
1787	# an unrequested, undocumented, and AFAICT pretty useless
1788	#"feature". It should be deprecated (or silently removed; I
1789	# really, really doubt anyone is using it)
1790	$this->{webName} = '';
1791	$this->redirect($topic);
1792	return $this;
1793	}
1794	elsif ( $topic =~ m#^(.)[./](.?)$# ) {
1795
1796	# is '?topic=Webname.SomeTopic'
1797	# implicit untaint OK - validated later
1798	$web = $1;
1799	$topic = $2;
1800	$web =~ s/\./\//g;
1801
1802	# jump to WebHome if 'bin/script?topic=Webname.'
1803	$topic = $Foswiki::cfg{HomeTopicName} if ( $web && !$topic );
1804	}
1805
1806	# otherwise assume 'bin/script/Webname?topic=SomeTopic'
1807	}
1808	else {
1809	$topic = '';
1810	}
1811
1812	my $pathInfo = $query->path_info();
1813	$pathInfo =~ s\|//+\|/\|g; # multiple //'s are illogical
1814
1815	# Get the web and topic names from PATH_INFO
1816	if ( $pathInfo =~ m#^/(.)[./](.?)$# ) {
1817
1818	# is '/Webname/SomeTopic' or '/Webname'
1819	# implicit untaint OK - validated later
1820	$web = $1 unless $web;
1821	$topic = $2 unless $topic;
1822	$web =~ s/\./\//g;
1823	}
1824	elsif ( $pathInfo =~ m#^/(.*?)$# ) {
1825
1826	# is 'bin/script/Webname' or 'bin/script/'
1827	# implicit untaint OK - validated later
1828	$web = $1 unless $web;
1829	}
1830	my $topicNameTemp = $this->UTF82SiteCharSet($topic);
1831	if ($topicNameTemp) {
1832	$topic = $topicNameTemp;
1833	}
1834
1835	# Item3270 - here's the appropriate place to enforce spec
1836	# http://develop.twiki.org/~twiki4/cgi-bin/view/Bugs/Item3270
1837	$topic = ucfirst($topic);
1838
1839	# Validate and untaint topic name from path info
1840	$this->{topicName} = Foswiki::Sandbox::untaint( $topic,
1841	\&Foswiki::Sandbox::validateTopicName );
1842
1843	# Set the requestedWebName before applying defaults - used by statistics
1844	# generation. Note: This is validated using Topic name rules to permit
1845	# names beginning with lower case.
1846	$this->{requestedWebName} =
1847	Foswiki::Sandbox::untaint( $web, \&Foswiki::Sandbox::validateTopicName );
1848
1849	# Validate web name from path info
1850	$this->{webName} =
1851	Foswiki::Sandbox::untaint( $web, \&Foswiki::Sandbox::validateWebName );
1852
1853	if ( !defined $this->{webName} && !defined $this->{topicName} ) {
1854	$this->{webName} = $Foswiki::cfg{UsersWebName};
1855	$this->{topicName} = $Foswiki::cfg{HomeTopicName};
1856	}
1857
1858	$this->{webName} = ''
1859	unless ( defined $this->{webName} );
1860
1861	$this->{topicName} = $Foswiki::cfg{HomeTopicName}
1862	unless ( defined $this->{topicName} );
1863
1864	# Convert UTF-8 web and topic name from URL into site charset if
1865	# necessary
1866	# SMELL: merge these two cases, browsers just don't mix two encodings
1867	# in one URL - can also simplify into 2 lines by making function
1868	# return unprocessed text if no conversion
1869	my $webNameTemp = $this->UTF82SiteCharSet( $this->{webName} );
1870	if ($webNameTemp) {
1871	$this->{webName} = $webNameTemp;
1872	}
1873
1874	$this->{scriptUrlPath} = $Foswiki::cfg{ScriptUrlPath};
1875
1876	# Form definition cache
1877	$this->{forms} = {};
1878
1879	# Push global preferences from %SYSTEMWEB%.DefaultPreferences
1880	$prefs->loadDefaultPreferences();
1881
1882	#Monitor::MARK("Loaded default prefs");
1883
1884	# SMELL: what happens if we move this into the Foswiki::Users::new?
1885	$this->{user} = $this->{users}->initialiseUser( $this->{remoteUser} );
1886
1887	#Monitor::MARK("Initialised user");
1888
1889	# Static session variables that can be expanded in topics when they
1890	# are enclosed in % signs
1891	# SMELL: should collapse these into one. The duplication is pretty
1892	# pointless.
1893	$prefs->setInternalPreferences(
1894	BASEWEB => $this->{webName},
1895	BASETOPIC => $this->{topicName},
1896	INCLUDINGTOPIC => $this->{topicName},
1897	INCLUDINGWEB => $this->{webName}
1898	);
1899
1900	# Push plugin settings
1901	$this->{plugins}->settings();
1902
1903	# Now the rest of the preferences
1904	$prefs->loadSitePreferences();
1905
1906	# User preferences only available if we can get to a valid wikiname,
1907	# which depends on the user mapper.
1908	my $wn = $this->{users}->getWikiName( $this->{user} );
1909	if ($wn) {
1910	$prefs->setUserPreferences($wn);
1911	}
1912
1913	$prefs->pushTopicContext( $this->{webName}, $this->{topicName} );
1914
1915	#Monitor::MARK("Preferences all set up");
1916
1917	# Finish plugin initialization - register handlers
1918	$this->{plugins}->enable();
1919
1920	Monitor::MARK("Foswiki object created");
1921
1922	return $this;
1923	}
1924
1925	=begin TML
1926
1927	---++ ObjectMethod renderer()
1928	Get a reference to the renderer object. Done lazily because not everyone
1929	needs the renderer.
1930
1931	=cut
1932
1933	sub renderer {
1934	my ($this) = @_;
1935
1936	unless ( $this->{renderer} ) {
1937	require Foswiki::Render;
1938	$this->{renderer} = new Foswiki::Render($this);
1939	}
1940	return $this->{renderer};
1941	}
1942
1943	=begin TML
1944
1945	---++ ObjectMethod attach()
1946	Get a reference to the attach object. Done lazily because not everyone
1947	needs the attach.
1948
1949	=cut
1950
1951	sub attach {
1952	my ($this) = @_;
1953
1954	unless ( $this->{attach} ) {
1955	require Foswiki::Attach;
1956	$this->{attach} = new Foswiki::Attach($this);
1957	}
1958	return $this->{attach};
1959	}
1960
1961	=begin TML
1962
1963	---++ ObjectMethod templates()
1964	Get a reference to the templates object. Done lazily because not everyone
1965	needs the templates.
1966
1967	=cut
1968
1969	sub templates {
1970	my ($this) = @_;
1971
1972	unless ( $this->{templates} ) {
1973	require Foswiki::Templates;
1974	$this->{templates} = new Foswiki::Templates($this);
1975	}
1976	return $this->{templates};
1977	}
1978
1979	=begin TML
1980
1981	---++ ObjectMethod i18n()
1982	Get a reference to the i18n object. Done lazily because not everyone
1983	needs the i18ner.
1984
1985	=cut
1986
1987	sub i18n {
1988	my ($this) = @_;
1989
1990	unless ( $this->{i18n} ) {
1991	require Foswiki::I18N;
1992
1993	# language information; must be loaded after
1994	# all possible preferences sources are available
1995	$this->{i18n} = new Foswiki::I18N($this);
1996	}
1997	return $this->{i18n};
1998	}
1999
2000	=begin TML
2001
2002	---++ ObjectMethod logger()
2003
2004	=cut
2005
2006	sub logger {
2007	my $this = shift;
2008
2009	unless ( $this->{logger} ) {
2010	if ( $Foswiki::cfg{Log}{Implementation} eq 'none' ) {
2011	$this->{logger} = Foswiki::Logger->new();
2012	}
2013	else {
2014	eval "require $Foswiki::cfg{Log}{Implementation}";
2015	if ($@) {
2016	print STDERR "Logger load failed: $@";
2017	$this->{logger} = Foswiki::Logger->new();
2018	}
2019	else {
2020	$this->{logger} = $Foswiki::cfg{Log}{Implementation}->new();
2021	}
2022	}
2023	}
2024
2025	return $this->{logger};
2026	}
2027
2028	=begin TML
2029
2030	---++ ObjectMethod search()
2031	Get a reference to the search object. Done lazily because not everyone
2032	needs the searcher.
2033
2034	=cut
2035
2036	sub search {
2037	my ($this) = @_;
2038
2039	unless ( $this->{search} ) {
2040	require Foswiki::Search;
2041	$this->{search} = new Foswiki::Search($this);
2042	}
2043	return $this->{search};
2044	}
2045
2046	=begin TML
2047
2048	---++ ObjectMethod net()
2049	Get a reference to the net object. Done lazily because not everyone
2050	needs the net.
2051
2052	=cut
2053
2054	sub net {
2055	my ($this) = @_;
2056
2057	unless ( $this->{net} ) {
2058	require Foswiki::Net;
2059	$this->{net} = new Foswiki::Net($this);
2060	}
2061	return $this->{net};
2062	}
2063
2064	=begin TML
2065
2066	---++ ObjectMethod access()
2067	Get a reference to the ACL object.
2068
2069	=cut
2070
2071	sub access {
2072	my ($this) = @_;
2073
2074	unless ( $this->{access} ) {
2075	require Foswiki::Access;
2076	$this->{access} = Foswiki::Access->new($this);
2077	}
2078	ASSERT( $this->{access} ) if DEBUG;
2079	return $this->{access};
2080	}
2081
2082	=begin TML
2083
2084	---++ ObjectMethod DESTROY()
2085
2086	called by Perl when the Foswiki object goes out of scope
2087	(maybe should be used kist to ASSERT that finish() was called..
2088
2089	=cut
2090
2091	#sub DESTROY {
2092	# my $this = shift;
2093	# $this->finish();
2094	#}
2095
2096	=begin TML
2097
2098	---++ ObjectMethod finish()
2099	Break circular references.
2100
2101	=cut
2102
2103	# Note to developers; please undef all fields in the object explicitly,
2104	# whether they are references or not. That way this method is "golden
2105	# documentation" of the live fields in the object.
2106	sub finish {
2107	my $this = shift;
2108
2109	# Print any macros that are never loaded
2110	#print STDERR "NEVER USED\n";
2111	#for my $i (keys %macros) {
2112	# print STDERR "\t$i\n" unless defined $macros{$i};
2113	#}
2114	$_->finish() foreach values %{ $this->{forms} };
2115	undef $this->{forms};
2116	foreach my $key (
2117	qw(plugins users prefs templates renderer net
2118	store search attach access i18n cache logger)
2119	)
2120	{
2121	next
2122	unless ref( $this->{$key} );
2123	$this->{$key}->finish();
2124	undef $this->{$key};
2125	}
2126
2127	undef $this->{_zones};
2128	undef $this->{_renderZonePlaceholder};
2129
2130	undef $this->{request};
2131	undef $this->{cgiQuery};
2132
2133	undef $this->{digester};
2134	undef $this->{urlHost};
2135	undef $this->{web};
2136	undef $this->{topic};
2137	undef $this->{webName};
2138	undef $this->{topicName};
2139	undef $this->{_ICONSPACE};
2140	undef $this->{_EXT2ICON};
2141	undef $this->{_KNOWNICON};
2142	undef $this->{_ICONSTEMPLATE};
2143	undef $this->{context};
2144	undef $this->{remoteUser};
2145	undef $this->{requestedWebName}; # Web name before renaming
2146	undef $this->{scriptUrlPath};
2147	undef $this->{user};
2148	undef $this->{_INCLUDES};
2149	undef $this->{response};
2150	undef $this->{evaluating_if};
2151	undef $this->{_addedToHEAD};
2152	undef $this->{sandbox};
2153	undef $this->{evaluatingEval};
2154
2155	undef $this->{DebugVerificationCode}; # from Foswiki::UI::Register
2156	if (SINGLE_SINGLETONS_TRACE) {
2157	require Data::Dumper;
2158	print STDERR "finish $this: "
2159	. Data::Dumper->Dump( [ [caller], [ caller(1) ] ] );
2160	}
2161	if (SINGLE_SINGLETONS) {
2162	ASSERT( defined $Foswiki::Plugins::SESSION );
2163	ASSERT( $Foswiki::Plugins::SESSION == $this );
2164	ASSERT( $Foswiki::Plugins::SESSION->isa('Foswiki') );
2165	}
2166	undef $Foswiki::Plugins::SESSION;
2167
2168	if (DEBUG) {
2169	my $remaining = join ',', grep { defined $this->{$_} } keys %$this;
2170	ASSERT( 0,
2171	"Fields with defined values in "
2172	. ref($this)
2173	. "->finish(): "
2174	. $remaining )
2175	if $remaining;
2176	}
2177	}
2178
2179	=begin TML
2180
2181	---++ ObjectMethod logEvent( $action, $webTopic, $extra, $user )
2182	* =$action= - what happened, e.g. view, save, rename
2183	* =$webTopic= - what it happened to
2184	* =$extra= - extra info, such as minor flag
2185	* =$user= - login name of user - default current user,
2186	or failing that the user agent
2187
2188	Write the log for an event to the logfile
2189
2190	=cut
2191
2192	sub logEvent {
2193	my $this = shift;
2194
2195	my $action = shift \|\| '';
2196	my $webTopic = shift \|\| '';
2197	my $extra = shift \|\| '';
2198	my $user = shift;
2199
2200	return
2201	if ( defined $Foswiki::cfg{Log}{Action}{$action}
2202	&& !$Foswiki::cfg{Log}{Action}{$action} );
2203
2204	$user \|\|= $this->{user};
2205	$user = ( $this->{users}->getLoginName($user) \|\| 'unknown' )
2206	if ( $this->{users} );
2207
2208	my $cgiQuery = $this->{request};
2209	if ($cgiQuery) {
2210	my $agent = $cgiQuery->user_agent();
2211	if ($agent) {
2212	$extra .= ' ' if $extra;
2213	if ( $agent =~
2214	/(MSIE 6\|MSIE 7\|MSIE 8\|MSI 9\|Firefox\|Opera\|Konqueror\|Chrome\|Safari)/
2215	)
2216	{
2217	$extra .= $1;
2218	}
2219	else {
2220	$agent =~ m/([\w]+)/;
2221	$extra .= $1;
2222	}
2223	}
2224	}
2225
2226	my $remoteAddr = $this->{request}->remoteAddress() \|\| '';
2227
2228	$this->logger->log( 'info', $user, $action, $webTopic, $extra,
2229	$remoteAddr );
2230	}
2231
2232	=begin TML
2233
2234	---++ StaticMethod validatePattern( $pattern ) -> $pattern
2235
2236	Validate a pattern provided in a parameter to $pattern so that
2237	dangerous chars (interpolation and execution) are disabled.
2238
2239	=cut
2240
2241	sub validatePattern {
2242	my $pattern = shift;
2243
2244	# Escape unescaped $ and @ characters that might interpolate
2245	# an internal variable.
2246	# There is no need to defuse (??{ and (?{ as perl won't allow
2247	# it anyway, unless one uses re 'eval' which we won't do
2248	$pattern =~ s/(^\|[^\\])([\$\@])/$1\\$2/g;
2249	return $pattern;
2250	}
2251
2252	=begin TML
2253
2254	---++ ObjectMethod inlineAlert($template, $def, ... ) -> $string
2255
2256	Format an error for inline inclusion in rendered output. The message string
2257	is obtained from the template 'oops'.$template, and the DEF $def is
2258	selected. The parameters (...) are used to populate %PARAM1%..%PARAMn%
2259
2260	=cut
2261
2262	sub inlineAlert {
2263	my $this = shift;
2264	my $template = shift;
2265	my $def = shift;
2266
2267	# web and topic can be anything; they are not used
2268	my $topicObject =
2269	Foswiki::Meta->new( $this, $this->{webName}, $this->{topicName} );
2270	my $text = $this->templates->readTemplate( 'oops' . $template );
2271	if ($text) {
2272	my $blah = $this->templates->expandTemplate($def);
2273	$text =~ s/%INSTANTIATE%/$blah/;
2274
2275	$text = $topicObject->expandMacros($text);
2276	my $n = 1;
2277	while ( defined( my $param = shift ) ) {
2278	$text =~ s/%PARAM$n%/$param/g;
2279	$n++;
2280	}
2281
2282	# Suppress missing params
2283	$text =~ s/%PARAM\d+%//g;
2284
2285	# Suppress missing params
2286	$text =~ s/%PARAM\d+%//g;
2287	}
2288	else {
2289
2290	# Error in the template system.
2291	$text = $topicObject->renderTML(<<MESSAGE);
2292	---+ Foswiki Installation Error
2293	Template 'oops$template' not found or returned no text, expanding $def.
2294
2295	Check your configuration settings for {TemplateDir} and {TemplatePath}
2296	or check for syntax errors in templates, or a missing TMPL:END.
2297	MESSAGE
2298	}
2299
2300	return $text;
2301	}
2302
2303	=begin TML
2304
2305	---++ StaticMethod parseSections($text) -> ($string,$sectionlistref)
2306
2307	Generic parser for sections within a topic. Sections are delimited
2308	by STARTSECTION and ENDSECTION, which may be nested, overlapped or
2309	otherwise abused. The parser builds an array of sections, which is
2310	ordered by the order of the STARTSECTION within the topic. It also
2311	removes all the SECTION tags from the text, and returns the text
2312	and the array of sections.
2313
2314	Each section is a =Foswiki::Attrs= object, which contains the attributes
2315	{type, name, start, end}
2316	where start and end are character offsets in the
2317	string after all section tags have been removed. All sections
2318	are required to be uniquely named; if a section is unnamed, it
2319	will be given a generated name. Sections may overlap or nest.
2320
2321	See test/unit/Fn_SECTION.pm for detailed testcases that
2322	round out the spec.
2323
2324	=cut
2325
2326	sub parseSections {
2327
2328	my $text = shift;
2329
2330	return ( '', [] ) unless defined $text;
2331
2332	my %sections;
2333	my @list = ();
2334
2335	my $seq = 0;
2336	my $ntext = '';
2337	my $offset = 0;
2338	foreach my $bit ( split( /(%(?:START\|END)SECTION(?:{.*?})?%)/, $text ) ) {
2339	if ( $bit =~ /^%STARTSECTION(?:{(.*)})?%$/ ) {
2340	require Foswiki::Attrs;
2341
2342	# SMELL: unchecked implicit untaint?
2343	my $attrs = new Foswiki::Attrs($1);
2344	$attrs->{type} \|\|= 'section';
2345	$attrs->{name} =
2346	$attrs->{_DEFAULT}
2347	\|\| $attrs->{name}
2348	\|\| '_SECTION' . $seq++;
2349	delete $attrs->{_DEFAULT};
2350	my $id = $attrs->{type} . ':' . $attrs->{name};
2351	if ( $sections{$id} ) {
2352
2353	# error, this named section already defined, ignore
2354	next;
2355	}
2356
2357	# close open unnamed sections of the same type
2358	foreach my $s (@list) {
2359	if ( $s->{end} < 0
2360	&& $s->{type} eq $attrs->{type}
2361	&& $s->{name} =~ /^_SECTION\d+$/ )
2362	{
2363	$s->{end} = $offset;
2364	}
2365	}
2366	$attrs->{start} = $offset;
2367	$attrs->{end} = -1; # open section
2368	$sections{$id} = $attrs;
2369	push( @list, $attrs );
2370	}
2371	elsif ( $bit =~ /^%ENDSECTION(?:{(.*)})?%$/ ) {
2372	require Foswiki::Attrs;
2373
2374	# SMELL: unchecked implicit untaint?
2375	my $attrs = new Foswiki::Attrs($1);
2376	$attrs->{type} \|\|= 'section';
2377	$attrs->{name} = $attrs->{_DEFAULT} \|\| $attrs->{name} \|\| '';
2378	delete $attrs->{_DEFAULT};
2379	unless ( $attrs->{name} ) {
2380
2381	# find the last open unnamed section of this type
2382	foreach my $s ( reverse @list ) {
2383	if ( $s->{end} == -1
2384	&& $s->{type} eq $attrs->{type}
2385	&& $s->{name} =~ /^_SECTION\d+$/ )
2386	{
2387	$attrs->{name} = $s->{name};
2388	last;
2389	}
2390	}
2391
2392	# ignore it if no matching START found
2393	next unless $attrs->{name};
2394	}
2395	my $id = $attrs->{type} . ':' . $attrs->{name};
2396	if ( !$sections{$id} \|\| $sections{$id}->{end} >= 0 ) {
2397
2398	# error, no such open section, ignore
2399	next;
2400	}
2401	$sections{$id}->{end} = $offset;
2402	}
2403	else {
2404	$ntext .= $bit;
2405	$offset = length($ntext);
2406	}
2407	}
2408
2409	# close open sections
2410	foreach my $s (@list) {
2411	$s->{end} = $offset if $s->{end} < 0;
2412	}
2413
2414	return ( $ntext, \@list );
2415	}
2416
2417	=begin TML
2418
2419	---++ ObjectMethod expandMacrosOnTopicCreation ( $topicObject )
2420
2421	* =$topicObject= - the topic
2422
2423	Expand only that subset of Foswiki variables that are
2424	expanded during topic creation, in the body text and
2425	PREFERENCE meta only. The expansion is in-place inside
2426	the topic object.
2427
2428	# SMELL: no plugin handler
2429
2430	=cut
2431
2432	sub expandMacrosOnTopicCreation {
2433	my ( $this, $topicObject ) = @_;
2434
2435	# Make sure func works, for registered tag handlers
2436	if (SINGLE_SINGLETONS) {
2437	ASSERT( defined $Foswiki::Plugins::SESSION );
2438	ASSERT( $Foswiki::Plugins::SESSION == $this );
2439	}
2440	local $Foswiki::Plugins::SESSION = $this;
2441	ASSERT( $Foswiki::Plugins::SESSION->isa('Foswiki') ) if DEBUG;
2442
2443	my $text = $topicObject->text();
2444	if ($text) {
2445
2446	# Chop out templateonly sections
2447	my ( $ntext, $sections ) = parseSections($text);
2448	if ( scalar(@$sections) ) {
2449
2450	# Note that if named templateonly sections overlap,
2451	# the behaviour is undefined.
2452	foreach my $s ( reverse @$sections ) {
2453	if ( $s->{type} eq 'templateonly' ) {
2454	$ntext =
2455	substr( $ntext, 0, $s->{start} )
2456	. substr( $ntext, $s->{end}, length($ntext) );
2457	}
2458	else {
2459
2460	# put back non-templateonly sections
2461	my $start = $s->remove('start');
2462	my $end = $s->remove('end');
2463	$ntext =
2464	substr( $ntext, 0, $start )
2465	. '%STARTSECTION{'
2466	. $s->stringify() . '}%'
2467	. substr( $ntext, $start, $end - $start )
2468	. '%ENDSECTION{'
2469	. $s->stringify() . '}%'
2470	. substr( $ntext, $end, length($ntext) );
2471	}
2472	}
2473	$text = $ntext;
2474	}
2475
2476	$text = _processMacros( $this, $text, \&_expandMacroOnTopicCreation,
2477	$topicObject, 16 );
2478
2479	# expand all variables for type="expandvariables" sections
2480	( $ntext, $sections ) = parseSections($text);
2481	if ( scalar(@$sections) ) {
2482	foreach my $s ( reverse @$sections ) {
2483	if ( $s->{type} eq 'expandvariables' ) {
2484	my $etext =
2485	substr( $ntext, $s->{start}, $s->{end} - $s->{start} );
2486	$this->innerExpandMacros( \$etext, $topicObject );
2487	$ntext =
2488	substr( $ntext, 0, $s->{start} )
2489	. $etext
2490	. substr( $ntext, $s->{end}, length($ntext) );
2491	}
2492	else {
2493
2494	# put back non-expandvariables sections
2495	my $start = $s->remove('start');
2496	my $end = $s->remove('end');
2497	$ntext =
2498	substr( $ntext, 0, $start )
2499	. '%STARTSECTION{'
2500	. $s->stringify() . '}%'
2501	. substr( $ntext, $start, $end - $start )
2502	. '%ENDSECTION{'
2503	. $s->stringify() . '}%'
2504	. substr( $ntext, $end, length($ntext) );
2505	}
2506	}
2507	$text = $ntext;
2508	}
2509
2510	# kill markers used to prevent variable expansion
2511	$text =~ s/%NOP%//g;
2512	$topicObject->text($text);
2513	}
2514
2515	# Expand preferences
2516	my @prefs = $topicObject->find('PREFERENCE');
2517	foreach my $p (@prefs) {
2518	$p->{value} =
2519	_processMacros( $this, $p->{value}, \&_expandMacroOnTopicCreation,
2520	$topicObject, 16 );
2521
2522	# kill markers used to prevent variable expansion
2523	$p->{value} =~ s/%NOP%//g;
2524	}
2525	}
2526
2527	=begin TML
2528
2529	---++ StaticMethod entityEncode( $text, $extras ) -> $encodedText
2530
2531	Escape special characters to HTML numeric entities. This is not a generic
2532	encoding, it is tuned specifically for use in Foswiki.
2533
2534	HTML4.0 spec:
2535	"Certain characters in HTML are reserved for use as markup and must be
2536	escaped to appear literally. The "<" character may be represented with
2537	an <em>entity</em>, <strong class=html>&lt;</strong>. Similarly, ">"
2538	is escaped as <strong class=html>&gt;</strong>, and "&" is escaped
2539	as <strong class=html>&amp;</strong>. If an attribute value contains a
2540	double quotation mark and is delimited by double quotation marks, then the
2541	quote should be escaped as <strong class=html>&quot;</strong>.
2542
2543	Other entities exist for special characters that cannot easily be entered
2544	with some keyboards..."
2545
2546	This method encodes HTML special and any non-printable ascii
2547	characters (except for \n and \r) using numeric entities.
2548
2549	FURTHER this method also encodes characters that are special in Foswiki
2550	meta-language.
2551
2552	$extras is an optional param that may be used to include additional
2553	characters in the set of encoded characters. It should be a string
2554	containing the additional chars.
2555
2556	=cut
2557
2558	sub entityEncode {
2559	my ( $text, $extra ) = @_;
2560	$extra \|\|= '';
2561
2562	# encode all non-printable 7-bit chars (< \x1f),
2563	# except \n (\xa) and \r (\xd)
2564	# encode HTML special characters '>', '<', '&', ''' and '"'.
2565	# encode TML special characters '%', '\|', '[', ']', '@', '_',
2566	# '*', and '='
2567	$text =~
2568	s/([[\x01-\x09\x0b\x0c\x0e-\x1f"%&'*<=>@[_\\|$extra])/'&#'.ord($1).';'/ge;
2569	return $text;
2570	}
2571
2572	=begin TML
2573
2574	---++ StaticMethod entityDecode ( $encodedText ) -> $text
2575
2576	Decodes all numeric entities (e.g. &#123;). _Does not_ decode
2577	named entities such as &amp; (use HTML::Entities for that)
2578
2579	=cut
2580
2581	sub entityDecode {
2582	my $text = shift;
2583
2584	$text =~ s/&#(\d+);/chr($1)/ge;
2585	return $text;
2586	}
2587
2588	=begin TML
2589
2590	---++ StaticMethod urlEncodeAttachment ( $text )
2591
2592	For attachments, URL-encode specially to 'freeze' any characters >127 in the
2593	site charset (e.g. ISO-8859-1 or KOI8-R), by doing URL encoding into native
2594	charset ($siteCharset) - used when generating attachment URLs, to enable the
2595	web server to serve attachments, including images, directly.
2596
2597	This encoding is required to handle the cases of:
2598
2599	- browsers that generate UTF-8 URLs automatically from site charset URLs - now quite common
2600	- web servers that directly serve attachments, using the site charset for
2601	filenames, and cannot convert UTF-8 URLs into site charset filenames
2602
2603	The aim is to prevent the browser from converting a site charset URL in the web
2604	page to a UTF-8 URL, which is the default. Hence we 'freeze' the URL into the
2605	site character set through URL encoding.
2606
2607	In two cases, no URL encoding is needed: For EBCDIC mainframes, we assume that
2608	site charset URLs will be translated (outbound and inbound) by the web server to/from an
2609	EBCDIC character set. For sites running in UTF-8, there's no need for Foswiki to
2610	do anything since all URLs and attachment filenames are already in UTF-8.
2611
2612	=cut
2613
2614	sub urlEncodeAttachment {
2615	my ($text) = @_;
2616
2617	my $usingEBCDIC = ( 'A' eq chr(193) ); # Only true on EBCDIC mainframes
2618
2619	if ( $Foswiki::cfg{Site}{CharSet} =~ /^utf-?8$/i or $usingEBCDIC ) {
2620
2621	# Just let browser do UTF-8 URL encoding
2622	return $text;
2623	}
2624
2625	# Freeze into site charset through URL encoding
2626	return urlEncode($text);
2627	}
2628
2629	=begin TML
2630
2631	---++ StaticMethod urlEncode( $string ) -> encoded string
2632
2633	Encode by converting characters that are illegal in URLs to
2634	their %NN equivalents. This method is used for encoding
2635	strings that must be embedded _verbatim_ in URLs; it cannot
2636	be applied to URLs themselves, as it escapes reserved
2637	characters such as = and ?.
2638
2639	RFC 1738, Dec. '94:
2640	<verbatim>
2641	...Only alphanumerics [0-9a-zA-Z], the special
2642	characters $-_.+!*'(), and reserved characters used for their
2643	reserved purposes may be used unencoded within a URL.
2644	</verbatim>
2645
2646	Reserved characters are $&+,/:;=?@ - these are _also_ encoded by
2647	this method.
2648
2649	This URL-encoding handles all character encodings including ISO-8859-*,
2650	KOI8-R, EUC-* and UTF-8.
2651
2652	This may not handle EBCDIC properly, as it generates an EBCDIC URL-encoded
2653	URL, but mainframe web servers seem to translate this outbound before it hits browser
2654	- see CGI::Util::escape for another approach.
2655
2656	=cut
2657
2658	sub urlEncode {
2659	my $text = shift;
2660
2661	$text =~ s/([^0-9a-zA-Z-_.:~!*'\/])/'%'.sprintf('%02x',ord($1))/ge;
2662
2663	return $text;
2664	}
2665
2666	=begin TML
2667
2668	---++ StaticMethod urlDecode( $string ) -> decoded string
2669
2670	Reverses the encoding done in urlEncode.
2671
2672	=cut
2673
2674	sub urlDecode {
2675	my $text = shift;
2676
2677	$text =~ s/%([\da-f]{2})/chr(hex($1))/gei;
2678
2679	return $text;
2680	}
2681
2682	=begin TML
2683
2684	---++ StaticMethod isTrue( $value, $default ) -> $boolean
2685
2686	Returns 1 if =$value= is true, and 0 otherwise. "true" means set to
2687	something with a Perl true value, with the special cases that "off",
2688	"false" and "no" (case insensitive) are forced to false. Leading and
2689	trailing spaces in =$value= are ignored.
2690
2691	If the value is undef, then =$default= is returned. If =$default= is
2692	not specified it is taken as 0.
2693
2694	=cut
2695
2696	sub isTrue {
2697	my ( $value, $default ) = @_;
2698
2699	$default \|\|= 0;
2700
2701	return $default unless defined($value);
2702
2703	$value =~ s/^\s(.?)\s*$/$1/gi;
2704	$value =~ s/off//gi;
2705	$value =~ s/no//gi;
2706	$value =~ s/false//gi;
2707	return ($value) ? 1 : 0;
2708	}
2709
2710	=begin TML
2711
2712	---++ StaticMethod spaceOutWikiWord( $word, $sep ) -> $string
2713
2714	Spaces out a wiki word by inserting a string (default: one space) between each word component.
2715	With parameter $sep any string may be used as separator between the word components; if $sep is undefined it defaults to a space.
2716
2717	=cut
2718
2719	sub spaceOutWikiWord {
2720	my ( $word, $sep ) = @_;
2721
2722	# Both could have the value 0 so we cannot use simple = \|\| ''
2723	$word = defined($word) ? $word : '';
2724	$sep = defined($sep) ? $sep : ' ';
2725	$word =~ s/([$regex{upperAlpha}])([$regex{numeric}])/$1$sep$2/go;
2726	$word =~ s/([$regex{numeric}])([$regex{upperAlpha}])/$1$sep$2/go;
2727	$word =~
2728	s/([$regex{lowerAlpha}])([$regex{upperAlpha}$regex{numeric}]+)/$1$sep$2/go;
2729	$word =~
2730	s/([$regex{upperAlpha}])([$regex{upperAlpha}])(?=[$regex{lowerAlpha}])/$1$sep$2/go;
2731	return $word;
2732	}
2733
2734	=begin TML
2735
2736	---++ ObjectMethod innerExpandMacros(\$text, $topicObject)
2737	Expands variables by replacing the variables with their
2738	values. Some example variables: %<nop>TOPIC%, %<nop>SCRIPTURL%,
2739	%<nop>WIKINAME%, etc.
2740	$web and $incs are passed in for recursive include expansion. They can
2741	safely be undef.
2742	The rules for tag expansion are:
2743	1 Tags are expanded left to right, in the order they are encountered.
2744	1 Tags are recursively expanded as soon as they are encountered -
2745	the algorithm is inherently single-pass
2746	1 A tag is not "encountered" until the matching }% has been seen, by
2747	which time all tags in parameters will have been expanded
2748	1 Tag expansions that create new tags recursively are limited to a
2749	set number of hierarchical levels of expansion
2750
2751	=cut
2752
2753	sub innerExpandMacros {
2754	my ( $this, $text, $topicObject ) = @_;
2755
2756	# push current context
2757	my $memTopic = $this->{prefs}->getPreference('TOPIC');
2758	my $memWeb = $this->{prefs}->getPreference('WEB');
2759
2760	# Historically this couldn't be called on web objects.
2761	my $webContext = $topicObject->web \|\| $this->{webName};
2762	my $topicContext = $topicObject->topic \|\| $this->{topicName};
2763
2764	$this->{prefs}->setInternalPreferences(
2765	TOPIC => $topicContext,
2766	WEB => $webContext
2767	);
2768
2769	# Escape ' !%VARIABLE%'
2770	$$text =~ s/(?<=\s)!%($regex{tagNameRegex})/%$1/g;
2771
2772	# Make sure func works, for registered tag handlers
2773	if (SINGLE_SINGLETONS) {
2774	ASSERT( defined $Foswiki::Plugins::SESSION );
2775	ASSERT( $Foswiki::Plugins::SESSION == $this );
2776	}
2777	local $Foswiki::Plugins::SESSION = $this;
2778	ASSERT( $Foswiki::Plugins::SESSION->isa('Foswiki') ) if DEBUG;
2779
2780	# NOTE TO DEBUGGERS
2781	# The depth parameter in the following call controls the maximum number
2782	# of levels of expansion. If it is set to 1 then only macros in the
2783	# topic will be expanded; macros that they in turn generate will be
2784	# left unexpanded. If it is set to 2 then the expansion will stop after
2785	# the first recursive inclusion, and so on. This is incredible useful
2786	# when debugging. The default, 16, was selected empirically.
2787	$$text = _processMacros( $this, $$text, \&_expandMacroOnTopicRendering,
2788	$topicObject, 16 );
2789
2790	# restore previous context
2791	$this->{prefs}->setInternalPreferences(
2792	TOPIC => $memTopic,
2793	WEB => $memWeb
2794	);
2795	}
2796
2797	=begin TML
2798
2799	---++ StaticMethod takeOutBlocks( \$text, $tag, \%map ) -> $text
2800	* =$text= - Text to process
2801	* =$tag= - XML-style tag.
2802	* =\%map= - Reference to a hash to contain the removed blocks
2803
2804	Return value: $text with blocks removed
2805
2806	Searches through $text and extracts blocks delimited by an XML-style tag,
2807	storing the extracted block, and replacing with a token string which is
2808	not affected by TML rendering. The text after these substitutions is
2809	returned.
2810
2811	=cut
2812
2813	sub takeOutBlocks {
2814	my ( $intext, $tag, $map ) = @_;
2815
2816	return $intext unless ( $intext =~ m/<$tag\b/i );
2817
2818	my $out = '';
2819	my $depth = 0;
2820	my $scoop;
2821	my $tagParams;
2822
2823	foreach my $token ( split( /(<\/?$tag[^>]*>)/i, $intext ) ) {
2824	if ( $token =~ /<$tag\b([^>]*)?>/i ) {
2825	$depth++;
2826	if ( $depth eq 1 ) {
2827	$tagParams = $1;
2828	next;
2829	}
2830	}
2831	elsif ( $token =~ /<\/$tag>/i ) {
2832	if ( $depth > 0 ) {
2833	$depth--;
2834	if ( $depth eq 0 ) {
2835	my $placeholder = "$tag$BLOCKID";
2836	$BLOCKID++;
2837	$map->{$placeholder}{text} = $scoop;
2838	$map->{$placeholder}{params} = $tagParams;
2839	$out .= "$OC$placeholder$CC";
2840	$scoop = '';
2841	next;
2842	}
2843	}
2844	}
2845	if ( $depth > 0 ) {
2846	$scoop .= $token;
2847	}
2848	else {
2849	$out .= $token;
2850	}
2851	}
2852
2853	# unmatched tags
2854	if ( defined($scoop) && ( $scoop ne '' ) ) {
2855	my $placeholder = "$tag$BLOCKID";
2856	$BLOCKID++;
2857	$map->{$placeholder}{text} = $scoop;
2858	$map->{$placeholder}{params} = $tagParams;
2859	$out .= "$OC$placeholder$CC";
2860	}
2861
2862	return $out;
2863	}
2864
2865	=begin TML
2866
2867	---++ StaticMethod putBackBlocks( \$text, \%map, $tag, $newtag, $callBack ) -> $text
2868
2869	Return value: $text with blocks added back
2870	* =\$text= - reference to text to process
2871	* =\%map= - map placeholders to blocks removed by takeOutBlocks
2872	* =$tag= - Tag name processed by takeOutBlocks
2873	* =$newtag= - Tag name to use in output, in place of $tag.
2874	If undefined, uses $tag.
2875	* =$callback= - Reference to function to call on each block
2876	being inserted (optional)
2877
2878	Reverses the actions of takeOutBlocks.
2879
2880	Each replaced block is processed by the callback (if there is one) before
2881	re-insertion.
2882
2883	Parameters to the outermost cut block are replaced into the open tag,
2884	even if that tag is changed. This allows things like =<verbatim class=''>=
2885	to be changed to =<pre class=''>=
2886
2887	If you set $newtag to '', replaces the taken-out block with the contents
2888	of the block, not including the open/close. This is used for <literal>,
2889	for example.
2890
2891	=cut
2892
2893	sub putBackBlocks {
2894	my ( $text, $map, $tag, $newtag, $callback ) = @_;
2895
2896	$newtag = $tag if ( !defined($newtag) );
2897
2898	foreach my $placeholder ( keys %$map ) {
2899	if ( $placeholder =~ /^$tag\d+$/ ) {
2900	my $params = $map->{$placeholder}{params} \|\| '';
2901	my $val = $map->{$placeholder}{text};
2902	$val = &$callback($val) if ( defined($callback) );
2903	if ( $newtag eq '' ) {
2904	$$text =~ s($OC$placeholder$CC)($val);
2905	}
2906	else {
2907	$$text =~ s($OC$placeholder$CC)
2908	(<$newtag$params>$val</$newtag>);
2909	}
2910	delete( $map->{$placeholder} );
2911	}
2912	}
2913	}
2914
2915	# Process Foswiki %TAGS{}% by parsing the input tokenised into
2916	# % separated sections. The parser is a simple stack-based parse,
2917	# sufficient to ensure nesting of tags is correct, but no more
2918	# than that.
2919	# $depth limits the number of recursive expansion steps that
2920	# can be performed on expanded tags.
2921	sub _processMacros {
2922	my ( $this, $text, $tagf, $topicObject, $depth ) = @_;
2923	my $tell = 0;
2924
2925	return '' if ( ( !defined($text) )
2926	\|\| ( $text eq '' ) );
2927
2928	#no tags to process
2929	return $text unless ( $text =~ /%/ );
2930
2931	unless ($depth) {
2932	my $mess = "Max recursive depth reached: $text";
2933	$this->logger->log( 'warning', $mess );
2934
2935	# prevent recursive expansion that just has been detected
2936	# from happening in the error message
2937	$text =~ s/%(.*?)%/$1/go;
2938	return $text;
2939	}
2940
2941	my $verbatim = {};
2942	$text = takeOutBlocks( $text, 'verbatim', $verbatim );
2943
2944	my $dirtyAreas = {};
2945	$text = takeOutBlocks( $text, 'dirtyarea', $dirtyAreas )
2946	if $Foswiki::cfg{Cache}{Enabled};
2947
2948	my @queue = split( /(%)/, $text );
2949	my @stack;
2950	my $stackTop = ''; # the top stack entry. Done this way instead of
2951	# referring to the top of the stack for efficiency. This var
2952	# should be considered to be $stack[$#stack]
2953
2954	while ( scalar(@queue) ) {
2955
2956	#print STDERR "QUEUE:".join("\n ", map { "'$_'" } @queue)."\n";
2957	my $token = shift(@queue);
2958
2959	#print STDERR ' ' x $tell,"PROCESSING $token \n";
2960
2961	# each % sign either closes an existing stacked context, or
2962	# opens a new context.
2963	if ( $token eq '%' ) {
2964
2965	#print STDERR ' ' x $tell,"CONSIDER $stackTop\n";
2966	# If this is a closing }%, try to rejoin the previous
2967	# tokens until we get to a valid tag construct. This is
2968	# a bit of a hack, but it's hard to think of a better
2969	# way to do this without a full parse that takes % signs
2970	# in tag parameters into account.
2971	if ( $stackTop =~ /}$/s ) {
2972	while ( scalar(@stack)
2973	&& $stackTop !~ /^%$regex{tagNameRegex}\{.*}$/so )
2974	{
2975	my $top = $stackTop;
2976
2977	#print STDERR ' ' x $tell,"COLLAPSE $top \n";
2978	$stackTop = pop(@stack) . $top;
2979	}
2980	}
2981
2982	# /s so you can have newlines in parameters
2983	if ( $stackTop =~ m/^%(($regex{tagNameRegex})(?:{(.*)})?)$/so ) {
2984
2985	# SMELL: unchecked implicit untaint?
2986	my ( $expr, $tag, $args ) = ( $1, $2, $3 );
2987
2988	#print STDERR ' ' x $tell,"POP $tag\n";
2989	#Monitor::MARK("Before $tag");
2990	my $e = &$tagf( $this, $tag, $args, $topicObject );
2991
2992	#Monitor::MARK("After $tag");
2993
2994	if ( defined($e) ) {
2995
2996	#print STDERR ' ' x $tell--,"EXPANDED $tag -> $e\n";
2997	$stackTop = pop(@stack);
2998
2999	# Don't bother recursively expanding unless there are
3000	# unexpanded tags in the result.
3001	unless ( $e =~ /%$regex{tagNameRegex}(?:{.*})?%/so ) {
3002	$stackTop .= $e;
3003	next;
3004	}
3005
3006	# Recursively expand tags in the expansion of $tag
3007	$stackTop .=
3008	$this->_processMacros( $e, $tagf, $topicObject,
3009	$depth - 1 );
3010	}
3011	else {
3012
3013	#print STDERR ' ' x $tell++,"EXPAND $tag FAILED\n";
3014	# To handle %NOP
3015	# correctly, we have to handle the %VAR% case differently
3016	# to the %VAR{}% case when a variable expansion fails.
3017	# This is so that recursively define variables e.g.
3018	# %A%B%D% expand correctly, but at the same time we ensure
3019	# that a mismatched }% can't accidentally close a context
3020	# that was left open when a tag expansion failed.
3021	# However TWiki didn't do this, so for compatibility
3022	# we have to accept that %NOP can never be fixed. if it
3023	# could, then we could uncomment the following:
3024
3025	#if( $stackTop =~ /}$/ ) {
3026	# # %VAR{...}% case
3027	# # We need to push the unexpanded expression back
3028	# # onto the stack, but we don't want it to match the
3029	# # tag expression again. So we protect the %'s
3030	# $stackTop = "%$expr%";
3031	#} else
3032	#{
3033
3034	# %VAR% case.
3035	# In this case we do want to match the tag expression
3036	# again, as an embedded %VAR% may have expanded to
3037	# create a valid outer expression. This is directly
3038	# at odds with the %VAR{...}% case.
3039	push( @stack, $stackTop );
3040	$stackTop = '%'; # open new context
3041	#}
3042	}
3043	}
3044	else {
3045	push( @stack, $stackTop );
3046	$stackTop = '%'; # push a new context
3047	#$tell++;
3048	}
3049	}
3050	else {
3051	$stackTop .= $token;
3052	}
3053	}
3054
3055	# Run out of input. Gather up everything in the stack.
3056	while ( scalar(@stack) ) {
3057	my $expr = $stackTop;
3058	$stackTop = pop(@stack);
3059	$stackTop .= $expr;
3060	}
3061
3062	putBackBlocks( \$stackTop, $dirtyAreas, 'dirtyarea' )
3063	if $Foswiki::cfg{Cache}{Enabled};
3064	putBackBlocks( \$stackTop, $verbatim, 'verbatim' );
3065
3066	#print STDERR "FINAL $stackTop\n";
3067
3068	return $stackTop;
3069	}
3070
3071	# Handle expansion of a tag during topic rendering
3072	# $tag is the tag name
3073	# $args is the bit in the {} (if there are any)
3074	# $topicObject should be passed for dynamic tags (not needed for
3075	# session or constant tags
3076	sub _expandMacroOnTopicRendering {
3077	my ( $this, $tag, $args, $topicObject ) = @_;
3078
3079	require Foswiki::Attrs;
3080	my $attrs;
3081
3082	my $e = $this->{prefs}->getPreference($tag);
3083	if ( defined $e ) {
3084	if ( $args && $args =~ /\S/ ) {
3085	$attrs = new Foswiki::Attrs( $args, 0 );
3086	$attrs->{DEFAULT} = $attrs->{_DEFAULT};
3087	$e = $this->_processMacros(
3088	$e,
3089	sub {
3090	my ( $this, $tag, $args, $topicObject ) = @_;
3091	return
3092	defined $attrs->{$tag}
3093	? expandStandardEscapes( $attrs->{$tag} )
3094	: undef;
3095	},
3096	$topicObject,
3097	1
3098	);
3099	}
3100	}
3101	elsif ( exists( $macros{$tag} ) ) {
3102	unless ( defined( $macros{$tag} ) ) {
3103
3104	# Demand-load the macro module
3105	die $tag unless $tag =~ /([A-Z_:]+)/i;
3106	$tag = $1;
3107	eval "require Foswiki::Macros::$tag";
3108	die $@ if $@;
3109	$macros{$tag} = eval "\\&$tag";
3110	die $@ if $@;
3111	}
3112
3113	$attrs = new Foswiki::Attrs( $args, $contextFreeSyntax{$tag} );
3114	$e = &{ $macros{$tag} }( $this, $attrs, $topicObject );
3115	}
3116	elsif ( $args && $args =~ /\S/ ) {
3117	$attrs = new Foswiki::Attrs($args);
3118	if ( defined $attrs->{default} ) {
3119	$e = expandStandardEscapes( $attrs->{default} );
3120	}
3121	}
3122	return $e;
3123	}
3124
3125	# Handle expansion of a tag during new topic creation. When creating a
3126	# new topic from a template we only expand a subset of the available legal
3127	# tags, and we expand %NOP% differently.
3128	sub _expandMacroOnTopicCreation {
3129	my $this = shift;
3130
3131	# my( $tag, $args, $topicObject ) = @_;
3132
3133	# Required for Cairo compatibility. Ignore %NOP{...}%
3134	# %NOP% is not ignored until all variable expansion is complete,
3135	# otherwise them inside-out rule would remove it too early e.g.
3136	# %GM%NOP%TIME -> %GMTIME -> 12:00. So we ignore it here and scrape it
3137	# out later. We have to remove %NOP{...}% because it can foul up
3138	# brace-matching.
3139	return '' if $_[0] eq 'NOP' && defined $_[1];
3140
3141	# Only expand a subset of legal tags. Warning: $this->{user} may be
3142	# overridden during this call, when a new user topic is being created.
3143	# This is what we want to make sure new user templates are populated
3144	# correctly, but you need to think about this if you extend the set of
3145	# tags expanded here.
3146	return
3147	unless $_[0] =~
3148	/^(URLPARAM\|DATE\|(SERVER\|GM)TIME\|(USER\|WIKI)NAME\|WIKIUSERNAME\|USERINFO)$/;
3149
3150	return $this->_expandMacroOnTopicRendering(@_);
3151	}
3152
3153	=begin TML
3154
3155	---++ ObjectMethod enterContext( $id, $val )
3156
3157	Add the context id $id into the set of active contexts. The $val
3158	can be anything you like, but should always evaluate to boolean
3159	TRUE.
3160
3161	An example of the use of contexts is in the use of tag
3162	expansion. The commonTagsHandler in plugins is called every
3163	time tags need to be expanded, and the context of that expansion
3164	is signalled by the expanding module using a context id. So the
3165	forms module adds the context id "form" before invoking common
3166	tags expansion.
3167
3168	Contexts are not just useful for tag expansion; they are also
3169	relevant when rendering.
3170
3171	Contexts are intended for use mainly by plugins. Core modules can
3172	use $session->inContext( $id ) to determine if a context is active.
3173
3174	=cut
3175
3176	sub enterContext {
3177	my ( $this, $id, $val ) = @_;
3178	$val \|\|= 1;
3179	$this->{context}->{$id} = $val;
3180	}
3181
3182	=begin TML
3183
3184	---++ ObjectMethod leaveContext( $id )
3185
3186	Remove the context id $id from the set of active contexts.
3187	(see =enterContext= for more information on contexts)
3188
3189	=cut
3190
3191	sub leaveContext {
3192	my ( $this, $id ) = @_;
3193	my $res = $this->{context}->{$id};
3194	delete $this->{context}->{$id};
3195	return $res;
3196	}
3197
3198	=begin TML
3199
3200	---++ ObjectMethod inContext( $id )
3201
3202	Return the value for the given context id
3203	(see =enterContext= for more information on contexts)
3204
3205	=cut
3206
3207	sub inContext {
3208	my ( $this, $id ) = @_;
3209	return $this->{context}->{$id};
3210	}
3211
3212	=begin TML
3213
3214	---++ StaticMethod registerTagHandler( $tag, $fnref, $syntax )
3215
3216	STATIC Add a tag handler to the function tag handlers.
3217	* =$tag= name of the tag e.g. MYTAG
3218	* =$fnref= Function to execute. Will be passed ($session, \%params, $web, $topic )
3219	* =$syntax= somewhat legacy - 'classic' or 'context-free' (context-free may be removed in future)
3220
3221
3222	$syntax parameter:
3223	Way back in prehistory, back when the dinosaur still roamed the earth,
3224	Crawford tried to extend the tag syntax of macros such that they could be processed
3225	by a context-free parser (hence the "context-free")
3226	and bring them into line with HTML.
3227	This work was banjaxed by one particular tyrranosaur,
3228	who felt that the existing syntax was perfect.
3229	However by that time Crawford had used it in a couple of places - most notable in the action tracker.
3230
3231	The syntax isn't vastly different from what's there; the differences are:
3232	1 Use either type of quote for parameters
3233	2 Optional quotes on parameter values e.g. recurse=on
3234	3 Standardised use of \ for escapes
3235	4 Boolean (valueless) options (i.e. recurse instead of recurse="on"
3236
3237
3238	=cut
3239
3240	sub registerTagHandler {
3241	my ( $tag, $fnref, $syntax ) = @_;
3242	$macros{$tag} = $fnref;
3243	if ( $syntax && $syntax eq 'context-free' ) {
3244	$contextFreeSyntax{$tag} = 1;
3245	}
3246	}
3247
3248	=begin TML
3249
3250	---++ ObjectMethod expandMacros( $text, $topicObject ) -> $text
3251
3252	Processes %<nop>VARIABLE%, and %<nop>TOC% syntax; also includes
3253	'commonTagsHandler' plugin hook.
3254
3255	Returns the text of the topic, after file inclusion, variable substitution,
3256	table-of-contents generation, and any plugin changes from commonTagsHandler.
3257
3258	$topicObject may be undef when, for example, expanding templates, or one-off strings
3259	at a time when meta isn't available.
3260
3261	DO NOT CALL THIS DIRECTLY; use $topicObject->expandMacros instead.
3262
3263	=cut
3264
3265	sub expandMacros {
3266	my ( $this, $text, $topicObject ) = @_;
3267
3268	return '' unless defined $text;
3269
3270	# Plugin Hook (for cache Plugins only)
3271	$this->{plugins}
3272	->dispatch( 'beforeCommonTagsHandler', $text, $topicObject->topic,
3273	$topicObject->web, $topicObject );
3274
3275	#use a "global var", so included topics can extract and putback
3276	#their verbatim blocks safetly.
3277	my $verbatim = {};
3278	$text = takeOutBlocks( $text, 'verbatim', $verbatim );
3279
3280	# take out dirty areas
3281	my $dirtyAreas = {};
3282	$text = takeOutBlocks( $text, 'dirtyarea', $dirtyAreas )
3283	if $Foswiki::cfg{Cache}{Enabled};
3284
3285	# Require defaults for plugin handlers :-(
3286	my $webContext = $topicObject->web \|\| $this->{webName};
3287	my $topicContext = $topicObject->topic \|\| $this->{topicName};
3288
3289	my $memW = $this->{prefs}->getPreference('INCLUDINGWEB');
3290	my $memT = $this->{prefs}->getPreference('INCLUDINGTOPIC');
3291	$this->{prefs}->setInternalPreferences(
3292	INCLUDINGWEB => $webContext,
3293	INCLUDINGTOPIC => $topicContext
3294	);
3295
3296	$this->innerExpandMacros( \$text, $topicObject );
3297
3298	$text = takeOutBlocks( $text, 'verbatim', $verbatim );
3299
3300	# Plugin Hook
3301	$this->{plugins}
3302	->dispatch( 'commonTagsHandler', $text, $topicContext, $webContext, 0,
3303	$topicObject );
3304
3305	# process tags again because plugin hook may have added more in
3306	$this->innerExpandMacros( \$text, $topicObject );
3307
3308	$this->{prefs}->setInternalPreferences(
3309	INCLUDINGWEB => $memW,
3310	INCLUDINGTOPIC => $memT
3311	);
3312
3313	# 'Special plugin tag' TOC hack, must be done after all other expansions
3314	# are complete, and has to reprocess the entire topic.
3315
3316	if ( $text =~ /%TOC(?:{.*})?%/ ) {
3317	require Foswiki::Macros::TOC;
3318	$text =~ s/%TOC(?:{(.*?)})?%/$this->TOC($text, $topicObject, $1)/ge;
3319	}
3320
3321	# Codev.FormattedSearchWithConditionalOutput: remove <nop> lines,
3322	# possibly introduced by SEARCHes with conditional CALC. This needs
3323	# to be done after CALC and before table rendering in order to join
3324	# table rows properly
3325	$text =~ s/^<nop>\r?\n//gm;
3326
3327	# restore dirty areas
3328	putBackBlocks( \$text, $dirtyAreas, 'dirtyarea' )
3329	if $Foswiki::cfg{Cache}{Enabled};
3330
3331	putBackBlocks( \$text, $verbatim, 'verbatim' );
3332
3333	# Foswiki Plugin Hook (for cache Plugins only)
3334	$this->{plugins}
3335	->dispatch( 'afterCommonTagsHandler', $text, $topicContext, $webContext,
3336	$topicObject );
3337
3338	return $text;
3339	}
3340
3341	=begin TML
3342
3343	---++ ObjectMethod addToZone($zone, $id, $data, $requires)
3344
3345	Add =$data= identified as =$id= to =$zone=, which will later be expanded (with
3346	renderZone() - implements =%<nop>RENDERZONE%=). =$ids= are unique within
3347	the zone that they are added - dependencies between =$ids= in different zones
3348	will not be resolved, except for the special case of =head= and =script= zones
3349	when ={MergeHeadAndScriptZones}= is enabled.
3350
3351	In this case, they are treated as separate zones when adding to them, but as
3352	one merged zone when rendering, i.e. a call to render either =head= or =script=
3353	zones will actually render both zones in this one call. Both zones are undef'd
3354	afterward to avoid double rendering of content from either zone, to support
3355	proper behaviour when =head= and =script= are rendered with separate calls even
3356	when ={MergeHeadAndScriptZones}= is set. See ZoneTests/explicit_RENDERZONE*.
3357
3358	This behaviour allows an addToZone('head') call to require an id that has been
3359	added to =script= only.
3360
3361	* =$zone= - name of the zone
3362	* =$id= - unique identifier
3363	* =$data= - content
3364	* =$requires= - optional, comma-separated string of =$id= identifiers
3365	that should precede the content
3366
3367	<blockquote class="foswikiHelp">%X%
3368	Note: Read the developer supplement at Foswiki:Development.AddToZoneFromPluginHandlers if you
3369	are calling =addToZone()= from a rendering or macro/tag-related plugin handler
3370	</blockquote>
3371
3372	Implements =%<nop>ADDTOZONE%=.
3373
3374	=cut
3375
3376	sub addToZone {
3377	my ( $this, $zone, $id, $data, $requires ) = @_;
3378
3379	$requires \|\|= '';
3380
3381	# get a random one
3382	unless ($id) {
3383	$id = int( rand(10000) ) + 1;
3384	}
3385
3386	# get zone, or create record
3387	my $thisZone = $this->{_zones}{$zone};
3388	unless ( defined $thisZone ) {
3389	$this->{_zones}{$zone} = $thisZone = {};
3390	}
3391
3392	my @requires;
3393	foreach my $req ( split( /\s,\s/, $requires ) ) {
3394	unless ( $thisZone->{$req} ) {
3395	$thisZone->{$req} = {
3396	id => $req,
3397	zone => $zone,
3398	requires => [],
3399	missingrequires => [],
3400	text => '',
3401	populated => 0
3402	};
3403	}
3404	push( @requires, $thisZone->{$req} );
3405	}
3406
3407	# store record within zone
3408	my $zoneID = $thisZone->{$id};
3409	unless ($zoneID) {
3410	$zoneID = { id => $id };
3411	$thisZone->{$id} = $zoneID;
3412	}
3413
3414	# override previous properties
3415	$zoneID->{zone} = $zone;
3416	$zoneID->{requires} = \@requires;
3417	$zoneID->{missingrequires} = [];
3418	$zoneID->{text} = $data;
3419	$zoneID->{populated} = 1;
3420
3421	return;
3422	}
3423
3424	sub _renderZoneById {
3425	my $this = shift;
3426	my $id = shift;
3427
3428	return '' unless defined $id;
3429
3430	my $renderZone = $this->{_renderZonePlaceholder}{$id};
3431
3432	return '' unless defined $renderZone;
3433
3434	my $params = $renderZone->{params};
3435	my $topicObject = $renderZone->{topicObject};
3436	my $zone = $params->{_DEFAULT} \|\| $params->{zone};
3437
3438	return _renderZone( $this, $zone, $params, $topicObject );
3439	}
3440
3441	# This private function is used in ZoneTests
3442	sub _renderZone {
3443	my ( $this, $zone, $params, $topicObject ) = @_;
3444
3445	# Check the zone is defined and has not already been rendered
3446	return '' unless $zone && $this->{_zones}{$zone};
3447
3448	$params->{header} \|\|= '';
3449	$params->{footer} \|\|= '';
3450	$params->{chomp} \|\|= 'off';
3451	$params->{missingformat} = '$id: requires= missing ids: $missingids';
3452	$params->{format} = '$item<!--<literal>$missing</literal>-->'
3453	unless defined $params->{format};
3454	$params->{separator} = '$n()' unless defined $params->{separator};
3455
3456	unless ( defined $topicObject ) {
3457	$topicObject =
3458	Foswiki::Meta->new( $this, $this->{webName}, $this->{topicName} );
3459	}
3460
3461	# Loop through the vertices of the graph, in any order, initiating
3462	# a depth-first search for any vertex that has not already been
3463	# visited by a previous search. The desired topological sorting is
3464	# the reverse postorder of these searches. That is, we can construct
3465	# the ordering as a list of vertices, by adding each vertex to the
3466	# start of the list at the time when the depth-first search is
3467	# processing that vertex and has returned from processing all children
3468	# of that vertex. Since each edge and vertex is visited once, the
3469	# algorithm runs in linear time.
3470	my %visited;
3471	my @total;
3472
3473	# When {MergeHeadAndScriptZones} is set, try to treat head and script
3474	# zones as merged for compatibility with ADDTOHEAD usage where requirements
3475	# have been moved to the script zone. See ZoneTests/Item9317
3476	if ( $Foswiki::cfg{MergeHeadAndScriptZones}
3477	and ( ( $zone eq 'head' ) or ( $zone eq 'script' ) ) )
3478	{
3479	my @zoneIDs = (
3480	values %{ $this->{_zones}{head} },
3481	values %{ $this->{_zones}{script} }
3482	);
3483
3484	foreach my $zoneID (@zoneIDs) {
3485	$this->_visitZoneID( $zoneID, \%visited, \@total );
3486	}
3487	undef $this->{_zones}{head};
3488	undef $this->{_zones}{script};
3489	}
3490	else {
3491	my @zoneIDs = values %{ $this->{_zones}{$zone} };
3492
3493	foreach my $zoneID (@zoneIDs) {
3494	$this->_visitZoneID( $zoneID, \%visited, \@total );
3495	}
3496
3497	# kill a zone once it has been rendered, to prevent it being
3498	# added twice (e.g. by duplicate %RENDERZONEs or by automatic
3499	# zone expansion in the head or script)
3500	undef $this->{_zones}{$zone};
3501	}
3502
3503	# nothing rendered for a zone with no ADDTOZONE calls
3504	return '' unless scalar(@total) > 0;
3505
3506	my @result = ();
3507	my $missingformat = $params->{missingformat};
3508	foreach my $item (@total) {
3509	my $text = $item->{text};
3510	my @missingids = @{ $item->{missingrequires} };
3511	my $missingformat =
3512	( scalar(@missingids) ) ? $params->{missingformat} : '';
3513
3514	if ( $params->{'chomp'} ) {
3515	$text =~ s/^\s+//g;
3516	$text =~ s/\s+$//g;
3517	}
3518
3519	# ASSERT($text, "No content for zone id $item->{id} in zone $zone")
3520	# if DEBUG;
3521
3522	next unless $text;
3523	my $id = $item->{id} \|\| '';
3524	my $line = $params->{format};
3525	if ( scalar(@missingids) ) {
3526	$line =~ s/\$missing\b/$missingformat/g;
3527	$line =~ s/\$missingids\b/join(', ', @missingids)/ge;
3528	}
3529	else {
3530	$line =~ s/\$missing\b/\$id/g;
3531	}
3532	$line =~ s/\$item\b/$text/g;
3533	$line =~ s/\$id\b/$id/g;
3534	$line =~ s/\$zone\b/$item->{zone}/g;
3535	push @result, $line if $line;
3536	}
3537	my $result =
3538	expandStandardEscapes( $params->{header}
3539	. join( $params->{separator}, @result )
3540	. $params->{footer} );
3541
3542	# delay rendering the zone until now
3543	$result = $topicObject->expandMacros($result);
3544	$result = $topicObject->renderTML($result);
3545
3546	return $result;
3547	}
3548
3549	sub _visitZoneID {
3550	my ( $this, $zoneID, $visited, $list ) = @_;
3551
3552	return if $visited->{$zoneID};
3553
3554	$visited->{$zoneID} = 1;
3555
3556	foreach my $requiredZoneID ( @{ $zoneID->{requires} } ) {
3557	my $zoneIDToVisit;
3558
3559	if ( $Foswiki::cfg{MergeHeadAndScriptZones}
3560	and not $requiredZoneID->{populated} )
3561	{
3562
3563	# Compatibility mode, where we are trying to treat head and script
3564	# zones as merged, and a required ZoneID isn't populated. Try
3565	# opposite zone to see if it exists there instead. Item9317
3566	if ( $requiredZoneID->{zone} eq 'head' ) {
3567	$zoneIDToVisit =
3568	$this->{_zones}{script}{ $requiredZoneID->{id} };
3569	}
3570	else {
3571	$zoneIDToVisit = $this->{_zones}{head}{ $requiredZoneID->{id} };
3572	}
3573	if ( not $zoneIDToVisit->{populated} ) {
3574
3575	# Oops, the required ZoneID doesn't exist there either; reset
3576	$zoneIDToVisit = $requiredZoneID;
3577	}
3578	}
3579	else {
3580	$zoneIDToVisit = $requiredZoneID;
3581	}
3582	$this->_visitZoneID( $zoneIDToVisit, $visited, $list );
3583
3584	if ( not $zoneIDToVisit->{populated} ) {
3585
3586	# Finally, we got to here and the required ZoneID just cannot be
3587	# found in either head or script (or other) zones, so record it for
3588	# diagnostic purposes ($missingids format token)
3589	push( @{ $zoneID->{missingrequires} }, $zoneIDToVisit->{id} );
3590	}
3591	}
3592	push( @{$list}, $zoneID );
3593
3594	return;
3595	}
3596
3597	# This private function is used in ZoneTests
3598	sub _renderZones {
3599	my ( $this, $text ) = @_;
3600
3601	# Render zones that were pulled out by Foswiki/Macros/RENDERZONE.pm
3602	# NOTE: once a zone has been rendered it is cleared, so cannot
3603	# be rendered again.
3604
3605	$text =~ s/${RENDERZONE_MARKER}RENDERZONE{(.*?)}${RENDERZONE_MARKER}/
3606	_renderZoneById($this, $1)/geo;
3607
3608	# get the head zone and insert it at the end of the </head>
3609	# if it has not already been rendered
3610	my $headZone = _renderZone( $this, 'head', { chomp => "on" } );
3611	$text =~ s!(</head>)!$headZone\n$1!i if $headZone;
3612
3613	# SMELL: Item9480 - can't trust that _renderzone(head) above has truly
3614	# flushed both script and head zones empty when {MergeHeadAndScriptZones} = 1.
3615	my $scriptZone = _renderZone( $this, 'script', { chomp => "on" } );
3616	$text =~ s!(</head>)!$scriptZone\n$1!i if $scriptZone;
3617
3618	chomp($text);
3619
3620	return $text;
3621	}
3622
3623	=begin TML
3624
3625	---++ StaticMethod readFile( $filename ) -> $text
3626
3627	Returns the entire contents of the given file, which can be specified in any
3628	format acceptable to the Perl open() function. Fast, but inherently unsafe.
3629
3630	WARNING: Never, ever use this for accessing topics or attachments! Use the
3631	Store API for that. This is for global control files only, and should be
3632	used only if there is absolutely no alternative.
3633
3634	=cut
3635
3636	sub readFile {
3637	my $name = shift;
3638	my $IN_FILE;
3639	open( $IN_FILE, "<$name" ) \|\| return '';
3640	local $/ = undef;
3641	my $data = <$IN_FILE>;
3642	close($IN_FILE);
3643	$data = '' unless ( defined($data) );
3644	return $data;
3645	}
3646
3647	=begin TML
3648
3649	---++ StaticMethod expandStandardEscapes($str) -> $unescapedStr
3650
3651	Expands standard escapes used in parameter values to block evaluation. See
3652	System.FormatTokens for a full list of supported tokens.
3653
3654	=cut
3655
3656	sub expandStandardEscapes {
3657	my $text = shift;
3658
3659	# expand '$n()' and $n! to new line
3660	$text =~ s/\$n/\n/gs;
3661	$text =~ s/\$n(?=[^$regex{mixedAlpha}]\|$)/\n/gos;
3662
3663	# filler, useful for nested search
3664	$text =~ s/\$nop()?//gs;
3665
3666	# $quot -> "
3667	$text =~ s/\$quot()?/\"/gs;
3668
3669	# $comma -> ,
3670	$text =~ s/\$comma()?/,/gs;
3671
3672	# $percent -> %
3673	$text =~ s/\$perce?nt()?/\%/gs;
3674
3675	# $lt -> <
3676	$text =~ s/\$lt()?/\</gs;
3677
3678	# $gt -> >
3679	$text =~ s/\$gt()?/\>/gs;
3680
3681	# $amp -> &
3682	$text =~ s/\$amp()?/\&/gs;
3683
3684	# $dollar -> $, done last to avoid creating the above tokens
3685	$text =~ s/\$dollar()?/\$/gs;
3686
3687	return $text;
3688	}
3689
3690	=begin TML
3691
3692	---++ ObjectMethod webExists( $web ) -> $boolean
3693
3694	Test if web exists
3695	* =$web= - Web name, required, e.g. ='Sandbox'=
3696
3697	A web _has_ to have a preferences topic to be a web.
3698
3699	=cut
3700
3701	sub webExists {
3702	my ( $this, $web ) = @_;
3703
3704	ASSERT( UNTAINTED($web), 'web is tainted' ) if DEBUG;
3705	return $this->{store}->webExists($web);
3706	}
3707
3708	=begin TML
3709
3710	---++ ObjectMethod topicExists( $web, $topic ) -> $boolean
3711
3712	Test if topic exists
3713	* =$web= - Web name, optional, e.g. ='Main'=
3714	* =$topic= - Topic name, required, e.g. ='TokyoOffice'=, or ="Main.TokyoOffice"=
3715
3716	=cut
3717
3718	sub topicExists {
3719	my ( $this, $web, $topic ) = @_;
3720	ASSERT( UNTAINTED($web), 'web is tainted' ) if DEBUG;
3721	ASSERT( UNTAINTED($topic), 'topic is tainted' ) if DEBUG;
3722	return $this->{store}->topicExists( $web, $topic );
3723	}
3724
3725	=begin TML
3726
3727	---+++ ObjectMethod getWorkArea( $key ) -> $directorypath
3728
3729	Gets a private directory uniquely identified by $key. The directory is
3730	intended as a work area for plugins etc. The directory will exist.
3731
3732	=cut
3733
3734	sub getWorkArea {
3735	my ( $this, $key ) = @_;
3736	return $this->{store}->getWorkArea($key);
3737	}
3738
3739	=begin TML
3740
3741	---++ ObjectMethod getApproxRevTime ( $web, $topic ) -> $epochSecs
3742
3743	Get an approximate rev time for the latest rev of the topic. This method
3744	is used to optimise searching. Needs to be as fast as possible.
3745
3746	SMELL: is there a reason this is in Foswiki.pm, and not in Search?
3747
3748	=cut
3749
3750	sub getApproxRevTime {
3751	my ( $this, $web, $topic ) = @_;
3752
3753	my $metacache = $this->search->metacache;
3754	if ( $metacache->hasCached( $web, $topic ) ) {
3755
3756	#don't kill me - this should become a property on Meta
3757	return $metacache->get( $web, $topic )->{modified};
3758	}
3759
3760	return $this->{store}->getApproxRevTime( $web, $topic );
3761	}
3762
3763	1;
3764	__END__
3765	Foswiki - The Free and Open Source Wiki, http://foswiki.org/
3766
3767	Copyright (C) 2008-2010 Foswiki Contributors. Foswiki Contributors
3768	are listed in the AUTHORS file in the root of this distribution.
3769	NOTE: Please extend that file, not this notice.
3770
3771	Additional copyrights apply to some or all of the code in this
3772	file as follows:
3773
3774	Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
3775	and TWiki Contributors. All Rights Reserved. TWiki Contributors
3776	are listed in the AUTHORS file in the root of this distribution.
3777	Based on parts of Ward Cunninghams original Wiki and JosWiki.
3778	Copyright (C) 1998 Markus Peter - SPiN GmbH (warpi@spin.de)
3779	Some changes by Dave Harris (drh@bhresearch.co.uk) incorporated
3780
3781	This program is free software; you can redistribute it and/or
3782	modify it under the terms of the GNU General Public License
3783	as published by the Free Software Foundation; either version 2
3784	of the License, or (at your option) any later version. For
3785	more details read LICENSE in the root of this distribution.
3786
3787	This program is distributed in the hope that it will be useful,
3788	but WITHOUT ANY WARRANTY; without even the implied warranty of
3789	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
3790
3791	As per the GPL, removal of this notice is prohibited.

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/core/lib/Foswiki.pm @ 14686

Download in other formats: