loncom/publisher/loncfile.pm - diff

Return to loncfile.pm CVS log

Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/loncfile.pm between versions 1.12 and 1.38

version 1.12, 2002/07/28 02:16:59	version 1.38, 2003/08/04 20:08:23
Line 8	Line 8
# and requests confirmation. The second phase commits the action	# and requests confirmation. The second phase commits the action
# and displays a page showing the results of the action.	# and displays a page showing the results of the action.
#	#

#	#
# $Id$	# $Id$
#	#
Line 34	Line 33
#	#
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
#
# (Handler to retrieve an old version of a file
#
# (Publication Handler
#
# (TeX Content Handler
#
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
# 03/23 Guy Albertelli
# 03/24,03/29 Gerd Kortemeyer)
#
# 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer)
#
# 06/23 Gerd Kortemeyer
# 05/07/02 Ron Fox:
# - Added Debug log output so that I can trace what the heck this
# undocumented thingy does.
# 05/28/02 Ron Fox:
# - Started putting in pod in standard format.
=pod	=pod

=head1 NAME	=head1 NAME
Line 69 directory.	Line 47 directory.
=head1 INTRODUCTION	=head1 INTRODUCTION

loncfile is invoked when buttons in the top frame of the construction	loncfile is invoked when buttons in the top frame of the construction
space directory listing are clicked. All operations procede in two phases.	space directory listing are clicked. All operations proceed in two phases.
The first phase describes to the user exactly what will be done. If the user	The first phase describes to the user exactly what will be done. If the user
confirms the operation, the second phase commits the operation and indicates	confirms the operation, the second phase commits the operation and indicates
completion. When the user dismisses the output of phase2, they are returned to	completion. When the user dismisses the output of phase2, they are returned to
Line 86 package Apache::loncfile;	Line 64 package Apache::loncfile;

use strict;	use strict;
use Apache::File;	use Apache::File;
	use File::Basename;
use File::Copy;	use File::Copy;
	use HTML::Entities();
use Apache::Constants qw(:common :http :methods);	use Apache::Constants qw(:common :http :methods);
use Apache::loncacc;	use Apache::loncacc;
use Apache::Log ();	use Apache::Log ();
	use Apache::lonnet;
	use Apache::loncommon();

my $DEBUG=0;	my $DEBUG=0;
my $r; # Needs to be global for some stuff RF.	my $r; # Needs to be global for some stuff RF.
Line 98 my $r; # Needs to be global for some	Line 80 my $r; # Needs to be global for some

=item Debug($request, $message)	=item Debug($request, $message)

If debugging is enabled puts out a debuggin message determined by the	If debugging is enabled puts out a debugging message determined by the
caller. The debug message goes to the Apache error log file. Debugging	caller. The debug message goes to the Apache error log file. Debugging
is enabled by ssetting the module global DEBUG variable to nonzero (TRUE).	is enabled by setting the module global DEBUG variable to nonzero (TRUE).

Parameters:	Parameters:

=over 4	=over 4

=item $request - The curretn request operation.	=item $request - The current request operation.

=item $message - The message to put inthe log file.	=item $message - The message to put in the log file.

=back	=back

