*** TablePlugin.pm.20031230 Wed Dec 31 20:14:54 2003 --- TablePlugin.pm Wed Dec 31 20:47:38 2003 *************** *** 107,112 **** --- 107,126 ---- } # ========================= + sub commonTagsHandler + { + ### my ( $text, $topic, $web ) = @_; # do not uncomment, use $_[0], $_[1]... instead + + #&TWiki::Func::writeDebug( "- TablePlugin::commonTagsHandler( $_[2].$_[1] )" ) if $debug; + + # This is the place to define customized tags and variables + # Called by sub handleCommonTags, after %INCLUDE:"..."% + + # do custom extension rule, like for example: + $_[0] =~ s/%METATABLESEARCH{(.*?)}%/&handleTableSearchWeb($1)/geo; + } + + # ========================= sub outsidePREHandler { ### my ( $text ) = @_; # do not uncomment, use $_[0] instead *************** *** 726,730 **** --- 740,1115 ---- # END -- Table Entry Code Built into TablePlugin.pm library # + # + # START -- %METATABLESEARCH{...}% + # + + # ========================= + sub handleTableSearchWeb + { + my( $attributes ) = @_; + my $searchVal = TWiki::Func::extractNameValuePair( $attributes ); + if( ! $searchVal ) { + # %METATABLESEARCH{"string" ...} not found, try + # %METATABLESEARCH{search="string" ...} + $searchVal = TWiki::Func::extractNameValuePair( $attributes, "search" ); + } + + my $attrWeb = TWiki::Func::extractNameValuePair( $attributes, "web" ); + my $attrReverse = TWiki::Func::extractNameValuePair( $attributes, "reverse" ); + my $attrCasesensitive = TWiki::Func::extractNameValuePair( $attributes, "casesensitive" ); + my $attrShowlock = TWiki::Func::extractNameValuePair( $attributes, "showlock" ); + my $attrNoEmpty = TWiki::Func::extractNameValuePair( $attributes, "noempty" ); + my $attrHeader = TWiki::Func::extractNameValuePair( $attributes, "header" ); + my $attrFormat = TWiki::Func::extractNameValuePair( $attributes, "format" ); + my $attrNewline = TWiki::Func::extractNameValuePair( $attributes, "newline" ); + + #TWiki::writeDebug("Newline=$attrNewline"); + $attrNewline = ($attrNewline eq "true") ? "2":"1"; + #TWiki::writeDebug("Newline=$attrNewline"); + + + return searchWebTables( $attrNewline, $attrWeb, $searchVal, + $attrCasesensitive, $attrShowlock, $attrNoEmpty, "", $attrHeader, $attrFormat + ); + } + + # =========================== + # Normally writes no output, uncomment writeDebug line to get output of all RCS etc command to debug file + sub _traceExec + { + my( $cmd, $result ) = @_; + + #TWiki::writeDebug( "Search exec: $cmd -> $result" ); + } + + # ========================= + # The following options from regular search are not supported + # scope="topic"|"text" Scope is always text + # limit="all"|n always return full result + # nosummary="on" never do summary + # regex="on" always do regular expression search + # bookview="on" bookview always off + # nosearch="on" Suppress search string + # noheader="on" Suppress search header + # The following still need to be decided + # order="topic"|"modified"|"editby" + # nototal="on" Do not show number of topics found Show number + + sub searchWebTables + { + ## 0501 kk : vvv Added params + my ( $doInline, $theWebName, $theSearchVal, $caseSensitive, + $doShowLock, $noEmpty, $theTemplate, $theHeader, + $theFormat, $noLineFeed, @junk ) = @_; + + if( ! $theFormat ) { + # TJW Is there a default format we could use? + # Better to redirect to an oops query + print ""; + print "

Search Error

