--- loncom/interface/lonsource.pm 2004/06/12 04:44:31 1.2 +++ 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.2 2004/06/12 04:44:31 albertel Exp $ +# $Id: lonsource.pm,v 1.27 2011/10/31 01:16:59 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,7 +31,7 @@ package Apache::lonsource; use strict; -use Apache::lonnet(); +use Apache::lonnet; use Apache::loncommon(); use Apache::lonhtmlcommon(); use Apache::lonsequence(); @@ -40,58 +40,243 @@ use Apache::lonmeta; use Apache::File; use Apache::lonlocal; use HTML::Entities; +use LONCAPA; sub make_link { - my ($filename) = @_; - my $sourcelink = "http://".$ENV{'SERVER_NAME'}. - "/adm/source/?filename=".$filename; + my ($filename, $listname) = @_; + my $sourcelink = "/adm/source?inhibitmenu=yes&filename=".$filename."&listname=".$listname; return $sourcelink; } sub stage_2 { - my ($r, $filename) = @_; - $r->print("Coming Soon"); + 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_author { + my $role; + my $domain; + my $author_name; + if ($env{'request.role'} =~ m{^ca\.}) { + ($role, $domain, $author_name) = split(/\//,$env{'request.role'}); + } else { + $role = "au."; + $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; + +#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); + + 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; + } + + #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); + } + + $r->print(&Apache::loncommon::end_page()); +} + +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'
+ .&mt('Cannot delete non-obsolete published file.')
+ .'
'
+ .&mt('Please use the code view in previous window to use shared code.')
+ .'
');
+ $r->print(''
+ .'
'.&mt('Error:').' '.$!.'
'); + return 0; + } + } else { + $r->print(''.&mt('No such file').'
'); + return 0; + } + ©_file($r, $newpath, $filename, $path_to_new_file); + } +} + +sub copy_file { + my ($r, $newpath, $filename, $path_to_new_file) = @_; + $r->print("Creating directories"); + +#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; + if(-e $path) {} #More moving along, isn't recursion fun' + + else { + unless(mkdir($path, 02770)) { + $r->print(''.&mt('Error:').' '.$!.'
'); + return 0; + } + unless(chmod(02770, ($path))) { + $r->print(''.&mt('Error:').' '.$!.'
'); + return 0; + } + } + } else { } #Just move along + + } + $r->print("