#!/usr/local/bin/perl -wT ##!/home/bradford/bin/perl -wT ##!/home/bradford/bin/perl -wT ##!/usr/bin/perl -wT # # TWiki WikiClone (see TWiki.pm for $wikiversion and other info) # # Copyright (C) 1999-2001 Peter Thoeny, peter@thoeny.com # Shawn Bradford 20011010 Initial design # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details, published at # http://www.gnu.org/copyleft/gpl.html use CGI::Carp qw(fatalsToBrowser); use CGI; use File::Copy; # FIXME remove use lib ( '.' ); use lib ( '../lib' ); use TWiki; $query = new CGI; ##### for debug only: Remove next 3 comments (but redirect does not work) #open(STDERR,'>&STDOUT'); # redirect error to browser $| = 1; # no buffering #TWiki::writeHeader( $query ); &main(); # ========================= sub handleError { my( $noredirect, $message, $query, $theWeb, $theTopic, $theOopsTemplate, $oopsArg1, $oopsArg2 ) = @_; if( $noredirect ) { $oopsArg1 = "" if( ! $oopsArg1 ); $oopsArg2 = "" if( ! $oopsArg2 ); &TWiki::writeHeader( $query ); print "ERROR $theWeb.$theTopic $message $oopsArg1 $oopsArg2\n"; } else { my $url = &TWiki::getOopsUrl( $theWeb, $theTopic, $theOopsTemplate, $oopsArg1, $oopsArg2 ); TWiki::redirect( $query, $url ); } } # ========================= sub main { my $thePathInfo = $query->path_info(); my $theRemoteUser = $query->remote_user(); my $theTopic = $query->param( 'topic' ); my $template = $query->param( 'template' || ""); my $tableName = $query->param( 'tableName' || ""); my $name = $query->param( 'name' || ""); my $theUrl = $query->url; my $deleteElement = $query->param( 'deleteElement' ); my $copyElement = $query->param( 'copyElement' ); my $noredirect = $query->param( 'noredirect' ) || ""; ( $topic, $webName, $dummy, $userName ) = &TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query ); $dummy = ""; # to suppress warning my $wikiUserName = &TWiki::userToWikiName( $userName ); if( ! &TWiki::Store::webExists( $webName ) ) { handleError( $noredirect, "Missing Web", $query, $webName, $topic, "oopsnoweb" ); return; } my( $mirrorSiteName, $mirrorViewURL ) = &TWiki::readOnlyMirrorWeb( $webName ); if( $mirrorSiteName ) { handleError( $noredirect, "This is a readonly mirror", $query, $webName, $topic, "oopsmirror", $mirrorSiteName, $mirrorViewURL ); return; } # check access permission if( ! &TWiki::Access::checkAccessPermission( "change", $wikiUserName, "", $topic, $webName ) ) { handleError( $noredirect, "No change permission", $query, $webName, $topic, "oopsaccesschange" ); return; } my $filePath = $query->param( 'filepath' ) || ""; my $fileName = $query->param( 'filename' ) || ""; if ( $filePath && ! $fileName ) { $filePath =~ m|([^/\\]*$)|; $fileName = $1; } # Need to cycle through the fieldDefs and query the parameters to fill the # the associative array my @fieldsInfo = &TWiki::Form::getFormDef( $webName, $template ); my @fieldElements = (); # Name is name based upon a unique time-stamp. This is based to the editTable.tmpl # and is transparent to the user. This removes the constraint of unique first columns. my $sortName = $name; if ( $copyElement ) { #Give unique table element keys for copied elements $sortName = time; } my $firstEntry = 1; foreach my $c ( @fieldsInfo ) { my @fieldInfo = @$c; my $entryName = shift @fieldInfo; my $title = shift @fieldInfo; my $type = shift @fieldInfo; my $size = shift @fieldInfo; my $tableEntry= $query->param( $entryName ); my $cvalue = ""; ## Puts default text "---" for first entry if ( ($firstEntry == 1) && ($tableEntry == "") ) { $tableEntry = "---"; $firstEntry = 0; } # Takes care of special checkbox entry (Form.pm -- line : 376) if( ! $tableEntry && $type =~ "^checkbox" ) { foreach my $name ( @fieldInfo ) { $cvalue = $query->param( "$entryName" . "$name" ); if( defined( $cvalue ) ) { if( ! $tableEntry ) { $tableEntry = ""; } else { $tableEntry .= ", " if( $cvalue ); } $tableEntry .= "$name" if( $cvalue ); } } } push @fieldElements, ( "$entryName" => TWiki::Plugins::TablePlugin::carriageReturnConvert( $tableEntry ) ); } push @fieldElements, ( "name" => TWiki::Plugins::TablePlugin::stringConvert( $sortName ) ); # JET need to change windows path to unix path $tmpFilename =~ s@\\@/@go; $tmpFilename =~ /(.*)/; $tmpFilename = $1; #&TWiki::writeDebug( "upload: tmpFilename $tmpFilename" ); my( $fileSize, $fileUser, $fileDate, $fileVersion ) = ""; # update topic my( $meta, $text ) = &TWiki::Store::readTopic( $webName, $topic ); # Remove any elements that have spaces in the name. They will be added without spaces (This should be removed) if ( $sortName ne TWiki::Plugins::TablePlugin::stringConvert($sortName) ) { $meta->remove ( "TABLE", $sortName ); } if ( $deleteElement ) { $meta->remove ( "TABLE", TWiki::Plugins::TablePlugin::stringConvert($sortName) ); } else { TWiki::Plugins::TablePlugin::updateTable ( $meta, $template, $tableName, @fieldElements ); } my $error = &TWiki::Store::saveTopic( $webName, $topic, $text, $meta ); if( $error ) { handleError( $noredirect, "Save topic error", $query, $webName, $topic, "oopssaveerr", $error ); } else { # and finally display topic if( $noredirect ) { &TWiki::writeHeader( $query ); my $message = ( $doChangeProperties ) ? "properties changed" : "$fileName uploaded"; print( "OK $message\n" ); } else { TWiki::redirect( $query, &TWiki::getViewUrl( "", $topic ) ); } } } # EOF