LON-CAPA Move source to construction space

# The LearningOnline Network with CAPA # Souce Code handler # # $Id: lonsource.pm,v 1.9 2005/02/17 08:29:43 albertel 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; sub make_link { my ($filename, $listname) = @_; my $sourcelink = "http://".$ENV{'SERVER_NAME'}. "/adm/source/?filename=".$filename."&listname=".$listname; return $sourcelink; } sub stage_2 { my ($r, $filename, $author, $listname) = @_; $filename = $filename; &Apache::loncommon::content_type($r,'text/html'); my ($uname, $udom) = &Apache::loncacc::constructaccess('/~'.$author.'/',$r->dir_config('lonDefDomain')); $r->send_http_header; my $html=&Apache::lonxml::xmlbegin(); $r->print($html.'LON-CAPA Move source to construction space'); $r->print(&Apache::loncommon::bodytag('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.

"); $r->print(''); return OK; } sub copy_stage { my ($r, $filename, $listname, $newpath) = @_; my $role; my $domain; my $author_name; #Figure out if we are author or co-author 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); unless (($uname) && ($udom)) { return HTTP_NOT_ACCEPTABLE; } &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $html=&Apache::lonxml::xmlbegin(); $r->print($html.'LON-CAPA Move source to construction space'); $r->print(&Apache::loncommon::bodytag('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); } return OK; } 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

"); $r->print(''); } sub delete_copy_file { my ($r, $author_name, $newpath, $filename, $path_to_new_file, $type) = @_; if($type eq '1') { $r->print("Cannot delete non-obsolete published file
Please use the code view in previous window to use shared code

"); $r->print(''); } else { if(-e $path_to_new_file) { unless(unlink($path_to_new_file)) { $r->print(''.&mt('Error').': '.$!.''); return 0; } } else { $r->print('

'.&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("
Copying File"); my $problem_filename = $Apache::lonnet::perlvar{'lonDocRoot'}.$filename; my $file_output = &Apache::lonnet::getfile($problem_filename); my $fs=Apache::File->new(">$path_to_new_file"); if (defined($fs)) { print $fs $file_output; } $r->print("

"); $r->print(''); #Some 1.3'ish feature is to include the derivative feature, will go here..' } sub print_item { my ($r, $filename) = @_; $filename = $Apache::lonnet::perlvar{'lonDocRoot'}.$filename; &Apache::lonnet::logthis("print_item filename = $filename"); my $file_output = &Apache::lonnet::getfile($filename); my $count=0; my $maxlength=-1; foreach (split ("\n", $file_output)) { $count+=int(length($_)/79); $count++; if (length($_) > $maxlength) { $maxlength = length($_); } } my $rows = $count; my $cols = $maxlength; $r->print(''); return OK; } sub handler { my $r=shift; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['filename','listname']); my $filename = $ENV{'form.filename'}; my $listname = $ENV{'form.listname'}; my $source = &Apache::lonnet::metadata($filename,'sourceavail'); if ($source ne 'open') { $ENV{'user.error.msg'}="$filename:cre:1:1:Source code not available"; return HTTP_NOT_ACCEPTABLE; } if ((!&Apache::lonnet::allowed('cre',$filename)) || (!&Apache::lonnet::allowed('bre',$filename))) { $ENV{'user.error.msg'}="$filename:bre:1:1:Access to resource denied"; return HTTP_NOT_ACCEPTABLE; } if ($ENV{'form.action'} eq 'stage2') { my $author = &Apache::lonnet::metadata($filename,'authorspace'); $author =~ m|@|; $author = $`; #This just tells who the author name is for later processing. &stage_2($r, $ENV{'form.filename'}, $author, $listname); } elsif($ENV{'form.action'} eq 'copy_stage') { ©_stage($r, $filename,$ENV{'form.listname'},$ENV{'form.newpath'}); } elsif($ENV{'form.action'} eq 'delete_confirm') { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &delete_copy_file($r, $ENV{'form.author'}, $ENV{'form.newpath'}, $ENV{'form.filename'}, $ENV{'form.path'}, '0'); } else { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; $r->print(''); $r->print('

'); &print_item($r, $ENV{'form.filename'}); } return OK; } 1;