lib/TWiki/Plugins/PreferencesPlugin.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
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) 2005-2007  TWiki Contributors.
colas@0
     4
# All Rights Reserved. TWiki Contributors are listed in the
colas@0
     5
# AUTHORS file in the root of this distribution.
colas@0
     6
# NOTE: Please extend that file, not this notice.
colas@0
     7
#
colas@0
     8
# This program is free software; you can redistribute it and/or
colas@0
     9
# modify it under the terms of the GNU General Public License
colas@0
    10
# as published by the Free Software Foundation; either version 2
colas@0
    11
# of the License, or (at your option) any later version. For
colas@0
    12
# more details read LICENSE in the root of this distribution.
colas@0
    13
#
colas@0
    14
# This program is distributed in the hope that it will be useful,
colas@0
    15
# but WITHOUT ANY WARRANTY; without even the implied warranty of
colas@0
    16
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
colas@0
    17
#
colas@0
    18
# For licensing info read LICENSE file in the TWiki root.
colas@0
    19
colas@0
    20
# Still do to:
colas@0
    21
# Handle continuation lines (see Prefs::parseText). These should always
colas@0
    22
# go into a text area.
colas@0
    23
colas@0
    24
package TWiki::Plugins::PreferencesPlugin;
colas@0
    25
colas@0
    26
use strict;
colas@0
    27
colas@0
    28
require TWiki::Func;    # The plugins API
colas@0
    29
require TWiki::Plugins; # For the API version
colas@0
    30
colas@0
    31
use vars qw( $VERSION $RELEASE @shelter );
colas@0
    32
colas@0
    33
# This should always be $Rev: 15487 (22 Jan 2008) $ so that TWiki can determine the checked-in
colas@0
    34
# status of the plugin. It is used by the build automation tools, so
colas@0
    35
# you should leave it alone.
colas@0
    36
$VERSION = '$Rev: 15487 (22 Jan 2008) $';
colas@0
    37
colas@0
    38
# This is a free-form string you can use to "name" your own plugin version.
colas@0
    39
# It is *not* used by the build automation tools, but is reported as part
colas@0
    40
# of the version number in PLUGINDESCRIPTIONS.
colas@0
    41
$RELEASE = 'TWiki-4.2';
colas@0
    42
colas@0
    43
my $MARKER = "\007";
colas@0
    44
colas@0
    45
# Markers used during form generation
colas@0
    46
my $START_MARKER  = $MARKER.'STARTPREF'.$MARKER;
colas@0
    47
my $END_MARKER    = $MARKER.'ENDPREF'.$MARKER;
colas@0
    48
colas@0
    49
sub initPlugin {
colas@0
    50
    # check for Plugins.pm versions
colas@0
    51
    if( $TWiki::Plugins::VERSION < 1.026 ) {
colas@0
    52
        TWiki::Func::writeWarning( 'Version mismatch between PreferencesPlugin and Plugins.pm' );
colas@0
    53
        return 0;
colas@0
    54
    }
colas@0
    55
    @shelter = ();
colas@0
    56
colas@0
    57
    return 1;
colas@0
    58
}
colas@0
    59
colas@0
    60
