--- loncom/interface/lonsource.pm 2007/08/28 22:46:32 1.20
+++ loncom/interface/lonsource.pm 2011/10/31 01:16:59 1.27
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
-# Souce Code handler
+# Source Code handler
#
-# $Id: lonsource.pm,v 1.20 2007/08/28 22:46:32 albertel Exp $
+# $Id: lonsource.pm,v 1.27 2011/10/31 01:16:59 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -50,26 +50,25 @@ sub make_link {
}
sub stage_2 {
- my ($r, $filename, $author, $listname) = @_;
- my ($uname, $udom) = &Apache::loncacc::constructaccess('/~'.$author.'/',$r->dir_config('lonDefDomain'));
- $r->print(&Apache::loncommon::start_page('Problem source code moving operation'));
- $r->print("Please enter the directory that you would like the source code to go into, a default has also been provided
");
- $r->print("Also note, the path is in reference to the root of your construction space, and new directories will be automatically created.
");
+ my ($r, $filename, $listname) = @_;
+ my ($author)=($filename=~/\/res\/[^\/]+\/([^\/]+)\//);
+ $r->print(&Apache::loncommon::start_page('Copy Problem Source Code to Construction Space')
+ .&mt('Please enter the directory that you would like the source code to go into.')
+ .'
' + .&mt('Note: the path is in reference to the root of your construction space,' + .' and new directories will be automatically created.') + .'
'); $r->print(''); return OK; } - -sub copy_stage { - my ($r, $filename, $listname, $newpath) = @_; - -#Figure out if we are author or co-author +sub copy_author { my $role; my $domain; my $author_name; @@ -80,11 +79,26 @@ sub copy_stage { $domain = $env{'user.domain'}; $author_name = $env{'user.name'}; } + return ($role,$author_name,$domain); +} + + +sub copy_stage { + my ($r, $filename, $listname, $newpath) = @_; + +#Figure out if we are author or co-author + my ($role,$author_name,$domain)=©_author(); + +# Construct path to copy and filter out any possibly nasty stuff + my $path_to_new_file = $r->dir_config('lonDocRoot'). + "/priv/$domain/$author_name/$newpath/$listname"; + $path_to_new_file=~s/\.\.//g; + $path_to_new_file=~s/\~//g; + $path_to_new_file=~s/\/+/\//g; - my $path_to_new_file = '/home/'.$author_name.'/public_html/'.$newpath.'/'.$listname; #Just checking again for access as we want to make sure that it is really ok now that we have the real path - my ($uname,$udom)= &Apache::loncacc::constructaccess($path_to_new_file,$domain); + my ($uname,$udom)= &Apache::loncacc::constructaccess($path_to_new_file); if (!$uname || !$udom) { $r->print(&Apache::loncommon::start_page('Not Allowed')); @@ -93,29 +107,27 @@ sub copy_stage { return; } - #allowed $r->print(&Apache::loncommon::start_page('Copying Source')); my $result = &Apache::loncfile::exists($uname, $udom, $path_to_new_file); $r->print($result); if(($result) && ($result =~ m|published|) ) { - &delete_copy_file($r, $author_name, $newpath, $filename, $path_to_new_file, '1'); + &delete_copy_file($r, $newpath, $filename, $path_to_new_file, '1'); } elsif(($result) && ($result =~ m|exists!|)) { - &confirm($r, $author_name, $newpath, $filename, $path_to_new_file); + &confirm($r, $newpath, $filename, $path_to_new_file); } else { - ©_file($r, $author_name, $newpath, $filename, $path_to_new_file); + ©_file($r, $newpath, $filename, $path_to_new_file); } $r->print(&Apache::loncommon::end_page()); } sub confirm { - my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_; + my ($r, $newpath, $filename, $path_to_new_file) = @_; $r->print("Press delete to remove file and replace it with a copy of the source you are viewing'.&mt('No such file').'
'); return 0; } - ©_file($r, $author_name, $newpath, $filename, $path_to_new_file); + ©_file($r, $newpath, $filename, $path_to_new_file); } } sub copy_file { - my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_; + my ($r, $newpath, $filename, $path_to_new_file) = @_; $r->print("Creating directories"); - my $path = '/home/'.$author_name.'/public_html/'; + +#Figure out if we are author or co-author + my ($role,$author_name,$domain)=©_author(); + + my $path = $r->dir_config('lonDocRoot')."/priv/$domain/$author_name/"; my @directories = split(/\//,$newpath); + foreach my $now_checking (@directories) { if($now_checking ne '') { $path = $path.'/'.$now_checking; @@ -155,11 +177,11 @@ sub copy_file { else { unless(mkdir($path, 02770)) { - $r->print(''.&mt('Error').': '.$!.''); + $r->print(''.&mt('Error:').' '.$!.'
'); return 0; } unless(chmod(02770, ($path))) { - $r->print(' '.&mt('Error').': '.$!.''); + $r->print(''.&mt('Error:').' '.$!.'
'); return 0; } } @@ -174,7 +196,7 @@ sub copy_file { print $fs $file_output; } $r->print("