Annotation of loncom/interface/lonsource.pm, revision 1.9

1.1       taceyjo1    1: # The LearningOnline Network with CAPA
1.2       albertel    2: # Souce Code handler
1.1       taceyjo1    3: #
1.9     ! albertel    4: # $Id: lonsource.pm,v 1.8 2004/07/08 20:17:59 taceyjo1 Exp $
1.1       taceyjo1    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
                     28: ###
                     29: 
                     30: 
                     31: package Apache::lonsource;
                     32: 
                     33: use strict;
                     34: use Apache::lonnet();
                     35: use Apache::loncommon();
                     36: use Apache::lonhtmlcommon();
                     37: use Apache::lonsequence();
                     38: use Apache::Constants qw(:common :http);
                     39: use Apache::lonmeta;
                     40: use Apache::File;
                     41: use Apache::lonlocal;
                     42: use HTML::Entities;
                     43: 
                     44: sub make_link {
1.4       taceyjo1   45:     my ($filename, $listname) = @_;
1.2       albertel   46:     my $sourcelink = "http://".$ENV{'SERVER_NAME'}.
1.5       taceyjo1   47:                      "/adm/source/?filename=".$filename."&listname=".$listname;
1.2       albertel   48: 
                     49:     return $sourcelink;
1.1       taceyjo1   50: }
                     51: 
                     52: sub stage_2 {
1.5       taceyjo1   53:     my ($r, $filename, $author, $listname) = @_;
                     54:     $filename = $filename;
                     55:     &Apache::loncommon::content_type($r,'text/html');
                     56:     my ($uname, $udom) = &Apache::loncacc::constructaccess('/~'.$author.'/',$r->dir_config('lonDefDomain'));
                     57:     $r->send_http_header;
1.9     ! albertel   58:     my $html=&Apache::lonxml::xmlbegin();
        !            59:     $r->print($html.'<head><title>LON-CAPA Move source to construction space</title>');
1.5       taceyjo1   60:     $r->print(&Apache::loncommon::bodytag('Problem source code moving operation'));
                     61:     $r->print("Please enter the directory that you would like the source code to go into, a default has also been 			provided <br />");
                     62:     $r->print("Also note, the path is in reference to the root of your construction space, and new directories will be 			automatically created. <br /><br />");
                     63:     $r->print('<form name="copy" action="/adm/source/" target="_parent" method="post">
                     64:               <input type="hidden" name="filename" value="'.$filename.'" />
                     65:               <input type="hidden" name="listname" value="'.$listname.'" />
                     66:               <input type="hidden" name="action" value="copy_stage" />
                     67:               <input type="text" name="newpath" value="/shared_source/'.$author.'" />&nbsp;
                     68:               <input type="submit" value="Copy" />
                     69:               </form>');
                     70:     return OK;
1.4       taceyjo1   71: }
                     72: 
                     73: 
                     74: sub copy_stage {
                     75:     my ($r, $filename, $listname, $newpath) = @_;
                     76:     my $role;
                     77:     my $domain;
                     78:     my $author_name;
1.5       taceyjo1   79: #Figure out if we are author or co-author
                     80: 
                     81:     if($ENV{'request.role'} =~ m|ca.|) {
                     82:         ($role, $domain, $author_name) = split(/\//,$ENV{'request.role'});
1.4       taceyjo1   83:     } else {
1.5       taceyjo1   84:         $role = "au.";
                     85:         $domain = $ENV{'user.domain'};
                     86:         $author_name = $ENV{'user.name'};
                     87:     }
                     88: 
1.4       taceyjo1   89:     my $path_to_new_file = '/home/'.$author_name.'/public_html/'.$newpath.'/'.$listname;
1.5       taceyjo1   90: #Just checking again for access as we want to make sure that it is really ok now that we have the real path
                     91: 
1.4       taceyjo1   92:     my ($uname,$udom)= &Apache::loncacc::constructaccess($path_to_new_file,$domain);
                     93:     unless (($uname) && ($udom)) {
1.5       taceyjo1   94:         return HTTP_NOT_ACCEPTABLE;
1.4       taceyjo1   95:     }
                     96:     &Apache::loncommon::content_type($r,'text/html');
                     97:     $r->send_http_header;
1.9     ! albertel   98:     my $html=&Apache::lonxml::xmlbegin();
        !            99:     $r->print($html.'<head><title>LON-CAPA Move source to construction space</title>');
1.5       taceyjo1  100:     $r->print(&Apache::loncommon::bodytag('Copying Source'));
                    101:     my $result = &Apache::loncfile::exists($uname, $udom, $path_to_new_file);
                    102:     $r->print($result);
                    103:     if(($result) && ($result =~ m|published|) ) {
1.6       taceyjo1  104:         &delete_copy_file($r, $author_name, $newpath, $filename, $path_to_new_file, '1');
1.5       taceyjo1  105:     } elsif(($result) && ($result =~ m|exists!|)) {
                    106:         &confirm($r, $author_name, $newpath, $filename, $path_to_new_file);
                    107:     } else {
                    108:         &copy_file($r, $author_name, $newpath, $filename, $path_to_new_file);
                    109:     }
                    110: 
                    111:     return OK;
                    112: 
1.4       taceyjo1  113: }
                    114: 
                    115: sub confirm {
1.5       taceyjo1  116:     my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_;
                    117:     $r->print("<b>Press delete to remove file and replace it with a copy of the source you are viewing</b><br /><br /	>");
                    118:     $r->print('<form name="delete_confirm" action="/adm/source/" target="_parent" method="post">
                    119:               <input type="hidden" name="filename" value="'.$filename.'" />
                    120:               <input type="hidden" name="path" value="'.$path_to_new_file.'" />
                    121:               <input type="hidden" name="author" value="'.$author_name.'" />
                    122:               <input type="hidden" name="newpath" value="'.$newpath.'" />
                    123:               <input type="hidden" name="action" value="delete_confirm" />
                    124: 
                    125:               <input type="submit" value="Delete" />
                    126:               </form>');
1.4       taceyjo1  127: }
                    128: 
1.6       taceyjo1  129: sub delete_copy_file {
1.5       taceyjo1  130:     my ($r, $author_name, $newpath, $filename, $path_to_new_file, $type) = @_;
                    131:     if($type eq '1') {
                    132:         $r->print("<b>Cannot delete non-obsolete published file</b><br />Please
                    133:               use the code view in previous window to use shared code<br /><br />");
1.6       taceyjo1  134:         $r->print('<input type="button" value="Close Window" name="close" onClick="window.close()" />');
1.5       taceyjo1  135:     } else {
                    136:         if(-e $path_to_new_file) {
                    137:             unless(unlink($path_to_new_file)) {
                    138:                 $r->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                    139:                 return 0;
                    140:             }
                    141:         } else {
                    142:             $r->print('<p> '.&mt('No such file').'. </p></form>');
                    143:             return 0;
                    144:         }
                    145:         &copy_file($r, $author_name, $newpath, $filename, $path_to_new_file);
                    146:     }
1.1       taceyjo1  147: }
                    148: 
1.4       taceyjo1  149: sub copy_file {
1.5       taceyjo1  150:     my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_;
                    151:     $r->print("<b>Creating directories</b>");
                    152:     my $path = '/home/'.$author_name.'/public_html/';
                    153:     my @directories = split(/\//,$newpath);
                    154:     foreach my $now_checking (@directories) {
                    155:         if($now_checking ne '') {
                    156:             $path = $path.'/'.$now_checking;
                    157:             if(-e $path) {} #More moving along, isn't recursion fun'
                    158: 
                    159:             else {
                    160:                 unless(mkdir($path, 02770)) {
                    161:                     $r->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                    162:                     return 0;
                    163:                 }
                    164:                 unless(chmod(02770, ($path))) {
                    165:                     $r->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
                    166:                     return 0;
                    167:                 }
                    168:             }
                    169:         } else { } #Just move along
                    170: 
                    171:     }
                    172:     $r->print("<br /><b>Copying File</b>");
1.6       taceyjo1  173:     my $problem_filename = $Apache::lonnet::perlvar{'lonDocRoot'}.$filename;
1.5       taceyjo1  174:     my $file_output = &Apache::lonnet::getfile($problem_filename);
                    175:     my $fs=Apache::File->new(">$path_to_new_file");
                    176:     if (defined($fs)) {
                    177:         print $fs $file_output;
                    178:     }
                    179:     $r->print("<br /><br />");
                    180:     $r->print('<input type="button" value="Close Window" name="close" onClick="window.close()">');
                    181:     #Some 1.3'ish feature is to include the derivative feature, will go here..'
                    182: }
1.4       taceyjo1  183: 
1.1       taceyjo1  184: sub print_item {
1.5       taceyjo1  185:     my ($r, $filename) = @_;
1.6       taceyjo1  186:     $filename = $Apache::lonnet::perlvar{'lonDocRoot'}.$filename;
1.5       taceyjo1  187:     &Apache::lonnet::logthis("print_item filename = $filename");
                    188:     my $file_output = &Apache::lonnet::getfile($filename);
                    189:     my $count=0;
                    190:     my $maxlength=-1;
                    191:     foreach (split ("\n", $file_output)) {
                    192:         $count+=int(length($_)/79);
                    193:         $count++;
                    194:         if (length($_) > $maxlength) {
                    195:             $maxlength = length($_);
                    196:         }
                    197:     }
                    198:     my $rows = $count;
                    199:     my $cols = $maxlength;
                    200:     $r->print('<textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.
                    201:               &HTML::Entities::encode($file_output,'<>&"').'</textarea>');
                    202:     return OK;
                    203: 
1.1       taceyjo1  204: }
                    205: 
                    206: 
1.5       taceyjo1  207: sub handler {
1.2       albertel  208:     my $r=shift;
1.3       www       209:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.5       taceyjo1  210:                                             ['filename','listname']);
1.3       www       211:     my $filename = $ENV{'form.filename'};
1.4       taceyjo1  212:     my $listname = $ENV{'form.listname'};
1.3       www       213:     my $source = &Apache::lonnet::metadata($filename,'sourceavail');
                    214:     if ($source ne 'open') {
1.5       taceyjo1  215:         $ENV{'user.error.msg'}="$filename:cre:1:1:Source code not available";
                    216:         return HTTP_NOT_ACCEPTABLE;
1.7       taceyjo1  217:     } 
                    218:     if ((!&Apache::lonnet::allowed('cre',$filename)) ||
1.5       taceyjo1  219:             (!&Apache::lonnet::allowed('bre',$filename))) {
                    220:         $ENV{'user.error.msg'}="$filename:bre:1:1:Access to resource denied";
                    221:         return HTTP_NOT_ACCEPTABLE;
1.7       taceyjo1  222:     } 
                    223:     if ($ENV{'form.action'} eq 'stage2') {
1.5       taceyjo1  224:         my $author = &Apache::lonnet::metadata($filename,'authorspace');
                    225:         $author =~ m|@|;
                    226:         $author = $`; #This just tells who the author name is for later processing.
                    227:         &stage_2($r, $ENV{'form.filename'}, $author, $listname);
1.8       taceyjo1  228:     } elsif($ENV{'form.action'} eq 'copy_stage') {
1.5       taceyjo1  229:         &copy_stage($r, $filename,$ENV{'form.listname'},$ENV{'form.newpath'});
1.8       taceyjo1  230:     } elsif($ENV{'form.action'} eq 'delete_confirm') {
1.5       taceyjo1  231:         &Apache::loncommon::content_type($r,'text/html');
                    232:         $r->send_http_header;
1.6       taceyjo1  233:         &delete_copy_file($r, $ENV{'form.author'}, $ENV{'form.newpath'}, $ENV{'form.filename'}, $ENV{'form.path'}, '0');
                    234:     } else {
1.5       taceyjo1  235:         &Apache::loncommon::content_type($r,'text/html');
                    236:         $r->send_http_header;
                    237:         $r->print('<form name="copy" action="/adm/source/" target="_parent" method="post">
1.6       taceyjo1  238:                   <input type="button" value="Close Window" name="close" onClick="window.close()" />
1.5       taceyjo1  239:                   <input type="hidden" name="filename" value="'.$filename.'" />
                    240:                   <input type="hidden" name="listname" value="'.$listname.'" />
                    241:                   <input type="hidden" name="action" value="stage2" />
                    242:                   <input type="submit" value="Copy to CSTR" />
                    243:                   </form>');
                    244:         $r->print('<hr />');
                    245:         &print_item($r, $ENV{'form.filename'});
                    246:     }
1.2       albertel  247:     return OK;
1.1       taceyjo1  248: }
                    249: 
                    250: 1;
1.5       taceyjo1  251: 
                    252: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>