Return to lonretrieve.pm CVS log

Up to [LON-CAPA] / loncom / publisher

Diff for current version, and unified output

# The LearningOnline Network with CAPA
# Handler to retrieve an old version of a file
#
# (Publication Handler
# 
# (TeX Content Handler
#
# 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
# 03/23 Guy Albertelli
# 03/24,03/29 Gerd Kortemeyer)
#
# 03/31,04/03,05/02 Gerd Kortemeyer

package Apache::lonretrieve;

use strict;
use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);

sub phaseone {
    my ($r,$fn,$uname,$udom)=@_;
    my $docroot=$r->dir_config('lonDocRoot');

    my $urldir='/res/'.$udom.'/'.$uname.$fn;
    $urldir=~s/\/[^\/]+$/\//;

    my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn;
    my $resdir=$resfn;
    $resdir=~s/\/[^\/]+$/\//;

    $fn=~/\/([^\/]+)\.(\w+)$/;
    my $main=$1;
    my $suffix=$2;

    if (-e $resfn) {  
    $r->print('<form action=/adm/retrieve method=post>'.
	      '<input type=hidden name=filename value="'.$fn.'">'.
              '<input type=hidden name=phase value=two>'.
              '<table border=2><tr><th>Select</th><th>Version</th>'.
              '<th>Became this version on ...</th>'.
              '<th>Metadata</th></tr>');
    my $filename;
    opendir(DIR,$resdir);
    while ($filename=readdir(DIR)) {
        if ($filename=~/^$main\.(\d+)\.$suffix$/) {
	   my $version=$1;
           my ($rdev,$rino,$rmode,$rnlink,
                $ruid,$rgid,$rrdev,$rsize,
                $ratime,$rmtime,$rctime,
                $rblksize,$rblocks)=stat($resdir.'/'.$filename);
           $r->print('<tr><td><input type=radio name=version value="'.
                     $version.'"></td><th>'.$version.'</th><td>'.
                     localtime($rmtime).'</td><td>'.
                     '<a href="'.$urldir.$filename.'.meta" target=cat>'.
                     'Metadata Version '.$version.'</a>');
           if (&Apache::lonnet::fileembstyle($suffix) eq 'ssi') {
               $r->print(
                    '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename='.$fn.
                        '&versionone=priv&versiontwo='.$version.
                        '">Diffs with Version '.$version.'</a>');
           }
           $r->print('</a></td></tr>');
        }
    }
    closedir(DIR);
    my ($rdev,$rino,$rmode,$rnlink,
        $ruid,$rgid,$rrdev,$rsize,
        $ratime,$rmtime,$rctime,
        $rblksize,$rblocks)=stat($resfn);
    $r->print('<tr><td><input type=radio name=version value="new"></td>'.
              '<th>Current</th><td>'.localtime($rmtime).
           '</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'.
              'Metadata current version</a>');           
           if (&Apache::lonnet::fileembstyle($suffix) eq 'ssi') {
               $r->print(
                    '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename='.$fn.
                        '&versionone=priv'.
                        '">Diffs with current Version</a>');
           }
           $r->print('</td></tr></table><p>'.
           '<font size=+1 color=red>Retrieval of an old version will '.
           'overwrite the file currently in construction space</font><p>'.
           '<input type=submit value="Retrieve version"></form>');
} else {
    $r->print('<h3>No previous versions published.</h3>');
}
}

sub phasetwo {
    my ($r,$fn,$uname,$udom)=@_;
    if ($ENV{'form.version'}) {
        my $version=$ENV{'form.version'};
	if ($version eq 'new') {
	    $r->print('<h3>Retrieving current (most recent) version</h3>');
        } else {
            $r->print('<h3>Retrieving old version '.$version.'</h3>');
        }
        my $logfile;
        my $ctarget='/home/'.$uname.'/public_html'.$fn;
        my $vfn=$fn;
        if ($version ne 'new') {
	    $vfn=~s/\.(\w+)$/\.$version\.$1/;
        }
        my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn;
        unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) {
	  $r->print(
         '<font color=red>No write permission to user directory, FAIL</font>');
        }
        print $logfile 
"\n\n================= Retrieve ".localtime()." ================\n".
"Version: $version\nSource: $csource\nTarget: $ctarget\n";
        $r->print('<p>Copying file: ');
        if (copy($csource,$ctarget)) {
	    $r->print('ok<p>');
            print $logfile "Copied sucessfully.\n\n";
        } else {
            my $error=$!;
	    $r->print('fail, '.$error.'<p>');
            print $logfile "Copy failed: $error\n\n";
        }
        $r->print('<font size=+2><a href="/priv/'.$uname.$fn.
                  '">Back to '.$fn.'</a></font>'); 
    } else {
       $r->print(
   '<font size=+1 color=red>Please pick a version to retrieve</font><p>');
       &phaseone($r,$fn,$uname,$udom);
    }
}

sub handler {

  my $r=shift;

  my $fn;

  if ($ENV{'form.filename'}) {
      $fn=$ENV{'form.filename'};
      $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//;
  } else {
     $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
         ' unspecified filename for retrieval', $r->filename); 
     return HTTP_NOT_FOUND;
  }

  unless ($fn) { 
     $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
         ' trying to retrieve non-existing file', $r->filename); 
     return HTTP_NOT_FOUND;
  } 

# ----------------------------------------------------------- Start page output

  my $uname=$ENV{'user.name'};
  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>');

  $r->print(
   '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');

  
  $r->print('<h1>Retrieve previous versions of <tt>'.$fn.'</tt></h1>');

  if ($ENV{'form.phase'} eq 'two') {
      &phasetwo($r,$fn,$uname,$udom);
  } else {
      &phaseone($r,$fn,$uname,$udom);
  }

  $r->print('</body></html>');
  return OK;  
}

1;
__END__

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.