--- loncom/interface/lonsource.pm 2013/06/07 16:07:46 1.31 +++ loncom/interface/lonsource.pm 2017/09/18 16:58:08 1.36 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Source Code handler # -# $Id: lonsource.pm,v 1.31 2013/06/07 16:07:46 bisitz Exp $ +# $Id: lonsource.pm,v 1.36 2017/09/18 16:58:08 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -44,15 +44,17 @@ use LONCAPA qw(:DEFAULT :match); sub make_link { my ($filename, $listname) = @_; - my $sourcelink = "/adm/source?inhibitmenu=yes&filename=".$filename."&listname=".$listname; - + my $sourcelink = '/adm/source?inhibitmenu=yes&filename='. + &escape(&escape($filename)).'&listname='. + &escape(&escape($listname)); return $sourcelink; } sub stage_2 { my ($r, $filename, $listname) = @_; my ($author)=($filename=~/\/res\/[^\/]+\/([^\/]+)\//); - $r->print(&Apache::loncommon::start_page('Copy Problem Source Code to Authoring Space') + $r->print(&Apache::loncommon::start_page('Copy Problem Source Code to Authoring Space',undef, + {'only_body' => 1,}) .&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 Authoring Space,'
@@ -64,7 +66,8 @@ sub stage_2 {
- ');
+ '.
+ &Apache::loncommon::end_page());
return OK;
}
@@ -86,83 +89,71 @@ sub copy_author {
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;
-
-#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::lonnet::constructaccess($path_to_new_file);
-
- if (!$uname || !$udom) {
- $r->print(&Apache::loncommon::start_page('Not Allowed'));
- $r->print(&mt('Not allowed to create file [_1]', $path_to_new_file));
- $r->print(&Apache::loncommon::end_page());
- return;
- }
+ my ($path_to_new_file,$uname,$udom) = &get_path_to_newfile($r,$newpath,$listname);
#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, $newpath, $filename, $path_to_new_file, '1');
- } elsif(($result) && ($result =~ m|exists!|)) {
- &confirm($r, $newpath, $filename, $path_to_new_file);
- } else {
- ©_file($r, $newpath, $filename, $path_to_new_file);
+ if ($path_to_new_file) {
+ $r->print(&Apache::loncommon::start_page('Copying Source',undef,{'only_body' => 1}));
+ my $result = &Apache::loncfile::exists($uname, $udom, $path_to_new_file);
+ $r->print($result);
+ if (($result) && ($result =~ /published/)) {
+ &delete_copy_file($r, $newpath, $filename, $path_to_new_file, '1');
+ } elsif (($result) && ($result =~ /exists\!/)) {
+ &confirm($r, $newpath, $filename, $listname);
+ } else {
+ ©_file($r, $newpath, $filename, $path_to_new_file);
+ }
+ $r->print(&Apache::loncommon::end_page());
}
-
- $r->print(&Apache::loncommon::end_page());
+ return;
}
sub confirm {
- 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
");
+ my ($r, $newpath, $filename, $listname) = @_;
+ $r->print(''.&mt('Press delete to remove file and replace it with a copy of the source you are viewing.').'
');
$r->print('
'
.&mt('Cannot delete non-obsolete published file.')
.'
'
.&mt('Please use the code view in previous window to use shared code.')
.'
');
- $r->print('print('
'.&mt('Error:').' '.$!.'
'); return 0; } } else { - $r->print(''.&mt('No such file').'
'); + $r->print(''.&mt('No such file').'
'); return 0; } ©_file($r, $newpath, $filename, $path_to_new_file); + $r->print(&Apache::loncommon::end_page()); + return; } } sub copy_file { my ($r, $newpath, $filename, $path_to_new_file) = @_; - $r->print("Creating directories"); + $r->print(''.&mt('Creating directories').''); #Figure out if we are author or co-author my ($role,$author_name,$domain)=©_author(); @@ -188,7 +179,7 @@ sub copy_file { } else { } #Just move along } - $r->print("