[BACK]Return to lonupload.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/lonupload.pm between versions 1.1 and 1.30

version 1.1, 2001/04/05 19:35:15 version 1.30, 2005/11/08 17:58:35
Line 1 Line 1
   
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Handler to upload files into construction space  # Handler to upload files into construction space
 #  #
 # (Handler to retrieve an old version of a file  # $Id$
   #
   # 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.
 #  #
 # (Publication Handler  # LON-CAPA is distributed in the hope that it will be useful,
 #   # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # (TeX Content Handler  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
 #  #
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  # 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
 #  #
 # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer  # /home/httpd/html/adm/gpl.txt
 # 03/23 Guy Albertelli  
 # 03/24,03/29 Gerd Kortemeyer)  
 #  #
 # 03/31,04/03 Gerd Kortemeyer)  # http://www.lon-capa.org/
 #  #
 # 04/05 Gerd Kortemeyer  ###
   
 package Apache::lonupload;  package Apache::lonupload;
   
 use strict;  use strict;
 use Apache::File;  use Apache::File;
 use File::Copy;  use File::Copy;
   use File::Basename;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
   use Apache::loncacc;
   use Apache::loncommon();
   use Apache::lonnet;
   use HTML::Entities();
   use Apache::lonlocal;
   use Apache::lonnet;
   
   my $DEBUG=0;
   
   sub Debug {
       # Put out the indicated message but only if DEBUG is true.
       if ($DEBUG) {
    my ($r,$message) = @_;
    $r->log_reason($message);
       }
   }
   
 sub phaseone {  sub upfile_store {
     my ($r,$fn,$uname,$udom)=@_;      my $r=shift;
     my $docroot=$r->dir_config('lonDocRoot');  
       my $fname=$env{'form.upfile.filename'};
       $fname=~s/\W//g;
       
       chomp($env{'form.upfile'});
     
       my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
     '_upload_'.$fname.'_'.time.'_'.$$;
       {
          my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                                      '/tmp/'.$datatoken.'.tmp');
          print $fh $env{'form.upfile'};
       }
       return $datatoken;
   }
   
     my $urldir='/res/'.$udom.'/'.$uname.$fn;  
     $urldir=~s/\/[^\/]+$/\//;  
   
     my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn;  sub phaseone {
     my $resdir=$resfn;      my ($r,$fn,$uname,$udom,$mode)=@_;
     $resdir=~s/\/[^\/]+$/\//;      my $action = '/adm/upload';
       if ($mode eq 'testbank') {
     $fn=~/^\/(.+)\.(\w+)$/;          $action = '/adm/testbank';
     my $main=$1;      } elsif ($mode eq 'imsimport') {
     my $suffix=$2;          $action = '/adm/imsimport';
         }
     $r->print('<form action=/adm/retrieve method=post>'.      $env{'form.upfile.filename'}=~s/\\/\//g;
       '<input type=hidden name=filename value="'.$fn.'">'.      $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
               '<input type=hidden name=phase value=two>'.      if ($env{'form.upfile.filename'}) {
               '<table border=2><tr><th>Select</th><th>Version</th>'.   $fn=~s/\/[^\/]+$//;
               '<th>Became this version on ...</th>'.   $fn=~s/([^\/])$/$1\//;
               '<th>Metadata</th></tr>');   $fn.=$env{'form.upfile.filename'};
     my $filename;   $fn=~s/^\///;
     opendir(DIR,$resdir);   $fn=~s/(\/)+/\//g;
     while ($filename=readdir(DIR)) {  
         if ($filename=~/^$main\.(\d+)\.$suffix$/) {  #    Fn is the full path to the destination filename.
    my $version=$1;  #    
            my ($rdev,$rino,$rmode,$rnlink,  
                 $ruid,$rgid,$rrdev,$rsize,   &Debug($r, "Filename for upload: $fn");
                 $ratime,$rmtime,$rctime,   if (($fn) && ($fn!~/\/$/)) {
                 $rblksize,$rblocks)=stat($resdir.'/'.$filename);      $r->print('<form action="'.$action.'" method="post" name="fileupload">'.
            $r->print('<tr><td><input type=radio name=version value="'.        '<input type="hidden" name="phase" value="two" />'.
                      $version.'"></td><th>'.$version.'</th><td>'.        '<input type="hidden" name="datatoken" value="'.
                      localtime($rmtime).'</td><td>'.        &upfile_store.'" />'.
                      '<a href="'.$urldir.$filename.'.meta" target=cat>'.        '<input type="hidden" name="uploaduname" value="'.$uname.
                      'Metadata Version '.$version.'</a></td></tr>');        '" />'.&mt('Store uploaded file as ').
         }                        "<tt>/priv/$uname/</tt>".
     }                        '<input type="text" size="50" name="filename" value="'.$fn.
     closedir(DIR);                        '" /><br />');
     my ($rdev,$rino,$rmode,$rnlink,              $r->print('<br />'.&mt('Please indicate the type of file you are uploading. The possible types of file are as follows:').'
         $ruid,$rgid,$rrdev,$rsize,  <ul>
         $ratime,$rmtime,$rctime,   <li><b>'.&mt('Regular file:').'</b>'.&mt(' A file that requires no special handling during upload. The "Regular file" designation applies to html files, image files etc., as well as to zip, tar or gzip files that you wish to decompress after upload. In the case of a zip/tar/gz file etc., once the file has been uploaded, a "Decompress" link will automatically be displayed adjacent to the name of the file in the display of construction space directory contents. You will be able to decompress this file by clicking the link.').'</li>     
         $rblksize,$rblocks)=stat($resfn);   <li><b>'.&mt('Testbank file:').'</b>'.&mt(' a testbank file containing plain text (ascii) questions and answers, which you plan to convert to LON-CAPA problems. The following question types can be converted: 1 of N multiple choice questions, individual True/False questions, groups of True/False questions, Fill-in-the-blank questions, Ranking questions, and Essay/short answer questions. Specific information about the format of the questions, foils, and correct answers is available ').'<a href="javascript:testbankWin()">'.&mt('here').'</a>,'.&mt(' and is also included in the pages displayed during step-by-step conversion of the testbank. The original testbank file can be removed from your construction space later, once the testbank questions have been converted.').'</li>
     $r->print('<tr><td><input type=radio name=version value="new"></td>'.  <li><b>'.&mt('IMS package').':</b>'.&mt(' a file containing course content from another Course Management System (e.g., Blackboard or ANGEL) packaged according to the IMS 1.1 specification.  The original IMS package file can be removed from your construction space later, once the package has been decompressed and the files converted to LON-CAPA sequence, page, problem, or bulletin board files, or stored as html, image or movie files etc., as appropriate.').'</li>
               '<th>Current</th><td>'.localtime($rmtime).  </ul>
            '</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'.  <br />'.&mt('Choose file type:').'
               'Metadata current version</a></td></tr></table><p>'.  <select name="filetype">
            '<font size=+1 color=red>Retrieval of an old version will '.   <option value="standard" selected>'.&mt('Regular file').'
            'overwrite the file currently in construction space</font><p>'.   <option value="testbank">'.&mt('Testbank file').'
            '<input type=submit value="Retrieve version"></form>');   <option value="imsimport">'.&mt('IMS package').'
   </select>
   <br />
   <br />
   ');
               $r->print('<input type="button" value="'.&mt('Store').'" onClick="javascript:verifyForm()"/></form>');
       # Check for bad extension and warn user
       if ($fn=~/\.(\w+)$/ && 
    (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
    $r->print('<font color="red">'.&mt('The extension on this file,').
     ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
     ' <br />'.&mt('Please change the extension.').'</font>');
       } elsif($fn=~/\.(\w+)$/ && 
       !defined(&Apache::loncommon::fileembstyle($1))) {
    $r->print('<font color="red">'.&mt('The extension on this file,').
     ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
     ' <br />'.&mt('Please change the extension.').
     '</font>');
       }
    } else {
       $r->print('<font color="red">'.&mt('Illegal filename.').'</font>');
    }
       } else {
    $r->print('<font color="red">'.&mt('No upload file specified.').'</font>');
       }
 }  }
   
 sub phasetwo {  sub phasetwo {
     my ($r,$fn,$uname,$udom)=@_;      my ($r,$tfn,$uname,$udom,$mode)=@_;
     if ($ENV{'form.version'}) {      my $action = '/adm/upload';
         my $version=$ENV{'form.version'};      my $returnflag = '';
  if ($version eq 'new') {      if ($mode eq 'testbank') {
     $r->print('<h3>Retrieving current (most recent) version</h3>');          $action = '/adm/testbank';
         } else {      } elsif ($mode eq 'imsimport') {
             $r->print('<h3>Retrieving old version '.$version.'</h3>');          $action = '/adm/imsimport';
         }      }
         my $logfile;      my $fn='/priv/'.$uname.'/'.$tfn;
         my $ctarget='/home/'.$uname.'/public_html'.$fn;      $fn=~s/\/+/\//g;
         my $vfn=$fn;      &Debug($r, "Filename is ".$tfn);
         if ($version ne 'new') {      if ($tfn) {
     $vfn=~s/\.(\w+)$/\.$version\.$1/;   &Debug($r, "Filename for tfn = ".$tfn);
         }   my $target='/home/'.$uname.'/public_html'.$tfn;
         my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn;   &Debug($r, "target -> ".$target);
         unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) {  #     target is the full filesystem path of the destination file.
   $r->print(   my $base = &File::Basename::basename($fn);
          '<font color=red>No write permission to user directory, FAIL</font>');   my $path = &File::Basename::dirname($fn);
         }   $base    = &HTML::Entities::encode($base,'<>&"');
         print $logfile    my $url  = $path."/".$base; 
 "\n\n================= Retrieve ".localtime()." ================\n".   &Debug($r, "URL is now ".$url);
 "Version: $version\nSource: $csource\nTarget: $ctarget\n";   my $datatoken=$env{'form.datatoken'};
         $r->print('<p>Copying file: ');   if (($fn) && ($datatoken)) {
         if (copy($csource,$ctarget)) {      if ((-e $target) && ($env{'form.override'} ne 'Yes')) {
     $r->print('ok<p>');   $r->print('<form action="'.$action.'" method="post">'.
             print $logfile "Copied sucessfully.\n\n";    &mt('File').' <tt>'.$fn.'</tt> '.
         } else {    &mt('exists. Overwrite?').' '.
             my $error=$!;    '<input type="hidden" name="phase" value="two" />'.
     $r->print('fail, '.$error.'<p>');    '<input type="hidden" name="filename" value="'."$url".'" />'.
             print $logfile "Copy failed: $error\n\n";    '<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.
         }    '<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');
         $r->print('<font size=+2><a href="/priv/'.$uname.$fn.      } else {
                   '">Back to '.$fn.'</a></font>');    my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
    my $dirpath=$path.'/';
    $dirpath=~s/\/+/\//g;
    # Check for bad extension and disallow upload
    if ($fn=~/\.(\w+)$/ && 
       (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
       $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
         &mt('could not be copied.').'<br />'.
         '<font color="red">'.
         &mt('The extension on this file is reserved internally by LON-CAPA.').
         '</font>');
       $r->print('<br /><font size=+2><a href="'.$dirpath.'">'.
         &mt('Back to Directory').'</a></font>');
    } elsif ($fn=~/\.(\w+)$/ && 
    !defined(&Apache::loncommon::fileembstyle($1))) {
       $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
         &mt('could not be copied.').'<br />'.
         '<font color="red">'.
         &mt('The extension on this file is not recognized by LON-CAPA.').
         '</font>');
       $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
         &mt('Back to Directory').'</a></font>');
    } elsif (-d $target) {
       $r->print('File <tt>'.$fn.'</tt> could not be copied.<br />'.
         '<font color="red">'.
         &mt('The target is an existing directory.').
         '</font><br />');
       $r->print('<font size="+2"><a href="'.$dirpath.'">'.
         &mt('Back to Directory').'</a></font>');
    } elsif (copy($source,$target)) {
       chmod(0660, $target); # Set permissions to rw-rw---.
                       if ($mode eq 'testbank' || $mode eq 'imsimport') {
                           $r->print(&mt("Your file - $fn - was uploaded successfully")."<br /><br />");
                           $returnflag = 'ok';
                       } else {
                           $r->print(&mt('File copied.'));
           $r->print('<br /><font size="+2"><a href="'.$url.'">'.
         &mt('View file').'</a></font>');
           $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
         &mt('Back to Directory').'</a></font><br />');
                       }
    } else {
       $r->print('Failed to copy: '.$!);
       $r->print('<br /><font size="+2"><a href="'.$path.'">'.
         &mt('Back to Directory').'</a></font>');
    }
       }
    } else {
       $r->print('<font size="+1" color="red">'.
         &mt('Please use browser "Back" button and pick a filename').
         '</font><br />');
    }
     } else {      } else {
        $r->print(   $r->print('<font size=+1 color=red>'.
    '<font size=+1 color=red>Please pick a version to retrieve</font><p>');    &mt('Please use browser "Back" button and pick a filename').
        &phaseone($r,$fn,$uname,$udom);    '</font><br />>');
     }      }
       return $returnflag;
 }  }
   
   # ---------------------------------------------------------------- Main Handler
 sub handler {  sub handler {
   
   my $r=shift;      my $r=shift;
   
   my $fn;      my $uname;
       my $udom;
       my $javascript = '';
   #
   # phase two: re-attach user
   #
       if ($env{'form.uploaduname'}) {
    $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
       $env{'form.filename'};
       }
   
   if ($ENV{'form.filename'}) {      unless ($env{'form.phase'} eq 'two') {
       $fn=$ENV{'form.filename'};          $javascript = qq|
       $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//;  function verifyForm() {
   } else {      var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.      if (mode == "testbank") {
          ' unspecified filename for retrieval', $r->filename);           document.fileupload.action = "/adm/testbank";
      return HTTP_NOT_FOUND;      }
   }      if (mode == "imsimport") {
           document.fileupload.action = "/adm/imsimport";
   unless ($fn) {       }
      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.      if (mode == "standard") {
          ' trying to retrieve non-existing file', $r->filename);           document.fileupload.action = "/adm/upload";
      return HTTP_NOT_FOUND;      }
   }       document.fileupload.submit();
   }
   
 # ----------------------------------------------------------- Start page output  function testbankWin() {
     newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")
     newWindow.document.open()
     newWindow.document.write("<html><head><title>'Importing a Testbank file into LON-CAPA</title><meta http-equiv='pragma' content='no-cache'>\\n")
     newWindow.document.write("</head><body bgcolor='#CCFFDD' topmargin='0' leftmargin='0' marginheight='0'marginwidth='0' rightmargin='0'>\\n")
     newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
     newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='95%' bgcolor='#CCFFDD'>\\n")
     newWindow.document.write("<tr><td width='2'>&nbsp;</td><td width='3'>&nbsp;</td>\\n")
     newWindow.document.write("<td><font face='arial,helvetica,sans-serif'><h3>Importing Testbank questions into LON-CAPA</h3>")
     newWindow.document.write("<font face='arial,helvetica,sans-serif'><br />Four requirements must be met to ensure that you will succeed in building LON-CAPA problem files using your plain text file containing testbank questions.")
     newWindow.document.write("<ol><li>The questions and answers you upload must be in plain text format.  Any header lines should occur before the text containing the questions and answers.</li>")
     newWindow.document.write("<li>All questions must occur before any of the answers.  Each question should be numbered sequentially using a number followed immediately by a space, a period, or enclosed in parentheses, i.e., 1 , 1., (1), 1), or (1 .</li>")
      newWindow.document.write("<li>One or more correct answers should be provided for all questions (although blank answers may be provided for <i>essay</i> questions).  Answers should be numbered sequentially, using the same scheme as used for the questions, and must occur after all the questions.")
       newWindow.document.write("<li><i>Multiple choice</i> and <i>multiple answer correct</i> questions should consist of (i) the question number followed by (ii) a question stem beginning on the same line and (iii) two or more foils, with each foil beginning on a new line and prefixed by a unique letter, or Roman numeral, listed in alphabetic or numeric order, beginning at a (alphabetic) or i (Roman numeral), followed by a period, or enclosed in parentheses, i.e., a., (a), i., or (i) .</li>")
        newWindow.document.write("<li>If <i>fill-in-the-blank</i> or <i>multiple answer</i> questions have more than one correct answer, each answer should appear in a comma-, tab-, space-, or new line-delimited list. </li></ol>")
     newWindow.document.write("</td></tr>\\n")
     newWindow.document.write("</table></body></html>")
     newWindow.document.close()
     newWindow.focus()
   }
   |;
       }
       ($uname,$udom)=
    &Apache::loncacc::constructaccess($env{'form.filename'},
     $r->dir_config('lonDefDomain'));
       unless (($uname) && ($udom)) {
    $r->log_reason($uname.' at '.$udom.
          ' trying to publish file '.$env{'form.filename'}.
          ' - not authorized', 
          $r->filename); 
    return HTTP_NOT_ACCEPTABLE;
       }
       
       my $fn;
       if ($env{'form.filename'}) {
    $fn=$env{'form.filename'};
    $fn=~s/^http\:\/\/[^\/]+\///;
    $fn=~s/^\///;
    $fn=~s/(\~|priv\/)(\w+)//;
    $fn=~s/\/+/\//g;
       } else {
    $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
          ' unspecified filename for upload', $r->filename); 
    return HTTP_NOT_FOUND;
       }
   
   my $uname=$ENV{'user.name'};  # ----------------------------------------------------------- Start page output
   my $udom=$ENV{'user.domain'};  
   
   $r->content_type('text/html');  
   $r->send_http_header;  
   
   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');      &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
   
   $r->print(      $r->print("<html><head><title>LON-CAPA Construction Space</title><script type=\"text/javascript\">\n//<!--\n$javascript\n// --></script>\n</head>");
    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');  
   
       $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));
       
   $r->print('<h1>Retrieve previous versions of <tt>'.$fn.'</tt></h1>');      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
    $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
     &mt(' at ').$udom.'</font></h3>');
       }
   
   if ($ENV{'form.phase'} eq 'two') {      if ($env{'form.phase'} eq 'two') {
       &phasetwo($r,$fn,$uname,$udom);   &phasetwo($r,$fn,$uname,$udom);
   } else {      } else {
       &phaseone($r,$fn,$uname,$udom);   &phaseone($r,$fn,$uname,$udom);
   }      }
   
   $r->print('</body></html>');      $r->print('</body></html>');
   return OK;        return OK;  
 }  }
   
   1;
   __END__
   
   =head1 NAME
   
   Apache::lonupload - upload files into construction space
   
   =head1 SYNOPSIS
   
   Invoked by /etc/httpd/conf/srm.conf:
   
    <Location /adm/upload>
    PerlAccessHandler       Apache::lonacc
    SetHandler perl-script
    PerlHandler Apache::lonupload
    ErrorDocument     403 /adm/login
    ErrorDocument     404 /adm/notfound.html
    ErrorDocument     406 /adm/unauthorized.html
    ErrorDocument  500 /adm/errorhandler
    </Location>
   
   =head1 INTRODUCTION
   
   This module uploads a file sitting on a client computer into 
   library server construction space.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   Initialize variables
   
   =item *
   
   Start page output
   
   =item *
   
   output relevant interface phase (phaseone or phasetwo)
   
   =item *
   
   (phase one is to specify upload file; phase two is to handle conditions
   subsequent to specification--like overwriting an existing file)
   
   =back
   
   =head1 OTHER SUBROUTINES
   
   =over 4
   
   =item *
   
   phaseone() : Interface for specifying file to upload.
   
   =item *
   
   phasetwo() : Interface for handling post-conditions about uploading (such
   as overwriting an existing file).
   
   =item *
   
   upfile_store() : Store contents of uploaded file into temporary space.  Invoked
   by phaseone subroutine.
   
   =back
   
   =cut
Removed from v.1.1  
changed lines
  Added in v.1.30

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