Line 125 sub Debug {	Line 107 sub Debug {
my $log = $r->log;	my $log = $r->log;
my $message = shift;	my $message = shift;

# Put out the indicated message butonly if DEBUG is false.	# Put out the indicated message butonly if DEBUG is true.

if ($DEBUG) {	if ($DEBUG) {
$log->debug($message);	$log->debug($message);
Line 153 sub Debug {	Line 135 sub Debug {

=over 4	=over 4

=item The corresponing file system path.	=item The corresponding file system path.

=back	=back

Line 170 Global References	Line 152 Global References
sub URLToPath {	sub URLToPath {
my $Url = shift;	my $Url = shift;
&Debug($r, "UrlToPath got: $Url");	&Debug($r, "UrlToPath got: $Url");
$Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;	$Url=~ s/\/+/\//g;
$Url=~ s/^http\:\/\/[^\/]+//;	$Url=~ s/^http\:\/\/[^\/]+//;
	$Url=~ s/^\///;
	$Url=~ s/(\~\|priv\/)(\w+)\//\/home\/$2\/public_html\//;
&Debug($r, "Returning $Url \n");	&Debug($r, "Returning $Url \n");
return $Url;	return $Url;
}	}

	sub url {
	my $fn=shift;
	$fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/;
	return $fn;
	}

	sub display {
	my $fn=shift;
	$fn=~s/^\/home\/(\w+)\/public\_html//;
	return '<tt>'.$fn.'</tt>';
	}

=pod	=pod

=item PublicationPath($domain, $user, $dir, $file)	=item PublicationPath($domain, $user, $dir, $file)

Determines the filesystem path corersponding to a published resource	Determines the filesystem path corresponding to a published resource
specification. The returned value is the path.	specification. The returned value is the path.
Parameters:	Parameters:

Line 191 Parameters:	Line 187 Parameters:

=item $user - string [in] Name of the user asking about the resource.	=item $user - string [in] Name of the user asking about the resource.

=item $dir - Directory pathr elatvie to the top of the resource space0	=item $dir - Directory path relative to the top of the resource space.

=item $file - name of the resource file itself without path info.	=item $file - name of the resource file itself without path info.

Line 219 sub PublicationPath	Line 215 sub PublicationPath

=item ConstructionPath($domain, $user, $dir, $file)	=item ConstructionPath($domain, $user, $dir, $file)

Determines the filesystem path corersponding to a construction space	Determines the filesystem path corresponding to a construction space
resource specification. The returned value is the path	resource specification. The returned value is the path
Parameters:	Parameters:

Line 227 Parameters:	Line 223 Parameters:

=item $user - string [in] Name of the user asking about the resource.	=item $user - string [in] Name of the user asking about the resource.

=item $dir - Directory path relatvie to the top of the resource space	=item $dir - Directory path relative to the top of the resource space.

=item $file - name of the resource file itself without path info.	=item $file - name of the resource file itself without path info.

Line 245 sub ConstructionPath {	Line 241 sub ConstructionPath {
return '/home/'.$user.'/public_html/'.$dir.'/'.$file;	return '/home/'.$user.'/public_html/'.$dir.'/'.$file;

}	}
=pod

=item ConstructionPathFromRelative($user, $relname)

Determines the path to a construction space file given
the username and the path relative to the root of construction space.

Parameters:

=over 4

=item $user - string [in] Name of the user in whose construction space the
file [will] live.

=item $relname - string[in] Path to the file relative to the root of the
construction space.

=back

Returns:

=over 4

=item string - Full path to the file.

=back

=cut

sub ConstructionPathFromRelative {

my ($user, $relname) = @_;
return '/home/'.$user.'/public_html'.$relname;

}

=pod	=pod

=item exists($user, $domain, $directory, $file)	=item exists($user, $domain, $directory, $file)

Determine if a resource file name has been publisehd or exists	Determine if a resource file name has been published or exists
in the construction space.	in the construction space.

Parameters:	Parameters:
Line 320 sub exists {	Line 281 sub exists {
my ($user, $domain, $dir, $file) = @_;	my ($user, $domain, $dir, $file) = @_;

# Create complete paths in publication and construction space.	# Create complete paths in publication and construction space.
	my $relativedir=$dir;
my $published = &PublicationPath($domain, $user, $dir, $file);	$relativedir=s\|/home/\Q$user\E/public_html\|\|;
my $construct = &ConstructionPath($user, $dir, $file);	my $published = &PublicationPath($domain, $user, $relativedir, $file);
	my $construct = &ConstructionPath($user, $relativedir, $file);

# If the resource exists in either space indicate this fact.	# If the resource exists in either space indicate this fact.
# Note that the check for existence in resource space is stricter.	# Note that the check for existence in resource space is stricter.

my $result;	my $result;
	if ( -d $construct ) {
	return 'Error: destination for operation is a directory.';
	}
if ( -e $published) {	if ( -e $published) {
$result.='<p><font color=red>Warning: target file exists, and has been published!</font></p>';	$result.='<p><font color="red">Warning: target file exists, and has been published!</font></p>';
	} elsif ( -e $construct) {
	$result.='<p><font color="red">Warning: target file exists!</font></p>';
}	}
elsif ( -e $construct) {
$result.='<p><font color=red>Warning: target file exists!</font></p>';
}

return $result;	return $result;

Line 360 as a result of this operation.	Line 324 as a result of this operation.

=over 4	=over 4

=item Empty string if everythikng worked.	=item Empty string if everything worked.

=item String containing an error message if there was a problem.	=item String containing an error message if there was a problem.

Line 377 sub checksuffix {	Line 341 sub checksuffix {
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }	if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
if ($oldsuffix ne $newsuffix) {	if ($oldsuffix ne $newsuffix) {
$result.=	$result.=
'<p><font color=red>Warning: change of MIME type!</font></p>';	'<p><font color="red">Warning: change of MIME type!</font></p>';
}	}
return $result;	return $result;
}	}

	sub cleanDest {
	my ($request,$dest)=@_;
	#remove bad characters
	if ($dest=~/[\#\?&]/) {
	$request->print("<p><font color=\"red\">Invalid characters in requested name have been removed.</font></p>");
	$dest=~s/[\#\?&]//g;
	}
	return $dest;
	}

	sub relativeDest {
	my ($fn,$newfilename,$uname)=@_;
	if ($newfilename=~/^\//) {
	# absolute, simply add path
	$newfilename='/home/'.$uname.'/public_html/';
	} else {
	my $dir=$fn;
	$dir=~s/\/[^\/]+$//;
	$newfilename=$dir.'/'.$newfilename;
	}
	$newfilename=~s://+:/:g; # remove duplicate /
	while ($newfilename=~m:/\.\./:) {
	$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
	}
	return $newfilename;
	}

=pod	=pod

=item CloseForm1($request, $user, $file)	=item CloseForm1($request, $user, $file)
Line 393 Parameters:	Line 385 Parameters:

=item $request - Apache Request Object [in] - Apache server request object.	=item $request - Apache Request Object [in] - Apache server request object.

=item $user - string [in] - Name of the user initiating the request.	=item $cancelurl - the url to go to on cancel.

=item $file - A filename.

=back	=back

=cut	=cut

sub CloseForm1 {	sub CloseForm1 {
my ($request, $user, $file) = @_;	my ($request, $fn) = @_;
my $url = "/priv/".$file;	$request->print('<p><input type="submit" value="Continue" /></p></form>');
	$request->print('<form action="'.&url($fn).
	'" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
$url =~ s/public_html\///;
$url =~ s/\/home//;
$url =~ s/\/\//\//;

$request->print('<p><input type=submit value=Continue></p></form>');
$request->print('<form action="'.$url.
'" method=GET"><p><input type=submit value=Cancel><p></form>');

}	}


Line 442 Parameters:	Line 424 Parameters:
=cut	=cut

sub CloseForm2 {	sub CloseForm2 {
my ($request, $user, $directory) = @_;	my ($request, $user, $fn) = @_;
	$request->print('<h3><a href="'.&url($fn).'/">Done</a></h3>');
$request->print('<h3><a=href="/priv/'.$user.$directory.'/">Done </a> </h3>');
}	}

=pod	=pod
Line 483 new filename relative to the current dir	Line 464 new filename relative to the current dir
=cut	=cut

sub Rename1 {	sub Rename1 {
my ($request, $filename, $user, $domain, $dir) = @_;	my ($request, $user, $domain, $fn, $newfilename) = @_;
&Debug($request, "Username - ".$user." filename: ".$filename."\n");
my $conspace = $filename;

	if(-e $fn) {
if(-e $conspace) {	if($newfilename) {
if($ENV{'form.newfilename'}) {	if ($newfilename =~ m\|/[^\.]+$\|) {
my $newfilename = $ENV{'form.newfilename'};	#no extension add on original extension
$request->print(&checksuffix($filename, $newfilename));	if ($fn =~ m\|/[^\.]*\.([^\.]+)$\|) {
$request->print(&exists($user, $domain, $dir, $newfilename));	$newfilename.='.'.$1;
$request->print('<input type=hidden name=newfilename value="'.	}
	}
	$request->print(&checksuffix($fn, $newfilename));
	#renaming a dir, delete the trailing /
	#remove last element for current dir
	my $dir=$fn;
	if ($fn =~ m\|/$\|) {
	$fn =~ s\|/$\|\|;
	$dir =~ s\|/[^/]*$\|\|;
	}
	my $return=&exists($user, $domain, $dir, $newfilename);
	$request->print($return);
	if ($return =~/^Error:/) {
	$request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
	return;
	}
	$request->print('<input type="hidden" name="newfilename" value="'.
$newfilename.	$newfilename.
'"><p>Rename <tt>'.$filename.'</tt> to <tt>'.	'" /><p>Rename '.&display($fn).
$dir.'/'.$newfilename.'</tt>?</p>');	'</tt><br />to '.&display($newfilename).'?</p>');
&CloseForm1($request, $user, $filename);	&CloseForm1($request, $fn);
} else {	} else {
$request->print('<p>No new filename specified</p></form>');	$request->print('<p>No new filename specified.</p></form>');
return;	return;
}	}
} else {	} else {
$request->print('<p> No such File </p> </form>');	$request->print('<p> No such file: '.&display($fn).'</p></form>');
return;	return;
}	}

Line 519 Parameters:	Line 514 Parameters:

=over 4	=over 4

=item $request - Apache Request Object [in] request object for the current	=item $request - Apache Request Object [in] request object for the current
request.	request.

=item $user - string [in] Name of session user.	=item $user - string [in] Name of the user initiating the request.

	=item $domain - string [in] Domain the initiating user is logged in as

=item $filename - string [in] Name fo the file to be deleted:	=item $filename - string [in] Source filename.
Filename is the full filesystem path to the file.

=back	=back

=cut	=cut

sub Delete1 {	sub Delete1 {
my ($request, $user, $filename) = @_;	my ($request, $user, $domain, $fn) = @_;

if( -e $filename) {	if( -e $fn) {
$request->print('<input type=hidden name=newfilename value="'.	$request->print('<input type="hidden" name="newfilename" value="'.
$filename.'">');	$fn.'"/>');
$request->print('<p> Delete <tt>'.$filename.'</tt>?</p>');	$request->print('<p>Delete '.&display($fn).'?</p>');
&CloseForm1($request, $user, $filename);	&CloseForm1($request, $fn);
} else {	} else {
$request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>');	$request->print('<p>No such file: '.&display($fn).'</p></form>');
}	}
}	}

Line 549 sub Delete1 {	Line 545 sub Delete1 {
=item Copy1($request, $user, $domain, $filename, $newfilename)	=item Copy1($request, $user, $domain, $filename, $newfilename)

Performs phase 1 processing of the construction space copy command.	Performs phase 1 processing of the construction space copy command.
Ensure that the source fil eexists. Ensure that a destination exists,	Ensure that the source file exists. Ensure that a destination exists,
also warn if the detination already exists.	also warn if the destination already exists.

Parameters:	Parameters:

Line 563 Parameters:	Line 559 Parameters:

=item $domain - string [in] Domain the initiating user is logged in as	=item $domain - string [in] Domain the initiating user is logged in as

=item $dir - string [in] Directory path.	=item $fn - string [in] Source filename.

=item $filename - string [in] Source filename.

=item $newfilename-string [in] Destination filename.	=item $newfilename-string [in] Destination filename.

Line 574 Parameters:	Line 568 Parameters:
=cut	=cut

sub Copy1 {	sub Copy1 {
my ($request, $user, $domain, $dir, $filename, $newfilename) = @_;	my ($request, $user, $domain, $fn, $newfilename) = @_;


if(-e $filename) {	if(-e $fn) {
$request->print(&checksuffix($filename,$newfilename));	$request->print(&checksuffix($fn,$newfilename));
$request->print(&exists($user, $domain, $dir, $newfilename));	my $return=&exists($user, $domain, $fn, $newfilename);
$request->print('<input type = hidden name = newfilename value = "'.	$request->print($return);
$dir.'/'.$newfilename.	if ($return =~/^Error:/) {
'"><p>Copy <tt>'.$filename.'</tt> to'.	$request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
'<tt>'.$dir.'/'.$newfilename.'</tt>/?</p>');	return;
&CloseForm1($request, $user, $filename);	}
	$request->print('<input type = "hidden" name = "newfilename" value = "'.
	$newfilename.
	'" /><p>Copy '.&display($fn).'<br />to '.
	&display($newfilename).'?</p>');
	&CloseForm1($request, $fn);
} else {	} else {
$request->print('<p>No such file <tt>'.$filename.'</p></form>');	$request->print('<p>No such file: '.&display($fn).'</p></form>');
}	}
}	}

Line 603 Parameters:	Line 601 Parameters:
=over 4	=over 4

=item $request - Apache Request Object [in] - Server request object for the	=item $request - Apache Request Object [in] - Server request object for the
current url..	current url.

=item $username - Name of the user that is requesting the directory creation.	=item $username - Name of the user that is requesting the directory creation.

=item $path - current directory relative to construction spacee.	=item $domain - Domain user is in

	=item $fn - source file.

=item $newdir - Name of the directory to be created; path relative to the	=item $newdir - Name of the directory to be created; path relative to the
top level of construction space.	top level of construction space.
Line 629 causes the newdir operation to transitio	Line 629 causes the newdir operation to transitio

sub NewDir1	sub NewDir1
{	{
my ($request, $username, $path, $newdir) = @_;	my ($request, $username, $domain, $fn, $newfilename) = @_;

my $fullpath = '/home/'.$username.'/public_html/'.	if(-e $newfilename) {
$path.'/'.$newdir;
Debug($request, "Full path is : ".$fullpath);

if(-e $fullpath) {
$request->print('<p>Directory exists.</p></form>');	$request->print('<p>Directory exists.</p></form>');
}	}
else {	else {
$request->print('<input type=hidden name=newfilename value="'.	$request->print('<input type="hidden" name="newfilename" value="'.
$newdir.'"><p>Make new directory <tt>'.	$newfilename.'" /><p>Make new directory '.
$path."/".$newdir.'</tt>?</p>');	&display($newfilename).'?</p>');
&CloseForm1($request, $username, $newdir);	&CloseForm1($request, $fn);

}	}
}	}

=pod	=pod

	=item NewFile1

	Does all phase 1 processing of file creation:
	Ensures that the user provides a new filename, adds proper extension
	if needed and that the file does not already exist, if it is a html,
	problem, page, or sequence, it then creates a form link to hand the
	actual creation off to the proper handler.

	Parameters:

	=over 4

	=item $request - Apache Request Object [in] - Server request object for the
	current url.

	=item $username - Name of the user that is requesting the directory creation.

	=item $domain - Name of the domain of the user

	=item $fn - Source file name

	=item $newfilename
	- Name of the file to be created; no path information
	=back

	Side Effects:

	=over 4

	=item 2 new forms are displayed. Clicking on the confirmation button
	causes the browser to attempt to load the specfied URL, allowing the
	proper handler to take care of file creation. There is also a Cancel
	button which returns you to the driectory listing you came from

	=back

	=cut


	sub NewFile1 {
	my ($request, $user, $domain, $fn, $newfilename) = @_;

	if ($ENV{'form.action'} =~ /new(.+)file/) {
	my $extension=$1;
	if ($newfilename !~ /\Q.$extension\E$/) {
	if ($newfilename =~ m\|^[^\.]*\.([^\.]+)$\|) {
	#already has an extension strip it and add in expected one
	$newfilename =~ s\|.([^\.]+)$\|\|;
	}
	$newfilename.=".$extension";
	}
	}

	if(-e $newfilename) {
	$request->print('<p>File exists.</p></form>');
	}
	else {
	$request->print('<p>Make new file '.&display($newfilename).'?</p>');
	$request->print('</form>');
	$request->print('<form action="'.&url($newfilename).
	'" method="POST"><p><input type="submit" value="Continue" /></p></form>');
	$request->print('<form action="'.&url($fn).
	'" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
	}
	}

	=pod

=item phaseone($r, $fn, $uname, $udom)	=item phaseone($r, $fn, $uname, $udom)

Peforms phase one processing of the request. In phase one, error messages	Peforms phase one processing of the request. In phase one, error messages
Line 669 performed and reported to the user.	Line 732 performed and reported to the user.

=item $uname - string [in] Name of user logged in and doing this action.	=item $uname - string [in] Name of user logged in and doing this action.

=item $udom - string [in] Domain nmae under which the user logged in.	=item $udom - string [in] Domain name under which the user logged in.

=back	=back

Line 678 performed and reported to the user.	Line 741 performed and reported to the user.
sub phaseone {	sub phaseone {
my ($r,$fn,$uname,$udom)=@_;	my ($r,$fn,$uname,$udom)=@_;

$fn=~m:(.*)/([^/]+)\.(\w+)$:;	my $newfilename=&cleanDest($r,$ENV{'form.newfilename'});
my $dir=$1;	$newfilename=&relativeDest($fn,$newfilename,$uname);
my $main=$2;
my $suffix=$3;	$r->print('<form action="/adm/cfile" method="post">'.
	'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
# my $conspace=ConstructionPathFromRelative($uname, $fn);	'<input type="hidden" name="phase" value="two" />'.
	'<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />');

$r->print('<form action=/adm/cfile method=post>'.
'<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
'<input type=hidden name=phase value=two>'.
'<input type=hidden name=action value='.$ENV{'form.action'}.'>');

if ($ENV{'form.action'} eq 'rename') {	if ($ENV{'form.action'} eq 'rename') {
	&Rename1($r, $uname, $udom, $fn, $newfilename);
&Rename1($r, $fn, $uname, $udom, $dir);

} elsif ($ENV{'form.action'} eq 'delete') {	} elsif ($ENV{'form.action'} eq 'delete') {
	&Delete1($r, $uname, $udom, $fn);
&Delete1($r, $uname, $fn);

} elsif ($ENV{'form.action'} eq 'copy') {	} elsif ($ENV{'form.action'} eq 'copy') {
if($ENV{'form.newfilename'}) {	if($newfilename) {
my $newfilename = $ENV{'form.newfilename'};	&Copy1($r, $uname, $udom, $fn, $newfilename);
&Copy1($r, $uname, $udom, $dir, $fn, $newfilename);	} else {
}else {	$r->print('<p>No new filename specified.</p></form>');
$r->print('<p>No new filename specified.</p></form>');	}
}
} elsif ($ENV{'form.action'} eq 'newdir') {	} elsif ($ENV{'form.action'} eq 'newdir') {
&NewDir1($r, $uname, $dir, $ENV{'form.newfilename'});	&NewDir1($r, $uname, $udom, $fn, $newfilename);
	} elsif ($ENV{'form.action'} eq 'newfile' \|\|
	$ENV{'form.action'} eq 'newhtmlfile' \|\|
	$ENV{'form.action'} eq 'newproblemfile' \|\|
	$ENV{'form.action'} eq 'newpagefile' \|\|
	$ENV{'form.action'} eq 'newsequencefile' \|\|
	$ENV{'form.action'} eq 'newrightsfile' \|\|
	$ENV{'form.action'} eq 'newstyfile' \|\|
	$ENV{'form.action'} eq 'Select Action') {
	if ($newfilename) {
	&NewFile1($r, $uname, $udom, $fn, $newfilename);
	} else {
	$r->print('<p>No new filename specified.</p></form>');
	}
}	}

}	}

=pod	=pod

=item Rename2($request, $user, $directory, $oldfile, $newfile)	=item Rename2($request, $user, $directory, $oldfile, $newfile)

Performs phase 2 procesing of a rename reequest. This is where the	Performs phase 2 processing of a rename reequest. This is where the
actual rename is performed.	actual rename is performed.

Parameters	Parameters
Line 754 sub Rename2 {	Line 819 sub Rename2 {
" new file ".$newfile."\n");	" new file ".$newfile."\n");
&Debug($request, "Target is: ".$directory.'/'.	&Debug($request, "Target is: ".$directory.'/'.
$newfile);	$newfile);
	if (-e $oldfile) {
if(-e $oldfile) {	unless (rename($oldfile,$newfile)) {
unless(rename($oldfile,	$request->print('<font color="red">Error: '.$!.'</font>');
$directory.'/'.$newfile)) {
$request->print('<font color=red>Error: '.$!.'</font>');
return 0;	return 0;
} else {}	}
} else {	} else {
$request->print("<p> No such file: /home".$user.'/public_html'.	$request->print("<p> No such file: ".&display($oldfile).'</p></form>');
$oldfile.' </p></form>');
return 0;	return 0;
}	}
return 1;	return 1;
Line 786 Parameters:	Line 848 Parameters:
=item $user - string [in] The name of the user initiating the delete	=item $user - string [in] The name of the user initiating the delete
request.	request.

=item $filename - string [in] The name of the file, relative to construction space,	=item $filename - string [in] The name of the file, relative to construction
to delete.	space, to delete.

=back	=back

Line 802 sub Delete2 {	Line 864 sub Delete2 {

if(-e $filename) {	if(-e $filename) {
unless(unlink($filename)) {	unless(unlink($filename)) {
$request->print('<font color=red>Error: '.$!.'</font>');	$request->print('<font color="red">Error: '.$!.'</font>');
return 0;	return 0;
}	}
} else {	} else {
$request->print('<p> No such file. </form');	$request->print('<p> No such file. </p></form');
return 0;	return 0;
}	}
return 1;	return 1;
Line 845 sub Copy2 {	Line 907 sub Copy2 {
&Debug($request ,"Will try to copy $oldfile to $newfile");	&Debug($request ,"Will try to copy $oldfile to $newfile");
if(-e $oldfile) {	if(-e $oldfile) {
unless (copy($oldfile, $newfile)) {	unless (copy($oldfile, $newfile)) {
$request->print('<font color=red> Error: '.$!.'</font>');	$request->print('<font color="red"> copy Error: '.$!.'</font>');
return 0;	return 0;
} else {	} else {
	unless (chmod(0660, $newfile)) {
	$request->print('<font color="red"> chmod error: '.$!.'</font>');
	return 0;
	}
return 1;	return 1;
}	}
} else {	} else {
Line 882 sub NewDir2 {	Line 948 sub NewDir2 {
my ($request, $user, $newdirectory) = @_;	my ($request, $user, $newdirectory) = @_;

unless(mkdir($newdirectory, 02770)) {	unless(mkdir($newdirectory, 02770)) {
$request->print('<font color=red>Error: '.$!.'</font>');	$request->print('<font color="red">Error: '.$!.'</font>');
return 0;	return 0;
}	}
unless(chmod(02770, ($newdirectory))) {	unless(chmod(02770, ($newdirectory))) {
$request->print('<font color=red> Error: '.$!.'</font>');	$request->print('<font color="red"> Error: '.$!.'</font>');
return 0;	return 0;
}	}
return 1;	return 1;
Line 931 sub phasetwo {	Line 997 sub phasetwo {

# Break down the file into it's component pieces.	# Break down the file into it's component pieces.

$fn=~/(.*)\/([^\/]+)\.(\w+)$/;	my $dir; # Directory path
my $dir=$1; # Directory path	my $main; # Filename.
my $main=$2; # Filename.	my $suffix; # Extension.
my $suffix=$3; # Extension.
	if ($fn=~m:(.*)/([^/]+)\.(\w+)$:) {
	$dir=$1; # Directory path
	$main=$2; # Filename.
	$suffix=$3; # Extension.
	}

my $dest; # On success this is where we'll go.	my $dest; # On success this is where we'll go.

&Debug($r,	&Debug($r,
Line 955 sub phasetwo {	Line 1026 sub phasetwo {

if ($ENV{'form.action'} eq 'rename') { # Rename.	if ($ENV{'form.action'} eq 'rename') { # Rename.
if($ENV{'form.newfilename'}) {	if($ENV{'form.newfilename'}) {
	if (!defined($dir)) {
	$fn=~m:^(.*)/:;
	$dir=$1;
	}
if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {	if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
return;	return;
}	}
# Prepend the directory to the new name to form the basis of the	$dest = &url($ENV{'form.newfilename'});
# url of the new resource.
#
$dest = $dir."/".$ENV{'form.newfilename'};
}	}
} elsif ($ENV{'form.action'} eq 'delete') {	} elsif ($ENV{'form.action'} eq 'delete') {
if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) {	if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) {
Line 970 sub phasetwo {	Line 1042 sub phasetwo {
# Once a resource is deleted, we just list the directory that	# Once a resource is deleted, we just list the directory that
# previously held it.	# previously held it.
#	#
$dest = $dir."/"; # Parent dir.	$dest = $dir."/."; # Parent dir.
} elsif ($ENV{'form.action'} eq 'copy') {	} elsif ($ENV{'form.action'} eq 'copy') {
if($ENV{'form.newfilename'}) {	if($ENV{'form.newfilename'}) {
if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {	if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
Line 979 sub phasetwo {	Line 1051 sub phasetwo {
$dest = $ENV{'form.newfilename'};	$dest = $ENV{'form.newfilename'};

} else {	} else {
$r->print('<p>No New filename specified</form>');	$r->print('<p>No New filename specified</p></form>');
return;	return;
}	}

} elsif ($ENV{'form.action'} eq 'newdir') {	} elsif ($ENV{'form.action'} eq 'newdir') {
#	my $newdir= $ENV{'form.newfilename'};
# Since the newfilename form field is construction space
# relative, ew need to prepend the current path; now in $fn.
#
my $newdir= $fn.$ENV{'form.newfilename'};
if(!&NewDir2($r, $uname, $newdir)) {	if(!&NewDir2($r, $uname, $newdir)) {
return;	return;
}	}
$dest = $newdir."/"	$dest = $newdir."/"
}	}
#	$r->print('<h3><a href="'.&url($dest).'">Done</a></h3>');
# Substitute for priv for the first home in $dir to get our
# construction space path.
#
&Debug($r, "Final url is: $dest");
$dest =~ s/\/home\//\/priv\//;
$dest =~ s/\/public_html//;
&Debug($r, "Final url after rewrite: $dest");

$r->print('<h3><a href="'.$dest.'">Done</a></h3>');
}	}

sub handler {	sub handler {
Line 1014 sub handler {	Line 1073 sub handler {
&Debug($r, "loncfile.pm - handler entered");	&Debug($r, "loncfile.pm - handler entered");
&Debug($r, " filename: ".$ENV{'form.filename'});	&Debug($r, " filename: ".$ENV{'form.filename'});
&Debug($r, " newfilename: ".$ENV{'form.newfilename'});	&Debug($r, " newfilename: ".$ENV{'form.newfilename'});
	#
	# Determine the root filename
	# This could come in as "filename", which actually is a URL, or
	# as "qualifiedfilename", which is indeed a real filename in filesystem
	#
my $fn;	my $fn;

if ($ENV{'form.filename'}) {	if ($ENV{'form.filename'}) {
$fn=$ENV{'form.filename'};	$fn=&Apache::lonnet::unescape($ENV{'form.filename'});
&Debug($r, "loncfile::handler - raw url: $fn");	$fn=&URLToPath($fn);
# $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;	} elsif ($ENV{'form.qualifiedfilename'}) {
# $fn=~s/^http\:\/\/[^\/]+//;	$fn=$ENV{'form.qualifiedfilename'};
$fn=URLToPath($fn);
&Debug($r, "loncfile::handler - doctored url: $fn");

} else {	} else {
&Debug($r, "loncfile::handler - no form.filename");	&Debug($r, "loncfile::handler - no form.filename");
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.	$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
Line 1055 sub handler {	Line 1115 sub handler {
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
}	}

$fn=~s/\/\~(\w+)//;
&Debug($r, "loncfile::handler ~ removed filename: $fn");

$r->content_type('text/html');	$r->content_type('text/html');
$r->send_http_header;	$r->send_http_header;

$r->print('<html><head><title>LON-CAPA Construction Space</title></head>');	$r->print('<html><head><title>LON-CAPA Construction Space</title></head>');

$r->print(	$r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');


$r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>');	$r->print('<h3>Location: '.&display($fn).'</h3>');

if (($uname ne $ENV{'user.name'}) \|\| ($udom ne $ENV{'user.domain'})) {	if (($uname ne $ENV{'user.name'}) \|\| ($udom ne $ENV{'user.domain'})) {
$r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.	$r->print('<h3><font color="red">Co-Author: '.$uname.' at '.$udom.
'</font></h3>');	'</font></h3>');
}	}

Line 1085 sub handler {	Line 1142 sub handler {
$r->print('<h3>New Directory</h3>');	$r->print('<h3>New Directory</h3>');
} elsif ($ENV{'form.action'} eq 'copy') {	} elsif ($ENV{'form.action'} eq 'copy') {
$r->print('<h3>Copy</h3>');	$r->print('<h3>Copy</h3>');
	} elsif ($ENV{'form.action'} eq 'newfile' \|\|
	$ENV{'form.action'} eq 'newhtmlfile' \|\|
	$ENV{'form.action'} eq 'newproblemfile' \|\|
	$ENV{'form.action'} eq 'newpagefile' \|\|
	$ENV{'form.action'} eq 'newsequencefile' \|\|
	$ENV{'form.action'} eq 'newrightsfile' \|\|
	$ENV{'form.action'} eq 'newstyfile' \|\|
	$ENV{'form.action'} eq 'Select Action' ) {
	$r->print('<h3>New Resource</h3>');
} else {	} else {
$r->print('<p>Unknown Action</body></html>');	$r->print('<p>Unknown Action '.$ENV{'form.action'}.' </p></body></html>');
return OK;	return OK;
}	}
if ($ENV{'form.phase'} eq 'two') {	if ($ENV{'form.phase'} eq 'two') {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.12
changed lines
	Added in v.1.38