1 rizwank 1.1 # Comment TWiki plugin
  2             # Original author David Weller, reimplemented by Peter Masiar
  3             # and again by Crawford Currie
  4             #
  5             # This version Copyright (C) 2004 Crawford Currie
  6             #
  7             use strict;
  8             
  9             use TWiki::Plugins::CommentPlugin::Attrs;
 10             use TWiki::Plugins::CommentPlugin::Templates;
 11             
 12             { package CommentPlugin::Comment;
 13             
 14               use vars qw( $inSave ); # recursion block
 15             
 16               # PUBLIC save the given comment. Note that this method is protected against
 17               # recursion. This is because the expansion of variables in the template
 18               # will invoke the commonTagsHandler in the plugin and therefore
 19               # this method.
 20               sub save {
 21                 my ( $web, $topic, $query ) = @_;
 22 rizwank 1.1 
 23                 return if ( $inSave );
 24             
 25                 my $url;
 26             
 27                 my $wikiUserName = &TWiki::Func::getWikiUserName();
 28                 if( ! TWiki::Func::checkAccessPermission( "change", $wikiUserName, "",
 29             											  $topic, $web ) ) {
 30                   # user has no permission to change the topic
 31                   $url = TWiki::Func::getOopsUrl( $web, $topic, "oopsaccesschange" );
 32                 } else {
 33                   my( $oopsUrl, $lockUser ) =
 34             		TWiki::Func::checkTopicEditLock( $web, $topic );
 35                   if( $lockUser ) {
 36             		$url = $oopsUrl;
 37                   } else {
 38             		TWiki::Func::setTopicEditLock( $web, $topic, 1 );
 39             		
 40             		$inSave = 1;
 41             		my $error = _buildNewTopic( $web, $topic, $query );
 42             		$inSave = 0;
 43 rizwank 1.1 
 44             		TWiki::Func::setTopicEditLock( $web, $topic, 0 );
 45             		if( $error ) {
 46             		  $url = $error;
 47             		} else {
 48             		  $url = TWiki::Func::getViewUrl( $web, $topic );
 49             		}
 50                   }
 51                 }
 52             
 53                 # shouldn't need this, but seem to.
 54                 $query->param( -name=>'comment_action', -value=>'none' );
 55                 TWiki::Func::redirectCgiQuery( $query, $url );
 56               }
 57             
 58               # PUBLIC STATIC convert COMMENT statements to form prompts
 59               sub prompt {
 60                 #my ( $previewing, $text, $topic, $web ) = @_;
 61             
 62                 my $defaultType = 
 63                   TWiki::Func::getPreferencesValue("COMMENTPLUGIN_DEFAULT_TYPE") ||
 64 rizwank 1.1 	  "below";
 65             
 66                 my $message = "";
 67                 # Is commenting disabled?
 68                 my $disable = "";
 69                 if ( $_[0] ) {
 70                   # We are in Preview mode
 71                   $message  = "(Edit - Preview)";
 72                   $disable = "disabled";
 73                 }
 74             
 75                 my $idx = 0;
 76                 $_[1] =~ s/%COMMENT({.*?})?%/&_handleInput($1,$_[2],$_[3],\$idx,$message,$disable,$defaultType)/ego;
 77               }
 78             
 79               # PRIVATE generate an input form for a %COMMENT tag
 80               sub _handleInput {
 81                 my ( $attributes, $topic, $web, $pidx, $message,
 82             	 $disable, $defaultType ) = @_;
 83             
 84                 $attributes =~ s/^{(.*)}$/$1/o if ( $attributes );
 85 rizwank 1.1     my $attrs = new TWiki::Plugins::CommentPlugin::Attrs( $attributes );
 86             
 87                 my $type =
 88                   $attrs->remove( "type" ) || $attrs->remove( "mode" ) || $defaultType;
 89                 my $silent = $attrs->remove( "nonotify" );
 90                 my $location = $attrs->remove( "location" );
 91             
 92                 # clean off whitespace
 93                 $type =~ m/(\S*)/o;
 94                 $type = $1;
 95             
 96                 # Expand the template in the context of the web where the comment
 97                 # box is (not the target of the comment!)
 98                 my $input = _getTemplate( "PROMPT:$type", $topic, $web );
 99             
100                 return $input if $input =~ m/^%RED%/so;
101             
102                 # Expand special attributes as required
103                 $input =~ s/%([a-z]\w+)\|(.*?)%/&_expandPromptParams($1, $2, $attrs)/iego;
104             
105                 # see if this comment is targeted at a different topic, and
106 rizwank 1.1     # change the url if it is.
107                 my $anchor = undef;
108                 my $target = $attrs->remove( "target" );
109                 if ( $target ) {
110                   # extract web and anchor
111                   if ( $target =~ s/^(\w+)\.//o ) {
112             	$web = $1;
113                   }
114                   if ( $target =~ s/(#\w+)$//o ) {
115             	$anchor = $1;
116                   }
117                   if ( $target ne "" ) {
118             	$topic = $target;
119                   }
120                 }
121             
122                 my $url = "";
123                 if ( $disable eq "" ) {
124             	  # invoke viewauth so we get authentication. When viewauth is run,
125             	  # the 'save' method in here will be invoked as the commenTagsHandler
126             	  # is run as flagged by the "comment_action" parameter.
127 rizwank 1.1       $url = TWiki::Func::getScriptUrl( "%INTURLENCODE{$web}%",
128             					"%INTURLENCODE{$topic}%",
129             					"viewauth" );
130             
131                   my ( $oopsUrl, $lockUser, $lockTime ) =
132             	TWiki::Func::checkTopicEditLock( $web, $topic );
133             
134                   if ( $lockUser ) {
135             	$message = "Commenting is locked out by <nop>$lockUser for at least $lockTime more minutes";
136             	$disable = "disabled";
137                   }
138                 }
139             
140                 if ( $input !~ m/^%RED%/o ) {
141                   $input =~ s/%DISABLED%/$disable/go;
142                   $input =~ s/%MESSAGE%/$message/g;
143                   my $n = $$pidx + 0;
144             	
145                   $input = "<form name=\"${disable}$type$n\" " .
146             	"action=\"$disable$url\" method=\"${disable}post\">\n$input";
147                   if ( $disable eq "" ) {
148 rizwank 1.1 	$input .= "<input name=\"comment_action\" " .
149             	"type=\"hidden\" value=\"save\" />\n";
150             	$input .= "<input name=\"comment_type\" " .
151             	  "type=\"hidden\" value=\"$type\" />\n";
152             	# remember to unlock the page
153             	$input .= "<input name=\"unlock\" " .
154             	"type=\"hidden\" value=\"1\" />\n";
155             	if( defined( $silent )) {
156             	  $input .= "<input name=\"comment_quietly\" " .
157             	    "type=\"hidden\" value=\"1\" />\n";
158             	}
159             	if ( $location ) {
160             	  $input .= "<input name=\"comment_location\" " .
161             	    "type=\"hidden\" value=\"$location\" />\n";
162             	} elsif ( $anchor ) {
163             	  $input .= "<input name=\"comment_anchor\" " .
164             	    "type=\"hidden\" value=\"$anchor\" />\n";
165             	} else {
166             	  $input .= "<input name=\"comment_index\" " .
167             	    "type=\"hidden\" value=\"$$pidx\" />\n";
168             	}
169 rizwank 1.1       }
170                   $input .= "</form>\n";
171                 }
172                 $$pidx++;
173                 return $input;
174               }
175             
176               # PRIVATE get the given template and do standard expansions
177               sub _getTemplate {
178                 my ( $name, $topic, $web ) = @_;
179             
180                 # Get the templates.
181                 my $templateFile =
182                   TWiki::Func::getPreferencesValue("COMMENTPLUGIN_TEMPLATES") ||
183             	"comments";
184             
185                 my $templates;
186             
187             	if ( $TWiki::Plugins::VERSION < 1.020 ) {
188             	  $templates = CairoCompatibilityModule::readTemplate( $templateFile );
189             	} else {
190 rizwank 1.1 	  $templates = TWiki::Store::readTemplate( $templateFile );
191             	}
192                 if (! $templates ) {
193                   TWiki::Func::writeWarning("No such template file '$templateFile'");
194                   return;
195                 }
196             
197                 my $t =
198                   TWiki::Func::expandCommonVariables( "%TMPL:P{$name}%", $topic, $web );
199             
200                 return "%RED%No such template def %<nop>TMPL:DEF{$name}%%ENDCOLOR%"
201                   unless ( defined($t) && $t ne "" );
202             
203                 return $t;
204               }
205             
206               # PRIVATE expand special %param|default% parameters in PROMPT template
207               sub _expandPromptParams {
208                 my ( $name, $default, $attrs ) = @_;
209             
210                 my $val = $attrs->get( $name );
211 rizwank 1.1     return $val if defined( $val );
212                 return $default;
213               }
214             
215               # PRIVATE STATIC Performs comment insertion in the topic.
216               sub _buildNewTopic {
217                 my ( $web, $topic, $query ) = @_;
218             
219                 my $type = $query->param( 'comment_type' );
220                 my $index = $query->param( 'comment_index' );
221                 my $anchor = $query->param( 'comment_anchor' );
222                 my $location = $query->param( 'comment_location' );
223                 my $silent = $query->param( 'comment_quietly' );
224             
225                 my $output = _getTemplate( "OUTPUT:$type", $topic, $web );
226                 if ( $output =~ m/^%RED%/o ) {
227                   return $output;
228                 }
229             
230                 # Expand the template
231                 $output =~ s/%POS:(.*?)%//go;
232 rizwank 1.1     my $position = $1 || "AFTER";
233             
234                 # Expand common variables in the template, but don't expand other
235                 # tags.
236             	if ( $TWiki::Plugins::VERSION < 1.020 ) {
237             	  eval "use TWiki::Plugins::CairoCompatibilityModule;";
238             	}
239             	$output = TWiki::expandVariablesOnTopicCreation($output);
240             
241             	# CODE_SMELL: This should be part of TWiki::expandVariablesOnTopicCreation
242                 my @t = gmtime();
243                 my $now = sprintf( "%02d:%02d:%02d", $t[2], $t[1], $t[0] );
244                 $output =~ s/%TIME%/$now/go;
245             
246                 my $bloody_hell = TWiki::Func::readTopicText( $web, $topic, undef, 1 );
247                 my $premeta = "";
248                 my $postmeta = "";
249                 my $inpost = 0;
250                 my $text = "";
251                 foreach my $line ( split( /\n/, $bloody_hell )) {
252                   if( $line =~ /^(%META:[^{]+{[^}]*}%)/ ) {
253 rizwank 1.1 		if ( $inpost) {
254             		  $postmeta .= "$1\n";
255             		} else {
256             		  $premeta .= "$1\n";
257             		}
258                   } else {
259             		$text .= "$line\n";
260             		$inpost = 1;
261                   }
262                 }
263             
264                 if ( $position eq "TOP" ) {
265                   $text = "$output$text";
266                 } elsif ( $position eq "BOTTOM" ) {
267                   $text .= "$output";
268                 } else {
269                   if ( $location ) {
270             		if ( $position eq "BEFORE" ) {
271             		  $text =~ s/($location)/$output$1/m;
272             		} else { # AFTER
273             		  $text =~ s/($location)/$1$output/m;
274 rizwank 1.1 		}
275                   } elsif ( $anchor ) {
276             		# position relative to anchor
277             		if ( $position eq "BEFORE" ) {
278             		  $text =~ s/^($anchor)/$output$1/m;
279             		} else { # AFTER
280             		  $text =~ s/^($anchor)/$1$output/m;
281             		}
282                   } else {
283             		# Position relative to index'th comment
284             		my $idx = 0;
285             		$text =~ s/(%COMMENT({.*?})?%)/&_nth($1,\$idx,$position,$index,$output)/ego;
286                   }
287                 }
288                 $text =~ s/ {3}/\t/go;
289                 $text = $premeta . $text . $postmeta;
290             	return TWiki::Func::saveTopicText( $web, $topic, $text, 1, $silent );
291               }
292             
293               # PRIVATE embed output if this comment is the interesting one
294               sub _nth {
295 rizwank 1.1     my ( $tag, $pidx, $position, $index, $output ) = @_;
296             
297                 if ( $$pidx == $index) {
298                   if ( $position eq "BEFORE" ) {
299             	$tag = "$output$tag";
300                   } else { # AFTER
301             	$tag .= "$output";
302                   }
303                 }
304                 $$pidx++;
305                 return $tag;
306               }
307             }
308             
309             1;