sub beforeCommonTagsHandler {
colas@0
    61
    ### my ( $text, $topic, $web ) = @_;
colas@0
    62
    my $topic = $_[1];
colas@0
    63
    my $web = $_[2];
colas@0
    64
    return unless ( $_[0] =~ m/%EDITPREFERENCES(?:{(.*?)})?%/ );
colas@0
    65
colas@0
    66
    require CGI;
colas@0
    67
    require TWiki::Attrs;
colas@0
    68
    my $formDef;
colas@0
    69
    my $attrs = new TWiki::Attrs( $1 );
colas@0
    70
    if( defined( $attrs->{_DEFAULT} )) {
colas@0
    71
        my( $formWeb, $form ) = TWiki::Func::normalizeWebTopicName(
colas@0
    72
            $web, $attrs->{_DEFAULT} );
colas@0
    73
colas@0
    74
        # SMELL: Unpublished API. No choice, though :-(
colas@0
    75
        require TWiki::Form;    # SMELL
colas@0
    76
        $formDef =
colas@0
    77
          new TWiki::Form( $TWiki::Plugins::SESSION, $formWeb, $form );
colas@0
    78
    }
colas@0
    79
colas@0
    80
    my $query = TWiki::Func::getCgiQuery();
colas@0
    81
colas@0
    82
    my $action = lc $query->param( 'prefsaction' );
colas@0
    83
    $query->Delete( 'prefsaction' );
colas@0
    84
    $action =~ s/\s.*$//;
colas@0
    85
colas@0
    86
    if ( $action eq 'edit' ) {
colas@0
    87
        TWiki::Func::setTopicEditLock( $web, $topic, 1 );
colas@0
    88
        
colas@0
    89
        # Replace setting values by form fields but not inside comments Item4816
colas@0
    90
        my $outtext = '';
colas@0
    91
        my $insidecomment = 0;
colas@0
    92
        foreach my $token ( split/(<!--|-->)/, $_[0] ) {
colas@0
    93
            if ( $token =~ /<!--/ ) {
colas@0
    94
                $insidecomment++;
colas@0
    95
            } elsif ( $token =~ /-->/ ) {
colas@0
    96
                $insidecomment-- if ( $insidecomment > 0 );
colas@0
    97
            } elsif ( !$insidecomment ) {
colas@0
    98
                $token =~ s(^((?:\t|   )+\*\sSet\s*)(\w+)\s*\=(.*$(\n[ \t]+[^\s*].*$)*))
colas@0
    99
                           ($1._generateEditField($web, $topic, $2, $3, $formDef))gem;
colas@0
   100
            }
colas@0
   101
            $outtext .= $token;
colas@0
   102
        }
colas@0
   103
        $_[0] = $outtext;
colas@0
   104
          
colas@0
   105
        $_[0] =~ s/%EDITPREFERENCES({.*?})?%/
colas@0
   106
          _generateControlButtons($web, $topic)/ge;
colas@0
   107
        my $viewUrl = TWiki::Func::getScriptUrl(
colas@0
   108
            $web, $topic, 'viewauth' );
colas@0
   109
        my $startForm = CGI::start_form(
colas@0
   110
            -name => 'editpreferences',
colas@0
   111
            -method => 'post',
colas@0
   112
            -action => $viewUrl );
colas@0
   113
        $startForm =~ s/\s+$//s;
colas@0
   114
        my $endForm = CGI::end_form();
colas@0
   115
        $endForm =~ s/\s+$//s;
colas@0
   116
        $_[0] =~ s/^(.*?)$START_MARKER(.*)$END_MARKER(.*?)$/$1$startForm$2$endForm$3/s;
colas@0
   117
        $_[0] =~ s/$START_MARKER|$END_MARKER//gs;
colas@0
   118
    }
colas@0
   119
colas@0
   120
    if( $action eq 'cancel' ) {
colas@0
   121
        TWiki::Func::setTopicEditLock( $web, $topic, 0 );
colas@0
   122
colas@0
   123
    } elsif( $action eq 'save' ) {
colas@0
   124
colas@0
   125
        my( $meta, $text ) = TWiki::Func::readTopic( $web, $topic );
colas@0
   126
        $text =~ s(^((?:\t|   )+\*\sSet\s)(\w+)\s\=\s(.*)$)
colas@0
   127
          ($1._saveSet($query, $web, $topic, $2, $3, $formDef))mgeo;
colas@0
   128
        TWiki::Func::saveTopic( $web, $topic, $meta, $text );
colas@0
   129
        TWiki::Func::setTopicEditLock( $web, $topic, 0 );
colas@0
   130
        # Finish with a redirect so that the *new* values are seen
colas@0
   131
        my $viewUrl = TWiki::Func::getScriptUrl( $web, $topic, 'view' );
colas@0
   132
        TWiki::Func::redirectCgiQuery( undef, $viewUrl );
colas@0
   133
        return;
colas@0
   134
    }
colas@0
   135
    # implicit action="view", or drop through from "save" or "cancel"
colas@0
   136
    $_[0] =~ s/%EDITPREFERENCES({.*?})?%/_generateEditButton($web, $topic)/ge;
colas@0
   137
}
colas@0
   138
colas@0
   139
# Use the post-rendering handler to plug our formatted editor units
colas@0
   140
# into the text
colas@0
   141
sub postRenderingHandler {
colas@0
   142
    ### my ( $text ) = @_;
colas@0
   143
colas@0
   144
    $_[0] =~ s/SHELTER$MARKER(\d+)/$shelter[$1]/g;
colas@0
   145
}
colas@0
   146
colas@0
   147
# Pluck the default value of a named field from a form definition
colas@0
   148
sub _getField {
colas@0
   149
    my( $formDef, $name ) = @_;
colas@0
   150
    foreach my $f ( @{$formDef->{fields}} ) {
colas@0
   151
        if( $f->{name} eq $name ) {
colas@0
   152
            return $f;
colas@0
   153
        }
colas@0
   154
    }
colas@0
   155
    return undef;
colas@0
   156
}
colas@0
   157
colas@0
   158
# Generate a field suitable for editing this type. Use of the core
colas@0
   159
# function 'renderFieldForEdit' ensures that we will pick up
colas@0
   160
# extra edit types defined in other plugins.
colas@0
   161
