lib/TWiki/Plugins/CommentPlugin/Comment.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
colas@0
     1
# Plugin for TWiki Enterprise Collaboration Platform, http://TWiki.org/
colas@0
     2
#
colas@0
     3
# Copyright (C) 2004 Crawford Currie
colas@0
     4
# Copyright (C) 2001-2006 TWiki Contributors.
colas@0
     5
# All Rights Reserved. TWiki Contributors
colas@0
     6
# are listed in the AUTHORS file in the root of this distribution.
colas@0
     7
# NOTE: Please extend that file, not this notice.
colas@0
     8
#
colas@0
     9
# This program is free software; you can redistribute it and/or
colas@0
    10
# modify it under the terms of the GNU General Public License
colas@0
    11
# as published by the Free Software Foundation; either version 2
colas@0
    12
# of the License, or (at your option) any later version. For
colas@0
    13
# more details read LICENSE in the root of this distribution.
colas@0
    14
#
colas@0
    15
# This program is distributed in the hope that it will be useful,
colas@0
    16
# but WITHOUT ANY WARRANTY; without even the implied warranty of
colas@0
    17
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
colas@0
    18
#
colas@0
    19
# For licensing info read LICENSE file in the TWiki root.
colas@0
    20
#
colas@0
    21
# Comment TWiki plugin
colas@0
    22
# Original author David Weller, reimplemented by Peter Masiar
colas@0
    23
# and again by Crawford Currie
colas@0
    24
#
colas@0
    25
# This version is specific to TWiki::Plugins::VERSION > 1.026
colas@0
    26
colas@0
    27
use strict;
colas@0
    28
colas@0
    29
use TWiki;
colas@0
    30
use TWiki::Plugins;
colas@0
    31
use TWiki::Store;
colas@0
    32
use TWiki::Attrs;
colas@0
    33
use CGI qw( -any );
colas@0
    34
colas@0
    35
package TWiki::Plugins::CommentPlugin::Comment;
colas@0
    36
colas@0
    37
# PUBLIC save the given comment.
colas@0
    38
sub save {
colas@0
    39
    #my ( $text, $topic, $web ) = @_;
colas@0
    40
colas@0
    41
    my $wikiName = TWiki::Func::getWikiName();
colas@0
    42
    if( ! TWiki::Func::checkAccessPermission( 'change', $wikiName, '',
colas@0
    43
											  $_[1], $_[2] ) ) {
colas@0
    44
        # user has no permission to change the topic
colas@0
    45
        throw TWiki::OopsException( 'accessdenied',
colas@0
    46
                                    def => 'topic_access',
colas@0
    47
                                    web => $_[2],
colas@0
    48
                                    topic => $_[1] );
colas@0
    49
    } else {
colas@0
    50
        _buildNewTopic( @_ );
colas@0
    51
    }
colas@0
    52
}
colas@0
    53
colas@0
    54
# PUBLIC STATIC convert COMMENT statements to form prompts
colas@0
    55
sub prompt {
colas@0
    56
    #my ( $previewing, $text, $web, $topic ) = @_;
colas@0
    57
colas@0
    58
    my $defaultType = TWiki::Func::getPreferencesValue('COMMENTPLUGIN_DEFAULT_TYPE') || 'above';
colas@0
    59
colas@0
    60
    my $message = '';
colas@0
    61
    # Is commenting disabled?
colas@0
    62
    my $disable = '';
colas@0
    63
    if ( $_[0] ) {
colas@0
    64
        # We are in Preview mode
colas@0
    65
        $message  = "(Edit - Preview)";
colas@0
    66
        $disable = 'disabled';
colas@0
    67
    }
colas@0
    68
colas@0
    69
    my $idx = 0;
colas@0
    70
    $_[1] =~ s/%COMMENT({.*?})?%/_handleInput($1,$_[2],$_[3],\$idx,$message,$disable,$defaultType)/eg;
colas@0
    71
}
colas@0
    72
colas@0
    73
=pod
colas@0
    74
colas@0
    75
