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

Diff for /loncom/publisher/lonretrieve.pm between versions 1.22 and 1.28

version 1.22, 2003/05/19 21:53:03 version 1.28, 2005/12/12 21:59:12
Line 26 Line 26
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 #  #
 # (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,05/02,05/09,06/23,08/20 Gerd Kortemeyer  
 #  
 ###  ###
   
 package Apache::lonretrieve;  package Apache::lonretrieve;
Line 50  use File::Copy; Line 36  use File::Copy;
 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::lonlocal;
   use Apache::lonnet;
   
 # ------------------------------------ Interface for selecting previous version  # ------------------------------------ Interface for selecting previous version
 sub phaseone {  sub phaseone {
Line 71  sub phaseone { Line 59  sub phaseone {
     $r->print('<form action=/adm/retrieve method=post>'.      $r->print('<form action=/adm/retrieve method=post>'.
       '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.        '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
               '<input type=hidden name=phase value=two>'.                '<input type=hidden name=phase value=two>'.
               '<table border=2><tr><th>Select</th><th>Version</th>'.                '<table border=2><tr><th>'.&mt('Select').'</th><th>'.
               '<th>Became this version on ...</th>'.        &mt('Version').'</th>'.
               '<th>Metadata</th></tr>');                '<th>'.&mt('Published on ...').'</th>'.
     my $filename;                '<th>'.&mt('Metadata').'</th></tr>');
   
     opendir(DIR,$resdir);      opendir(DIR,$resdir);
     while ($filename=readdir(DIR)) {      my @files = grep(/^\Q$main\E\.(\d+)\.\Q$suffix\E$/,readdir(DIR));
       @files = sort {
    my ($aver) = ($a=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/);
    my ($bver) = ($b=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/);
    return $aver <=> $bver;
       } (@files);
       closedir(DIR);
   
       foreach my $filename (@files) {
         if ($filename=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/) {          if ($filename=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/) {
    my $version=$1;     my $version=$1;
            my ($rdev,$rino,$rmode,$rnlink,             my $rmtime=&Apache::lonnet::metadata($resdir.'/'.$filename,'lastrevisiondate');
                 $ruid,$rgid,$rrdev,$rsize,  
                 $ratime,$rmtime,$rctime,  
                 $rblksize,$rblocks)=stat($resdir.'/'.$filename);  
            $r->print('<tr><td><input type=radio name=version value="'.             $r->print('<tr><td><input type=radio name=version value="'.
                      $version.'"></td><th>'.$version.'</th><td>'.                       $version.'"></td><td>'.&mt('Previously published version').' '.$version.'</td><td>'.
                      localtime($rmtime).'</td><td>'.                       localtime($rmtime).'</td><td>'.
                      '<a href="'.$urldir.$filename.'.meta" target=cat>'.                       '<a href="'.$urldir.$filename.'.meta" target=cat>'.
                      'Metadata Version '.$version.'</a>');                       &mt('Metadata Version').' '.$version.'</a>');
            if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') {             if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
                $r->print(                 $r->print(
                     '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename=/~'.                      '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename=/~'.
                         $uname.$fn.                          $uname.$fn.
                         '&versiontwo=priv&versiontwo='.$version.                          '&versiontwo=priv&versionone='.$version.
                         '">Diffs with Version '.$version.'</a>');                          '">'.&mt('Diffs with Version').' '.$version.'</a>');
            }             }
            $r->print('</a></td></tr>');             $r->print('</a></td></tr>');
         }          }
     }      }
     closedir(DIR);      closedir(DIR);
     my ($rdev,$rino,$rmode,$rnlink,      my $rmtime=&Apache::lonnet::metadata($resfn,'lastrevisiondate');
         $ruid,$rgid,$rrdev,$rsize,  
         $ratime,$rmtime,$rctime,  
         $rblksize,$rblocks)=stat($resfn);  
     $r->print('<tr><td><input type=radio name=version value="new"></td>'.      $r->print('<tr><td><input type=radio name=version value="new"></td>'.
               '<th>Current</th><td>'.localtime($rmtime).                '<th>'.&mt('Currently public version').'</th><td>'.localtime($rmtime).
            '</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'.             '</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'.
               'Metadata current version</a>');                           &mt('Metadata current version').'</a>');           
            if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') {             if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
                $r->print(                 $r->print(
                     '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename=/~'.                      '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename=/~'.
                         $uname.$fn.                          $uname.$fn.
                         '&versiontwo=priv'.                          '&versiontwo=priv'.
                         '">Diffs with current Version</a>');                          '">'.&mt('Diffs with current Version').'</a>');
            }             }
            $r->print('</td></tr></table><p>'.             $r->print('</td></tr></table><p>'.
            '<font size=+1 color=red>Retrieval of an old version will '.             '<font size=+1 color=red>'.
            'overwrite the file currently in construction space</font><p>'.  &mt('Retrieval of an old version will overwrite the file currently in construction space').'</font><p>'.
            '<input type=submit value="Retrieve version"></form>');             '<input type=submit value="'.&mt('Retrieve version').'"></form>');
 } else {  } else {
     $r->print('<h3>No previous versions published.</h3>');      $r->print('<h3>'.&mt('No previous versions published.').'</h3>');
 }  }
       $r->print('<p><a href="/priv/'.$uname.$fn.'">'.&mt('Back to').' '.$fn.
         '</a></p>'); 
 }  }
   
 # ---------------------------------- Interface for presenting specified version  # ---------------------------------- Interface for presenting specified version
 sub phasetwo {  sub phasetwo {
     my ($r,$fn,$uname,$udom)=@_;      my ($r,$fn,$uname,$udom)=@_;
     if ($ENV{'form.version'}) {      if ($env{'form.version'}) {
         my $version=$ENV{'form.version'};          my $version=$env{'form.version'};
  if ($version eq 'new') {   if ($version eq 'new') {
     $r->print('<h3>Retrieving current (most recent) version</h3>');      $r->print('<h3>'.&mt('Retrieving current (most recent) version').'</h3>');
         } else {          } else {
             $r->print('<h3>Retrieving old version '.$version.'</h3>');              $r->print('<h3>'.&mt('Retrieving old version').' '.$version.'</h3>');
         }          }
         my $logfile;          my $logfile;
         my $ctarget='/home/'.$uname.'/public_html'.$fn;          my $ctarget='/home/'.$uname.'/public_html'.$fn;
Line 142  sub phasetwo { Line 135  sub phasetwo {
         my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn;          my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn;
         unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) {          unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) {
   $r->print(    $r->print(
          '<font color=red>No write permission to user directory, FAIL</font>');           '<font color=red>'.&mt('No write permission to user directory, FAIL').'</font>');
         }          }
         print $logfile           print $logfile 
 "\n\n================= Retrieve ".localtime()." ================\n".  "\n\n================= Retrieve ".localtime()." ================\n".
 "Version: $version\nSource: $csource\nTarget: $ctarget\n";  "Version: $version\nSource: $csource\nTarget: $ctarget\n";
         $r->print('<p>Copying file: ');          $r->print('<p>'.&mt('Copying file').': ');
         if (copy($csource,$ctarget)) {          if (copy($csource,$ctarget)) {
     $r->print('ok<p>');      $r->print('ok<p>');
             print $logfile "Copied sucessfully.\n\n";              print $logfile "Copied sucessfully.\n\n";
Line 157  sub phasetwo { Line 150  sub phasetwo {
             print $logfile "Copy failed: $error\n\n";              print $logfile "Copy failed: $error\n\n";
         }          }
         $r->print('<font size=+2><a href="/priv/'.$uname.$fn.          $r->print('<font size=+2><a href="/priv/'.$uname.$fn.
                   '">Back to '.$fn.'</a></font>');                     '">'.&mt('Back to').' '.$fn.'</a></font>'); 
     } else {      } else {
        $r->print(         $r->print(
    '<font size=+1 color=red>Please pick a version to retrieve</font><p>');     '<font size=+1 color=red>'.&mt('Please pick a version to retrieve').'</font><p>');
        &phaseone($r,$fn,$uname,$udom);         &phaseone($r,$fn,$uname,$udom);
     }      }
 }  }
Line 178  sub handler { Line 171  sub handler {
   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
   ['filename']);    ['filename']);
   
   if ($ENV{'form.filename'}) {    if ($env{'form.filename'}) {
       $fn=$ENV{'form.filename'};        $fn=$env{'form.filename'};
       $fn=~s/^http\:\/\/[^\/]+//;        $fn=~s/^http\:\/\/[^\/]+//;
   } else {    } else {
      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.       $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
          ' unspecified filename for retrieval', $r->filename);            ' unspecified filename for retrieval', $r->filename); 
      return HTTP_NOT_FOUND;       return HTTP_NOT_FOUND;
   }    }
   
   unless ($fn) {     unless ($fn) { 
      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.       $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
          ' trying to retrieve non-existing file', $r->filename);            ' trying to retrieve non-existing file', $r->filename); 
      return HTTP_NOT_FOUND;       return HTTP_NOT_FOUND;
   }     } 