"; + print "Missing format in %METATABLESEARCH%"; + print ""; + return; + } + + # add META:TABLE to searchval + $theSearchVal = "\%META\:TABLE.*" . $theSearchVal; + + my $theLimit = 32000; + + my $searchResult = ""; + my $topic = $TWiki::mainTopicname; + + my @webList = (); + + # A value of 'all' or 'on' by itself gets all webs, + # otherwise ignored (unless there is a web called "All".) + my $searchAllFlag = ( $theWebName =~ /(^|[\,\s])(all|on)([\,\s]|$)/i ); + + # Search what webs? "" current web, list gets the list, all gets + # all (unless marked in WebPrefs as NOSEARCHALL) + + if( $theWebName ) { + foreach my $web ( split( /[\,\s]+/, $theWebName ) ) { + # the web processing loop filters for valid web names, so don't do it here. + + if( $web =~ /^(all|on)$/i ) { + # get list of all webs by scanning $dataDir + opendir DIR, $TWiki::dataDir; + my @tmpList = readdir(DIR); + closedir(DIR); + @tmpList = sort + grep { s#^.+/([^/]+)$#$1# } + grep { -d } + map { "$TWiki::dataDir/$_" } + grep { ! /^[._]/ } @tmpList; + + # what that does (looking from the bottom up) is take the file + # list, filter out the dot directories and dot files, turn the + # list into full paths instead of just file names, filter out + # any non-directories, strip the path back off, and sort + # whatever was left after all that (which should be merely a + # list of directory's names.) + + foreach my $aweb ( @tmpList ) { + push( @webList, $aweb ) unless( grep { /^$aweb$/ } @webList ); + } + + } else { + push( @webList, $web ) unless( grep { /^$web$/ } @webList ); + } + } + + } else { + #default to current web + push @webList, $TWiki::webName; + } + + my $tempVal = ""; + my $tmpl = ""; + my $topicCount = 0; # JohnTalintyre + my $originalSearch = $theSearchVal; + $theTemplate = "searchformat"; + $tmpl = &TWiki::Store::readTemplate( "$theTemplate" ); + + $tmpl =~ s/\%META{.*?}\%//go; # remove %META{"parent"}% + + my( $tmplHead, $tmplSearch, + $tmplTable, $tmplNumber, $tmplTail ) = split( /%SPLIT%/, $tmpl ); + $tmplHead = &TWiki::handleCommonTags( $tmplHead, $topic ); + $tmplSearch = &TWiki::handleCommonTags( $tmplSearch, $topic ); + $tmplNumber = &TWiki::handleCommonTags( $tmplNumber, $topic ); + $tmplTail = &TWiki::handleCommonTags( $tmplTail, $topic ); + + if( ! $tmplTail ) { + print ""; + print "

TWiki Installation Error

