[TWiki-Dev] [SVN] r7637 - in twiki/branches/DEVELOP/twikiplugins: . DBCachePlugin DBCachePlugin/data

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Author: MichaelDaum
Date: 2005-11-24 11:01:28 -0800 (Thu, 24 Nov 2005)
New Revision: 7637

Added:
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/data/
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/data/TWiki/
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/data/TWiki/DBCachePlugin.txt
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin.pm
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/DEPENDENCIES
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/MANIFEST
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/WebDB.pm
   twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/build.pl
Log:
Item1048: initial release; externalized from BlogPlugin


Added: twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/data/TWiki/DBCachePlugin.txt
===================================================================

--- twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/data/TWiki/DBCachePlugin.txt	2005-11-24 17:26:33 UTC (rev 7636)
+++ twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/data/TWiki/DBCachePlugin.txt	2005-11-24 19:01:28 UTC (rev 7637)
@@ -0,0 +1,185 @@
+%META:TOPICINFO{author="TWikiContributor" date="1132858289" format="1.1" version="1.1"}%
+---+!! <nop>%TOPIC%
+
+%TOC%
+
+---++ Description
+This is a lightweighted frontend to the DBCacheContrib. The provided
+tags DBQUERY and DBCALL can be used as a drop-in replacement for SEARCH and INCLUDE
+that use the database store instread of searching and extracting on the raw
+topic files. If you are looking for a more sophisticated way of
+handling queries and sub-queries then have a look at the TWiki:Plugins.FormQueryPlugin.
+
+*DBQUERY* is provided to ease the use of
+<nop>TWikiApplications based on the DBCacheContrib combining its flexible query
+language with unrestricted formatting and an extend mechanism to extract topic
+properties. 
+
+*DBCALL* is named "call" and not "include" as its main purpose is to ease 
+<nop>TWikiApplications where <nop>TopicFunctions are treated as stored procedures.
+It fetches pre-compiled topics or sections of it. "Glue" chars
+(see TWiki:Plugins:GluePlugin) are applied in advance so that the actual rendering time
+is minimized. DBCALL does therefore not allow to call "external" pages as INCLUDE allows.
+DBCALL's "warn" parameter can only be set to "on" and "off" and does not allow 
+alternative content in case of a warning. The "pattern" feature used to extract a fragment from
+an INCLUDEd text using regular expression  has been droppped.
+That aside DBCALLs can be called recursively as INCLUDEs can,
+parametrized using key-value arguments and
+obeys to %<nop>STARTINCLUDE%, %<nop>STOPINCLUDE%, %<nop>SECTION{"..."}% 
+and %<nop>ENDSECTION{"..."}%.
+
+Using the <nop>DBCacheContrib topic sections are stored into the topic object of the database.
+The section between %<nop>STARTINCLUDE% ... %<nop>STOPINCLUDE% is called 
+=_sectiondefault= whereas all sections between %<nop>SECTION{"&lt;name>"}% .... 
+%<nop>ENDSECTION{"&lt;name>"}% are called =_section&lt;name>= and are stored accordingly.
+
+
+---++ Syntax
+---+++ DBQUERY
+DBQUERY can be used in either of two modes (a) as a pure search
+tool or (b) as a tool to extract properties of (a set of) known topics. So you
+have to specify either the "search" or the "topics" argument in the DBQUERY
+tag.
+
+*Syntax:*
+| *%<nop>DBQUERY{"&lt;search>"}%* ||
+| ="&lt;search>"= \
+| search clause, see documentation of the DBCacheContrib (mode (a)) |
+| =topics="..."= or =topic="..."= \
+| set of topics to consult (mode (b)); \
+  if "topics" are specified in addition to a "search" it will be restricted to \
+  the given topics |
+| =web="..."= | web where to search for hits; defaults to the current one |
+| =format="..."= | format string to display search hits;\
+  defaults to "$topic"; the special format string "none" disables the format string |
+| =header="..."= | format string to prepended to the list of hits |
+| =footer="..."= | format string to appended to the list of hits |
+| =separator="..."= | format string used to separate hits; \
+  defaults to "$n"; the special separator "none" disables separation |
+| =include="..."= | pattern each found topic name must match to be considered a hit |
+| =exclude="..."= | pattern each found topic name must not match to be considered a hit |
+| =order="..."= | specifies the sorting of hits; defaults to "name" |
+| =reverse="..."= | specify if hits should be sorted in reverse order; defaults to "off" |
+| =limit="..."= | maximum number of topics to include in the hit set |
+| =skip="..."= | number of topics to skip while constructing the hit set; defaults to "0" |
+| =hidenull="..."= | flag to indicate that an empty hit set should not be displayed |
+
+Following variables are expanded in format strings:
+   * $percnt: % sign
+   * $dollar: $ sign
+   * $n: newline
+   * $t: tab
+   * $nop: "empty string"
+   * $count: the number of hits
+   * $web: the web where the hits where found
+   * $formfield(&lt;formfield-name>): the value of the given formfield
+   * $formatTime(&lt;formfield-accessor> [,&lt;format>]): format the datefield pointed
+     to by the &lt;formfield-accessor> using the given &lt;format>; the format can be
+     in any form supported by =TWiki::Func::formatTime()= 
+     (see [[%TWIKIWEB%.TWikiVariables#DISPLAYTIME_format_formatted_dis][TWikiVariables]] documentation).
+   * $expand(&lt;formfield-accessor>): return the formfield pointed to by the 
+      &lt;formfield-accessor>
+   * $encode(...): encode entities so that the text can be included in an rss feed
+
+*Formfield accessors:*
+
+In its most basic form =$expand(Ref)= is identical to =$formfield(Ref)=. In addition
+=$expand()= can be used to refer to topic properties of related topics that can be reached from the current one using the '@' symbol. For example, if a topic A uses a form that contains a field named "Ref" and specifies a reference to 
+another topic B (by using its name) you can access the "Headline" in B from A using =$expand(@Ref.Headline)=.
+A formfield accessor can be a composed one using 'or' and 'and'. Example: =$expand(Name or Author)=
+will expand to the value of the formfield "Name" if it exists and is non-empty and to the value 
+of the formfield "Author" otherwise. More valid examples:
+   * =$expand(@Ref.Headline)=: headline of the refered topic
+   * =$expand(Nr and '.')=: append a dot to the formfield value "Nr" if it exists
+   * =$expand(Name or Author)=: expand to "Name" or "Author"
+
+---+++ DBCALL
+*Syntax:*
+| *%<nop>DBCALL{"&lt;topic" ...}%* ||
+| ="&lt;topic>"= | topic that we'd like to call |
+| =section="..."= | optional named section; without this parameter the "default" section is used |
+| =&lt;key>="&lt;value>"= | topic arguments to be substituted within the included text; that is \
+            every occurence of &lt;key> is substituted with &lt;value> |
+| =warn="on,off"= | enable/suppress error warnings |
+
+---++ Perl API
+
+The <nop>DBCachePlugin supports overloading the contained default database cache by inherriting
+from =DBCachePlugin::WebDB= being itself a =DBCacheContrib=. The only purpose of the 
+=DBCachePlugin::WebDB= is to extract the <nop>TopicFunctions contained in a topic as described
+above. You can easily extend this functionality by deriving a <nop>WebDB specific of your
+own <nop>TWikiApplication. For example, the TWiki:Plugins.BlogPlugin defines a <no>WebDB of
+its own where it caches the createdate of a topic being either specified in a formfield  or
+given in the timestamp of the first revision of a topic.
+
+---+++ initDB()
+This function must be called ahead of any actual database access. If your <nop>TWikiApplication
+is using a derived <nop>WebDB then use the =WEBDB= variable in your WebPreferences to
+point to its implementation (example: =Set WEBDB = TWiki::Plugins::BlogPlugin::WebDB=). If
+=WEBDB= is not defined the default implementation =TWiki::Plugins::DBCachePlugin::WebDB= is used.
+Note, that this way only one application-specific database cache can be loaded _per web_.
+This is rather a design decision; otherwise each DBQUERY and DBCALL tag had to declare which database it operated on. So currently the rule of thumb is: one web one <nop>TWikiApplication making use
+of this plugin.
+
+| *$webDB = initDB($web)* ||
+| =web= | name of the web whose database is to be loaded |
+
+returns a database handle. See the TWiki:Plugins::DBCacheContrib documentation
+for its interfaces.
+
+---+++ dbQuery()
+The DBQUERY functionality can be access from within perl using the plugins =dbQuery()= function.
+
+| *(@$topicNames, %$topicObjs, $errorMsg) = dbQuery($webDB, $search, [, @$topics, $order, $reverse])* ||
+| =webDB= | database handle |
+| =search= | search clause |
+| =topics= | restrict search to this list of topics |
+
+returns a list pointer of all found topics names, a hash pointer to an array of all found
+topic objects (keys are the name of the topics) and a possibly defined error message.
+
+---+++ getFormField()
+Access the formfield value of an arbitrary topic.
+
+| *$value = getFormField($webDB, $topic, $formfield)* ||
+| =webDB= | database handle |
+| =topic= | a topic name |
+| =formfield= | a formfield name |
+
+returns the value of the named formfield
+
+%RED%TODO: possibly export the other functions also %ENDCOLOR%
+
+---++ Plugin Settings
+   * Set SHORTDESCRIPTION = Lightweighted frontend to the DBCacheContrib
+
+---++ Plugin Installation Instructions
+
+   * Download and install all additionally required plugins listed in the
+     [[#Plugin_Info][dependencies information]] below
+   * Download the %TOPIC% ZIP file from the Plugin web (see below)
+   * Unzip ==%TOPIC%.zip== in your twiki installation directory. Content:
+     | *File:* | *Description:* |
+     | ==data/TWiki/%TOPIC%.txt== | Plugin topic |
+     | ==lib/TWiki/Plugins/%TOPIC%.pm== | Plugin Perl module |
+     | ==lib/TWiki/Plugins/%TOPIC%/WebDB.pm== | Plugin Perl module |
+
+---++ Plugin Info
+
+|  Plugin Author: | TWiki:Main.MichaelDaum |
+|  Plugin Version: | 24 Nov 2005 (v0.90) |
+|  Change History: | <!-- versions below in reverse order -->&nbsp; |
+|  24 Nov 2005: | Initial version |
+|  TWiki Dependency: | $TWiki::Plugins::VERSION 1.1 |
+|  CPAN Dependencies: | none |
+|  Other Dependencies: | TWiki:Contrib.DBCacheContrib |
+|  Perl Version: | 5.005 |
+|  License: | GPL ([[http://www.gnu.org/copyleft/gpl.html][GNU General Public License]]) |
+|  [[TWiki:Plugins/Benchmark][Benchmarks]]: | %TWIKIWEB%.GoodStyle nn%, %TWIKIWEB%.FormattedSearch nn%, %TOPIC% nn% |
+|  Plugin Home: | TWiki:Plugins/%TOPIC% |
+|  Feedback: | TWiki:Plugins/%TOPIC%Dev |
+|  Appraisal: | TWiki:Plugins/%TOPIC%Appraisal |
+
+-- TWiki:Main.MichaelDaum - 24 Nov 2005
+
+

Added: twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/DEPENDENCIES
===================================================================
--- twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/DEPENDENCIES	2005-11-24 17:26:33 UTC (rev 7636)
+++ twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/DEPENDENCIES	2005-11-24 19:01:28 UTC (rev 7637)
@@ -0,0 +1,2 @@
+TWiki::Plugins,>=1.1,perl,TWiki Dakar release.
+TWiki::Contrib::DBCacheContrib,Dakar,perl,Required

Added: twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/MANIFEST
===================================================================
--- twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/MANIFEST	2005-11-24 17:26:33 UTC (rev 7636)
+++ twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/MANIFEST	2005-11-24 19:01:28 UTC (rev 7637)
@@ -0,0 +1,3 @@
+lib/TWiki/Plugins/DBCachePlugin.pm 0440
+lib/TWiki/Plugins/DBCachePlugin/WebDB.pm 0440
+data/TWiki/DBCachePlugin.txt 0440

Added: twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/WebDB.pm
===================================================================
--- twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/WebDB.pm	2005-11-24 17:26:33 UTC (rev 7636)
+++ twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/WebDB.pm	2005-11-24 19:01:28 UTC (rev 7637)
@@ -0,0 +1,77 @@
+# Plugin for TWiki Collaboration Platform, http://TWiki.org/
+#
+# Copyright (C) 2005 Michael Daum <mi...@na...>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details, published at 
+# http://www.gnu.org/copyleft/gpl.html
+#
+###############################################################################
+
+package TWiki::Plugins::DBCachePlugin::WebDB;
+
+use strict;
+use TWiki::Contrib::DBCacheContrib;
+
+@TWiki::Plugins::DBCachePlugin::WebDB::ISA = ("TWiki::Contrib::DBCacheContrib");
+
+###############################################################################
+sub new {
+  my ( $class, $web, $cacheName ) = @_;
+  $cacheName = '_DBCachePluginDB' unless $cacheName;
+  my $this = bless($class->SUPER::new($web, $cacheName), $class);
+  return $this;
+}
+
+###############################################################################
+# called by superclass when one or more topics had
+# to be reloaded from disc.
+sub onReload {
+  my ($this, $topics) = @_;
+
+  #print STDERR "DEBUG: DBCachePlugin::WebDB - called onReload(@_)\n";
+
+  foreach my $topicName (@$topics) {
+    my $topic = $this->fastget($topicName);
+
+    #print STDERR "DEBUG: reloading $topicName\n";
+
+    # stored procedures
+    my $text = $topic->fastget('text');
+
+    # get default section
+    my $defaultSection = $text;
+    $defaultSection =~ s/.*?%STARTINCLUDE%//s;
+    $defaultSection =~ s/%STOPINCLUDE%.*//s;
+    applyGlue($defaultSection);
+    $topic->set('_sectiondefault', $defaultSection);
+
+    # get named sections
+    while($text =~ s/%SECTION{[^}]*?"(.*?)"}%(.*?)%ENDSECTION{[^}]*?"(.*?)"}%//s) {
+      my $name = $1;
+      my $sectionText = $2;
+      applyGlue($sectionText);
+      $topic->set("_section$name", $sectionText);
+    }
+  }
+
+  #print STDERR "DEBUG: DBCachePlugin::WebDB - done onReload()\n";
+}
+
+###############################################################################
+# local copy from GluePlugin
+sub applyGlue {
+
+  $_[0] =~ s/%~~\s+([A-Z]+{)/%$1/gos;  # %~~
+  $_[0] =~ s/\s*[\n\r]+~~~\s+/ /gos;   # ~~~
+  $_[0] =~ s/\s*[\n\r]+\*~~\s+//gos;   # *~~
+}
+
+1;

Added: twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/build.pl
===================================================================
--- twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/build.pl	2005-11-24 17:26:33 UTC (rev 7636)
+++ twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin/build.pl	2005-11-24 19:01:28 UTC (rev 7637)
@@ -0,0 +1,18 @@
+#!/usr/bin/perl -w
+#
+# Build for DBCachePlugin
+#
+BEGIN {
+  foreach my $pc (split(/:/, $ENV{TWIKI_LIBS})) {
+    unshift @INC, $pc;
+  }
+}
+
+use TWiki::Contrib::Build;
+
+# Create the build object
+$build = new TWiki::Contrib::Build( 'DBCachePlugin' );
+
+# Build the target on the command line, or the default target
+$build->build($build->{target});
+

Added: twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin.pm
===================================================================
--- twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin.pm	2005-11-24 17:26:33 UTC (rev 7636)
+++ twiki/branches/DEVELOP/twikiplugins/DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin.pm	2005-11-24 19:01:28 UTC (rev 7637)
@@ -0,0 +1,421 @@
+# Plugin for TWiki Collaboration Platform, http://TWiki.org/
+#
+# Copyright (C) 2005 Michael Daum <mi...@na...>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version. For
+# more details read LICENSE in the root of this distribution.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+package TWiki::Plugins::DBCachePlugin;
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(initDB dbQuery getFormField);
+
+use strict;
+use vars qw( $VERSION $RELEASE $debug $pluginName %webDBs);
+
+use TWiki::Contrib::DBCacheContrib;
+use TWiki::Contrib::DBCacheContrib::Search;
+use TWiki::Plugins::DBCachePlugin::WebDB;
+
+$VERSION = '$Rev$';
+$RELEASE = '0.90';
+$pluginName = 'DBCachePlugin';
+$debug = 0; # toggle me
+
+###############################################################################
+sub writeDebug {
+  #&TWiki::Func::writeDebug('- '.$pluginName.' - '.$_[0]) if $debug;
+  print STDERR "DEBUG: - $pluginName - $_[0]\n" if $debug;
+}
+
+###############################################################################
+sub initPlugin {
+  my ($topic, $web, $user, $installWeb) = @_;
+
+  %webDBs = ();
+
+  TWiki::Func::registerTagHandler('DBQUERY', \&_DBQUERY);
+  TWiki::Func::registerTagHandler('DBCALL', \&_DBCALL);
+
+  writeDebug("initialized");
+  return 1;
+}
+
+###############################################################################
+sub _DBQUERY {
+  my ($session, $params, $theTopic, $theWeb) = @_;
+  
+  writeDebug("called _DBQUERY");
+
+  # params
+  my $theSearch = $params->{_DEFAULT} || $params->{search};
+  my $theTopics = $params->{topics} || $params->{topic};
+  
+  return &inlineError("ERROR: DBQUERY needs either a \"search\" or a \"topic\" argument ") 
+    if !$theSearch && !$theTopics;
+  return '' if $theTopics && $theTopics eq 'none';
+
+  my $theFormat = $params->{format} || '$topic';
+  my $theHeader = $params->{header} || '';
+  my $theFooter = $params->{footer} || '';
+  my $theInclude = $params->{include};
+  my $theExclude = $params->{exclude};
+  my $theOrder = $params->{order} || 'name';
+  my $theReverse = $params->{reverse} || 'off';
+  my $theSep = $params->{separator} || '$n';
+  my $theLimit = $params->{limit} || '';
+  my $theSkip = $params->{skip} || 0;
+  my $theHideNull = $params->{hidenull} || 'off';
+  $theWeb = $params->{web} || $theWeb;
+
+  my $theDB = &initDB($theWeb);
+
+  #print STDERR "DEBUG: _DBQUERY(" . $params->stringify() . ")\n";
+
+  # get topics
+  my @topicNames;
+  if ($theTopics) {
+    @topicNames = split(/, /, $theTopics);
+  } else {
+    @topicNames = $theDB->getKeys();
+  }
+  @topicNames = grep(/$theInclude/, @topicNames) if $theInclude;
+  @topicNames = grep(!/$theExclude/, @topicNames) if $theExclude;
+
+  # normalize 
+  $theSkip =~ s/[^-\d]//go;
+  $theSkip = 0 if $theSkip eq '';
+  $theSkip = 0 if $theSkip < 0;
+  $theFormat = '' if $theFormat eq 'none';
+  $theSep = '' if $theSep eq 'none';
+  $theLimit =~ s/[^\d]//go;
+  $theLimit = scalar(@topicNames) if $theLimit eq '';
+  $theLimit += $theSkip;
+
+  my ($topicNames, $hits, $msg) = &dbQuery($theDB, $theSearch, 
+    \@topicNames, $theOrder, $theReverse);
+#  print STDERR "DEBUG: topicNames=@$topicNames\n";
+
+  return $msg if $msg;
+
+
+  my $count = scalar(@$topicNames);
+#  print STDERR "DEBUG: count=$count\n";
+  return '' if ($count <= $theSkip) && $theHideNull eq 'on';
+
+  # format
+  my $text = '';
+  if ($theFormat && $theLimit) {
+    my $index = 0;
+    my $isFirst = 1;
+    foreach my $topicName (@$topicNames) {
+      $index++;
+      next if $index <= $theSkip;
+      my $root = $hits->{$topicName};
+      my $format = '';
+      $format = $theSep unless $isFirst;
+      $isFirst = 0;
+      $format .= $theFormat;
+      $format =~ s/\$formfield\((.*?)\)/getFormField($theDB, $topicName, $1)/geo;
+      $format =~ s/\$expand\((.*?)\)/expandPath($theDB, $root, $1)/geo;
+      $format =~ s/\$formatTime\((.*?)(?:,\s*'([^']*?)')?\)/TWiki::Func::formatTime(expandPath($theDB, $root, $1), $2)/geo; # single quoted
+      #$format =~ s/\$dbcall\((.*?)\)/dbCall($1)/ge; ## TODO
+      $format = expandVariables($format, topic=>$topicName, web=>$theWeb, index=>$index, count=>$count);
+      $text .= $format;
+      last if $index == $theLimit;
+    }
+  }
+
+  $theHeader = expandVariables($theHeader.$theSep, count=>$count, web=>$theWeb) if $theHeader;
+  $theFooter = expandVariables($theSep.$theFooter, count=>$count, web=>$theWeb) if $theFooter;
+
+  $text = &TWiki::Func::expandCommonVariables("$theHeader$text$theFooter");
+  #print STDERR "DEBUG: text='$text'\n";
+  return $text;
+}
+
+###############################################################################
+sub _DBCALL {
+  my ($session, $params, $theTopic, $theWeb) = @_;
+
+  writeDebug("called _DBCALL");
+
+  # remember args for the key before mangling the params
+  my $args = $params->stringify();
+
+  #print STDERR "DEBUG: called DBCALL{$args}\n";
+
+  my $path = $params->remove('_DEFAULT') || '';
+  my $section = $params->remove('section') || 'default';
+  my $warn = $params->remove('warn') || 'on';
+  $warn = ($warn eq 'on')?1:0;
+
+  my ($thisWeb, $thisTopic) = &TWiki::Func::normalizeWebTopicName($theWeb, $path);
+  
+  # check access rights
+  my $wikiUserName = TWiki::Func::getWikiUserName();
+  unless (TWiki::Func::checkAccessPermission('VIEW', $wikiUserName, undef, $thisTopic, $thisWeb)) {
+    if ($warn) {
+      return inlineError("ERROR: DBCALL access to '$thisWeb.$thisTopic' denied");
+    } 
+    return '';
+  }
+
+  # init database
+  my $theDB = &initDB($thisWeb);
+
+  # get section
+  my $topicObj = $theDB->fastget($thisTopic);
+  if (!$topicObj) {
+    if ($warn) {
+      return inlineError("ERROR: DBCALL can't find topic <nop>$thisWeb.$thisTopic");
+    } else {
+      return '';
+    }
+  }
+  my $sectionText = $topicObj->fastget("_section$section") if $topicObj;
+  if (!$sectionText) {
+    if($warn) {
+      return inlineError("ERROR: DBCALL can't find section '$section' in topic '$thisWeb.$thisTopic'");
+    } else {
+      return '';
+    }
+  }
+
+  # prevent recursive calls
+  my $key = $thisWeb.'.'.$thisTopic;
+  my $count = grep($key, keys %{$session->{dbcalls}});
+  $key .= $args;
+  if ($session->{dbcalls}->{$key} || $count > 99) {
+    if($warn) {
+      return inlineError("ERROR: DBCALL reached max recursion at '$thisWeb.$thisTopic'");
+    }
+    return '';
+  }
+  $session->{dbcalls}->{$key} = 1;
+
+  # substitute variables
+  $sectionText =~ s/%INCLUDINGWEB%/$theWeb/g;
+  $sectionText =~ s/%INCLUDINGTOPIC%/$theTopic/g;
+  $sectionText =~ s/%WEB%/$thisWeb/g;
+  $sectionText =~ s/%TOPIC%/$thisTopic/g;
+  foreach my $key (keys %$params) {
+    $sectionText =~ s/%$key%/$params->{$key}/g;
+  }
+
+  # expand
+  $sectionText = TWiki::Func::expandCommonVariables($sectionText);
+
+  # cleanup
+  delete $session->{dbcalls}->{$key};
+
+  return $sectionText;
+  #return '<verbatim>'.$sectionText.'</verbatim>';
+}
+
+###############################################################################
+sub initDB {
+  my ($theWeb) = @_;
+
+  return undef unless $theWeb;
+
+  writeDebug("called initDB($theWeb)");
+
+  unless ($webDBs{$theWeb}) {
+    my $impl = TWiki::Func::getPreferencesValue('WEBDB', $theWeb) 
+      || 'TWiki::Plugins::DBCachePlugin::WebDB';
+    $impl =~ s/^\s*(.*?)\s*$/$1/o;
+    $webDBs{$theWeb} = new $impl($theWeb);
+    $webDBs{$theWeb}->load();
+    writeDebug("loaded $webDBs{$theWeb}");
+  }
+
+  return $webDBs{$theWeb};
+}
+
+###############################################################################
+sub dbQuery {
+  my ($theDB, $theSearch, $theTopics, $theOrder, $theReverse) = @_;
+
+# TODO return empty result on an emtpy topics list
+
+  $theOrder ||= '';
+  $theReverse ||= '';
+  $theSearch ||= '';
+  $theTopics ||= '';
+
+  writeDebug("called dbQuery($theDB, $theSearch, $theTopics, $theOrder, $theReverse) called");
+#  print STDERR "DEBUG: theTopics=" . join(',', @$theTopics) . "\n" if $theTopics;
+
+  my @topicNames = $theTopics?@$theTopics:$theDB->getKeys();
+  
+  # parse & fetch
+  my %hits;
+  if ($theSearch) {
+    my $search = new TWiki::Contrib::DBCacheContrib::Search($theSearch);
+    unless ($search) {
+      return (undef, undef, &inlineError("ERROR: can't parse query $theSearch"));
+    }
+    foreach my $topicName (@topicNames) {
+      my $topicObj = $theDB->fastget($topicName);
+      if ($search->matches($topicObj)) {
+	$hits{$topicName} = $topicObj;
+#	print STDERR "DEBUG: adding hit for $topicName\n";
+      }
+    }
+  } else {
+    foreach my $topicName (@topicNames) {
+      my $topicObj = $theDB->fastget($topicName);
+      $hits{$topicName} = $topicObj if $topicObj;
+#      print STDERR "DEBUG: adding hit for $topicName\n";
+    }
+  }
+
+  # sort
+  @topicNames = keys %hits;
+  if (@topicNames > 1) {
+    if ($theOrder eq 'name') {
+      @topicNames = sort {$a cmp $b} @topicNames;
+    } elsif ($theOrder =~ /^created/) {
+      @topicNames = sort {
+	expandPath($theDB, $hits{$a}, 'createdate') <=> expandPath($theDB, $hits{$b}, 'createdate')
+      } @topicNames;
+    } else {
+      @topicNames = sort {
+	expandPath($theDB, $hits{$a}, $theOrder) cmp expandPath($theDB, $hits{$b}, $theOrder)
+      } @topicNames;
+    }
+    @topicNames = reverse @topicNames if $theReverse eq 'on';
+  }
+
+  return (\@topicNames, \%hits, undef);
+}
+
+###############################################################################
+sub expandPath {
+  my ($theDB, $theRoot, $thePath) = @_;
+
+  return '' if !$thePath || !$theRoot;
+  $thePath =~ s/^\.//o;
+  $thePath =~ s/\[([^\]]+)\]/$1/o;
+
+  #print STDERR "DEBUG: expandPath($theRoot, $thePath)\n";
+  if ($thePath =~ /^(.*?) and (.*)$/) {
+    my $first = $1;
+    my $tail = $2;
+    my $result1 = expandPath($theDB, $theRoot, $first);
+    return '' unless defined $result1 && $result1 ne '';
+    my $result2 = expandPath($theDB, $theRoot, $tail);
+    return '' unless defined $result2 && $result2 ne '';
+    return $result1.$result2;
+  }
+  if ($thePath =~ /^'([^']*)'$/) {
+    return $1;
+  }
+  if ($thePath =~ /^(.*?) or (.*)$/) {
+    my $first = $1;
+    my $tail = $2;
+    my $result = expandPath($theDB, $theRoot, $first);
+    return $result if (defined $result && $result ne '');
+    return expandPath($theDB, $theRoot, $tail);
+  }
+
+  if ($thePath =~ m/^(\w+)(.*)$/o) {
+    my $first = $1;
+    my $tail = $2;
+    my $root = $theRoot->fastget($first);
+    unless ($root) {
+      # try form
+      # TODO: try form FIRST
+      my $form = $theRoot->fastget('form');
+      if ($form) {
+	$form = $theRoot->fastget($form);
+	$root = $form->fastget($first) if $form;
+      }
+    }
+    return expandPath($theDB, $root, $tail) if ref($root);
+    if ($root) {
+      my $field = TWiki::urlDecode($root);
+      #print STDERR "DEBUG: result=$field\n";
+      return $field;
+    }
+  }
+
+  if ($thePath =~ /^@([^\.]+)(.*)$/) {
+    my $first = $1;
+    my $tail = $2;
+    my $result = expandPath($theDB, $theRoot, $first);
+    my $root = ref($result)?$result:$theDB->fastget($result); 
+    return expandPath($theDB, $root, $tail)
+  }
+
+  #print STDERR "DEBUG: result is empty\n";
+  return '';
+}
+
+###############################################################################
+sub expandVariables {
+  my ($theFormat, %params) = @_;
+
+  return '' unless $theFormat;
+  
+  foreach my $key (keys %params) {
+    if($theFormat =~ s/\$$key/$params{$key}/g) {
+      #print STDERR "DEBUG: expanding $key->$params{$key}\n";
+    }
+  }
+  $theFormat =~ s/\$percnt/\%/go;
+  $theFormat =~ s/\$dollar/\$/go;
+  $theFormat =~ s/\$n/\n/go;
+  $theFormat =~ s/\$t\b/\t/go;
+  $theFormat =~ s/\$nop//g;
+  $theFormat =~ s/\$encode\((.*)\)/&encode($1)/ges;
+
+  return $theFormat;
+}
+
+###############################################################################
+sub encode {
+  my $text = shift;
+
+  $text = "\n<noautolink>\n$text\n</noautolink>\n";
+  $text = &TWiki::Func::expandCommonVariables($text);
+  $text = &TWiki::Func::renderText($text);
+  $text =~ s/[\n\r]+/ /go;
+  $text =~ s/\n*<\/?noautolink>\n*//go;
+  $text = &TWiki::entityEncode($text);
+  $text =~ s/^\s*(.*?)\s*$/$1/gos;
+
+  return $text;
+}
+
+###############################################################################
+sub getFormField {
+  my ($theDB, $theTopic, $theFormField) = @_;
+
+  my $topicObj = $theDB->fastget($theTopic);
+  return '' unless $topicObj;
+  
+  my $form = $topicObj->fastget('form');
+  return '' unless $form;
+
+  $form = $topicObj->fastget($form);
+  my $formfield = $form->fastget($theFormField) || '';
+  return TWiki::urlDecode($formfield);
+}
+
+###############################################################################
+sub inlineError {
+  return '<span class="twikiAlert">' . $_[0] . '</span>' ;
+}
+
+
+###############################################################################
+1;





[TWiki-Dev] [SVN] r7637 - in twiki/branches/DEVELOP/twikiplugins: . DBCachePlugin DBCachePlugin/data

Open Source Enterprise Wiki and Web Application Platform

[TWiki-Dev] [SVN] r7637 - in twiki/branches/DEVELOP/twikiplugins: . DBCachePlugin DBCachePlugin/data DBCachePlugin/data/TWiki DBCachePlugin/lib DBCachePlugin/lib/TWiki DBCachePlugin/lib/TWiki/Plugins DBCachePlugin/lib/TWiki/Plugins/DBCachePlugin