lib/TWiki/Search.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 # See bottom of file for license and copyright information
       
     2 package TWiki::Search;
       
     3 
       
     4 =pod
       
     5 
       
     6 ---+ package TWiki::Search
       
     7 
       
     8 This module implements all the search functionality.
       
     9 
       
    10 =cut
       
    11 
       
    12 use strict;
       
    13 use Assert;
       
    14 use Error qw( :try );
       
    15 
       
    16 require TWiki;
       
    17 require TWiki::Sandbox;
       
    18 require TWiki::Render; # SMELL: expensive
       
    19 
       
    20 my $queryParser;
       
    21 
       
    22 BEGIN {
       
    23 
       
    24     # 'Use locale' for internationalisation of Perl sorting and searching -
       
    25     # main locale settings are done in TWiki::setupLocale
       
    26     # Do a dynamic 'use locale' for this module
       
    27     if ( $TWiki::cfg{UseLocale} ) {
       
    28         require locale;
       
    29         import locale();
       
    30     }
       
    31 }
       
    32 
       
    33 =pod
       
    34 
       
    35 ---++ ClassMethod new ($session)
       
    36 
       
    37 Constructor for the singleton Search engine object.
       
    38 
       
    39 =cut
       
    40 
       
    41 sub new {
       
    42     my ( $class, $session ) = @_;
       
    43     my $this = bless( { session => $session }, $class );
       
    44 
       
    45     return $this;
       
    46 }
       
    47 
       
    48 =begin twiki
       
    49 
       
    50 ---++ ObjectMethod finish()
       
    51 Break circular references.
       
    52 
       
    53 =cut
       
    54 
       
    55 # Note to developers; please undef *all* fields in the object explicitly,
       
    56 # whether they are references or not. That way this method is "golden
       
    57 # documentation" of the live fields in the object.
       
    58 sub finish {
       
    59     my $this = shift;
       
    60     undef $this->{session};
       
    61 }
       
    62 
       
    63 =pod
       
    64 
       
    65 ---++ StaticMethod getTextPattern (  $text, $pattern  )
       
    66 
       
    67 Sanitise search pattern - currently used for FormattedSearch only
       
    68 
       
    69 =cut
       
    70 
       
    71 sub getTextPattern {
       
    72     my ( $text, $pattern ) = @_;
       
    73 
       
    74     $pattern =~
       
    75       s/([^\\])([\$\@\%\&\#\'\`\/])/$1\\$2/go;    # escape some special chars
       
    76     $pattern = TWiki::Sandbox::untaintUnchecked($pattern);
       
    77 
       
    78     my $OK = 0;
       
    79     eval { $OK = ( $text =~ s/$pattern/$1/is ); };
       
    80     $text = '' unless ($OK);
       
    81 
       
    82     return $text;
       
    83 }
       
    84 
       
    85 # Split the search string into tokens depending on type of search.
       
    86 # Search is an 'AND' of all tokens - various syntaxes implemented
       
    87 # by this routine.
       
    88 sub _tokensFromSearchString {
       
    89     my ( $this, $searchString, $type ) = @_;
       
    90 
       
    91     my @tokens = ();
       
    92     if ( $type eq 'regex' ) {
       
    93 
       
    94         # Regular expression search Example: soap;wsdl;web service;!shampoo
       
    95         @tokens = split( /;/, $searchString );
       
    96 
       
    97     }
       
    98     elsif ( $type eq 'literal' || $type eq 'query' ) {
       
    99 
       
   100         if( $searchString eq '' ) {
       
   101             # Legacy: empty search returns nothing
       
   102         } else {
       
   103             # Literal search (old style) or query
       
   104             $tokens[0] = $searchString;
       
   105         }
       
   106 
       
   107     }
       
   108     else {
       
   109 
       
   110         # Keyword search (Google-style) - implemented by converting
       
   111         # to regex format. Example: soap +wsdl +"web service" -shampoo
       
   112 
       
   113         # Prevent tokenizing on spaces in "literal string"
       
   114         $searchString =~ s/(\".*?)\"/&_translateSpace($1)/geo;
       
   115         $searchString =~ s/[\+\-]\s+//go;
       
   116 
       
   117         # Build pattern of stop words
       
   118         my $prefs = $this->{session}->{prefs};
       
   119         my $stopWords = $prefs->getPreferencesValue('SEARCHSTOPWORDS') || '';
       
   120         $stopWords =~ s/[\s\,]+/\|/go;
       
   121         $stopWords =~ s/[\(\)]//go;
       
   122 
       
   123         # Tokenize string taking account of literal strings, then remove
       
   124         # stop words and convert '+' and '-' syntax.
       
   125         @tokens =
       
   126           map {
       
   127             s/^\+//o;
       
   128             s/^\-/\!/o;
       
   129             s/^"//o;
       
   130             $_
       
   131           }    # remove +, change - to !, remove "
       
   132           grep { !/^($stopWords)$/i }    # remove stopwords
       
   133           map { s/$TWiki::TranslationToken/ /go; $_ }    # restore space
       
   134           split( /[\s]+/, $searchString );               # split on spaces
       
   135     }
       
   136 
       
   137     return @tokens;
       
   138 }
       
   139 
       
   140 # Convert spaces into translation token characters (typically NULs),
       
   141 # preventing tokenization.
       
   142 #
       
   143 # FIXME: Terminology confusing here!
       
   144 sub _translateSpace {
       
   145     my $text = shift;
       
   146     $text =~ s/\s+/$TWiki::TranslationToken/go;
       
   147     return $text;
       
   148 }
       
   149 
       
   150 # get a list of topics to search in the web, filtered by the $topic
       
   151 # spec
       
   152 sub _getTopicList {
       
   153     my( $this, $web, $topic, $options ) = @_;
       
   154 
       
   155     my @topicList = ();
       
   156     my $store = $this->{session}->{store};
       
   157     if ($topic) {
       
   158 
       
   159         # limit search to topic list
       
   160         if ( $topic =~ /^\^\([\_\-\+$TWiki::regex{mixedAlphaNum}\|]+\)\$$/ ) {
       
   161 
       
   162             # topic list without wildcards
       
   163             # for speed, do not get all topics in web
       
   164             # but convert topic pattern into topic list
       
   165             my $topics = $topic;
       
   166             $topics =~ s/^\^\(//o;
       
   167             $topics =~ s/\)\$//o;
       
   168 
       
   169             # build list from topic pattern
       
   170             @topicList = grep( $store->topicExists($web, $_),
       
   171                                split( /\|/, $topics ));
       
   172         }
       
   173         else {
       
   174 
       
   175             # topic list with wildcards
       
   176             @topicList = $store->getTopicNames($web);
       
   177             if ( $options->{caseSensitive} ) {
       
   178 
       
   179                 # limit by topic name,
       
   180                 @topicList = grep( /$topic/, @topicList );
       
   181             }
       
   182             else {
       
   183 
       
   184                 # Codev.SearchTopicNameAndTopicText
       
   185                 @topicList = grep( /$topic/i, @topicList );
       
   186             }
       
   187         }
       
   188     }
       
   189     else {
       
   190         @topicList = $store->getTopicNames($web);
       
   191     }
       
   192     return @topicList;
       
   193 }
       
   194 
       
   195 # Run a query over a list of topics
       
   196 sub _queryTopics {
       
   197     my( $this, $web, $query, @topicList ) = @_;
       
   198 
       
   199     my $store = $this->{session}->{store};
       
   200 
       
   201     my $matches = $store->searchInWebMetaData(
       
   202         $query, $web, \@topicList);
       
   203 
       
   204     return keys %$matches;
       
   205 }
       
   206 
       
   207 # Run a search over a list of topics - @tokens is a list of
       
   208 # search terms to be ANDed together
       
   209 sub _searchTopics {
       
   210     my ( $this, $web, $scope, $type, $options, $tokens, @topicList ) = @_;
       
   211 
       
   212     my $store = $this->{session}->{store};
       
   213 
       
   214     # default scope is 'text'
       
   215     $scope = 'text' unless ( $scope =~ /^(topic|all)$/ );
       
   216 
       
   217     # AND search - search once for each token, ANDing result together
       
   218     foreach my $token (@$tokens) {
       
   219 
       
   220         my $invertSearch = 0;
       
   221 
       
   222         $invertSearch = ( $token =~ s/^\!//o );
       
   223 
       
   224         # flag for AND NOT search
       
   225         my @scopeTextList  = ();
       
   226         my @scopeTopicList = ();
       
   227 
       
   228         # scope can be 'topic' (default), 'text' or "all"
       
   229         # scope='text', e.g. Perl search on topic name:
       
   230         unless ( $scope eq 'text' ) {
       
   231             my $qtoken = $token;
       
   232 
       
   233             # FIXME I18N
       
   234             $qtoken = quotemeta($qtoken) if ( $type ne 'regex' );
       
   235             if ( $options->{'caseSensitive'} ) {
       
   236 
       
   237                 # fix for Codev.SearchWithNoPipe
       
   238                 @scopeTopicList = grep( /$qtoken/, @topicList );
       
   239             }
       
   240             else {
       
   241                 @scopeTopicList = grep( /$qtoken/i, @topicList );
       
   242             }
       
   243         }
       
   244 
       
   245         # scope='text', e.g. grep search on topic text:
       
   246         unless ( $scope eq 'topic' ) {
       
   247             my $matches = $store->searchInWebContent(
       
   248                 $token, $web,
       
   249                 \@topicList,
       
   250                 {
       
   251                     type                => $type,
       
   252                     casesensitive       => $options->{'caseSensitive'},
       
   253                     wordboundaries      => $options->{'wordBoundaries'},
       
   254                     files_without_match => 1
       
   255                    }
       
   256                );
       
   257             @scopeTextList = keys %$matches;
       
   258         }
       
   259 
       
   260         if ( @scopeTextList && @scopeTopicList ) {
       
   261 
       
   262             # join 'topic' and 'text' lists
       
   263             push( @scopeTextList, @scopeTopicList );
       
   264             my %seen = ();
       
   265 
       
   266             # make topics unique
       
   267             @scopeTextList = sort grep { !$seen{$_}++ } @scopeTextList;
       
   268         }
       
   269         elsif (@scopeTopicList) {
       
   270             @scopeTextList = @scopeTopicList;
       
   271         }
       
   272 
       
   273         if ($invertSearch) {
       
   274 
       
   275             # do AND NOT search
       
   276             my %seen = ();
       
   277             foreach my $topic (@scopeTextList) {
       
   278                 $seen{$topic} = 1;
       
   279             }
       
   280             @scopeTextList = ();
       
   281             foreach my $topic (@topicList) {
       
   282                 push( @scopeTextList, $topic ) unless ( $seen{$topic} );
       
   283             }
       
   284         }
       
   285 
       
   286         # reduced topic list for next token
       
   287         @topicList = @scopeTextList;
       
   288     }
       
   289     return @topicList;
       
   290 }
       
   291 
       
   292 sub _makeTopicPattern {
       
   293     my ($topic) = @_;
       
   294     return '' unless ($topic);
       
   295 
       
   296     # 'Web*, FooBar' ==> ( 'Web*', 'FooBar' ) ==> ( 'Web.*', "FooBar" )
       
   297     my @arr =
       
   298       map { s/[^\*\_\-\+$TWiki::regex{mixedAlphaNum}]//go; s/\*/\.\*/go; $_ }
       
   299       split( /,\s*/, $topic );
       
   300     return '' unless (@arr);
       
   301 
       
   302     # ( 'Web.*', 'FooBar' ) ==> "^(Web.*|FooBar)$"
       
   303     return '^(' . join( '|', @arr ) . ')$';
       
   304 }
       
   305 
       
   306 =pod
       
   307 
       
   308 ---++ ObjectMethod searchWeb (...)
       
   309 
       
   310 Search one or more webs according to the parameters.
       
   311 
       
   312 If =_callback= is set, that means the caller wants results as
       
   313 soon as they are ready. =_callback_ should be set to a reference
       
   314 to a function which takes =_cbdata= as the first parameter and
       
   315 remaining parameters the same as 'print'.
       
   316 
       
   317 If =_callback= is set, the result is always undef. Otherwise the
       
   318 result is a string containing the rendered search results.
       
   319 
       
   320 If =inline= is set, then the results are *not* decorated with
       
   321 the search template head and tail blocks.
       
   322 
       
   323 The function will throw Error::Simple if it encounters any problems with the
       
   324 syntax of the search string.
       
   325 
       
   326 Note: If =format= is set, =template= will be ignored.
       
   327 
       
   328 Note: For legacy, if =regex= is defined, it will force type='regex'
       
   329 
       
   330 If =type="word"= it will be changed to =type="keyword"= with =wordBoundaries=1=. This will be used for searching with scope="text" only, because scope="topic" will do a Perl search on topic names.
       
   331 
       
   332 SMELL: If =template= is defined =bookview= will not work
       
   333 
       
   334 SMELL: it seems that if you define =_callback= or =inline= then you are
       
   335 	responsible for converting the TML to HTML yourself!
       
   336 	
       
   337 FIXME: =callback= cannot work with format parameter (consider format='| $topic |'
       
   338 
       
   339 =cut
       
   340 
       
   341 sub searchWeb {
       
   342     my $this = shift;
       
   343     my %params        = @_;
       
   344     my $callback      = $params{_callback};
       
   345     my $cbdata        = $params{_cbdata};
       
   346     my $baseTopic     = $params{basetopic} || $this->{session}->{topicName};
       
   347     my $baseWeb       = $params{baseweb} || $this->{session}->{webName};
       
   348     my $doBookView    = TWiki::isTrue( $params{bookview} );
       
   349     my $caseSensitive = TWiki::isTrue( $params{casesensitive} );
       
   350     my $excludeTopic  = $params{excludetopic} || '';
       
   351     my $doExpandVars  = TWiki::isTrue( $params{expandvariables} );
       
   352     my $format        = $params{format} || '';
       
   353     my $header        = $params{header};
       
   354     my $inline        = $params{inline};
       
   355     my $limit         = $params{limit} || '';
       
   356     my $doMultiple    = TWiki::isTrue( $params{multiple} );
       
   357     my $nonoise       = TWiki::isTrue( $params{nonoise} );
       
   358     my $noEmpty       = TWiki::isTrue( $params{noempty}, $nonoise );
       
   359 
       
   360     # Note: a defined header overrides noheader
       
   361     my $noHeader =
       
   362       !defined($header)
       
   363       && TWiki::isTrue( $params{noheader}, $nonoise )
       
   364 
       
   365       # Note: This is done for Cairo compatibility
       
   366       || ( !$header && $format && $inline );
       
   367 
       
   368     my $noSearch  = TWiki::isTrue( $params{nosearch},  $nonoise );
       
   369     my $noSummary = TWiki::isTrue( $params{nosummary}, $nonoise );
       
   370     my $zeroResults =
       
   371       1 - TWiki::isTrue( ( $params{zeroresults} || 'on' ), $nonoise );
       
   372     my $noTotal = TWiki::isTrue( $params{nototal}, $nonoise );
       
   373     my $newLine   = $params{newline} || '';
       
   374     my $sortOrder = $params{order}   || '';
       
   375     my $revSort        = TWiki::isTrue( $params{reverse} );
       
   376     my $scope          = $params{scope} || '';
       
   377     my $searchString   = $params{search} || '';
       
   378     my $separator      = $params{separator};
       
   379     my $template       = $params{template} || '';
       
   380     my $topic          = $params{topic} || '';
       
   381     my $type           = $params{type} || '';
       
   382 
       
   383     my $wordBoundaries = 0;
       
   384     if ( $type eq 'word' ) {
       
   385         # 'word' is exactly the same as 'keyword', except we will be searching
       
   386         # with word boundaries
       
   387         $type = 'keyword';
       
   388         $wordBoundaries = 1;
       
   389     }
       
   390 
       
   391     my $webName        = $params{web} || '';
       
   392     my $date           = $params{date} || '';
       
   393     my $recurse        = $params{'recurse'} || '';
       
   394     my $finalTerm      = $inline ? ( $params{nofinalnewline} || 0 ) : 0;
       
   395     my $users          = $this->{session}->{users};
       
   396 
       
   397     $baseWeb =~ s/\./\//go;
       
   398 
       
   399     my $session  = $this->{session};
       
   400     my $renderer = $session->renderer;
       
   401 
       
   402     # Limit search results
       
   403     if ( $limit =~ /(^\d+$)/o ) {
       
   404 
       
   405         # only digits, all else is the same as
       
   406         # an empty string.  "+10" won't work.
       
   407         $limit = $1;
       
   408     }
       
   409     else {
       
   410 
       
   411         # change 'all' to 0, then to big number
       
   412         $limit = 0;
       
   413     }
       
   414     $limit = 32000 unless ($limit);
       
   415 
       
   416     $type = 'regex' if ( $params{regex} );
       
   417 
       
   418     my $mixedAlpha = $TWiki::regex{mixedAlpha};
       
   419     if ( defined($separator) ) {
       
   420         $separator =~ s/\$n\(\)/\n/gos;    # expand "$n()" to new line
       
   421         $separator =~ s/\$n([^$mixedAlpha]|$)/\n$1/gos;
       
   422     }
       
   423     if ($newLine) {
       
   424         $newLine =~ s/\$n\(\)/\n/gos;                # expand "$n()" to new line
       
   425         $newLine =~ s/\$n([^$mixedAlpha]|$)/\n$1/gos;
       
   426     }
       
   427 
       
   428     my $searchResult = '';
       
   429     my $homeWeb      = $session->{webName};
       
   430     my $homeTopic    = $TWiki::cfg{HomeTopicName};
       
   431     my $store        = $session->{store};
       
   432 
       
   433     my %excludeWeb;
       
   434     my @tmpWebs;
       
   435 
       
   436     # A value of 'all' or 'on' by itself gets all webs,
       
   437     # otherwise ignored (unless there is a web called 'All'.)
       
   438     my $searchAllFlag = ( $webName =~ /(^|[\,\s])(all|on)([\,\s]|$)/i );
       
   439 
       
   440     if ($webName) {
       
   441         foreach my $web ( split( /[\,\s]+/, $webName ) ) {
       
   442             $web =~ s#\.#/#go;
       
   443 
       
   444             # the web processing loop filters for valid web names,
       
   445             # so don't do it here.
       
   446             if ( $web =~ s/^-// ) {
       
   447                 $excludeWeb{$web} = 1;
       
   448             }
       
   449             else {
       
   450                 push( @tmpWebs, $web );
       
   451                 if ( TWiki::isTrue($recurse) || $web =~ /^(all|on)$/i ) {
       
   452                     my $webarg = ( $web =~ /^(all|on)$/i ) ? undef: $web;
       
   453                     push( @tmpWebs,
       
   454                         $store->getListOfWebs( 'user,allowed', $webarg ) );
       
   455                 }
       
   456             }
       
   457         }
       
   458 
       
   459     }
       
   460     else {
       
   461 
       
   462         # default to current web
       
   463         push( @tmpWebs, $session->{webName} );
       
   464         if ( TWiki::isTrue($recurse) ) {
       
   465             push( @tmpWebs,
       
   466                 $store->getListOfWebs( 'user,allowed', $session->{webName} ) );
       
   467         }
       
   468     }
       
   469 
       
   470     my @webs;
       
   471     foreach my $web (@tmpWebs) {
       
   472         push( @webs, $web ) unless $excludeWeb{$web};
       
   473         $excludeWeb{$web} = 1;
       
   474     }
       
   475 
       
   476     # E.g. "Bug*, *Patch" ==> "^(Bug.*|.*Patch)$"
       
   477     $topic = _makeTopicPattern($topic);
       
   478 
       
   479     # E.g. "Web*, FooBar" ==> "^(Web.*|FooBar)$"
       
   480     $excludeTopic = _makeTopicPattern($excludeTopic);
       
   481 
       
   482     my $output = '';
       
   483     my $tmpl   = '';
       
   484 
       
   485     my $originalSearch = $searchString;
       
   486     my $spacedTopic;
       
   487 
       
   488     if ($format) {
       
   489         $template = 'searchformat';
       
   490     }
       
   491     elsif ($template) {
       
   492 
       
   493         # template definition overrides book and rename views
       
   494     }
       
   495     elsif ($doBookView) {
       
   496         $template = 'searchbookview';
       
   497     }
       
   498     else {
       
   499         $template = 'search';
       
   500     }
       
   501     $tmpl = $session->templates->readTemplate($template);
       
   502 
       
   503     # SMELL: the only META tags in a template will be METASEARCH
       
   504     # Why the heck are they being filtered????
       
   505     $tmpl =~ s/\%META{.*?}\%//go;    # remove %META{'parent'}%
       
   506 
       
   507     # Split template into 5 sections
       
   508     my ( $tmplHead, $tmplSearch, $tmplTable, $tmplNumber, $tmplTail ) =
       
   509       split( /%SPLIT%/, $tmpl );
       
   510 
       
   511     # Invalid template?
       
   512     if ( !$tmplTail ) {
       
   513         my $mess =
       
   514             CGI::h1('TWiki Installation Error')
       
   515           . 'Incorrect format of '
       
   516           . $template
       
   517           . ' template (missing sections? There should be 4 %SPLIT% tags)';
       
   518         if ( defined $callback ) {
       
   519             &$callback( $cbdata, $mess );
       
   520             return undef;
       
   521         }
       
   522         else {
       
   523             return $mess;
       
   524         }
       
   525     }
       
   526 
       
   527     # Expand tags in template sections
       
   528     $tmplSearch =
       
   529       $session->handleCommonTags( $tmplSearch, $homeWeb, $homeTopic );
       
   530     $tmplNumber =
       
   531       $session->handleCommonTags( $tmplNumber, $homeWeb, $homeTopic );
       
   532 
       
   533     # If not inline search, also expand tags in head and tail sections
       
   534     unless ($inline) {
       
   535         $tmplHead =
       
   536           $session->handleCommonTags( $tmplHead, $homeWeb, $homeTopic );
       
   537 
       
   538         if ( defined $callback ) {
       
   539             $tmplHead =
       
   540               $renderer->getRenderedVersion( $tmplHead, $homeWeb, $homeTopic );
       
   541             $tmplHead =~ s|</*nop/*>||goi;    # remove <nop> tags
       
   542             &$callback( $cbdata, $tmplHead );
       
   543         }
       
   544         else {
       
   545 
       
   546             # don't getRenderedVersion; this will be done by a single
       
   547             # call at the end.
       
   548             $searchResult .= $tmplHead;
       
   549         }
       
   550     }
       
   551 
       
   552     # Generate 'Search:' part showing actual search string used
       
   553     unless ($noSearch) {
       
   554         my $searchStr = $searchString;
       
   555         $searchStr  =~ s/&/&amp;/go;
       
   556         $searchStr  =~ s/</&lt;/go;
       
   557         $searchStr  =~ s/>/&gt;/go;
       
   558         $searchStr  =~ s/^\.\*$/Index/go;
       
   559         $tmplSearch =~ s/%SEARCHSTRING%/$searchStr/go;
       
   560         if ( defined $callback ) {
       
   561             $tmplSearch =
       
   562               $renderer->getRenderedVersion( $tmplSearch, $homeWeb,
       
   563                 $homeTopic );
       
   564             $tmplSearch =~ s|</*nop/*>||goi;    # remove <nop> tag
       
   565             &$callback( $cbdata, $tmplSearch );
       
   566         }
       
   567         else {
       
   568 
       
   569             # don't getRenderedVersion; will be done later
       
   570             $searchResult .= $tmplSearch;
       
   571         }
       
   572     }
       
   573 
       
   574     # Write log entry
       
   575     # FIXME: Move log entry further down to log actual webs searched
       
   576     if ( ( $TWiki::cfg{Log}{search} ) && ( !$inline ) ) {
       
   577         my $t = join( ' ', @webs );
       
   578         $session->writeLog( 'search', $t, $searchString );
       
   579     }
       
   580 
       
   581     my $query;
       
   582     my @tokens;
       
   583 
       
   584     if( $type eq 'query' ) {
       
   585         unless( defined( $queryParser )) {
       
   586             require TWiki::Query::Parser;
       
   587             $queryParser = new TWiki::Query::Parser();
       
   588         }
       
   589         my $error = '';
       
   590         try {
       
   591             $query = $queryParser->parse( $searchString );
       
   592         } catch TWiki::Infix::Error with {
       
   593             # Pass the error on to the caller
       
   594             throw Error::Simple( shift->stringify());
       
   595         };
       
   596         return $error unless $query;
       
   597     } else {
       
   598         # Split the search string into tokens depending on type of search -
       
   599         # each token is ANDed together by actual search
       
   600         @tokens = _tokensFromSearchString( $this, $searchString, $type );
       
   601         return '' unless scalar(@tokens);
       
   602     }
       
   603 
       
   604     # Loop through webs
       
   605     my $isAdmin = $session->{users}->isAdmin( $session->{user} );
       
   606     my $ttopics = 0;
       
   607     my $prefs = $session->{prefs};
       
   608     foreach my $web (@webs) {
       
   609         $web =~ s/$TWiki::cfg{NameFilter}//go;
       
   610         $web = TWiki::Sandbox::untaintUnchecked($web);
       
   611 
       
   612         next unless $store->webExists($web);    # can't process what ain't thar
       
   613 
       
   614         my $thisWebNoSearchAll =
       
   615           $prefs->getWebPreferencesValue( 'NOSEARCHALL', $web ) || '';
       
   616 
       
   617         # make sure we can report this web on an 'all' search
       
   618         # DON'T filter out unless it's part of an 'all' search.
       
   619         next
       
   620           if ( $searchAllFlag
       
   621             && !$isAdmin
       
   622             && ( $thisWebNoSearchAll =~ /on/i || $web =~ /^[\.\_]/ )
       
   623             && $web ne $session->{webName} );
       
   624 
       
   625         my $options = {
       
   626             caseSensitive  => $caseSensitive,
       
   627             wordBoundaries => $wordBoundaries,
       
   628         };
       
   629 
       
   630         # Run the search on topics in this web
       
   631         my @topicList = _getTopicList($this, $web, $topic, $options);
       
   632 
       
   633         # exclude topics, Codev.ExcludeWebTopicsFromSearch
       
   634         if ( $caseSensitive && $excludeTopic ) {
       
   635             @topicList = grep( !/$excludeTopic/, @topicList );
       
   636         }
       
   637         elsif ($excludeTopic) {
       
   638             @topicList = grep( !/$excludeTopic/i, @topicList );
       
   639         }
       
   640         next if ( $noEmpty && !@topicList );    # Nothing to show for this web
       
   641 
       
   642         if ($type eq 'query' ) {
       
   643             @topicList = _queryTopics(
       
   644                 $this, $web, $query, @topicList );
       
   645         } else {
       
   646             @topicList = _searchTopics(
       
   647                 $this, $web, $scope, $type, $options, \@tokens, @topicList );
       
   648         }
       
   649 
       
   650         my $topicInfo = {};
       
   651 
       
   652         # sort the topic list by date, author or topic name, and cache the
       
   653         # info extracted to do the sorting
       
   654         if ( $sortOrder eq 'modified' ) {
       
   655 
       
   656             # For performance:
       
   657             #   * sort by approx time (to get a rough list)
       
   658             #   * shorten list to the limit + some slack
       
   659             #   * sort by rev date on shortened list to get the accurate list
       
   660             # SMELL: Ciaro had efficient two stage handling of modified sort.
       
   661             # SMELL: In Dakar this seems to be pointless since latest rev
       
   662             # time is taken from topic instead of dir list.
       
   663             my $slack = 10;
       
   664             if ( $limit + 2 * $slack < scalar(@topicList) ) {
       
   665 
       
   666                 # sort by approx latest rev time
       
   667                 my @tmpList =
       
   668                   map  { $_->[1] }
       
   669                   sort { $a->[0] <=> $b->[0] }
       
   670                   map  { [ $store->getTopicLatestRevTime( $web, $_ ), $_ ] }
       
   671                   @topicList;
       
   672                 @tmpList = reverse(@tmpList) if ($revSort);
       
   673 
       
   674                 # then shorten list and build the hashes for date and author
       
   675                 my $idx = $limit + $slack;
       
   676                 @topicList = ();
       
   677                 foreach (@tmpList) {
       
   678                     push( @topicList, $_ );
       
   679                     $idx -= 1;
       
   680                     last if $idx <= 0;
       
   681                 }
       
   682             }
       
   683 
       
   684             $topicInfo =
       
   685               _sortTopics( $this, $web, \@topicList, $sortOrder, !$revSort );
       
   686         }
       
   687         elsif (
       
   688             $sortOrder =~ /^creat/ ||    # topic creation time
       
   689             $sortOrder eq 'editby' ||    # author
       
   690             $sortOrder =~ s/^formfield\((.*)\)$/$1/    # form field
       
   691           )
       
   692         {
       
   693 
       
   694             $topicInfo =
       
   695               _sortTopics( $this, $web, \@topicList, $sortOrder, !$revSort );
       
   696 
       
   697         }
       
   698         else {
       
   699 
       
   700             # simple sort, see Codev.SchwartzianTransformMisused
       
   701             # note no extraction of topic info here, as not needed
       
   702             # for the sort. Instead it will be read lazily, later on.
       
   703             if ($revSort) {
       
   704                 @topicList = sort { $b cmp $a } @topicList;
       
   705             }
       
   706             else {
       
   707                 @topicList = sort { $a cmp $b } @topicList;
       
   708             }
       
   709         }
       
   710 
       
   711         if ($date) {
       
   712             require TWiki::Time;
       
   713             my @ends       = TWiki::Time::parseInterval($date);
       
   714             my @resultList = ();
       
   715             foreach my $topic (@topicList) {
       
   716 
       
   717                 # if date falls out of interval: exclude topic from result
       
   718                 my $topicdate = $store->getTopicLatestRevTime( $web, $topic );
       
   719                 push( @resultList, $topic )
       
   720                   unless ( $topicdate < $ends[0] || $topicdate > $ends[1] );
       
   721             }
       
   722             @topicList = @resultList;
       
   723         }
       
   724 
       
   725         # header and footer of $web
       
   726         my ( $beforeText, $repeatText, $afterText ) =
       
   727           split( /%REPEAT%/, $tmplTable );
       
   728         if ( defined $header ) {
       
   729             $beforeText = TWiki::expandStandardEscapes($header);
       
   730             $beforeText =~ s/\$web/$web/gos;    # expand name of web
       
   731             if ( defined($separator) ) {
       
   732                 $beforeText .= $separator;
       
   733             }
       
   734             else {
       
   735                 $beforeText =~
       
   736                   s/([^\n])$/$1\n/os;           # add new line at end if needed
       
   737             }
       
   738         }
       
   739 
       
   740         # output the list of topics in $web
       
   741         my $ntopics    = 0;
       
   742         my $headerDone = $noHeader;
       
   743         foreach my $topic (@topicList) {
       
   744             my $forceRendering = 0;
       
   745             unless ( exists( $topicInfo->{$topic} ) ) {
       
   746 
       
   747                 # not previously cached
       
   748                 $topicInfo->{$topic} =
       
   749                   _extractTopicInfo( $this, $web, $topic, 0, undef );
       
   750             }
       
   751             my $epochSecs = $topicInfo->{$topic}->{modified};
       
   752             require TWiki::Time;
       
   753             my $revDate   = TWiki::Time::formatTime($epochSecs);
       
   754             my $isoDate =
       
   755               TWiki::Time::formatTime( $epochSecs, '$iso', 'gmtime' );
       
   756 
       
   757             my $ru     = $topicInfo->{$topic}->{editby} || 'UnknownUser';
       
   758             my $revNum = $topicInfo->{$topic}->{revNum} || 0;
       
   759 
       
   760             # Check security
       
   761             # FIXME - how do we deal with user login not being available if
       
   762             # coming from search script?
       
   763             my $allowView = $topicInfo->{$topic}->{allowView};
       
   764             next unless $allowView;
       
   765 
       
   766             my ( $meta, $text );
       
   767 
       
   768             # Special handling for format='...'
       
   769             if ($format) {
       
   770                 ( $meta, $text ) =
       
   771                   _getTextAndMeta( $this, $topicInfo, $web, $topic );
       
   772 
       
   773                 if ($doExpandVars) {
       
   774                     if ( $web eq $baseWeb && $topic eq $baseTopic ) {
       
   775 
       
   776                         # primitive way to prevent recursion
       
   777                         $text =~ s/%SEARCH/%<nop>SEARCH/g;
       
   778                     }
       
   779                     $text =
       
   780                       $session->handleCommonTags( $text, $web, $topic, $meta );
       
   781                 }
       
   782             }
       
   783 
       
   784             my @multipleHitLines = ();
       
   785             if ($doMultiple) {
       
   786                 my $pattern = $tokens[$#tokens];   # last token in an AND search
       
   787                 $pattern = quotemeta($pattern) if ( $type ne 'regex' );
       
   788                 ( $meta, $text ) =
       
   789                   _getTextAndMeta( $this, $topicInfo, $web, $topic )
       
   790                   unless $text;
       
   791                 if ($caseSensitive) {
       
   792                     @multipleHitLines =
       
   793                       reverse grep { /$pattern/ } split( /[\n\r]+/, $text );
       
   794                 }
       
   795                 else {
       
   796                     @multipleHitLines =
       
   797                       reverse grep { /$pattern/i } split( /[\n\r]+/, $text );
       
   798                 }
       
   799             }
       
   800 
       
   801             # SMELL: this loop is a rather hairy; why not do it thus:
       
   802             # while(scalar(@multipleHitLines))?
       
   803             # presumably you are relying on the fact that text will be set
       
   804             # when doMultiple is off, even though @multipleHitLines will
       
   805             # be empty? I can't work it out.
       
   806             do {    # multiple=on loop
       
   807 
       
   808                 my $out = '';
       
   809 
       
   810                 $text = pop(@multipleHitLines) if ( scalar(@multipleHitLines) );
       
   811 
       
   812                 if ($format) {
       
   813                     $out = $format;
       
   814                     $out =~ s/\$web/$web/gs;
       
   815                     $out =~
       
   816 s/\$topic\(([^\)]*)\)/TWiki::Render::breakName( $topic, $1 )/ges;
       
   817                     $out =~ s/\$topic/$topic/gs;
       
   818                     $out =~ s/\$date/$revDate/gs;
       
   819                     $out =~ s/\$isodate/$isoDate/gs;
       
   820                     $out =~ s/\$rev/$revNum/gs;
       
   821                     $out =~ s/\$wikiusername/$users->webDotWikiName($ru)/ges;
       
   822                     $out =~ s/\$wikiname/$users->getWikiName($ru)/ges;
       
   823                     $out =~ s/\$username/$users->getLoginName($ru)/ges;
       
   824                     my $r1info = {};
       
   825                     $out =~
       
   826 s/\$createdate/_getRev1Info( $this, $web, $topic, 'date', $r1info )/ges;
       
   827                     $out =~
       
   828 s/\$createusername/_getRev1Info( $this, $web, $topic, 'username', $r1info )/ges;
       
   829                     $out =~
       
   830 s/\$createwikiname/_getRev1Info( $this, $web, $topic, 'wikiname', $r1info )/ges;
       
   831                     $out =~
       
   832 s/\$createwikiusername/_getRev1Info( $this, $web, $topic, 'wikiusername', $r1info )/ges;
       
   833 
       
   834                     if ( $out =~ m/\$text/ ) {
       
   835                         ( $meta, $text ) =
       
   836                           _getTextAndMeta( $this, $topicInfo, $web, $topic )
       
   837                           unless $text;
       
   838                         if ( $topic eq $session->{topicName} ) {
       
   839 
       
   840                             # defuse SEARCH in current topic to prevent loop
       
   841                             $text =~ s/%SEARCH{.*?}%/SEARCH{...}/go;
       
   842                         }
       
   843                         $out =~ s/\$text/$text/gos;
       
   844                         $forceRendering = 1 unless ($doMultiple);
       
   845                     }
       
   846                 }
       
   847                 else {
       
   848                     $out = $repeatText;
       
   849                 }
       
   850                 $out =~ s/%WEB%/$web/go;
       
   851                 $out =~ s/%TOPICNAME%/$topic/go;
       
   852                 $out =~ s/%TIME%/$revDate/o;
       
   853 
       
   854                 my $srev = 'r' . $revNum;
       
   855                 if ( $revNum eq '0' || $revNum eq '1' ) {
       
   856                     $srev = CGI::span( { class => 'twikiNew' },
       
   857                         ( $this->{session}->i18n->maketext('NEW') ) );
       
   858                 }
       
   859                 $out =~ s/%REVISION%/$srev/o;
       
   860                 $out =~ s/%AUTHOR%/$users->webDotWikiName($ru)/e;
       
   861 
       
   862                 if ($doBookView) {
       
   863 
       
   864                     # BookView
       
   865                     ( $meta, $text ) =
       
   866                       _getTextAndMeta( $this, $topicInfo, $web, $topic )
       
   867                       unless $text;
       
   868                     if ( $web eq $baseWeb && $topic eq $baseTopic ) {
       
   869 
       
   870                         # primitive way to prevent recursion
       
   871                         $text =~ s/%SEARCH/%<nop>SEARCH/g;
       
   872                     }
       
   873                     $text =
       
   874                       $session->handleCommonTags( $text, $web, $topic, $meta );
       
   875                     $text =
       
   876                       $session->renderer
       
   877                       ->getRenderedVersion( $text, $web, $topic );
       
   878 
       
   879                     # FIXME: What about meta data rendering?
       
   880                     $out =~ s/%TEXTHEAD%/$text/go;
       
   881 
       
   882                 }
       
   883                 elsif ($format) {
       
   884                     $out =~
       
   885 s/\$summary(?:\(([^\)]*)\))?/$renderer->makeTopicSummary( $text, $topic, $web, $1 )/ges;
       
   886                     $out =~
       
   887 s/\$changes(?:\(([^\)]*)\))?/$renderer->summariseChanges($ru,$web,$topic,$1,$revNum)/ges;
       
   888                     $out =~
       
   889 s/\$formfield\(\s*([^\)]*)\s*\)/displayFormField( $meta, $1 )/ges;
       
   890                     $out =~
       
   891 s/\$parent\(([^\)]*)\)/TWiki::Render::breakName( $meta->getParent(), $1 )/ges;
       
   892                     $out =~ s/\$parent/$meta->getParent()/ges;
       
   893                     $out =~ s/\$formname/$meta->getFormName()/ges;
       
   894                     $out =~
       
   895                       s/\$count\((.*?\s*\.\*)\)/_countPattern( $text, $1 )/ges;
       
   896 
       
   897    # FIXME: Allow all regex characters but escape them
       
   898    # Note: The RE requires a .* at the end of a pattern to avoid false positives
       
   899    # in pattern matching
       
   900                     $out =~
       
   901 s/\$pattern\((.*?\s*\.\*)\)/getTextPattern( $text, $1 )/ges;
       
   902                     $out =~ s/\r?\n/$newLine/gos if ($newLine);
       
   903                     if ( defined($separator) ) {
       
   904                         $out .= $separator;
       
   905                     }
       
   906                     else {
       
   907 
       
   908                         # add new line at end if needed
       
   909                         # SMELL: why?
       
   910                         $out =~ s/([^\n])$/$1\n/s;
       
   911                     }
       
   912 
       
   913                     $out = TWiki::expandStandardEscapes($out);
       
   914 
       
   915                 }
       
   916                 elsif ($noSummary) {
       
   917                     $out =~ s/%TEXTHEAD%//go;
       
   918                     $out =~ s/&nbsp;//go;
       
   919 
       
   920                 }
       
   921                 else {
       
   922 
       
   923                     # regular search view
       
   924                     ( $meta, $text ) =
       
   925                       _getTextAndMeta( $this, $topicInfo, $web, $topic )
       
   926                       unless $text;
       
   927                     $text = $renderer->makeTopicSummary( $text, $topic, $web );
       
   928                     $out =~ s/%TEXTHEAD%/$text/go;
       
   929                 }
       
   930 
       
   931                 # lazy output of header (only if needed for the first time)
       
   932                 unless ($headerDone) {
       
   933                     $headerDone = 1;
       
   934                     my $prefs = $session->{prefs};
       
   935                     my $thisWebBGColor =
       
   936                       $prefs->getWebPreferencesValue( 'WEBBGCOLOR', $web )
       
   937                       || '\#FF00FF';
       
   938                     $beforeText =~ s/%WEBBGCOLOR%/$thisWebBGColor/go;
       
   939                     $beforeText =~ s/%WEB%/$web/go;
       
   940                     $beforeText =
       
   941                       $session->handleCommonTags( $beforeText, $web, $topic );
       
   942                     if ( defined $callback ) {
       
   943                         $beforeText =
       
   944                           $renderer->getRenderedVersion( $beforeText, $web,
       
   945                             $topic );
       
   946                         $beforeText =~ s|</*nop/*>||goi;    # remove <nop> tag
       
   947                         &$callback( $cbdata, $beforeText );
       
   948                     }
       
   949                     else {
       
   950                         $searchResult .= $beforeText;
       
   951                     }
       
   952                 }
       
   953 
       
   954              #don't expand if a format is specified - it breaks tables and stuff
       
   955                 unless ($format) {
       
   956                     $out = $renderer->getRenderedVersion( $out, $web, $topic );
       
   957                 }
       
   958 
       
   959                 # output topic (or line if multiple=on)
       
   960                 if ( defined $callback ) {
       
   961                     $out =~ s|</*nop/*>||goi;    # remove <nop> tag
       
   962                     &$callback( $cbdata, $out );
       
   963                 }
       
   964                 else {
       
   965                     $searchResult .= $out;
       
   966                 }
       
   967 
       
   968             } while (@multipleHitLines);    # multiple=on loop
       
   969 
       
   970             $ntopics += 1;
       
   971             $ttopics += 1;
       
   972 
       
   973             # delete topic info to clear any cached data
       
   974             undef $topicInfo->{$topic};
       
   975 
       
   976             last if ( $ntopics >= $limit );
       
   977         }    # end topic loop
       
   978 
       
   979         # output footer only if hits in web
       
   980         if ($ntopics) {
       
   981 
       
   982             # output footer of $web
       
   983             $afterText =
       
   984               $session->handleCommonTags( $afterText, $web, $homeTopic );
       
   985             if ( $inline || $format ) {
       
   986                 $afterText =~ s/\n$//os;    # remove trailing new line
       
   987             }
       
   988 
       
   989             if ( defined $callback ) {
       
   990                 $afterText =
       
   991                   $renderer->getRenderedVersion( $afterText, $web, $homeTopic );
       
   992                 $afterText =~ s|</*nop/*>||goi;    # remove <nop> tag
       
   993                 &$callback( $cbdata, $afterText );
       
   994             }
       
   995             else {
       
   996                 $searchResult .= $afterText;
       
   997             }
       
   998         }
       
   999 
       
  1000         # output number of topics (only if hits in web or if
       
  1001         # only searching one web)
       
  1002         if ( $ntopics || scalar(@webs) < 2 ) {
       
  1003             unless ($noTotal) {
       
  1004                 my $thisNumber = $tmplNumber;
       
  1005                 $thisNumber =~ s/%NTOPICS%/$ntopics/go;
       
  1006                 if ( defined $callback ) {
       
  1007                     $thisNumber =
       
  1008                       $renderer->getRenderedVersion( $thisNumber, $web,
       
  1009                         $homeTopic );
       
  1010                     $thisNumber =~ s|</*nop/*>||goi;    # remove <nop> tag
       
  1011                     &$callback( $cbdata, $thisNumber );
       
  1012                 }
       
  1013                 else {
       
  1014                     $searchResult .= $thisNumber;
       
  1015                 }
       
  1016             }
       
  1017         }
       
  1018     }    # end of: foreach my $web ( @webs )
       
  1019     return '' if ( $ttopics == 0 && $zeroResults );
       
  1020 
       
  1021     if ( $format && !$finalTerm ) {
       
  1022         if ($separator) {
       
  1023             $separator = quotemeta($separator);
       
  1024             $searchResult =~ s/$separator$//s;    # remove separator at end
       
  1025         }
       
  1026         else {
       
  1027             $searchResult =~ s/\n$//os;           # remove trailing new line
       
  1028         }
       
  1029     }
       
  1030 
       
  1031     unless ($inline) {
       
  1032         $tmplTail =
       
  1033           $session->handleCommonTags( $tmplTail, $homeWeb, $homeTopic );
       
  1034 
       
  1035         if ( defined $callback ) {
       
  1036             $tmplTail =
       
  1037               $renderer->getRenderedVersion( $tmplTail, $homeWeb, $homeTopic );
       
  1038             $tmplTail =~ s|</*nop/*>||goi;        # remove <nop> tag
       
  1039             &$callback( $cbdata, $tmplTail );
       
  1040         }
       
  1041         else {
       
  1042             $searchResult .= $tmplTail;
       
  1043         }
       
  1044     }
       
  1045 
       
  1046     return undef         if ( defined $callback );
       
  1047     return $searchResult if $inline;
       
  1048 
       
  1049     $searchResult =
       
  1050       $session->handleCommonTags( $searchResult, $homeWeb, $homeTopic );
       
  1051     $searchResult =
       
  1052       $renderer->getRenderedVersion( $searchResult, $homeWeb, $homeTopic );
       
  1053 
       
  1054     return $searchResult;
       
  1055 }
       
  1056 
       
  1057 # extract topic info required for sorting and sort.
       
  1058 sub _sortTopics {
       
  1059     my ( $this, $web, $topics, $sortfield, $revSort ) = @_;
       
  1060 
       
  1061     my $topicInfo = {};
       
  1062     foreach my $topic (@$topics) {
       
  1063         $topicInfo->{$topic} =
       
  1064           _extractTopicInfo( $this, $web, $topic, $sortfield );
       
  1065     }
       
  1066     if ($revSort) {
       
  1067         @$topics = map { $_->[1] }
       
  1068           sort { _compare( $b->[0], $a->[0] ) }
       
  1069           map { [ $topicInfo->{$_}->{$sortfield}, $_ ] } @$topics;
       
  1070     }
       
  1071     else {
       
  1072         @$topics = map { $_->[1] }
       
  1073           sort { _compare( $a->[0], $b->[0] ) }
       
  1074           map { [ $topicInfo->{$_}->{$sortfield}, $_ ] } @$topics;
       
  1075     }
       
  1076 
       
  1077     return $topicInfo;
       
  1078 }
       
  1079 
       
  1080 # RE for a full-spec floating-point number
       
  1081 my $number = qr/^[-+]?[0-9]+(\.[0-9]*)?([Ee][-+]?[0-9]+)?$/s;
       
  1082 
       
  1083 sub _compare {
       
  1084     if ( $_[0] =~ /$number/o && $_[1] =~ /$number/o ) {
       
  1085 
       
  1086         # when sorting numbers do it largest first; this is just because
       
  1087         # this is what date comparisons need.
       
  1088         return $_[1] <=> $_[0];
       
  1089     }
       
  1090     else {
       
  1091         return $_[1] cmp $_[0];
       
  1092     }
       
  1093 }
       
  1094 
       
  1095 # extract topic info
       
  1096 sub _extractTopicInfo {
       
  1097     my ( $this, $web, $topic, $sortfield ) = @_;
       
  1098     my $info    = {};
       
  1099     my $session = $this->{session};
       
  1100     my $store   = $session->{store};
       
  1101     my $users   = $this->{session}->{users};
       
  1102 
       
  1103     my ( $meta, $text ) = _getTextAndMeta( $this, undef, $web, $topic );
       
  1104 
       
  1105     $info->{text} = $text;
       
  1106     $info->{meta} = $meta;
       
  1107 
       
  1108     my ( $revdate, $revuser, $revnum ) = $meta->getRevisionInfo();
       
  1109     $info->{editby}   = $revuser || '';
       
  1110     $info->{modified} = $revdate;
       
  1111     $info->{revNum}   = $revnum;
       
  1112 
       
  1113     $info->{allowView} =
       
  1114       $session->security
       
  1115       ->checkAccessPermission( 'VIEW', $session->{user}, $text, $meta, $topic,
       
  1116         $web );
       
  1117 
       
  1118     return $info unless $sortfield;
       
  1119 
       
  1120     if ( $sortfield =~ /^creat/ ) {
       
  1121         ( $info->{$sortfield} ) = $meta->getRevisionInfo(1);
       
  1122     }
       
  1123     elsif ( !defined( $info->{$sortfield} ) ) {
       
  1124         $info->{$sortfield} = displayFormField( $meta, $sortfield );
       
  1125     }
       
  1126 
       
  1127     return $info;
       
  1128 }
       
  1129 
       
  1130 # get the text and meta for a topic
       
  1131 sub _getTextAndMeta {
       
  1132     my ( $this, $topicInfo, $web, $topic ) = @_;
       
  1133     my ( $meta, $text );
       
  1134     my $store = $this->{session}->{store};
       
  1135 
       
  1136     # read from cache if it's there
       
  1137     if ($topicInfo) {
       
  1138         $text = $topicInfo->{$topic}->{text};
       
  1139         $meta = $topicInfo->{$topic}->{meta};
       
  1140     }
       
  1141 
       
  1142     unless ( defined $text ) {
       
  1143         ( $meta, $text ) = $store->readTopic( undef, $web, $topic, undef );
       
  1144         $text =~ s/%WEB%/$web/gos;
       
  1145         $text =~ s/%TOPIC%/$topic/gos;
       
  1146     }
       
  1147     return ( $meta, $text );
       
  1148 }
       
  1149 
       
  1150 =pod
       
  1151 
       
  1152 ---++ StaticMethod displayFormField( $meta, $args ) -> $text
       
  1153 
       
  1154 Parse the arguments to a $formfield specification and extract
       
  1155 the relevant formfield from the given meta data.
       
  1156 
       
  1157    * =args= string containing name of form field
       
  1158 
       
  1159 In addition to the name of a field =args= can be appended with a commas
       
  1160 followed by a string format (\d+)([,\s*]\.\.\.)?). This supports the formatted
       
  1161 search function $formfield and is used to shorten the returned string or a 
       
  1162 hyphenated string.
       
  1163 
       
  1164 =cut
       
  1165 
       
  1166 sub displayFormField {
       
  1167     my( $meta, $args ) = @_;
       
  1168 
       
  1169     my $name = $args;
       
  1170     my $breakArgs = '';
       
  1171     my @params = split( /\,\s*/, $args, 2 );
       
  1172     if( @params > 1 ) {
       
  1173         $name = $params[0] || '';
       
  1174         $breakArgs = $params[1] || 1;
       
  1175     }
       
  1176 
       
  1177     return $meta->renderFormFieldForDisplay(
       
  1178         $name, '$value', { break => $breakArgs, protectdollar => 1 } );
       
  1179 }
       
  1180 
       
  1181 # Returns the topic revision info of the base version,
       
  1182 # attributes are 'date', 'username', 'wikiname',
       
  1183 # 'wikiusername'. Revision info is cached in the search
       
  1184 # object for speed.
       
  1185 sub _getRev1Info {
       
  1186     my ( $this, $web, $topic, $attr, $info ) = @_;
       
  1187     my $key   = $web . '.' . $topic;
       
  1188     my $store = $this->{session}->{store};
       
  1189     my $users = $this->{session}->{users};
       
  1190 
       
  1191     unless ( $info->{webTopic} && $info->{webTopic} eq $key ) {
       
  1192         require TWiki::Meta;
       
  1193         my $meta = new TWiki::Meta( $this->{session}, $web, $topic );
       
  1194         my ( $d, $u ) = $meta->getRevisionInfo(1);
       
  1195         $info->{date}     = $d;
       
  1196         $info->{user}     = $u;
       
  1197         $info->{webTopic} = $key;
       
  1198     }
       
  1199     if ( $attr eq 'username' ) {
       
  1200         return $users->getLoginName( $info->{user} );
       
  1201     }
       
  1202     if ( $attr eq 'wikiname' ) {
       
  1203         return $users->getWikiName( $info->{user} );
       
  1204     }
       
  1205     if ( $attr eq 'wikiusername' ) {
       
  1206         return $users->webDotWikiName( $info->{user} );
       
  1207     }
       
  1208     if ( $attr eq 'date' ) {
       
  1209         require TWiki::Time;
       
  1210         return TWiki::Time::formatTime( $info->{date} );
       
  1211     }
       
  1212 
       
  1213     return 1;
       
  1214 }
       
  1215 
       
  1216 # With the same argument as $pattern, returns a number which is the count of
       
  1217 # occurences of the pattern argument.
       
  1218 sub _countPattern {
       
  1219     my ( $theText, $thePattern ) = @_;
       
  1220 
       
  1221     $thePattern =~
       
  1222       s/([^\\])([\$\@\%\&\#\'\`\/])/$1\\$2/go;    # escape some special chars
       
  1223     $thePattern =~ /(.*)/;                        # untaint
       
  1224     $thePattern = $1;
       
  1225     my $OK = 0;
       
  1226     eval {
       
  1227 
       
  1228         # counting hack, see: http://dev.perl.org/perl6/rfc/110.html
       
  1229         $OK = () = $theText =~ /$thePattern/g;
       
  1230     };
       
  1231 
       
  1232     return $OK;
       
  1233 }
       
  1234 
       
  1235 1;
       
  1236 __DATA__
       
  1237 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
  1238 #
       
  1239 # Copyright (C) 2000-2007 Peter Thoeny, peter@thoeny.org
       
  1240 # and TWiki Contributors. All Rights Reserved. TWiki Contributors
       
  1241 # are listed in the AUTHORS file in the root of this distribution.
       
  1242 # NOTE: Please extend that file, not this notice.
       
  1243 #
       
  1244 # This program is free software; you can redistribute it and/or
       
  1245 # modify it under the terms of the GNU General Public License
       
  1246 # as published by the Free Software Foundation; either version 2
       
  1247 # of the License, or (at your option) any later version. For
       
  1248 # more details read LICENSE in the root of this distribution.
       
  1249 #
       
  1250 # This program is distributed in the hope that it will be useful,
       
  1251 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
  1252 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
  1253 #
       
  1254 # As per the GPL, removal of this notice is prohibited.