sub _generateEditField {
colas@0
   162
    my( $web, $topic, $name, $value, $formDef ) = @_;
colas@0
   163
    $value =~ s/^\s*(.*?)\s*$/$1/ge;
colas@0
   164
colas@0
   165
    my ($extras, $html);
colas@0
   166
colas@0
   167
    if( $formDef ) {
colas@0
   168
        my $fieldDef;
colas@0
   169
        if (defined(&TWiki::Form::getField)) {
colas@0
   170
            # TWiki 4.2 and later
colas@0
   171
            $fieldDef = $formDef->getField( $name );
colas@0
   172
        } else {
colas@0
   173
            # TWiki < 4.2
colas@0
   174
            $fieldDef = _getField( $formDef, $name );
colas@0
   175
        }
colas@0
   176
        if ( $fieldDef ) {
colas@0
   177
            if( defined(&TWiki::Form::renderFieldForEdit)) {
colas@0
   178
                # TWiki < 4.2 SMELL: use of unpublished core function
colas@0
   179
                ( $extras, $html ) =
colas@0
   180
                  $formDef->renderFieldForEdit( $fieldDef, $web, $topic, $value);
colas@0
   181
            } else {
colas@0
   182
                # TWiki 4.2 and later SMELL: use of unpublished core function
colas@0
   183
                ( $extras, $html ) =
colas@0
   184
                  $fieldDef->renderForEdit( $web, $topic, $value );
colas@0
   185
            }
colas@0
   186
        }
colas@0
   187
    }
colas@0
   188
    unless( $html ) {
colas@0
   189
        # No form definition, default to text field.
colas@0
   190
        $html = CGI::textfield( -class=>'twikiEditFormError twikiInputField',
colas@0
   191
                                -name => $name,
colas@0
   192
                                -size => 80, -value => $value );
colas@0
   193
    }
colas@0
   194
colas@0
   195
    push( @shelter, $html );
colas@0
   196
colas@0
   197
    return $START_MARKER.
colas@0
   198
      CGI::span({class=>'twikiAlert',
colas@0
   199
                 style=>'font-weight:bold;'},
colas@0
   200
                $name . ' = SHELTER' . $MARKER . $#shelter).$END_MARKER;
colas@0
   201
}
colas@0
   202
colas@0
   203
# Generate the button that replaces the EDITPREFERENCES tag in view mode
colas@0
   204
sub _generateEditButton {
colas@0
   205
    my( $web, $topic ) = @_;
colas@0
   206
colas@0
   207
    my $viewUrl = TWiki::Func::getScriptUrl(
colas@0
   208
        $web, $topic, 'viewauth' );
colas@0
   209
    my $text = CGI::start_form(
colas@0
   210
        -name => 'editpreferences',
colas@0
   211
        -method => 'post',
colas@0
   212
        -action => $viewUrl );
colas@0
   213
    $text .= CGI::input({
colas@0
   214
        type => 'hidden',
colas@0
   215
        name => 'prefsaction',
colas@0
   216
        value => 'edit'});
colas@0
   217
    $text .= CGI::submit(-name => 'edit',
colas@0
   218
                         -value=>'Edit Preferences',
colas@0
   219
                         -class=>'twikiButton');
colas@0
   220
    $text .= CGI::end_form();
colas@0
   221
    $text =~ s/\n//sg;
colas@0
   222
    return $text;
colas@0
   223
}
colas@0
   224
colas@0
   225
# Generate the buttons that replace the EDITPREFERENCES tag in edit mode
colas@0
   226
sub _generateControlButtons {
colas@0
   227
    my( $web, $topic ) = @_;
colas@0
   228
colas@0
   229
    my $text = $START_MARKER.CGI::submit(-name=>'prefsaction',
colas@0
   230
                                         -value=>'Save new settings',
colas@0
   231
                                         -class=>'twikiSubmit',
colas@0
   232
                                         -accesskey=>'s');
colas@0
   233
    $text .= '&nbsp;';
colas@0
   234
    $text .= CGI::submit(-name=>'prefsaction', -value=>'Cancel',
colas@0
   235
                         -class=>'twikiButton',
colas@0
   236
                         -accesskey=>'c').$END_MARKER;
colas@0
   237
    return $text;
colas@0
   238
}
colas@0
   239
colas@0
   240
# Given a Set in the topic being saved, look in the query to see
colas@0
   241
# if there is a new value for the Set and generate a new
colas@0
   242
# Set statement.
colas@0
   243
sub _saveSet {
colas@0
   244
    my( $query, $web, $topic, $name, $value, $formDef ) = @_;
colas@0
   245
colas@0
   246
    my $newValue = $query->param( $name ) || $value;
colas@0
   247
colas@0
   248
    if( $formDef ) {
colas@0
   249
        my $fieldDef = _getField( $formDef, $name );
colas@0
   250
        my $type = $fieldDef->{type} || '';
colas@0
   251
        if( $type && $type =~ /^checkbox/ ) {
colas@0
   252
            my $val = '';
colas@0
   253
            my $vals = $fieldDef->{value};
colas@0
   254
            foreach my $item ( @$vals ) {
colas@0
   255
                my $cvalue = $query->param( $name.$item );
colas@0
   256
                if( defined( $cvalue ) ) {
colas@0
   257
                    if( ! $val ) {
colas@0
   258
                        $val = '';
colas@0
   259
                    } else {
colas@0
   260
                        $val .= ', ' if( $cvalue );
colas@0
   261
                    }
colas@0
   262
                    $val .= $item if( $cvalue );
colas@0
   263
                }
colas@0
   264
            }
colas@0
   265
            $newValue = $val;
colas@0
   266
        }
colas@0
   267
    }
colas@0
   268
    # if no form def, it's just treated as text
colas@0
   269
colas@0
   270
    return $name.' = '.$newValue;
colas@0
   271
}
colas@0
   272
colas@0
   273
1;