Skip to content

Commit 5e23915

Browse files
SvenDowideitSvenDowideit
authored andcommitted
import SetVariableAddOn
1 parent 55a55c8 commit 5e23915

File tree

1 file changed

+171
-0
lines changed

1 file changed

+171
-0
lines changed

SetVariableAddOn/bin/setvar

Lines changed: 171 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,171 @@
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

Comments
 (0)