Context Navigation

source: tags/FoswikiRelease01x01x06/core/lib/Foswiki.pm @ 16746

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

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

Download in other formats: