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

Diff for /loncom/publisher/lonupload.pm between versions 1.16 and 1.32

version 1.16, 2003/06/23 21:56:31 version 1.32, 2006/04/10 22:30:31
Line 26 Line 26
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # (Handler to retrieve an old version of a file  
 #  
 # (Publication Handler  
 #   
 # (TeX Content Handler  
 #  
 # YEAR=2000  
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  
 #  
 # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer  
 # YEAR=2001  
 # 03/23 Guy Albertelli  
 # 03/24,03/29 Gerd Kortemeyer)  
 #  
 # 03/31,04/03 Gerd Kortemeyer)  
 #  
 # 04/05,04/09,05/25,06/23,06/24,08/22 Gerd Kortemeyer  
 # 11/29 Matthew Hall  
 #  
 ###  ###
   
 package Apache::lonupload;  package Apache::lonupload;
Line 56  use File::Basename; Line 37  use File::Basename;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use Apache::loncacc;  use Apache::loncacc;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::Log();  
 use Apache::lonnet;  use Apache::lonnet;
 use HTML::Entities();  use HTML::Entities();
   use Apache::lonlocal;
   use Apache::lonnet;
   
 my $DEBUG=0;  my $DEBUG=0;
   
 sub Debug {  sub Debug {
         # Put out the indicated message but only if DEBUG is true.
   # Marshall the parameters.      if ($DEBUG) {
      my ($r,$message) = @_;
   my $r       = shift;   $r->log_reason($message);
   my $log     = $r->log;      }
   my $message = shift;  
     
   # Put out the indicated message butonly if DEBUG is false.  
     
   if ($DEBUG) {  
     $log->debug($message);  
   }  
 }  }
   
 sub upfile_store {  sub upfile_store {
     my $r=shift;      my $r=shift;
   
     my $fname=$ENV{'form.upfile.filename'};      my $fname=$env{'form.upfile.filename'};
     $fname=~s/\W//g;      $fname=~s/\W//g;
           
     chop($ENV{'form.upfile'});      chomp($env{'form.upfile'});
       
     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.      my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
   '_upload_'.$fname.'_'.time.'_'.$$;    '_upload_'.$fname.'_'.time.'_'.$$;
     {      {
        my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').         my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                                    '/tmp/'.$datatoken.'.tmp');                                     '/tmp/'.$datatoken.'.tmp');
        print $fh $ENV{'form.upfile'};         print $fh $env{'form.upfile'};
     }      }
     return $datatoken;      return $datatoken;
 }  }
   
   
 sub phaseone {  sub phaseone {
    my ($r,$fn,$uname,$udom)=@_;      my ($r,$fn,$uname,$udom,$mode)=@_;
    $ENV{'form.upfile.filename'}=~s/\\/\//g;      my $action = '/adm/upload';
    $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;      if ($mode eq 'testbank') {
    if ($ENV{'form.upfile.filename'}) {          $action = '/adm/testbank';
     $fn=~s/\/[^\/]+$//;      } elsif ($mode eq 'imsimport') {
     $fn=~s/([^\/])$/$1\//;          $action = '/adm/imsimport';
     $fn.=$ENV{'form.upfile.filename'};      }
     $fn=~s/^\///;      $env{'form.upfile.filename'}=~s/\\/\//g;
     $fn=~s/(\/)+/\//g;      $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
       if ($env{'form.upfile.filename'}) {
    $fn=~s/\/[^\/]+$//;
    $fn=~s/([^\/])$/$1\//;
    $fn.=$env{'form.upfile.filename'};
    $fn=~s/^\///;
    $fn=~s/(\/)+/\//g;
   
 #    Fn is the full path to the destination filename.  #    Fn is the full path to the destination filename.
 #      #    
   
     &Debug($r, "Filename for upload: $fn");   &Debug($r, "Filename for upload: $fn");
     if (($fn) && ($fn!~/\/$/)) {   if (($fn) && ($fn!~/\/$/)) {
       $r->print(      $r->print('<form action="'.$action.'" method="post" name="fileupload">'.
  '<form action=/adm/upload method=post>'.        '<input type="hidden" name="phase" value="two" />'.
  '<input type=hidden name=phase value=two>'.        '<input type="hidden" name="datatoken" value="'.
  '<input type=hidden name=datatoken value="'.&upfile_store.'">'.        &upfile_store.'" />'.
  'Store uploaded file as '.        '<input type="hidden" name="uploaduname" value="'.$uname.
  '<input type=text size=50 name=filename value="/priv/'.        '" />'.&mt('Store uploaded file as ').
   $uname.'/'.$fn.'"><br>'.                        "<tt>/priv/$uname/</tt>".
  '<input type=submit value="Store"></form>');                        '<input type="text" size="50" name="filename" value="'.$fn.
       # Check for bad extension and warn user                        '" /><br />');
       if ($fn=~/\.(\w+)$/ &&               $r->print('<br />'.&mt('Please indicate the type of file you are uploading. The possible types of file are as follows:').'
   (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {  <ul>
   $r->print(   <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>     
  '<font color=red>'.   <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>
  'The extension on this file, "'.$1.  <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>
  '", is reserved internally by LON-CAPA. <br \>'.  </ul>
  'Please change the extension.'.  <br />'.&mt('Choose file type:').'
  '</font>');  <select name="filetype">
       } elsif($fn=~/\.(\w+)$/ &&    <option value="standard" selected>'.&mt('Regular file').'
       !defined(&Apache::loncommon::fileembstyle($1))) {   <option value="testbank">'.&mt('Testbank file').'
   $r->print(   <option value="imsimport">'.&mt('IMS package').'
  '<font color=red>'.  </select>
  'The extension on this file, "'.$1.  <br />
  '", is not recognized by LON-CAPA. <br \>'.  <br />
  'Please change the extension.'.  ');
  '</font>');              $r->print('<input type="button" value="'.&mt('Store').'" onClick="javascript:verifyForm()"/></form>');
       }      # Check for bad extension and warn user
   } else {      if ($fn=~/\.(\w+)$/ && 
       $r->print('<font color=red>Illegal filename.</font>');   (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
   }   $r->print('<font color="red">'.&mt('The extension on this file,').
  } else {    ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
      $r->print('<font color=red>No upload file specified.</font>');    ' <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)=@_;
    &Debug($r, "Filename is ".$fn);      my $action = '/adm/upload';
    if ($fn=~/^\/priv\/$uname\//) {      my $returnflag = '';
     &Debug($r, "Filename after priv substitution: ".$fn);      if ($mode eq 'testbank') {
     my $tfn=$fn;          $action = '/adm/testbank';
     $tfn=~s/^\/(\~|priv)\/(\w+)//;      } elsif ($mode eq 'imsimport') {
     &Debug($r, "Filename for tfn = ".$tfn);          $action = '/adm/imsimport';
     my $target='/home/'.$uname.'/public_html'.$tfn;      }
     &Debug($r, "target -> ".$target);      my $fn='/priv/'.$uname.'/'.$tfn;
       $fn=~s/\/+/\//g;
       &Debug($r, "Filename is ".$tfn);
       if ($tfn) {
    &Debug($r, "Filename for tfn = ".$tfn);
    my $target='/home/'.$uname.'/public_html'.$tfn;
    &Debug($r, "target -> ".$target);
 #     target is the full filesystem path of the destination file.  #     target is the full filesystem path of the destination file.
     my $base = &File::Basename::basename($fn);   my $base = &File::Basename::basename($fn);
     my $path = &File::Basename::dirname($fn);   my $path = &File::Basename::dirname($fn);
     $base    = &HTML::Entities::encode($base);   $base    = &HTML::Entities::encode($base,'<>&"');
     my $url  = $path."/".$base;    my $url  = $path."/".$base; 
     &Debug($r, "URL is now ".$url);   &Debug($r, "URL is now ".$url);
     my $datatoken=$ENV{'form.datatoken'};   my $datatoken=$env{'form.datatoken'};
     if (($fn) && ($datatoken)) {   if (($fn) && ($datatoken)) {
  if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {      if ((-e $target) && ($env{'form.override'} ne 'Yes')) {
            $r->print(   $r->print('<form action="'.$action.'" method="post">'.
  '<form action=/adm/upload method=post>'.    &mt('File').' <tt>'.$fn.'</tt> '.
  'File <tt>'.$fn.'</tt> exists. Overwrite? '.    &mt('exists. Overwrite?').' '.
  '<input type=hidden name=phase value=two>'.    '<input type="hidden" name="phase" value="two" />'.
  '<input type=hidden name=filename value="'."$url".'">'.    '<input type="hidden" name="filename" value="'."$url".'" />'.
  '<input type=hidden name=datatoken value="'.$datatoken.'">'.    '<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.
  '<input type=submit name=override value="Yes"></form>');    '<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');
        } else {      } else {
            my $source=$r->dir_config('lonDaemons').   my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
                              '/tmp/'.$datatoken.'.tmp';   my $dirpath=$path.'/';
            # Check for bad extension and disallow upload   $dirpath=~s/\/+/\//g;
    if ($fn=~/\.(\w+)$/ &&    # Check for bad extension and disallow upload
        (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {   if ($fn=~/\.(\w+)$/ && 
        $r->print(      (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
  'File <tt>'.$fn.'</tt> could not be copied.<br />'.      $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
  '<font color=red>'.        &mt('could not be copied.').'<br />'.
  'The extension on this file is reserved internally by LON-CAPA.'.        '<font color="red">'.
  '</font>');        &mt('The extension on this file is reserved internally by LON-CAPA.').
    } elsif ($fn=~/\.(\w+)$/ &&         '</font>');
     !defined(&Apache::loncommon::fileembstyle($1))) {      $r->print('<br /><font size=+2><a href="'.$dirpath.'">'.
        $r->print(        &mt('Back to Directory').'</a></font>');
  'File <tt>'.$fn.'</tt> could not be copied.<br />'.   } elsif ($fn=~/\.(\w+)$/ && 
  '<font color=red>'.   !defined(&Apache::loncommon::fileembstyle($1))) {
  'The extension on this file is not recognized by LON-CAPA.'.      $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
  '</font>');        &mt('could not be copied.').'<br />'.
    } elsif (copy($source,$target)) {        '<font color="red">'.
        chmod(0660, $target); # Set permissions to rw-rw---.        &mt('The extension on this file is not recognized by LON-CAPA.').
       $r->print('File copied.');        '</font>');
               $r->print('<p><font size=+2><a href="'.$url.      $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
                         '">View file</a></font>');        &mt('Back to Directory').'</a></font>');
               $r->print('<p><font size=+2><a href="'.$path.   } elsif (-d $target) {
                         '">Back to Directory</a></font>');      $r->print('File <tt>'.$fn.'</tt> could not be copied.<br />'.
    } else {        '<font color="red">'.
               $r->print('Failed to copy: '.$!);        &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 filename</font><p>');    &mt('Please use browser "Back" button and pick a filename').
        &phaseone($r,$fn,$uname,$udom);    '</font><br />>');
     }      }
   } else {      return $returnflag;
     $r->print(  
    '<font size=+1 color=red>Please pick a filename</font><p>');  
     &phaseone($r,$fn,$uname,$udom);  
   }  
 }  }
   
 # ---------------------------------------------------------------- Main Handler  # ---------------------------------------------------------------- Main Handler
 sub handler {  sub handler {
   
   my $r=shift;      my $r=shift;
   
       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'};
       }
   
   my $uname;      unless ($env{'form.phase'} eq 'two') {
   my $udom;   my %body_layout = ('rightmargin'  => "0",
      'leftmargin'   => "0",
      'marginwidth'  => "0",
      'topmargin'    => "0",
      'marginheight' => "0");
    my $start_page = 
       &Apache::loncommon::start_page('Importing a Testbank file into LON-CAPA',
      undef,
      {'only_body'   => 1,
       'add_entries' => \%body_layout,
       'js_ready'    => 1,});
    my $end_page = 
       &Apache::loncommon::end_page({'js_ready' => 1,});
   
           $javascript = qq|
   function verifyForm() {
       var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
       if (mode == "testbank") {
           document.fileupload.action = "/adm/testbank";
       }
       if (mode == "imsimport") {
           document.fileupload.action = "/adm/imsimport";
       }
       if (mode == "standard") {
           document.fileupload.action = "/adm/upload";
       }
       document.fileupload.submit();
   }
   
   ($uname,$udom)=  function testbankWin() {
     &Apache::loncacc::constructaccess(    newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")
  $ENV{'form.filename'},$r->dir_config('lonDefDomain'));    newWindow.document.open()
   unless (($uname) && ($udom)) {    newWindow.document.write('$start_page')
      $r->log_reason($uname.' at '.$udom.    newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
          ' trying to publish file '.$ENV{'form.filename'}.    newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='95%' bgcolor='#CCFFDD'>\\n")
          ' - not authorized',     newWindow.document.write("<tr><td width='2'>&nbsp;</td><td width='3'>&nbsp;</td>\\n")
          $r->filename);     newWindow.document.write("<td><font face='arial,helvetica,sans-serif'><h3>Importing Testbank questions into LON-CAPA</h3>")
      return HTTP_NOT_ACCEPTABLE;    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>")
   my $fn;     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>")
   if ($ENV{'form.filename'}) {       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>")
       $fn=$ENV{'form.filename'};    newWindow.document.write("</td></tr>\\n")
       $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;    newWindow.document.write("</table>")
   } else {    newWindow.document.write('$end_page')
      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.    newWindow.document.close()
          ' unspecified filename for upload', $r->filename);     newWindow.focus()
      return HTTP_NOT_FOUND;  }
   }  |;
       }
       ($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;
       }
   
 # ----------------------------------------------------------- Start page output  # ----------------------------------------------------------- Start page output
   
   
   $r->content_type('text/html');      &Apache::loncommon::content_type($r,'text/html');
   $r->send_http_header;      $r->send_http_header;
   
   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');  
   
   $r->print(     $javascript = "<script type=\"text/javascript\">\n//<!--\n".
    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');   $javascript."\n// --></script>\n";
   
       $r->print(&Apache::loncommon::start_page('Upload file to Construction Space',
        $javascript));
       
   $r->print('<h1>Upload file to Construction Space</h1>');      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
      $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {    &mt(' at ').$udom.'</font></h3>');
           $r->print('<h3><font color=red>Co-Author: '.$uname.' 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(&Apache::loncommon::end_page());
   return OK;        return OK;  
 }  }
   
 1;  1;
Removed from v.1.16  
changed lines
  Added in v.1.32

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