# The LearningOnline Network with CAPA # Souce Code handler # # $Id: lonsource.pm,v 1.21 2008/08/01 16:01:44 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA 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. # # LON-CAPA 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. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ### package Apache::lonsource; use strict; use Apache::lonnet; use Apache::loncommon(); use Apache::lonhtmlcommon(); use Apache::lonsequence(); use Apache::Constants qw(:common :http); use Apache::lonmeta; use Apache::File; use Apache::lonlocal; use HTML::Entities; use LONCAPA; sub make_link { my ($filename, $listname) = @_; my $sourcelink = "/adm/source?inhibitmenu=yes&filename=".$filename."&listname=".$listname; return $sourcelink; } 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('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 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'}; } 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); 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, $author_name, $newpath, $filename, $path_to_new_file, '1'); } elsif(($result) && ($result =~ m|exists!|)) { &confirm($r, $author_name, $newpath, $filename, $path_to_new_file); } else { ©_file($r, $author_name, $newpath, $filename, $path_to_new_file); } $r->print(&Apache::loncommon::end_page()); } sub confirm { my ($r, $author_name, $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); } } sub copy_file { my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_; $r->print("Creating directories"); my $path = '/home/'.$author_name.'/public_html/'; 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("