Line 201  sub handler { Line 194  sub handler {
     &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));      &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
   unless (($uname) && ($udom)) {    unless (($uname) && ($udom)) {
      $r->log_reason($uname.' at '.$udom.       $r->log_reason($uname.' at '.$udom.
          ' trying to publish file '.$ENV{'form.filename'}.           ' trying to publish file '.$env{'form.filename'}.
          ' ('.$fn.') - not authorized',            ' ('.$fn.') - not authorized', 
          $r->filename);            $r->filename); 
      return HTTP_NOT_ACCEPTABLE;       return HTTP_NOT_ACCEPTABLE;
Line 209  sub handler { Line 202  sub handler {
   
   $fn=~s/\/\~(\w+)//;    $fn=~s/\/\~(\w+)//;
   
   $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('<html><head><title>LON-CAPA Construction Space</title></head>');
Line 217  sub handler { Line 210  sub handler {
   $r->print(&Apache::loncommon::bodytag('Retrieve Published Resources'));    $r->print(&Apache::loncommon::bodytag('Retrieve Published Resources'));
   
       
   $r->print('<h1>Retrieve previous versions of <tt>'.$fn.'</tt></h1>');    $r->print('<h1>'.&mt('Retrieve previous versions of').' <tt>'.$fn.'</tt></h1>');
       
   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {    if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
           $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.            $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
       &mt(' at ').$udom.
                '</font></h3>');                 '</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);
Removed from v.1.22  
changed lines
  Added in v.1.28

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.