|
| 1 | +#!/usr/bin/perl -wT |
| 2 | +# |
| 3 | +# TWiki WikiClone (see wiki.pm for $wikiversion and other info) |
| 4 | +# |
| 5 | +# Based on parts of Ward Cunninghams original Wiki and JosWiki. |
| 6 | +# Copyright (C) 1998 Markus Peter - SPiN GmbH ([email protected]) |
| 7 | +# Some changes by Dave Harris ([email protected]) incorporated |
| 8 | +# Copyright (C) 1999-2000 Peter Thoeny, [email protected] |
| 9 | +# |
| 10 | +# This program is free software; you can redistribute it and/or |
| 11 | +# modify it under the terms of the GNU General Public License |
| 12 | +# as published by the Free Software Foundation; either version 2 |
| 13 | +# of the License, or (at your option) any later version. |
| 14 | +# |
| 15 | +# This program is distributed in the hope that it will be useful, |
| 16 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | +# GNU General Public License for more details, published at |
| 19 | +# http://www.gnu.org/copyleft/gpl.html |
| 20 | + |
| 21 | +#This is a hack to the standard "save" script until Plugins are allowed |
| 22 | +#to handle form processing |
| 23 | + |
| 24 | +BEGIN { unshift @INC, '.'; require 'setlib.cfg'; } |
| 25 | + |
| 26 | +use CGI::Carp qw(fatalsToBrowser); |
| 27 | +use CGI; |
| 28 | +use TWiki; |
| 29 | + |
| 30 | +$query= new CGI; |
| 31 | + |
| 32 | +&main(); |
| 33 | + |
| 34 | +sub main |
| 35 | +{ |
| 36 | + |
| 37 | +=pod |
| 38 | +
|
| 39 | +###################################################################### |
| 40 | +# USE THIS CODE TO DO THE DEBUGGING # |
| 41 | +###################################################################### |
| 42 | +
|
| 43 | +my $thePathInfo = $query->path_info(); |
| 44 | +my $theRemoteUser = $query->remote_user(); |
| 45 | +my $theUrl = $query->url; |
| 46 | +
|
| 47 | +print "Content-type: text/html\n\n"; |
| 48 | +print "Hello, world!\n"; |
| 49 | +print "# $varweb # $vartopic # $varname # $varvalue #\n"; |
| 50 | +print "# $thePathInfo # $theRemoteUser # $theUrl #\n"; |
| 51 | +
|
| 52 | +( $topic, $webName, $dummy, $userName ) = |
| 53 | + &TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query ); |
| 54 | +$dummy = ""; # to suppress warning |
| 55 | +print "# $topic # $webName # $userName #\n"; |
| 56 | +=cut |
| 57 | + |
| 58 | + my $thePathInfo = $query->path_info(); |
| 59 | + my $theRemoteUser = $query->remote_user(); |
| 60 | + my $theUrl = $query->url; |
| 61 | + |
| 62 | + my $varweb = $query->param( 'varweb' ); |
| 63 | + my $vartopic = $query->param( 'vartopic' ); |
| 64 | + my $varname = $query->param( 'varname' ); |
| 65 | + my $varvalue = $query->param( 'varvalue' ); |
| 66 | + my $modtype = $query->param( 'modtype' ); |
| 67 | + |
| 68 | + |
| 69 | + ( $topic, $webName, $dummy, $userName ) = |
| 70 | + &TWiki::initialize( $thePathInfo, $theRemoteUser, "", $theUrl, $query ); |
| 71 | + |
| 72 | + $dummy = ""; # to suppress warning |
| 73 | + |
| 74 | + my $wikiUserName = TWiki::Func::getWikiUserName(); |
| 75 | + |
| 76 | + $topic = $vartopic; |
| 77 | + $webName = $varweb; |
| 78 | + |
| 79 | + if( ! &TWiki::Store::webExists( $webName ) ) { |
| 80 | + my $url = &TWiki::getOopsUrl( $webName, $topic, "oopsnoweb" ); |
| 81 | + TWiki::redirect( $query, $url ); |
| 82 | + return; |
| 83 | + } |
| 84 | + |
| 85 | + if( ! &TWiki::Store::topicExists( $webName, $topic ) ) { |
| 86 | + TWiki::redirect( $query, &TWiki::getViewUrl( $webName, $topic ) ); |
| 87 | + return; |
| 88 | + } |
| 89 | + |
| 90 | + if( $varname eq "" or $varvalue eq "" or $modtype eq "" ) { |
| 91 | + TWiki::redirect( $query, &TWiki::getViewUrl( $webName, $topic ) ); |
| 92 | + return; |
| 93 | + } |
| 94 | + |
| 95 | + |
| 96 | + # check access permission using POST |
| 97 | + my $accessChange = TWiki::Func::checkAccessPermission( "change", $wikiUserName, "", $topic, $webName ); |
| 98 | + |
| 99 | + my $accessSetvar = TWiki::Func::checkAccessPermission( "setvar", $wikiUserName, "", $topic, $webName ); |
| 100 | + |
| 101 | + $accessSetvar = 1 if ( $varname =~ /CHANGEABLE/ ); |
| 102 | + |
| 103 | + if( ! $accessChange or ! $accessSetvar ) { |
| 104 | + my $url = &TWiki::getOopsUrl( $webName, $topic, "oopsaccesschange" ); |
| 105 | + TWiki::redirect( $query, $url ); |
| 106 | + return; |
| 107 | + } |
| 108 | + |
| 109 | + my $unlock = "on"; |
| 110 | + my $dontNotify = ""; |
| 111 | + my $saveCmd = ""; |
| 112 | + |
| 113 | + #now just read in the topic file, modify it, and save |
| 114 | + my ($meta, $text) = &TWiki::Store::readTopic( $webName, $topic ); |
| 115 | + |
| 116 | + my $emptyvalue = 1; # does the TWiki Variable have an empty value? |
| 117 | + # 1 -> the value of the TWiki Var is an empty string |
| 118 | + # 0 -> the value is not an empty string |
| 119 | + |
| 120 | + $emptyvalue = 0 if ( $text =~ /Set $varname = ./ ); |
| 121 | + |
| 122 | + if ( $modtype eq "replace" ) |
| 123 | + { |
| 124 | + $text =~ s/Set $varname = .*/Set $varname = $varvalue/g; |
| 125 | + } |
| 126 | + elsif ( $modtype eq "append" ) |
| 127 | + { |
| 128 | + $emptyvalue ? |
| 129 | + $text =~ s/Set $varname = /Set $varname = ${varvalue}/g : |
| 130 | + $text =~ s/Set $varname = (.*)/Set $varname = ${1}, ${varvalue}/g; |
| 131 | + } |
| 132 | + elsif ( $modtype eq "add" ) |
| 133 | + { |
| 134 | + if ( $text !~ /Set $varname = .*${varvalue}.*/ ) |
| 135 | + { |
| 136 | + $emptyvalue ? |
| 137 | + $text =~ s/Set $varname = /Set $varname = ${varvalue}/g : |
| 138 | + $text =~ s/Set $varname = (.*)/Set $varname = ${1}, ${varvalue}/g; |
| 139 | + } |
| 140 | + } |
| 141 | + elsif ( $modtype eq "remove" ) |
| 142 | + { |
| 143 | + if ( $text =~ /Set $varname = (.*${varvalue}.*)/ ) |
| 144 | + { |
| 145 | + my $textpart = $1; |
| 146 | + $textpart =~ s/$varvalue//g; |
| 147 | + $textpart =~ s/, , /, /g; |
| 148 | + $textpart =~ s/^, //g; |
| 149 | + $textpart =~ s/, $//g; |
| 150 | + $text =~ s/Set $varname = .*/Set $varname = $textpart/g; |
| 151 | + } |
| 152 | + } |
| 153 | + |
| 154 | + |
| 155 | + my $error = &TWiki::Store::saveTopic( $webName, $topic, $text, $meta, $saveCmd, $unlock, $dontNotify ); |
| 156 | + |
| 157 | + if( $error ) { |
| 158 | + # S. Knutson 30 Nov 2000: error happened (probably from RCS), show it |
| 159 | + my $url = &TWiki::getOopsUrl( $webName, $topic, "oopssaveerr", $error ); |
| 160 | + TWiki::redirect( $query, $url ); |
| 161 | + } else { |
| 162 | + # We use referer.... it may not be supported by all browsers |
| 163 | + |
| 164 | + if ( $query->referer() ne "" ) { |
| 165 | + TWiki::redirect( $query, $query->referer() ); |
| 166 | + } |
| 167 | + else { |
| 168 | + TWiki::redirect( $query, &TWiki::getViewUrl( $webName, $topic ) ); |
| 169 | + } |
| 170 | + } |
| 171 | +} |
0 commit comments