"; + # Might not be search.tmpl FIXME + print "Incorrect format of search.tmpl (missing %SPLIT% parts)"; + print ""; + return; + } + + if( ! $doInline ) { + # print first part of full HTML page + $tmplHead = &TWiki::getRenderedVersion( $tmplHead ); + $tmplHead =~ s|||goi; # remove tags (PTh 06 Nov 2000) + print $tmplHead; + } + + my $cmd = ""; + $cmd = "%GREP% %SWITCHES% -- $TWiki::cmdQuote%TOKEN%$TWiki::cmdQuote %FILES%"; + + if( $caseSensitive ) { + $tempVal = ""; + } else { + $tempVal = "-i"; + } + $cmd =~ s/%SWITCHES%/$tempVal/go; + + my @tokens; + $tempVal = $TWiki::egrepCmd; + @tokens = split( /;/, $theSearchVal ); + + $cmd =~ s/%GREP%/$tempVal/go; + + # write log entry + if( ( $TWiki::doLogTopicSearch ) && ( ! $doInline ) ) { + # 0501 kk : vvv Moved from search + # PTh 17 May 2000: reverted to old behaviour, + # e.g. do not log inline search + # PTh 03 Nov 2000: Moved out of the 'foreach $thisWebName' loop + my $tempVal = join( ' ', @webList ); + &TWiki::Store::writeLog( "search", $tempVal, $theSearchVal ); + } + + foreach my $thisWebName (@webList) { + + # PTh 03 Nov 2000: Add security check + $thisWebName =~ s/$TWiki::securityFilter//go; + $thisWebName =~ /(.*)/; + $thisWebName = $1; # untaint variable + + next unless &TWiki::Store::webExists( $thisWebName ); # can't process what ain't thar + + my $thisWebBGColor = &TWiki::Prefs::getPreferencesValue( "WEBBGCOLOR", $thisWebName ) || "\#FF00FF"; + my $thisWebNoSearchAll = &TWiki::Prefs::getPreferencesValue( "NOSEARCHALL", $thisWebName ); + + # make sure we can report this web on an 'all' search + # DON'T filter out unless it's part of an 'all' search. + # PTh 18 Aug 2000: Need to include if it is the current web + next if ( ( $searchAllFlag ) + && ( ( $thisWebNoSearchAll =~ /on/i ) || ( $thisWebName =~ /^[\.\_]/ ) ) + && ( $thisWebName ne $TWiki::webName ) ); + + (my $baz = "foo") =~ s/foo//; # reset search vars. defensive coding + + # 0501 kjk : vvv New var for accessing web dirs. + my $sDir = "$TWiki::dataDir/$thisWebName"; + my @topicList = ""; + if( $theSearchVal ) { + # do grep search + chdir( "$sDir" ); + _traceExec( "chdir to $sDir", "" ); + @topicList = ( "*.txt" ); + foreach my $token ( @tokens ) { + my $acmd = $cmd; + $acmd =~ s/%TOKEN%/$token/o; + $acmd =~ s/%FILES%/@topicList/; + $acmd =~ /(.*)/; + $acmd = "$1"; # untaint variable (NOTE: Needs a better check!) + $tempVal = `$acmd`; + _traceExec( $acmd, $tempVal ); + @topicList = split( /\n/, $tempVal ); + last if( ! @topicList ); + } + } + + next if ( $noEmpty && ! @topicList ); # Nothing to show for this topic + + # output header of $thisWebName + my( $beforeText, $repeatText, $afterText ) = split( /%REPEAT%/, $tmplTable ); + if( $theHeader ) { + $theHeader =~ s/\$n/\n/gos; # expand "$n()" to new line + $theHeader =~ s/\$n([^a-zA-Z])/\n$1/gos; # expand "$n" to new line + $theHeader =~ s/([^\n])$/$1\n/gos; + $beforeText = $theHeader; + $beforeText =~ s/\$web/$thisWebName/gos; + } + + $beforeText =~ s/%WEBBGCOLOR%/$thisWebBGColor/go; + $beforeText =~ s/%WEB%/$thisWebName/go; + $beforeText = &TWiki::handleCommonTags( $beforeText, $topic ); + $afterText = &TWiki::handleCommonTags( $afterText, $topic ); + + # output the list of topics in $thisWebName + my $topic = ""; + my $head = ""; + my $revDate = ""; + my $revUser = ""; + my $revNum = ""; + my $allowView = ""; + my $locked = ""; + my $found = ""; + foreach( @topicList ) { + ($topic, $found, @junk) = /^(.*)\.txt:.*%META:TABLE\{(.*)\}/; + my $meta = ""; + my $text = ""; + + ( $meta, $text ) = &TWiki::Store::readTopic( $thisWebName, $topic ); + $text =~ s/%WEB%/$thisWebName/gos; + $text =~ s/%TOPIC%/$topic/gos; + $allowView = &TWiki::Access::checkAccessPermission( "view", $TWiki::wikiUserName, $text, $topic, $thisWebName ); + ( $revDate, $revUser, $revNum ) = &TWiki::Store::getRevisionInfoFromMeta( $thisWebName, $topic, $meta, 1 ); + $revUser = &TWiki::userToWikiName( $revUser ); + + $locked = ""; + if( $doShowLock ) { + ( $tempVal ) = &TWiki::Store::topicIsLockedBy( $thisWebName, $topic ); + if( $tempVal ) { + $revUser = &TWiki::userToWikiName( $tempVal ); + $locked = "(LOCKED)"; + } + } + + # Check security + # FIXME - how deal with user login not available if coming from search script? + if( ! $allowView ) { + next; + } + + $tempVal = $theFormat; + $tempVal =~ s/([^\n])$/$1\n/gos; # cut last trailing new line + $tempVal =~ s/\$n/\n/gos; # expand "$n()" to new line + $tempVal =~ s/\$n([^a-zA-Z])/\n$1/gos; # expand "$n" to new line + + $tempVal =~ s/\$editlink/%SCRIPTURL%\/editTable\/\$web\/\$topic\?template\=\$formfield(template)\&tablename\=\$formfield(tablename)\&entry\=\$formfield(name)/gos; + + $tempVal =~ s/\$web/$thisWebName/gos; + $tempVal =~ s/\$topic$([^$]*)\)/TWiki::Search::breakName( $topic, $1 )/geos; + $tempVal =~ s/\$topic/$topic/gos; + $tempVal =~ s/\$locked/$locked/gos; + $tempVal =~ s/\$date/$revDate/gos; + $tempVal =~ s/\$isodate/&TWiki::revDate2ISO($revDate)/geos; + $tempVal =~ s/\$rev/1.$revNum/gos; + $tempVal =~ s/\$wikiusername/$revUser/gos; + $tempVal =~ s/\$username/&TWiki::wikiToUserName($revUser)/geos; + $tempVal =~ s/%WEB%/$thisWebName/go; + $tempVal =~ s/%TOPICNAME%/$topic/go; + $tempVal =~ s/%LOCKED%/$locked/o; + $tempVal =~ s/%TIME%/$revDate/o; + if( $revNum > 1 ) { + $revNum = "r1.$revNum"; + } else { + $revNum = "NEW"; + } + $tempVal =~ s/%REVISION%/$revNum/o; + $tempVal =~ s/%AUTHOR%/$revUser/o; + + $tempVal =~ s/\$formfield$\s*([^$]*)\s*\)/getMetaFormField( $found, $1 )/geos; + $tempVal =~ s/\$nop()?//gos; # remove filler, useful for nested search + $tempVal =~ s/\$quot()?/\"/gos; # expand double quote + $tempVal =~ s/\$percnt()?/\%/gos; # expand percent + $tempVal =~ s/\$dollar()?/\$/gos; # expand dollar + + # print at the end if formatted search because of table rendering + $searchResult .= $tempVal; + + } + + # output footer of $thisWebName + # print at the end if formatted search because of table rendering + $afterText =~ s/\n$//gos; # remove trailing new line + $searchResult .= $afterText; + + } + + #Remove to allow for dealing with empty result + if( ($doInline == "1")) { + $searchResult =~ s/\n$//gos; # remove trailing new line + } + if( $doInline ) { + # return formatted search result + return $searchResult; + + } else { + # finally print $searchResult which got delayed because of formatted search + $tmplTail = "$searchResult$tmplTail"; + + # print last part of full HTML page + $tmplTail = &TWiki::getRenderedVersion( $tmplTail ); + $tmplTail =~ s|||goi; # remove tag + print $tmplTail; + } + return $searchResult; + } + + #========================= + sub getMetaFormField + { + my( $theMeta, $theParams ) = @_; + + my $name = $theParams; + my $break = ""; + my @params = split( /\,\s*/, $theParams, 2 ); + if( @params > 1 ) { + $name = $params[0] || ""; + $break = $params[1] || 1; + } + my $title = ""; + my ($value, @junk) = ($theMeta =~ m/$name=\"(.*?)\"/x); + $value =~ s/^\s*(.*?)\s*$/$1/go; + if( $value ) { + $value = TWiki::Search::breakName( $value, $break ); + return $value; + } + return ""; + } + + # + # END -- %METATABLESEARCH{...}% + # + 1;