Parses a templatetopic attribute and returns a "Web.Topic" string.
colas@0
    76
colas@0
    77
=cut
colas@0
    78
colas@0
    79
sub _getTemplateLocation {
colas@0
    80
    my ( $attrtemplatetopic, $web ) = @_;
colas@0
    81
colas@0
    82
    my $templatetopic = '';
colas@0
    83
    my $templateweb = $web || '';
colas@0
    84
    if ( $attrtemplatetopic ) {
colas@0
    85
        my ($templocweb, $temploctopic ) =
colas@0
    86
          TWiki::Func::normalizeWebTopicName($templateweb, $attrtemplatetopic);
colas@0
    87
        $templatetopic = "$templocweb.$temploctopic";
colas@0
    88
    }
colas@0
    89
    return $templatetopic;
colas@0
    90
}
colas@0
    91
colas@0
    92
# PRIVATE generate an input form for a %COMMENT tag
colas@0
    93
sub _handleInput {
colas@0
    94
    my ( $attributes, $web, $topic, $pidx, $message,
colas@0
    95
         $disable, $defaultType ) = @_;
colas@0
    96
colas@0
    97
    $attributes =~ s/^{(.*)}$/$1/ if ( $attributes );
colas@0
    98
colas@0
    99
    my $attrs = new TWiki::Attrs( $attributes, 1 );
colas@0
   100
    my $type =
colas@0
   101
      $attrs->remove( 'type' ) || $attrs->remove( 'mode' ) || $defaultType;
colas@0
   102
    my $silent = $attrs->remove( 'nonotify' );
colas@0
   103
    my $location = $attrs->remove( 'location' );
colas@0
   104
    my $remove = $attrs->remove( 'remove' );
colas@0
   105
    my $nopost = $attrs->remove( 'nopost' );
colas@0
   106
    my $default = $attrs->remove( 'default' );
colas@0
   107
    my $attrtemplatetopic = $attrs->remove( 'templatetopic' ) || '';
colas@0
   108
    my $templatetopic = _getTemplateLocation( $attrtemplatetopic, $web );
colas@0
   109
colas@0
   110
    $message ||= $default || '';
colas@0
   111
    $message ||= $default || '';
colas@0
   112
	$disable ||= '';
colas@0
   113
colas@0
   114
    # clean off whitespace
colas@0
   115
    $type =~ m/(\S*)/;
colas@0
   116
    $type = $1;
colas@0
   117
colas@0
   118
    # Expand the template in the context of the web where the comment
colas@0
   119
    # box is (not the target of the comment!)
colas@0
   120
    my $input = _getTemplate( "PROMPT:$type", $web, $topic, $templatetopic ) || '';
colas@0
   121
    return $input if $input =~ m/^%RED%/so;
colas@0
   122
colas@0
   123
    # Expand special attributes as required
colas@0
   124
    $input =~ s/%([a-z]\w+)\|(.*?)%/_expandPromptParams($1, $2, $attrs)/ieg;
colas@0
   125
colas@0
   126
    # see if this comment is targeted at a different topic, and
colas@0
   127
    # change the url if it is.
colas@0
   128
    my $anchor = undef;
colas@0
   129
    my $target = $attrs->remove( 'target' );
colas@0
   130
    if ( $target ) {
colas@0
   131
        # extract web and anchor
colas@0
   132
        if ( $target =~ s/^(\w+)\.// ) {
colas@0
   133
            $web = $1;
colas@0
   134
        }
colas@0
   135
        if ( $target =~ s/(#\w+)$// ) {
colas@0
   136
            $anchor = $1;
colas@0
   137
        }
colas@0
   138
        if ( $target ne '' ) {
colas@0
   139
            $topic = $target;
colas@0
   140
        }
colas@0
   141
    }
colas@0
   142
colas@0
   143
    my $url = '';
colas@0
   144
    if ( $disable eq '' ) {
colas@0
   145
        $url = TWiki::Func::getScriptUrl( $web, $topic, 'save' );
colas@0
   146
    }
colas@0
   147
colas@0
   148
    my $noform = $attrs->remove('noform') || '';
colas@0
   149
    if ( $input !~ m/^%RED%/ ) {
colas@0
   150
        $input =~ s/%DISABLED%/$disable/g;
colas@0
   151
        $input =~ s/%MESSAGE%/$message/g;
colas@0
   152
        my $n = $$pidx + 0;
colas@0
   153
colas@0
   154
        if ( $disable eq '' ) {
colas@0
   155
            my $hiddenFields = "";
colas@0
   156
            $hiddenFields .= "\n".CGI::hidden(
colas@0
   157
                -name=>'comment_action', -value=>'save' );
colas@0
   158
            $hiddenFields .= "\n".CGI::hidden(
colas@0
   159
                -name=>'comment_type', -value=>$type );
colas@0
   160
            if( defined( $silent )) {
colas@0
   161
                $hiddenFields .= "\n".CGI::hidden(
colas@0
   162
                    -name=>'comment_nonotify', value=>1 );
colas@0
   163
            }
colas@0
   164
            if ( $templatetopic ) {
colas@0
   165
                $hiddenFields .= "\n".CGI::hidden(
colas@0
   166
                    -name=>'comment_templatetopic', -value=>$templatetopic );
colas@0
   167
            }
colas@0
   168
            if ( $location ) {
colas@0
   169
                $hiddenFields .= "\n".CGI::hidden(
colas@0
   170
                    -name=>'comment_location', -value=>$location );
colas@0
   171
            } elsif ( $anchor ) {
colas@0
   172
                $hiddenFields .= "\n".CGI::hidden(
colas@0
   173
                    -name=>'comment_anchor', -value=>$anchor );
colas@0
   174
            } else {
colas@0
   175
                $hiddenFields .= "\n".CGI::hidden(
colas@0
   176
                    -name=>'comment_index', -value=>$$pidx );
colas@0
   177
            }
colas@0
   178
            if( $nopost ) {
colas@0
   179
                $hiddenFields .= "\n".CGI::hidden(
colas@0
   180
                    -name=>'comment_nopost', -value=>$nopost );
colas@0
   181
            }
colas@0
   182
            if( $remove ) {
colas@0
   183
                $hiddenFields .= "\n".CGI::hidden(
colas@0
   184
                    -name=>'comment_remove', -value=>$$pidx );
colas@0
   185
            }
colas@0
   186
            $input .= $hiddenFields;
colas@0
   187
        }
colas@0
   188
        if ( $noform ) {
colas@0
   189
            my $form = _getTemplate( "FORM:$type", $topic, $web,
colas@0
   190
                                     $templatetopic, 'off' ) || '';
colas@0
   191
            if ( $form ) {
colas@0
   192
                $form =~ s/%COMMENTPROMPT%/$input/;
colas@0
   193
                $input = $form;
colas@0
   194
            }
colas@0
   195
        }
colas@0
   196
        unless ($noform eq 'on') {
colas@0
   197
            $input = CGI::start_form( -name => $type.$n,
colas@0
   198
                                      -id => $type.$n,
colas@0
   199
                                      -action=>$url,
colas@0
   200
                                      -method=>'post' ).$input.CGI::end_form();
colas@0
   201
        }
colas@0
   202
    }
colas@0
   203
    $$pidx++;
colas@0
   204
    return $input;
colas@0
   205
}
colas@0
   206
colas@0
   207
# PRIVATE get the given template and do standard expansions
colas@0
   208
sub _getTemplate {
colas@0
   209
    my ( $name, $topic, $web, $templatetopic, $warn ) = @_;
colas@0
   210
colas@0
   211
    $warn ||= '';
colas@0
   212
colas@0
   213
    # Get the templates.
colas@0
   214
    my $templateFile = $templatetopic
colas@0
   215
        || TWiki::Func::getPreferencesValue('COMMENTPLUGIN_TEMPLATES')
colas@0
   216
        || 'comments';
colas@0
   217
colas@0
   218
    my $templates =
colas@0
   219
      TWiki::Func::loadTemplate( $templateFile );
colas@0
   220
    if (! $templates ) {
colas@0
   221
        TWiki::Func::writeWarning("Could not read template file '$templateFile'");
colas@0
   222
        return;
colas@0
   223
    }
colas@0
   224
colas@0
   225
    my $t = TWiki::Func::expandTemplate( $name );
colas@0
   226
    return "%RED%No such template def TMPL:DEF{$name}%ENDCOLOR%"
colas@0
   227
      unless ( defined($t) && $t ne '' ) || $warn eq 'off';
colas@0
   228
colas@0
   229
    return $t;
colas@0
   230
}
colas@0
   231
colas@0
   232
# PRIVATE expand special %param|default% parameters in PROMPT template
colas@0
   233
sub _expandPromptParams {
colas@0
   234
    my ( $name, $default, $attrs ) = @_;
colas@0
   235
colas@0
   236
    my $val = $attrs->{$name};
colas@0
   237
    return $val if defined( $val );
colas@0
   238
    return $default;
colas@0
   239
}
colas@0
   240
colas@0
   241
# PRIVATE STATIC Performs comment insertion in the topic.
colas@0
   242
sub _buildNewTopic {
colas@0
   243
    #my ( $text, $topic, $web ) = @_;
colas@0
   244
    my ( $topic, $web ) = ( $_[1], $_[2] );
colas@0
   245
colas@0
   246
    my $query = TWiki::Func::getCgiQuery();
colas@0
   247
    return unless $query;
colas@0
   248
colas@0
   249
    my $type = $query->param( 'comment_type' ) ||
colas@0
   250
      TWiki::Func::getPreferencesValue('COMMENTPLUGIN_DEFAULT_TYPE') ||
colas@0
   251
          'below';
colas@0
   252
    my $index = $query->param( 'comment_index' ) || 0;
colas@0
   253
    my $anchor = $query->param( 'comment_anchor' );
colas@0
   254
    my $location = $query->param( 'comment_location' );
colas@0
   255
    my $remove = $query->param( 'comment_remove' );
colas@0
   256
    my $nopost = $query->param( 'comment_nopost' );
colas@0
   257
    my $templatetopic = $query->param( 'comment_templatetopic' ) || '';
colas@0
   258
colas@0
   259
    my $output = _getTemplate( "OUTPUT:$type", $topic, $web, $templatetopic );
colas@0
   260
    if ( $output =~ m/^%RED%/ ) {
colas@0
   261
        die $output;
colas@0
   262
    }
colas@0
   263
colas@0
   264
    # Expand the template
colas@0
   265
    my $position = 'AFTER';
colas@0
   266
    if( $output =~ s/%POS:(.*?)%//g ) {
colas@0
   267
        $position = $1;
colas@0
   268
    }
colas@0
   269
colas@0
   270
    # Expand common variables in the template, but don't expand other
colas@0
   271
    # tags.
colas@0
   272
    $output = TWiki::Func::expandVariablesOnTopicCreation($output);
colas@0
   273
colas@0
   274
    $output = '' unless defined($output);
colas@0
   275
colas@0
   276
    # SMELL: Reverse the process that inserts meta-data just performed
colas@0
   277
    # by the TWiki core, but this time without the support of the
colas@0
   278
    # methods in the core. Fortunately this will work even if there is
colas@0
   279
    # no embedded meta-data.
colas@0
   280
    # Note: because this is Dakar, and has sensible semantics for handling
colas@0
   281
    # the =text= parameter to =save=, there is no longer any need to re-read
colas@0
   282
    # the topic. The text is automatically defaulted to the existing topic
colas@0
   283
    # text if the =text= parameter isn't specified - which for comments,
colas@0
   284
    # it isn't.
colas@0
   285
    my $premeta = '';
colas@0
   286
    my $postmeta = '';
colas@0
   287
    my $inpost = 0;
colas@0
   288
    my $text = '';
colas@0
   289
    foreach my $line ( split( /\r?\n/, $_[0] )) {
colas@0
   290
        if( $line =~ /^%META:[A-Z]+{[^}]*}%/ ) {
colas@0
   291
            if ( $inpost) {
colas@0
   292
                $postmeta .= $line."\n";
colas@0
   293
            } else {
colas@0
   294
                $premeta .= $line."\n";
colas@0
   295
            }
colas@0
   296
        } else {
colas@0
   297
            $text .= $line."\n";
colas@0
   298
            $inpost = 1;
colas@0
   299
        }
colas@0
   300
    }
colas@0
   301
colas@0
   302
    unless( $nopost ) {
colas@0
   303
        if( $position eq 'TOP' ) {
colas@0
   304
            $text = $output.$text;
colas@0
   305
        } elsif ( $position eq 'BOTTOM' ) {
colas@0
   306
            # Awkward newlines here, to avoid running into meta-data.
colas@0
   307
            # This should _not_ be a problem.
colas@0
   308
            $text =~ s/[\r\n]+$//;
colas@0
   309
            $text .= "\n" unless $output =~ m/^\n/s;
colas@0
   310
            $text .= $output;
colas@0
   311
            $text .= "\n" unless $text =~ m/\n$/s;
colas@0
   312
        } else {
colas@0
   313
            if ( $location ) {
colas@0
   314
                if ( $position eq 'BEFORE' ) {
colas@0
   315
                    $text =~ s/(?<!location\=\")($location)/$output$1/m;
colas@0
   316
                } else { # AFTER
colas@0
   317
                    $text =~ s/(?<!location\=\")($location)/$1$output/m;
colas@0
   318
                }
colas@0
   319
            } elsif ( $anchor ) {
colas@0
   320
                # position relative to anchor
colas@0
   321
                if ( $position eq 'BEFORE' ) {
colas@0
   322
                    $text =~ s/^($anchor\s)/$output$1/m;
colas@0
   323
                } else { # AFTER
colas@0
   324
                    $text =~ s/^($anchor\s)/$1$output/m;
colas@0
   325
                }
colas@0
   326
            } else {
colas@0
   327
                # Position relative to index'th comment
colas@0
   328
                my $idx = 0;
colas@0
   329
                unless( $text =~ s((%COMMENT({.*?})?%.*\n))
colas@0
   330
                          (&_nth($1,\$idx,$position,$index,$output))eg ) {
colas@0
   331
                    # If there was a problem adding relative to the comment,
colas@0
   332
                    # add to the end of the topic
colas@0
   333
                    $text .= $output;
colas@0
   334
                };
colas@0
   335
            }
colas@0
   336
        }
colas@0
   337
    }
colas@0
   338
colas@0
   339
    if (defined $remove) {
colas@0
   340
        # remove the index'th comment box
colas@0
   341
        my $idx = 0;
colas@0
   342
        $text =~ s/(%COMMENT({.*?})?%)/_remove_nth($1,\$idx,$remove)/eg;
colas@0
   343
    }
colas@0
   344
colas@0
   345
    $_[0] = $premeta . $text . $postmeta;
colas@0
   346
}
colas@0
   347
colas@0
   348
# PRIVATE embed output if this comment is the interesting one
colas@0
   349
sub _nth {
colas@0
   350
    my ( $tag, $pidx, $position, $index, $output ) = @_;
colas@0
   351
colas@0
   352
    if ( $$pidx == $index) {
colas@0
   353
        if ( $position eq 'BEFORE' ) {
colas@0
   354
            $tag = $output.$tag;
colas@0
   355
        } else { # AFTER
colas@0
   356
            $tag .= $output;
colas@0
   357
        }
colas@0
   358
    }
colas@0
   359
    $$pidx++;
colas@0
   360
    return $tag;
colas@0
   361
}
colas@0
   362
colas@0
   363
# PRIVATE remove the nth comment box
colas@0
   364
sub _remove_nth {
colas@0
   365
    my( $tag, $pidx, $index ) = @_;
colas@0
   366
    $tag = '' if( $$pidx == $index);
colas@0
   367
    $$pidx++;
colas@0
   368
    return $tag;
colas@0
   369
}
colas@0
   370
colas@0
   371
1;