1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Search engine of TWiki.
4 #
5 # Copyright (C) 2000-2004 Peter Thoeny, peter@thoeny.com
6 #
7 # For licensing info read license.txt file in the TWiki root.
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License
10 # as published by the Free Software Foundation; either version 2
11 # of the License, or (at your option) any later version.
12 #
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details, published at
17 # http://www.gnu.org/copyleft/gpl.html
18 #
19 # Notes:
20 # - Latest version at http://twiki.org/
21 # - Installation instructions in $dataDir/Main/TWikiDocumentation.txt
22 rizwank 1.1 # - Customize variables in TWiki.cfg when installing TWiki.
23 #
24 # 20000501 Kevin Kinnell : Many many many changes, best view is to
25 # run a diff.
26 # 20000605 Kevin Kinnell : Bug hunting. Fixed to allow web colors
27 # spec'd as "word" instead of hex only.
28 # Found a lovely bug that screwed up the
29 # search limits because Perl (as we all know
30 # but may forget) doesn't clear the $n match
31 # params if a match fails... *^&$#!!!
32 # PTh 03 Nov 2000: Performance improvements
33
34 =begin twiki
35
36 ---+ TWiki::Search Module
37
38 This module implements all the search functionality.
39
40 =cut
41
42 package TWiki::Search;
43 rizwank 1.1 use strict;
44
45 use vars qw(
46 $cacheRev1webTopic $cacheRev1date $cacheRev1user
47 );
48
49
50 # 'Use locale' for internationalisation of Perl sorting and searching -
51 # main locale settings are done in TWiki::setupLocale
52 BEGIN {
53 # Do a dynamic 'use locale' for this module
54 if( $TWiki::useLocale ) {
55 require locale;
56 import locale ();
57 }
58 $cacheRev1webTopic = "";
59 }
60
61 # ===========================
62 # Normally writes no output, uncomment writeDebug line to get output of all RCS etc command to debug file
63 =pod
64 rizwank 1.1
65 ---++ sub _traceExec ( $cmd, $result )
66
67 Not yet documented.
68
69 =cut
70
71 sub _traceExec
72 {
73 my( $cmd, $result ) = @_;
74
75 #TWiki::writeDebug( "Search exec: $cmd -> $result" );
76 }
77
78 # ===========================
79 =pod
80
81 ---++ sub _translateSpace ( $theText )
82
83 Not yet documented.
84
85 rizwank 1.1 =cut
86
87 sub _translateSpace
88 {
89 my( $theText ) = @_;
90 $theText =~ s/\s+/$TWiki::TranslationToken/go;
91 return $theText;
92 }
93
94 # ===========================
95 =pod
96
97 ---++ sub _tokensFromSearchString ( $theSearchVal, $theType )
98
99 Not yet documented.
100
101 =cut
102
103 sub _tokensFromSearchString
104 {
105 my( $theSearchVal, $theType ) = @_;
106 rizwank 1.1
107 my @tokens = ();
108 if( $theType eq "regex" ) {
109 # regular expression search Example: soap;wsdl;web service;!shampoo
110 @tokens = split( /;/, $theSearchVal );
111
112 } elsif( $theType eq "literal" ) {
113 # literal search
114 $tokens[0] = $theSearchVal;
115
116 } else {
117 # keyword search. Example: soap +wsdl +"web service" -shampoo
118 $theSearchVal =~ s/(\".*?)\"/&_translateSpace($1)/geo; # hide spaces in "literal text"
119 $theSearchVal =~ s/[\+\-]\s+//go;
120
121 # build pattern of stop words
122 my $stopWords = &TWiki::Prefs::getPreferencesValue( "SEARCHSTOPWORDS" ) || "";
123 $stopWords =~ s/[\s\,]+/\|/go;
124 $stopWords =~ s/[\(\)]//go;
125
126 # read from bottom to up:
127 rizwank 1.1 @tokens =
128 map { s/^\+//o; s/^\-/\!/o; s/^\"//o; $_ } # remove +, change - to !, remove "
129 grep { ! /^($stopWords)$/i } # remove stopwords
130 map { s/$TWiki::TranslationToken/ /go; $_ } # restore space
131 split( /[\s]+/, $theSearchVal ); # split on spaces
132 }
133
134 return @tokens;
135 }
136
137 # =========================
138 =pod
139
140 ---++ sub _searchTopicsInWeb ( $theWeb, $theTopic, $theScope, $theType, $caseSensitive, @theTokens )
141
142 Not yet documented.
143
144 =cut
145
146 sub _searchTopicsInWeb
147 {
148 rizwank 1.1 my( $theWeb, $theTopic, $theScope, $theType, $caseSensitive, @theTokens ) = @_;
149
150 my @topicList = ();
151 return @topicList unless( @theTokens ); # bail out if no search string
152
153 if( $theTopic ) { # limit search to topic list
154 if( $theTopic =~ /^\^\([$TWiki::regex{mixedAlphaNum}\|]+\)\$$/ ) { # topic list without wildcards
155 my $topics = $theTopic; # for speed, do not get all topics in web
156 $topics =~ s/^\^\(//o; # but convert topic pattern into topic list
157 $topics =~ s/\)\$//o; #
158 @topicList = split( /\|/, $topics ); # build list from topic pattern
159 } else { # topic list with wildcards
160 @topicList = _getTopicList( $theWeb ); # get all topics in web
161 if( $caseSensitive ) {
162 @topicList = grep( /$theTopic/, @topicList ); # limit by topic name,
163 } else { # Codev.SearchTopicNameAndTopicText
164 @topicList = grep( /$theTopic/i, @topicList );
165 }
166 }
167 } else {
168 @topicList = _getTopicList( $theWeb ); # get all topics in web
169 rizwank 1.1 }
170
171 my $sDir = "$TWiki::dataDir/$theWeb";
172 $theScope = "text" unless( $theScope =~ /^(topic|all)$/ ); # default scope is "text"
173
174 foreach my $token ( @theTokens ) { # search each token
175 my $invertSearch = ( $token =~ s/^\!//o ); # flag for AND NOT search
176 my @scopeTextList = ();
177 my @scopeTopicList = ();
178 return @topicList unless( @topicList ); # bail out if no topics left
179
180 # scope can be "topic" (default), "text" or "all"
181 # scope="text", e.g. Perl search on topic name:
182 unless( $theScope eq "text" ) {
183 my $qtoken = $token;
184 $qtoken = quotemeta( $qtoken ) if( $theType ne "regex" ); # FIXME I18N
185 if( $caseSensitive ) { # fix for Codev.SearchWithNoPipe
186 @scopeTopicList = grep( /$qtoken/, @topicList );
187 } else {
188 @scopeTopicList = grep( /$qtoken/i, @topicList );
189 }
190 rizwank 1.1 }
191
192 # scope="text", e.g. grep search on topic text:
193 unless( $theScope eq "topic" ) {
194 # Construct command line with 'grep'. I18N: 'grep' must use locales if needed,
195 # for case-insensitive searching. See TWiki::setupLocale.
196 my $cmd = "";
197 if( $theType eq "regex" ) {
198 $cmd .= $TWiki::egrepCmd;
199 } else {
200 $cmd .= $TWiki::fgrepCmd;
201 }
202 $cmd .= " -i" unless( $caseSensitive );
203 $cmd .= " -l -- $TWiki::cmdQuote%TOKEN%$TWiki::cmdQuote %FILES%";
204
205 my $result = "";
206 if( $sDir ) {
207 chdir( "$sDir" );
208 _traceExec( "chdir to $sDir", "" );
209 $sDir = ""; # chdir only once
210 }
211 rizwank 1.1
212 # process topics in sets, fix for Codev.ArgumentListIsTooLongForSearch
213 my $maxTopicsInSet = 512; # max number of topics for a grep call
214 my @take = @topicList;
215 my @set = splice( @take, 0, $maxTopicsInSet );
216 while( @set ) {
217 @set = map { "$_.txt" } @set; # add ".txt" extension to topic names
218 my $acmd = $cmd;
219 $acmd =~ s/%TOKEN%/$token/o;
220 $acmd =~ s/%FILES%/@set/o;
221 $acmd =~ /(.*)/;
222 $acmd = "$1"; # untaint variable (FIXME: Needs a better check!)
223 $result = `$acmd`;
224 _traceExec( $acmd, $result );
225 @set = split( /\n/, $result );
226 @set = map { /(.*)\.txt$/; $_ = $1; } @set; # cut ".txt" extension
227 my %seen = ();
228 foreach my $topic ( @set ) {
229 $seen{$topic}++; # make topics unique
230 }
231 push( @scopeTextList, sort keys %seen ); # add hits to found list
232 rizwank 1.1 @set = splice( @take, 0, $maxTopicsInSet );
233 }
234 }
235
236 if( @scopeTextList && @scopeTopicList ) {
237 push( @scopeTextList, @scopeTopicList ); # join "topic" and "text" lists
238 my %seen = ();
239 @scopeTextList = sort grep { ! $seen{$_} ++ } @scopeTextList; # make topics unique
240 } elsif( @scopeTopicList ) {
241 @scopeTextList = @scopeTopicList;
242 }
243
244 if( $invertSearch ) { # do AND NOT search
245 my %seen = ();
246 foreach my $topic ( @scopeTextList ) {
247 $seen{$topic} = 1;
248 }
249 @scopeTextList = ();
250 foreach my $topic ( @topicList ) {
251 push( @scopeTextList, $topic ) unless( $seen{$topic} );
252 }
253 rizwank 1.1 }
254 @topicList = @scopeTextList; # reduced topic list for next token
255 }
256 return @topicList;
257 }
258
259 # =========================
260 =pod
261
262 ---++ sub _getTopicList ( $web )
263
264 Not yet documented.
265
266 =cut
267
268 sub _getTopicList
269 {
270 my( $web ) = @_ ;
271 opendir DIR, "$TWiki::dataDir/$web" ;
272 my @topicList = sort map { s/\.txt$//o; $_ } grep { /\.txt$/ } readdir( DIR );
273 closedir( DIR );
274 rizwank 1.1 return @topicList;
275 }
276
277 # =========================
278 =pod
279
280 ---++ sub _makeTopicPattern ( $theTopic )
281
282 Not yet documented.
283
284 =cut
285
286 sub _makeTopicPattern
287 {
288 my( $theTopic ) = @_ ;
289 return "" unless( $theTopic );
290 # "Web*, FooBar" ==> ( "Web*", "FooBar" ) ==> ( "Web.*", "FooBar" )
291 my @arr = map { s/[^\*\_$TWiki::regex{mixedAlphaNum}]//go; s/\*/\.\*/go; $_ }
292 split( /,\s*/, $theTopic );
293 return "" unless( @arr );
294 # ( "Web.*", "FooBar" ) ==> "^(Web.*|FooBar)$"
295 rizwank 1.1 return '^(' . join( "|", @arr ) . ')$';
296 }
297
298 # =========================
299 =pod
300
301 ---++ sub revDate2ISO ()
302
303 Not yet documented.
304
305 =cut
306
307 sub revDate2ISO
308 {
309 my $epochSec = &TWiki::revDate2EpSecs( $_[0] );
310 return &TWiki::formatTime( $epochSec, "\$iso", "gmtime");
311 }
312
313 # =========================
314 =pod
315
316 rizwank 1.1 ---++ sub searchWeb ()
317
318 Not yet documented.
319
320 =cut
321
322 sub searchWeb
323 {
324 my %params = @_;
325 my $doInline = $params{"inline"} || 0;
326 my $baseWeb = $params{"baseweb"} || $TWiki::webName;
327 my $baseTopic = $params{"basetopic"} || $TWiki::topicName;
328 my $emptySearch = "something.Very/unLikelyTo+search-for;-)";
329 my $theSearchVal = $params{"search"} || $emptySearch;
330 my $theWebName = $params{"web"} || "";
331 my $theTopic = $params{"topic"} || "";
332 my $theExclude = $params{"excludetopic"} || "";
333 my $theScope = $params{"scope"} || "";
334 my $theOrder = $params{"order"} || "";
335 my $theType = $params{"type"} || "";
336 my $theRegex = $params{"regex"} || "";
337 rizwank 1.1 my $theLimit = $params{"limit"} || "";
338 my $revSort = $params{"reverse"} || "";
339 my $caseSensitive = $params{"casesensitive"} || "";
340 my $noSummary = $params{"nosummary"} || "";
341 my $noSearch = $params{"nosearch"} || "";
342 my $noHeader = $params{"noheader"} || "";
343 my $noTotal = $params{"nototal"} || "";
344 my $doBookView = $params{"bookview"} || "";
345 my $doRenameView = $params{"renameview"} || "";
346 my $doShowLock = $params{"showlock"} || "";
347 my $doExpandVars = $params{"expandvariables"} || "";
348 my $noEmpty = $params{"noempty"} || "";
349 my $theTemplate = $params{"template"} || "";
350 my $theHeader = $params{"header"} || "";
351 my $theFormat = $params{"format"} || "";
352 my $doMultiple = $params{"multiple"} || "";
353 my $theSeparator = $params{"separator"} || "";
354 my $newLine = $params{"newline"} || "";
355
356 ##TWiki::writeDebug "Search locale is $TWiki::siteLocale";
357
358 rizwank 1.1 ## 0501 kk : vvv new option to limit results
359 # process the result limit here, this is the 'global' limit for
360 # all webs in a multi-web search
361
362 ## #############
363 ## 0605 kk : vvv This code broke due to changes in the wiki.pm
364 ## file; it used to rely on the value of $1 being
365 ## a null string if there was no match. What a pity
366 ## Perl doesn't do The Right Thing, but whatever--it's
367 ## fixed now.
368 if ($theLimit =~ /(^\d+$)/o) { # only digits, all else is the same as
369 $theLimit = $1; # an empty string. "+10" won't work.
370 } else {
371 $theLimit = 0; # change "all" to 0, then to big number
372 }
373 if (! $theLimit ) { # PTh 03 Nov 2000:
374 $theLimit = 32000; # Big number, needed for performance improvements
375 }
376
377 $theType = "regex" if( $theRegex );
378
379 rizwank 1.1 # I18N fix
380 my $mixedAlpha = $TWiki::regex{mixedAlpha};
381
382 if( $theSeparator ) {
383 $theSeparator =~ s/\$n\(\)/\n/gos; # expand "$n()" to new line
384 $theSeparator =~ s/\$n([^$mixedAlpha]|$)/\n$1/gos;
385 }
386 if( $newLine ) {
387 $newLine =~ s/\$n\(\)/\n/gos; # expand "$n()" to new line
388 $newLine =~ s/\$n([^$mixedAlpha]|$)/\n$1/gos;
389 }
390
391 my $searchResult = "";
392 my $topic = $TWiki::mainTopicname;
393
394 my @webList = ();
395
396 # A value of 'all' or 'on' by itself gets all webs,
397 # otherwise ignored (unless there is a web called "All".)
398 my $searchAllFlag = ( $theWebName =~ /(^|[\,\s])(all|on)([\,\s]|$)/i );
399
400 rizwank 1.1 # Search what webs? "" current web, list gets the list, all gets
401 # all (unless marked in WebPrefs as NOSEARCHALL)
402
403 if( $theWebName ) {
404 foreach my $web ( split( /[\,\s]+/, $theWebName ) ) {
405 # the web processing loop filters for valid web names, so don't do it here.
406
407 if( $web =~ /^(all|on)$/i ) {
408 # get list of all webs by scanning $dataDir
409 opendir DIR, $TWiki::dataDir;
410 my @tmpList = readdir(DIR);
411 closedir(DIR);
412 @tmpList = sort
413 grep { s#^.+/([^/]+)$#$1# }
414 grep { -d }
415 map { "$TWiki::dataDir/$_" }
416 grep { ! /^[._]/ } @tmpList;
417
418 # what that does (looking from the bottom up) is take the file
419 # list, filter out the dot directories and dot files, turn the
420 # list into full paths instead of just file names, filter out
421 rizwank 1.1 # any non-directories, strip the path back off, and sort
422 # whatever was left after all that (which should be merely a
423 # list of directory's names.)
424
425 foreach my $aweb ( @tmpList ) {
426 push( @webList, $aweb ) unless( grep { /^$aweb$/ } @webList );
427 }
428
429 } else {
430 push( @webList, $web ) unless( grep { /^$web$/ } @webList );
431 }
432 }
433
434 } else {
435 #default to current web
436 push @webList, $TWiki::webName;
437 }
438
439 $theTopic = _makeTopicPattern( $theTopic ); # E.g. "Bug*, *Patch" ==> "^(Bug.*|.*Patch)$"
440 $theExclude = _makeTopicPattern( $theExclude ); # E.g. "Web*, FooBar" ==> "^(Web.*|FooBar)$"
441
442 rizwank 1.1 my $tempVal = "";
443 my $tmpl = "";
444 my $topicCount = 0; # JohnTalintyre
445 my $originalSearch = $theSearchVal;
446 my $renameTopic;
447 my $renameWeb = "";
448 my $spacedTopic;
449 $theTemplate = "searchformat" if( $theFormat );
450
451 if( $theTemplate ) {
452 $tmpl = &TWiki::Store::readTemplate( "$theTemplate" );
453 # FIXME replace following with this @@@
454 } elsif( $doBookView ) {
455 $tmpl = &TWiki::Store::readTemplate( "searchbookview" );
456 } elsif ($doRenameView ) {
457 # Rename view, showing where topics refer to topic being renamed.
458 $tmpl = &TWiki::Store::readTemplate( "searchrenameview" ); # JohnTalintyre
459
460 # Create full search string from topic name that is passed in
461 $renameTopic = $theSearchVal;
462 if( $renameTopic =~ /(.*)\\\.(.*)/o ) {
463 rizwank 1.1 $renameWeb = $1;
464 $renameTopic = $2;
465 }
466 $spacedTopic = spacedTopic( $renameTopic );
467 $spacedTopic = $renameWeb . '\.' . $spacedTopic if( $renameWeb );
468
469 # I18N: match non-alpha before and after topic name in renameview searches
470 # This regex must work under grep, i.e. if using Perl 5.6 or higher
471 # the POSIX character classes will be used in grep as well.
472 my $alphaNum = $TWiki::regex{mixedAlphaNum};
473 $theSearchVal = "(^|[^${alphaNum}_])$theSearchVal" .
474 "([^${alphaNum}_]" . '|$)|' .
475 '(\[\[' . $spacedTopic . '\]\])';
476 } else {
477 $tmpl = &TWiki::Store::readTemplate( "search" );
478 }
479
480 $tmpl =~ s/\%META{.*?}\%//go; # remove %META{"parent"}%
481
482 my( $tmplHead, $tmplSearch,
483 $tmplTable, $tmplNumber, $tmplTail ) = split( /%SPLIT%/, $tmpl );
484 rizwank 1.1 $tmplHead = &TWiki::handleCommonTags( $tmplHead, $topic );
485 $tmplSearch = &TWiki::handleCommonTags( $tmplSearch, $topic );
486 $tmplNumber = &TWiki::handleCommonTags( $tmplNumber, $topic );
487 $tmplTail = &TWiki::handleCommonTags( $tmplTail, $topic );
488
489 if( ! $tmplTail ) {
490 print "<html><body>";
491 print "<h1>TWiki Installation Error</h1>";
492 # Might not be search.tmpl FIXME
493 print "Incorrect format of search.tmpl (missing %SPLIT% parts)";
494 print "</body></html>";
495 return;
496 }
497
498 if( ! $doInline ) {
499 # print first part of full HTML page
500 $tmplHead = &TWiki::Render::getRenderedVersion( $tmplHead );
501 $tmplHead =~ s|</*nop/*>||goi; # remove <nop> tags (PTh 06 Nov 2000)
502 print $tmplHead;
503 }
504
505 rizwank 1.1 if( ! $noSearch ) {
506 # print "Search:" part
507 my $searchStr = $theSearchVal;
508 $searchStr = "" if( $theSearchVal eq $emptySearch );
509 $searchStr =~ s/&/&/go;
510 $searchStr =~ s/</</go;
511 $searchStr =~ s/>/>/go;
512 $searchStr =~ s/^\.\*$/Index/go;
513 $tmplSearch =~ s/%SEARCHSTRING%/$searchStr/go;
514 if( $doInline ) {
515 $searchResult .= $tmplSearch;
516 } else {
517 $tmplSearch = &TWiki::Render::getRenderedVersion( $tmplSearch );
518 $tmplSearch =~ s|</*nop/*>||goi; # remove <nop> tag
519 print $tmplSearch;
520 }
521 }
522
523 my @tokens = &_tokensFromSearchString( $theSearchVal, $theType );
524
525 # write log entry
526 rizwank 1.1 # FIXME: Move log entry further down to log actual webs searched
527 if( ( $TWiki::doLogTopicSearch ) && ( ! $doInline ) ) {
528 # 0501 kk : vvv Moved from search
529 # PTh 17 May 2000: reverted to old behaviour,
530 # e.g. do not log inline search
531 # PTh 03 Nov 2000: Moved out of the 'foreach $thisWebName' loop
532 $tempVal = join( ' ', @webList );
533 &TWiki::Store::writeLog( "search", $tempVal, $theSearchVal );
534 }
535
536 # loop through webs
537 foreach my $thisWebName ( @webList ) {
538
539 # PTh 03 Nov 2000: Add security check
540 $thisWebName =~ s/$TWiki::securityFilter//go;
541 $thisWebName =~ /(.*)/;
542 $thisWebName = $1; # untaint variable
543
544 next unless &TWiki::Store::webExists( $thisWebName ); # can't process what ain't thar
545
546 my $thisWebBGColor = &TWiki::Prefs::getPreferencesValue( "WEBBGCOLOR", $thisWebName ) || "\#FF00FF";
547 rizwank 1.1 my $thisWebNoSearchAll = &TWiki::Prefs::getPreferencesValue( "NOSEARCHALL", $thisWebName );
548
549 # make sure we can report this web on an 'all' search
550 # DON'T filter out unless it's part of an 'all' search.
551 # PTh 18 Aug 2000: Need to include if it is the current web
552 next if ( ( $searchAllFlag )
553 && ( ( $thisWebNoSearchAll =~ /on/i ) || ( $thisWebName =~ /^[\.\_]/ ) )
554 && ( $thisWebName ne $TWiki::webName ) );
555
556 # search topics in this web
557 my @topicList = _searchTopicsInWeb( $thisWebName, $theTopic, $theScope, $theType, $caseSensitive, @tokens );
558
559 # exclude topics, Codev.ExcludeWebTopicsFromSearch
560 if( $caseSensitive ) {
561 @topicList = grep( !/$theExclude/, @topicList ) if( $theExclude );
562 } else {
563 @topicList = grep( !/$theExclude/i, @topicList ) if( $theExclude );
564 }
565 next if( $noEmpty && ! @topicList ); # Nothing to show for this web
566
567 # use hash tables for date, author, rev number and view permission
568 rizwank 1.1 my %topicRevDate = ();
569 my %topicRevUser = ();
570 my %topicRevNum = ();
571 my %topicAllowView = ();
572
573 # sort the topic list by date, author or topic name
574 if( $theOrder eq "modified" ) {
575 # PTh 03 Nov 2000: Performance improvement
576 # Dates are tricky. For performance we do not read, say,
577 # 2000 records of author/date, sort and then use only 50.
578 # Rather we
579 # * sort by file timestamp (to get a rough list)
580 # * shorten list to the limit + some slack
581 # * sort by rev date on shortened list to get the acurate list
582
583 # Do performance exercise only if it pays off
584 if( $theLimit + 20 < scalar(@topicList) ) {
585 # sort by file timestamp, Schwartzian Transform
586 my @tmpList = ();
587 if( $revSort ) {
588 @tmpList = map { $_->[1] }
589 rizwank 1.1 sort {$b->[0] <=> $a->[0] }
590 map { [ (stat "$TWiki::dataDir\/$thisWebName\/$_.txt")[9], $_ ] }
591 @topicList;
592 } else {
593 @tmpList = map { $_->[1] }
594 sort {$a->[0] <=> $b->[0] }
595 map { [ (stat "$TWiki::dataDir\/$thisWebName\/$_.txt")[9], $_ ] }
596 @topicList;
597 }
598
599 # then shorten list and build the hashes for date and author
600 my $idx = $theLimit + 10; # slack on limit
601 @topicList = ();
602 foreach( @tmpList ) {
603 push( @topicList, $_ );
604 $idx -= 1;
605 last if $idx <= 0;
606 }
607 }
608
609 # build the hashes for date and author
610 rizwank 1.1 foreach( @topicList ) {
611 $tempVal = $_;
612 # Permission check done below, so force this read to succeed with "internal" parameter
613 my( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $tempVal, "", "internal" );
614 my ( $revdate, $revuser, $revnum ) = &TWiki::Store::getRevisionInfoFromMeta( $thisWebName, $tempVal, $meta );
615 $topicRevUser{ $tempVal } = &TWiki::userToWikiName( $revuser );
616 $topicRevDate{ $tempVal } = $revdate; # keep epoc sec for sorting
617 $topicRevNum{ $tempVal } = $revnum;
618 $topicAllowView{ $tempVal } = &TWiki::Access::checkAccessPermission( "view", $TWiki::wikiUserName,
619 $text, $tempVal, $thisWebName );
620 }
621
622 # sort by date (second time if exercise), Schwartzian Transform
623 my $dt = "";
624 if( $revSort ) {
625 @topicList = map { $_->[1] }
626 sort {$b->[0] <=> $a->[0] }
627 map { $dt = $topicRevDate{$_}; $topicRevDate{$_} = TWiki::formatTime( $dt ); [ $dt, $_ ] }
628 @topicList;
629 } else {
630 @topicList = map { $_->[1] }
631 rizwank 1.1 sort {$a->[0] <=> $b->[0] }
632 map { $dt = $topicRevDate{$_}; $topicRevDate{$_} = TWiki::formatTime( $dt ); [ $dt, $_ ] }
633 @topicList;
634 }
635
636 } elsif( $theOrder =~ /^creat/ ) {
637 # sort by topic creation time
638
639 # first we need to build the hashes for modified date, author, creation time
640 my %topicCreated = (); # keep only temporarily for sort
641 foreach( @topicList ) {
642 $tempVal = $_;
643 # Permission check done below, so force this read to succeed with "internal" parameter
644 my( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $tempVal, "", "internal" );
645 my( $revdate, $revuser, $revnum ) = &TWiki::Store::getRevisionInfoFromMeta( $thisWebName, $tempVal, $meta );
646 $topicRevUser{ $tempVal } = &TWiki::userToWikiName( $revuser );
647 $topicRevDate{ $tempVal } = &TWiki::formatTime( $revdate );
648 $topicRevNum{ $tempVal } = $revnum;
649 $topicAllowView{ $tempVal } = &TWiki::Access::checkAccessPermission( "view", $TWiki::wikiUserName,
650 $text, $tempVal, $thisWebName );
651 my ( $createdate ) = &TWiki::Store::getRevisionInfo( $thisWebName, $tempVal, "1.1" );
652 rizwank 1.1 $topicCreated{ $tempVal } = $createdate; # Sortable epoc second format
653 }
654
655 # sort by creation time, Schwartzian Transform
656 if( $revSort ) {
657 @topicList = map { $_->[1] }
658 sort {$b->[0] <=> $a->[0] }
659 map { [ $topicCreated{$_}, $_ ] }
660 @topicList;
661 } else {
662 @topicList = map { $_->[1] }
663 sort {$a->[0] <=> $b->[0] }
664 map { [ $topicCreated{$_}, $_ ] }
665 @topicList;
666 }
667
668 } elsif( $theOrder eq "editby" ) {
669 # sort by author
670
671 # first we need to build the hashes for date and author
672 foreach( @topicList ) {
673 rizwank 1.1 $tempVal = $_;
674 # Permission check done below, so force this read to succeed with "internal" parameter
675 my( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $tempVal, "", "internal" );
676 my( $revdate, $revuser, $revnum ) = &TWiki::Store::getRevisionInfoFromMeta( $thisWebName, $tempVal, $meta );
677 $topicRevUser{ $tempVal } = &TWiki::userToWikiName( $revuser );
678 $topicRevDate{ $tempVal } = &TWiki::formatTime( $revdate );
679 $topicRevNum{ $tempVal } = $revnum;
680 $topicAllowView{ $tempVal } = &TWiki::Access::checkAccessPermission( "view", $TWiki::wikiUserName,
681 $text, $tempVal, $thisWebName );
682 }
683
684 # sort by author, Schwartzian Transform
685 if( $revSort ) {
686 @topicList = map { $_->[1] }
687 sort {$b->[0] cmp $a->[0] }
688 map { [ $topicRevUser{$_}, $_ ] }
689 @topicList;
690 } else {
691 @topicList = map { $_->[1] }
692 sort {$a->[0] cmp $b->[0] }
693 map { [ $topicRevUser{$_}, $_ ] }
694 rizwank 1.1 @topicList;
695 }
696
697 } elsif( $theOrder =~ m/^formfield\((.*)\)$/ ) {
698 # sort by TWikiForm field
699 my $sortfield = $1;
700 my %fieldVals= ();
701 # first we need to build the hashes for fields
702 foreach( @topicList ) {
703 $tempVal = $_;
704 # Permission check done below, so force this read to succeed with "internal" parameter
705 my( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $tempVal, "", "internal" );
706 my( $revdate, $revuser, $revnum ) = &TWiki::Store::getRevisionInfoFromMeta( $thisWebName, $tempVal, $meta );
707 $topicRevUser{ $tempVal } = &TWiki::userToWikiName( $revuser );
708 $topicRevDate{ $tempVal } = &TWiki::formatTime( $revdate );
709 $topicRevNum{ $tempVal } = $revnum;
710 $topicAllowView{ $tempVal } = &TWiki::Access::checkAccessPermission( "view", $TWiki::wikiUserName,
711 $text, $tempVal, $thisWebName );
712 $fieldVals{ $tempVal } = getMetaFormField( $meta, $sortfield );
713 }
714
715 rizwank 1.1 # sort by field, Schwartzian Transform
716 if( $revSort ) {
717 @topicList = map { $_->[1] }
718 sort {$b->[0] cmp $a->[0] }
719 map { [ $fieldVals{$_}, $_ ] }
720 @topicList;
721 } else {
722 @topicList = map { $_->[1] }
723 sort {$a->[0] cmp $b->[0] }
724 map { [ $fieldVals{$_}, $_ ] }
725 @topicList;
726 }
727
728 } else {
729 # simple sort, suggested by RaymondLutz in Codev.SchwartzianTransformMisused
730 ##TWiki::writeDebug "Topic list before sort = @topicList";
731 if( $revSort ) {
732 @topicList = sort {$b cmp $a} @topicList;
733 } else {
734 @topicList = sort {$a cmp $b} @topicList;
735 }
736 rizwank 1.1 ##TWiki::writeDebug "Topic list after sort = @topicList";
737 }
738
739 # header and footer of $thisWebName
740 my( $beforeText, $repeatText, $afterText ) = split( /%REPEAT%/, $tmplTable );
741 if( $theHeader ) {
742 $theHeader =~ s/\$n\(\)/\n/gos; # expand "$n()" to new line
743 $theHeader =~ s/\$n([^$mixedAlpha]|$)/\n$1/gos; # expand "$n" to new line
744 $beforeText = $theHeader;
745 $beforeText =~ s/\$web/$thisWebName/gos;
746 if( $theSeparator ) {
747 $beforeText .= $theSeparator;
748 } else {
749 $beforeText =~ s/([^\n])$/$1\n/os; # add new line at end if needed
750 }
751 }
752
753 # output the list of topics in $thisWebName
754 my $ntopics = 0;
755 my $headerDone = 0;
756 my $topic = "";
757 rizwank 1.1 my $head = "";
758 my $revDate = "";
759 my $revUser = "";
760 my $revNum = "";
761 my $revNumText = "";
762 my $allowView = "";
763 my $locked = "";
764 foreach( @topicList ) {
765 $topic = $_;
766
767 my $meta = "";
768 my $text = "";
769 my $forceRendering = 0;
770
771 # make sure we have date and author
772 if( exists( $topicRevUser{$topic} ) ) {
773 $revDate = $topicRevDate{$topic};
774 $revUser = $topicRevUser{$topic};
775 $revNum = $topicRevNum{$topic};
776 $allowView = $topicAllowView{$topic};
777 } else {
778 rizwank 1.1 # lazy query, need to do it at last
779 ( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $topic );
780 $text =~ s/%WEB%/$thisWebName/gos;
781 $text =~ s/%TOPIC%/$topic/gos;
782 $allowView = &TWiki::Access::checkAccessPermission( "view", $TWiki::wikiUserName, $text, $topic, $thisWebName );
783 ( $revDate, $revUser, $revNum ) = &TWiki::Store::getRevisionInfoFromMeta( $thisWebName, $topic, $meta );
784 $revDate = &TWiki::formatTime( $revDate );
785 $revUser = &TWiki::userToWikiName( $revUser );
786 }
787
788 $locked = "";
789 if( $doShowLock ) {
790 ( $tempVal ) = &TWiki::Store::topicIsLockedBy( $thisWebName, $topic );
791 if( $tempVal ) {
792 $revUser = &TWiki::userToWikiName( $tempVal );
793 $locked = "(LOCKED)";
794 }
795 }
796
797 # Check security
798 # FIXME - how do we deal with user login not being available if
799 rizwank 1.1 # coming from search script?
800 if( ! $allowView ) {
801 next;
802 }
803
804 # Special handling for format="..."
805 if( $theFormat ) {
806 unless( $text ) {
807 ( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $topic );
808 $text =~ s/%WEB%/$thisWebName/gos;
809 $text =~ s/%TOPIC%/$topic/gos;
810 }
811 if( $doExpandVars ) {
812 if( "$thisWebName.$topic" eq "$baseWeb.$baseTopic" ) {
813 # primitive way to prevent recursion
814 $text =~ s/%SEARCH/%<nop>SEARCH/g;
815 }
816 $text = &TWiki::handleCommonTags( $text, $topic, $thisWebName );
817 }
818 }
819
820 rizwank 1.1 my @multipleHitLines = ();
821 if( $doMultiple ) {
822 my $pattern = $tokens[$#tokens]; # last token in an AND search
823 $pattern = quotemeta( $pattern ) if( $theType ne "regex" );
824 ( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $topic ) unless $text;
825 if( $caseSensitive ) {
826 @multipleHitLines = reverse grep { /$pattern/ } split( /[\n\r]+/, $text );
827 } else {
828 @multipleHitLines = reverse grep { /$pattern/i } split( /[\n\r]+/, $text );
829 }
830 }
831
832 do { # multiple=on loop
833
834 $text = pop( @multipleHitLines ) if( scalar( @multipleHitLines ) );
835
836 if( $theFormat ) {
837 $tempVal = $theFormat;
838 $tempVal =~ s/\$web/$thisWebName/gos;
839 $tempVal =~ s/\$topic\(([^\)]*)\)/breakName( $topic, $1 )/geos;
840 $tempVal =~ s/\$topic/$topic/gos;
841 rizwank 1.1 $tempVal =~ s/\$locked/$locked/gos;
842 $tempVal =~ s/\$date/$revDate/gos;
843 $tempVal =~ s/\$isodate/&revDate2ISO($revDate)/geos;
844 $tempVal =~ s/\$rev/1.$revNum/gos;
845 $tempVal =~ s/\$wikiusername/$revUser/gos;
846 $tempVal =~ s/\$wikiname/wikiName($revUser)/geos;
847 $tempVal =~ s/\$username/&TWiki::wikiToUserName($revUser)/geos;
848 $tempVal =~ s/\$createdate/_getRev1Info( $thisWebName, $topic, "date" )/geos;
849 $tempVal =~ s/\$createusername/_getRev1Info( $thisWebName, $topic, "username" )/geos;
850 $tempVal =~ s/\$createwikiname/_getRev1Info( $thisWebName, $topic, "wikiname" )/geos;
851 $tempVal =~ s/\$createwikiusername/_getRev1Info( $thisWebName, $topic, "wikiusername" )/geos;
852 if( $tempVal =~ m/\$text/ ) {
853 # expand topic text
854 ( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $topic ) unless $text;
855 if( $topic eq $TWiki::topicName ) {
856 # defuse SEARCH in current topic to prevent loop
857 $text =~ s/%SEARCH{.*?}%/SEARCH{...}/go;
858 }
859 $tempVal =~ s/\$text/$text/gos;
860 $forceRendering = 1 unless( $doMultiple );
861 }
862 rizwank 1.1 } else {
863 $tempVal = $repeatText;
864 }
865 $tempVal =~ s/%WEB%/$thisWebName/go;
866 $tempVal =~ s/%TOPICNAME%/$topic/go;
867 $tempVal =~ s/%LOCKED%/$locked/o;
868 $tempVal =~ s/%TIME%/$revDate/o;
869 if( $revNum > 1 ) {
870 $revNumText = "r1.$revNum";
871 } else {
872 $revNumText = "<span class=\"twikiNew\"><b>NEW</b></span>";
873 }
874 $tempVal =~ s/%REVISION%/$revNumText/o;
875 $tempVal =~ s/%AUTHOR%/$revUser/o;
876
877 if( ( $doInline || $theFormat ) && ( ! ( $forceRendering ) ) ) {
878 # print at the end if formatted search because of table rendering
879 # do nothing
880 } else {
881 $tempVal = &TWiki::handleCommonTags( $tempVal, $topic );
882 $tempVal = &TWiki::Render::getRenderedVersion( $tempVal );
883 rizwank 1.1 }
884
885 if( $doRenameView ) { # added JET 19 Feb 2000
886 # Permission check done below, so force this read to succeed with "internal" parameter
887 my $rawText = &TWiki::Store::readTopicRaw( $thisWebName, $topic, "", "internal" );
888 my $changeable = "";
889 my $changeAccessOK = &TWiki::Access::checkAccessPermission( "change", $TWiki::wikiUserName, $text, $topic, $thisWebName );
890 if( ! $changeAccessOK ) {
891 $changeable = "(NO CHANGE PERMISSION)";
892 $tempVal =~ s/%SELECTION%.*%SELECTION%//o;
893 } else {
894 $tempVal =~ s/%SELECTION%//go;
895 }
896 $tempVal =~ s/%CHANGEABLE%/$changeable/o;
897
898 $tempVal =~ s/%LABEL%/$doRenameView/go;
899 my $reducedOutput = "";
900
901 # Remove lines that don't contain the topic and highlight matched string
902 my $insidePRE = 0;
903 my $insideVERBATIM = 0;
904 rizwank 1.1 my $noAutoLink = 0;
905
906 foreach( split( /\n/, $rawText ) ) {
907
908 next if( /^%META:TOPIC(INFO|MOVED)/ );
909 s/</</go;
910 s/>/>/go;
911
912 # This code is in far too many places
913 m|<pre>|i && ( $insidePRE = 1 );
914 m|</pre>|i && ( $insidePRE = 0 );
915 if( m|<verbatim>|i ) {
916 $insideVERBATIM = 1;
917 }
918 if( m|</verbatim>|i ) {
919 $insideVERBATIM = 0;
920 }
921 m|<noautolink>|i && ( $noAutoLink = 1 );
922 m|</noautolink>|i && ( $noAutoLink = 0 );
923
924 if( ! ( $insidePRE || $insideVERBATIM || $noAutoLink ) ) {
925 rizwank 1.1 # Case insensitive option is required to get [[spaced Word]] to match
926 # I18N: match non-alpha before and after topic name in renameview searches
927 my $alphaNum = $TWiki::regex{mixedAlphaNum};
928 my $match = "(^|[^${alphaNum}_.])($originalSearch)(?=[^${alphaNum}]|\$)";
929 # NOTE: Must *not* use /o here, since $match is based on
930 # search string that will vary during lifetime of
931 # compiled code with mod_perl.
932 my $subs = s|$match|$1<font color="red"><span class="twikiAlert">$2</span></font> |g;
933 $match = '(\[\[)' . "($spacedTopic)" . '(?=\]\])';
934 $subs += s|$match|$1<font color="red"><span class="twikiAlert">$2</span></font> |gi;
935 if( $subs ) {
936 $topicCount++ if( ! $reducedOutput );
937 $reducedOutput .= "$_<br />\n" if( $subs );
938 }
939 }
940 }
941 $tempVal =~ s/%TOPIC_NUMBER%/$topicCount/go;
942 $tempVal =~ s/%TEXTHEAD%/$reducedOutput/go;
943 next if ( ! $reducedOutput );
944
945 } elsif( $doBookView ) {
946 rizwank 1.1 # BookView, added PTh 20 Jul 2000
947 if( ! $text ) {
948 ( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $topic );
949 }
950 if( "$thisWebName.$topic" eq "$baseWeb.$baseTopic" ) {
951 # primitive way to prevent recursion
952 $text =~ s/%SEARCH/%<nop>SEARCH/g;
953 }
954 $text = &TWiki::handleCommonTags( $text, $topic, $thisWebName );
955 $text = &TWiki::Render::getRenderedVersion( $text, $thisWebName );
956 # FIXME: What about meta data rendering?
957 $tempVal =~ s/%TEXTHEAD%/$text/go;
958
959 } elsif( $theFormat ) {
960 # free format, added PTh 10 Oct 2001
961 $tempVal =~ s/\$summary\(([^\)]*)\)/&TWiki::makeTopicSummary( $text, $topic, $thisWebName, $1 )/geos;
962 $tempVal =~ s/\$summary/&TWiki::makeTopicSummary( $text, $topic, $thisWebName )/geos;
963 $tempVal =~ s/\$parent\(([^\)]*)\)/breakName( getMetaParent( $meta ), $1 )/geos;
964 $tempVal =~ s/\$parent/getMetaParent( $meta )/geos;
965 $tempVal =~ s/\$formfield\(\s*([^\)]*)\s*\)/getMetaFormField( $meta, $1 )/geos;
966 $tempVal =~ s/\$formname/_getMetaFormName( $meta )/geos;
967 rizwank 1.1 $tempVal =~ s/\$pattern\((.*?\s*\.\*)\)/getTextPattern( $text, $1 )/geos;
968 $tempVal =~ s/\r?\n/$newLine/gos if( $newLine );
969 if( $theSeparator ) {
970 $tempVal .= $theSeparator;
971 } else {
972 $tempVal =~ s/([^\n])$/$1\n/os; # add new line at end if needed
973 }
974 $tempVal =~ s/\$n\(\)/\n/gos; # expand "$n()" to new line
975 $tempVal =~ s/\$n([^$mixedAlpha]|$)/\n$1/gos; # expand "$n" to new line
976 $tempVal =~ s/\$nop(\(\))?//gos; # remove filler, useful for nested search
977 $tempVal =~ s/\$quot(\(\))?/\"/gos; # expand double quote
978 $tempVal =~ s/\$percnt(\(\))?/\%/gos; # expand percent
979 $tempVal =~ s/\$dollar(\(\))?/\$/gos; # expand dollar
980
981 } elsif( $noSummary ) {
982 $tempVal =~ s/%TEXTHEAD%//go;
983 $tempVal =~ s/ //go;
984
985 } else {
986 # regular search view
987 if( $text ) {
988 rizwank 1.1 $head = $text;
989 } else {
990 $head = &TWiki::Store::readFileHead( "$TWiki::dataDir\/$thisWebName\/$topic.txt", 16 );
991 }
992 $head = &TWiki::makeTopicSummary( $head, $topic, $thisWebName );
993 $tempVal =~ s/%TEXTHEAD%/$head/go;
994 }
995
996 # lazy output of header (only if needed for the first time)
997 unless( $headerDone || $noHeader ) {
998 $headerDone = 1;
999 $beforeText =~ s/%WEBBGCOLOR%/$thisWebBGColor/go;
1000 $beforeText =~ s/%WEB%/$thisWebName/go;
1001 $beforeText = &TWiki::handleCommonTags( $beforeText, $topic );
1002 if( $doInline || $theFormat ) {
1003 # print at the end if formatted search because of table rendering
1004 $searchResult .= $beforeText;
1005 } else {
1006 $beforeText = &TWiki::Render::getRenderedVersion( $beforeText, $thisWebName );
1007 $beforeText =~ s|</*nop/*>||goi; # remove <nop> tag
1008 print $beforeText;
1009 rizwank 1.1 }
1010 }
1011
1012 # output topic (or line if multiple=on)
1013 if( $doInline || $theFormat ) {
1014 # print at the end if formatted search because of table rendering
1015 $searchResult .= $tempVal;
1016 } else {
1017 $tempVal = &TWiki::Render::getRenderedVersion( $tempVal, $thisWebName );
1018 $tempVal =~ s|</*nop/*>||goi; # remove <nop> tag
1019 print $tempVal;
1020 }
1021
1022 } while( @multipleHitLines ); # multiple=on loop
1023
1024 $ntopics += 1;
1025 last if( $ntopics >= $theLimit );
1026 } # end topic loop in a web
1027
1028 # output footer only if hits in web
1029 if( $ntopics ) {
1030 rizwank 1.1 # output footer of $thisWebName
1031 $afterText = &TWiki::handleCommonTags( $afterText, $topic );
1032 if( $doInline || $theFormat ) {
1033 # print at the end if formatted search because of table rendering
1034 $afterText =~ s/\n$//os; # remove trailing new line
1035 $searchResult .= $afterText;
1036 } else {
1037 $afterText = &TWiki::Render::getRenderedVersion( $afterText, $thisWebName );
1038 $afterText =~ s|</*nop/*>||goi; # remove <nop> tag
1039 print $afterText;
1040 }
1041 }
1042
1043 # output number of topics (only if hits in web or if search only one web)
1044 if( $ntopics || @webList < 2 ) {
1045 unless( $noTotal ) {
1046 my $thisNumber = $tmplNumber;
1047 $thisNumber =~ s/%NTOPICS%/$ntopics/go;
1048 if( $doInline || $theFormat ) {
1049 # print at the end if formatted search because of table rendering
1050 $searchResult .= $thisNumber;
1051 rizwank 1.1 } else {
1052 $thisNumber = &TWiki::Render::getRenderedVersion( $thisNumber, $thisWebName );
1053 $thisNumber =~ s|</*nop/*>||goi; # remove <nop> tag
1054 print $thisNumber;
1055 }
1056 }
1057 }
1058 }
1059
1060 if( $theFormat ) {
1061 if( $theSeparator ) {
1062 $searchResult =~ s/$theSeparator$//s; # remove separator at end
1063 } else {
1064 $searchResult =~ s/\n$//os; # remove trailing new line
1065 }
1066 }
1067 if( $doInline ) {
1068 # return formatted search result
1069 return $searchResult;
1070
1071 } else {
1072 rizwank 1.1 if( $theFormat ) {
1073 # finally print $searchResult which got delayed because of formatted search
1074 $tmplTail = "$searchResult$tmplTail";
1075 }
1076
1077 # print last part of full HTML page
1078 $tmplTail = &TWiki::Render::getRenderedVersion( $tmplTail );
1079 $tmplTail =~ s|</*nop/*>||goi; # remove <nop> tag
1080 print $tmplTail;
1081 }
1082 return $searchResult;
1083 }
1084
1085 #=========================
1086 =pod
1087
1088 ---++ sub _getRev1Info( $theWeb, $theTopic, $theAttr )
1089
1090 Returns the topic revision info of version 1.1, attributes are "date", "username", "wikiname",
1091 "wikiusername". Revision info is cached for speed
1092
1093 rizwank 1.1 =cut
1094
1095 sub _getRev1Info
1096 {
1097 my( $theWeb, $theTopic, $theAttr ) = @_;
1098
1099 unless( $cacheRev1webTopic eq "$theWeb.$theTopic" ) {
1100 # refresh cache
1101 $cacheRev1webTopic = "$theWeb.$theTopic";
1102 ( $cacheRev1date, $cacheRev1user ) = &TWiki::Store::getRevisionInfo( $theWeb, $theTopic, "1.1" );
1103 }
1104 if( $theAttr eq "username" ) {
1105 return $cacheRev1user;
1106 }
1107 if( $theAttr eq "wikiname" ) {
1108 return &TWiki::userToWikiName( $cacheRev1user, 1 );
1109 }
1110 if( $theAttr eq "wikiusername" ) {
1111 return &TWiki::userToWikiName( $cacheRev1user );
1112 }
1113 if( $theAttr eq "date" ) {
1114 rizwank 1.1 return &TWiki::formatTime( $cacheRev1date );
1115 }
1116 # else assume attr "key"
1117 return "1.1";
1118 }
1119
1120 #=========================
1121 =pod
1122
1123 ---++ sub getMetaParent( $theMeta )
1124
1125 Not yet documented.
1126
1127 =cut
1128
1129 sub getMetaParent
1130 {
1131 my( $theMeta ) = @_;
1132
1133 my $value = "";
1134 my %parent = $theMeta->findOne( "TOPICPARENT" );
1135 rizwank 1.1 $value = $parent{"name"} if( %parent );
1136 return $value;
1137 }
1138
1139 #=========================
1140 =pod
1141
1142 ---++ sub getMetaFormField ( $theMeta, $theParams )
1143
1144 Not yet documented.
1145
1146 =cut
1147
1148 sub getMetaFormField
1149 {
1150 my( $theMeta, $theParams ) = @_;
1151
1152 my $name = $theParams;
1153 my $break = "";
1154 my @params = split( /\,\s*/, $theParams, 2 );
1155 if( @params > 1 ) {
1156 rizwank 1.1 $name = $params[0] || "";
1157 $break = $params[1] || 1;
1158 }
1159 my $value = "";
1160 my @fields = $theMeta->find( "FIELD" );
1161 foreach my $field ( @fields ) {
1162 $value = $field->{"value"};
1163 $value =~ s/^\s*(.*?)\s*$/$1/go;
1164 if( $name =~ /^($field->{"name"}|$field->{"title"})$/ ) {
1165 $value = breakName( $value, $break );
1166 return $value;
1167 }
1168 }
1169 return "";
1170 }
1171
1172 #=========================
1173 =pod
1174
1175 ---++ sub _getMetaFormName ( $theMeta )
1176
1177 rizwank 1.1 Returns the name of the form attached to the topic
1178
1179 =cut
1180
1181 sub _getMetaFormName
1182 {
1183 my( $theMeta ) = @_;
1184
1185 my %aForm = $theMeta->findOne( "FORM" );
1186 if( %aForm ) {
1187 return $aForm{"name"};
1188 }
1189 return "";
1190 }
1191
1192 #=========================
1193 =pod
1194
1195 ---++ sub getTextPattern ( $theText, $thePattern )
1196
1197 Not yet documented.
1198 rizwank 1.1
1199 =cut
1200
1201 sub getTextPattern
1202 {
1203 my( $theText, $thePattern ) = @_;
1204
1205 $thePattern =~ s/([^\\])([\$\@\%\&\#\'\`\/])/$1\\$2/go; # escape some special chars
1206 $thePattern =~ /(.*)/; # untaint
1207 $thePattern = $1;
1208 my $OK = 0;
1209 eval {
1210 $OK = ( $theText =~ s/$thePattern/$1/is );
1211 };
1212 $theText = "" unless( $OK );
1213
1214 return $theText;
1215 }
1216
1217 #=========================
1218 =pod
1219 rizwank 1.1
1220 ---++ sub wikiName ( $theWikiUserName )
1221
1222 Not yet documented.
1223
1224 =cut
1225
1226 sub wikiName
1227 {
1228 my( $theWikiUserName ) = @_;
1229
1230 $theWikiUserName =~ s/^.*\.//o;
1231 return $theWikiUserName;
1232 }
1233
1234 #=========================
1235 =pod
1236
1237 ---++ sub breakName ( $theText, $theParams )
1238
1239 Not yet documented.
1240 rizwank 1.1
1241 =cut
1242
1243 sub breakName
1244 {
1245 my( $theText, $theParams ) = @_;
1246
1247 my @params = split( /[\,\s]+/, $theParams, 2 );
1248 if( @params ) {
1249 my $len = $params[0] || 1;
1250 $len = 1 if( $len < 1 );
1251 my $sep = "- ";
1252 $sep = $params[1] if( @params > 1 );
1253 if( $sep =~ /^\.\.\./i ) {
1254 # make name shorter like "ThisIsALongTop..."
1255 $theText =~ s/(.{$len})(.+)/$1.../s;
1256
1257 } else {
1258 # split and hyphenate the topic like "ThisIsALo- ngTopic"
1259 $theText =~ s/(.{$len})/$1$sep/gs;
1260 $theText =~ s/$sep$//;
1261 rizwank 1.1 }
1262 }
1263 return $theText;
1264 }
1265
1266 #=========================
1267 # Turn a topic into a spaced-out topic, with space before each part of
1268 # the WikiWord.
1269 =pod
1270
1271 ---++ sub spacedTopic ( $topic )
1272
1273 Not yet documented.
1274
1275 =cut
1276
1277 sub spacedTopic
1278 {
1279 my( $topic ) = @_;
1280 # FindMe -> Find\s*Me
1281 # I18N fix
1282 rizwank 1.1 my $upperAlpha = $TWiki::regex{singleUpperAlphaRegex};
1283 my $lowerAlpha = $TWiki::regex{singleLowerAlphaRegex};
1284 $topic =~ s/($lowerAlpha)($upperAlpha)/$1 *$2/go;
1285 return $topic;
1286 }
1287
1288 #=========================
1289
1290 1;
1291
1292 # EOF
|
Return to
Search.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki