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

1.1       taceyjo1    1: # The LearningOnline Network with CAPA
1.2       albertel    2: # Souce Code handler
1.1       taceyjo1    3: #
1.18    ! albertel    4: # $Id: lonsource.pm,v 1.17 2006/06/22 18:17:23 www 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;
1.11      albertel   34: use Apache::lonnet;
1.1       taceyjo1   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;
1.17      www        43: use LONCAPA;
1.1       taceyjo1   44: 
                     45: sub make_link {
1.4       taceyjo1   46:     my ($filename, $listname) = @_;
1.18    ! albertel   47:     my $sourcelink = "/adm/source?inhibitmenu=yes&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.16      albertel   58:     $r->print(&Apache::loncommon::start_page('Problem source code moving operation'));
1.5       taceyjo1   59:     $r->print("Please enter the directory that you would like the source code to go into, a default has also been 			provided <br />");
                     60:     $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 />");
1.13      www        61:     $r->print('<form name="copy" action="/adm/source" target="_parent" method="post">
1.5       taceyjo1   62:               <input type="hidden" name="filename" value="'.$filename.'" />
                     63:               <input type="hidden" name="listname" value="'.$listname.'" />
                     64:               <input type="hidden" name="action" value="copy_stage" />
1.14      www        65:               <input type="text" size="50" name="newpath" value="/shared_source/'.$author.'" />&nbsp;
1.5       taceyjo1   66:               <input type="submit" value="Copy" />
                     67:               </form>');
                     68:     return OK;
1.4       taceyjo1   69: }
                     70: 
                     71: 
                     72: sub copy_stage {
                     73:     my ($r, $filename, $listname, $newpath) = @_;
                     74:     my $role;
                     75:     my $domain;
                     76:     my $author_name;
1.5       taceyjo1   77: #Figure out if we are author or co-author
                     78: 
1.11      albertel   79:     if($env{'request.role'} =~ m|ca.|) {
                     80:         ($role, $domain, $author_name) = split(/\//,$env{'request.role'});
1.4       taceyjo1   81:     } else {
1.5       taceyjo1   82:         $role = "au.";
1.11      albertel   83:         $domain = $env{'user.domain'};
                     84:         $author_name = $env{'user.name'};
1.5       taceyjo1   85:     }
                     86: 
1.4       taceyjo1   87:     my $path_to_new_file = '/home/'.$author_name.'/public_html/'.$newpath.'/'.$listname;
1.5       taceyjo1   88: #Just checking again for access as we want to make sure that it is really ok now that we have the real path
                     89: 
1.4       taceyjo1   90:     my ($uname,$udom)= &Apache::loncacc::constructaccess($path_to_new_file,$domain);
                     91:     unless (($uname) && ($udom)) {
1.5       taceyjo1   92:         return HTTP_NOT_ACCEPTABLE;
1.4       taceyjo1   93:     }
                     94:     &Apache::loncommon::content_type($r,'text/html');
                     95:     $r->send_http_header;
1.16      albertel   96:     $r->print(&Apache::loncommon::start_page('Copying Source'));
1.5       taceyjo1   97:     my $result = &Apache::loncfile::exists($uname, $udom, $path_to_new_file);
                     98:     $r->print($result);
                     99:     if(($result) && ($result =~ m|published|) ) {
1.6       taceyjo1  100:         &delete_copy_file($r, $author_name, $newpath, $filename, $path_to_new_file, '1');
1.5       taceyjo1  101:     } elsif(($result) && ($result =~ m|exists!|)) {
                    102:         &confirm($r, $author_name, $newpath, $filename, $path_to_new_file);
                    103:     } else {
                    104:         &copy_file($r, $author_name, $newpath, $filename, $path_to_new_file);
                    105:     }
                    106: 
                    107:     return OK;
                    108: 
1.4       taceyjo1  109: }
                    110: 
                    111: sub confirm {
1.5       taceyjo1  112:     my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_;
                    113:     $r->print("<b>Press delete to remove file and replace it with a copy of the source you are viewing</b><br /><br /	>");
1.13      www       114:     $r->print('<form name="delete_confirm" action="/adm/source" target="_parent" method="post">
1.5       taceyjo1  115:               <input type="hidden" name="filename" value="'.$filename.'" />
                    116:               <input type="hidden" name="path" value="'.$path_to_new_file.'" />
                    117:               <input type="hidden" name="author" value="'.$author_name.'" />
                    118:               <input type="hidden" name="newpath" value="'.$newpath.'" />
                    119:               <input type="hidden" name="action" value="delete_confirm" />
                    120: 
                    121:               <input type="submit" value="Delete" />
                    122:               </form>');
1.4       taceyjo1  123: }
                    124: 
1.6       taceyjo1  125: sub delete_copy_file {
1.5       taceyjo1  126:     my ($r, $author_name, $newpath, $filename, $path_to_new_file, $type) = @_;
                    127:     if($type eq '1') {
                    128:         $r->print("<b>Cannot delete non-obsolete published file</b><br />Please
                    129:               use the code view in previous window to use shared code<br /><br />");
1.6       taceyjo1  130:         $r->print('<input type="button" value="Close Window" name="close" onClick="window.close()" />');
1.5       taceyjo1  131:     } else {
                    132:         if(-e $path_to_new_file) {
                    133:             unless(unlink($path_to_new_file)) {
                    134:                 $r->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                    135:                 return 0;
                    136:             }
                    137:         } else {
                    138:             $r->print('<p> '.&mt('No such file').'. </p></form>');
                    139:             return 0;
                    140:         }
                    141:         &copy_file($r, $author_name, $newpath, $filename, $path_to_new_file);
                    142:     }
1.1       taceyjo1  143: }
                    144: 
1.4       taceyjo1  145: sub copy_file {
1.5       taceyjo1  146:     my ($r, $author_name, $newpath, $filename, $path_to_new_file) = @_;
                    147:     $r->print("<b>Creating directories</b>");
                    148:     my $path = '/home/'.$author_name.'/public_html/';
                    149:     my @directories = split(/\//,$newpath);
                    150:     foreach my $now_checking (@directories) {
                    151:         if($now_checking ne '') {
                    152:             $path = $path.'/'.$now_checking;
                    153:             if(-e $path) {} #More moving along, isn't recursion fun'
                    154: 
                    155:             else {
                    156:                 unless(mkdir($path, 02770)) {
                    157:                     $r->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                    158:                     return 0;
                    159:                 }
                    160:                 unless(chmod(02770, ($path))) {
                    161:                     $r->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
                    162:                     return 0;
                    163:                 }
                    164:             }
                    165:         } else { } #Just move along
                    166: 
                    167:     }
                    168:     $r->print("<br /><b>Copying File</b>");
1.6       taceyjo1  169:     my $problem_filename = $Apache::lonnet::perlvar{'lonDocRoot'}.$filename;
1.17      www       170:     my $file_output = &includemeta(&Apache::lonnet::getfile($problem_filename),$filename);
1.5       taceyjo1  171:     my $fs=Apache::File->new(">$path_to_new_file");
                    172:     if (defined($fs)) {
                    173:         print $fs $file_output;
                    174:     }
                    175:     $r->print("<br /><br />");
                    176:     $r->print('<input type="button" value="Close Window" name="close" onClick="window.close()">');
                    177:     #Some 1.3'ish feature is to include the derivative feature, will go here..'
                    178: }
1.4       taceyjo1  179: 
1.1       taceyjo1  180: sub print_item {
1.5       taceyjo1  181:     my ($r, $filename) = @_;
1.17      www       182:     my $file_output = &includemeta(&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$filename),$filename);
1.5       taceyjo1  183:     my $count=0;
                    184:     my $maxlength=-1;
                    185:     foreach (split ("\n", $file_output)) {
                    186:         $count+=int(length($_)/79);
                    187:         $count++;
                    188:         if (length($_) > $maxlength) {
                    189:             $maxlength = length($_);
                    190:         }
                    191:     }
                    192:     my $rows = $count;
                    193:     my $cols = $maxlength;
                    194:     $r->print('<textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.
                    195:               &HTML::Entities::encode($file_output,'<>&"').'</textarea>');
                    196:     return OK;
                    197: 
1.1       taceyjo1  198: }
                    199: 
1.17      www       200: sub includemeta {
                    201:     my ($file_output,$orgfilename)=@_;
                    202:     my $escfilename=&escape($orgfilename);
                    203:     my $copytime=time;
                    204:     if ($file_output=~/\<meta\s*name\=\"isbasedonres\"/i) {
                    205: 	$file_output=~s/(\<meta\s*name\=\"isbasedonres\"\s*content\=\"[^\"]*)\"/$1\,\Q$escfilename\E\"/i;
                    206:     } else {
                    207: 	$file_output=~s/(\<(?:html|problem)[^\>]*\>)/$1\n\<meta name=\"isbasedonres\" content=\"\Q$escfilename\E\" \/\>/i;
                    208:     }
                    209:     if ($file_output=~/\<meta\s*name\=\"isbasedontime\"/i) {
                    210: 	$file_output=~s/(\<meta\s*name\=\"isbasedontime\"\s*content\=\"[^\"]*)\"/$1\,\Q$copytime\E\"/i;
                    211:     } else {
                    212: 	$file_output=~s/(\<(?:html|problem)[^\>]*\>)/$1\n\<meta name=\"isbasedontime\" content=\"\Q$copytime\E\" \/\>/i;
                    213:     }
                    214:     return $file_output;
                    215: }
1.1       taceyjo1  216: 
1.5       taceyjo1  217: sub handler {
1.2       albertel  218:     my $r=shift;
1.3       www       219:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.5       taceyjo1  220:                                             ['filename','listname']);
1.11      albertel  221:     my $filename = $env{'form.filename'};
                    222:     my $listname = $env{'form.listname'};
1.3       www       223:     my $source = &Apache::lonnet::metadata($filename,'sourceavail');
                    224:     if ($source ne 'open') {
1.11      albertel  225:         $env{'user.error.msg'}="$filename:cre:1:1:Source code not available";
1.5       taceyjo1  226:         return HTTP_NOT_ACCEPTABLE;
1.7       taceyjo1  227:     } 
1.15      www       228:     unless ((&Apache::lonnet::allowed('bre',$filename)) &&
                    229: 	    (&Apache::lonnet::allowed('cre','/'))) {
1.11      albertel  230:         $env{'user.error.msg'}="$filename:bre:1:1:Access to resource denied";
1.5       taceyjo1  231:         return HTTP_NOT_ACCEPTABLE;
1.7       taceyjo1  232:     } 
1.11      albertel  233:     if ($env{'form.action'} eq 'stage2') {
1.5       taceyjo1  234:         my $author = &Apache::lonnet::metadata($filename,'authorspace');
1.10      albertel  235:         ($author) = split('@',$author); #strip the domain of the author name
1.11      albertel  236:         &stage_2($r, $env{'form.filename'}, $author, $listname);
                    237:     } elsif($env{'form.action'} eq 'copy_stage') {
                    238:         &copy_stage($r, $filename,$env{'form.listname'},$env{'form.newpath'});
                    239:     } elsif($env{'form.action'} eq 'delete_confirm') {
1.5       taceyjo1  240:         &Apache::loncommon::content_type($r,'text/html');
                    241:         $r->send_http_header;
1.11      albertel  242:         &delete_copy_file($r, $env{'form.author'}, $env{'form.newpath'}, $env{'form.filename'}, $env{'form.path'}, '0');
1.6       taceyjo1  243:     } else {
1.5       taceyjo1  244:         &Apache::loncommon::content_type($r,'text/html');
                    245:         $r->send_http_header;
1.13      www       246:         $r->print('<form name="copy" action="/adm/source" target="_parent" method="post">
1.6       taceyjo1  247:                   <input type="button" value="Close Window" name="close" onClick="window.close()" />
1.5       taceyjo1  248:                   <input type="hidden" name="filename" value="'.$filename.'" />
                    249:                   <input type="hidden" name="listname" value="'.$listname.'" />
                    250:                   <input type="hidden" name="action" value="stage2" />
                    251:                   <input type="submit" value="Copy to CSTR" />
                    252:                   </form>');
                    253:         $r->print('<hr />');
1.11      albertel  254:         &print_item($r, $env{'form.filename'});
1.5       taceyjo1  255:     }
1.2       albertel  256:     return OK;
1.1       taceyjo1  257: }
                    258: 
                    259: 1;
1.5       taceyjo1  260: 
                    261: 

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