![]() ![]() | ![]() |
Now retrieves old versions from res to priv
1: # The LearningOnline Network with CAPA 2: # Handler to retrieve an old version of a file 3: # 4: # (Publication Handler 5: # 6: # (TeX Content Handler 7: # 8: # 05/29/00,05/30,10/11 Gerd Kortemeyer) 9: # 10: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer 11: # 03/23 Guy Albertelli 12: # 03/24,03/29 Gerd Kortemeyer) 13: # 14: # 03/31,04/03 Gerd Kortemeyer 15: 16: package Apache::lonretrieve; 17: 18: use strict; 19: use Apache::File; 20: use File::Copy; 21: use Apache::Constants qw(:common :http :methods); 22: 23: sub phaseone { 24: my ($r,$fn,$uname,$udom)=@_; 25: my $docroot=$r->dir_config('lonDocRoot'); 26: 27: my $urldir='/res/'.$udom.'/'.$uname.$fn; 28: $urldir=~s/\/[^\/]+$/\//; 29: 30: my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn; 31: my $resdir=$resfn; 32: $resdir=~s/\/[^\/]+$/\//; 33: 34: $fn=~/^\/(.+)\.(\w+)$/; 35: my $main=$1; 36: my $suffix=$2; 37: 38: $r->print('<form action=/adm/retrieve method=post>'. 39: '<input type=hidden name=filename value="'.$fn.'">'. 40: '<input type=hidden name=phase value=two>'. 41: '<table border=2><tr><th>Select</th><th>Version</th>'. 42: '<th>Became this version on ...</th>'. 43: '<th>Metadata</th></tr>'); 44: my $filename; 45: opendir(DIR,$resdir); 46: while ($filename=readdir(DIR)) { 47: if ($filename=~/^$main\.(\d+)\.$suffix$/) { 48: my $version=$1; 49: my ($rdev,$rino,$rmode,$rnlink, 50: $ruid,$rgid,$rrdev,$rsize, 51: $ratime,$rmtime,$rctime, 52: $rblksize,$rblocks)=stat($resdir.'/'.$filename); 53: $r->print('<tr><td><input type=radio name=version value="'. 54: $version.'"></td><th>'.$version.'</th><td>'. 55: localtime($rmtime).'</td><td>'. 56: '<a href="'.$urldir.$filename.'.meta" target=cat>'. 57: 'Metadata Version '.$version.'</a></td></tr>'); 58: } 59: } 60: closedir(DIR); 61: my ($rdev,$rino,$rmode,$rnlink, 62: $ruid,$rgid,$rrdev,$rsize, 63: $ratime,$rmtime,$rctime, 64: $rblksize,$rblocks)=stat($resfn); 65: $r->print('<tr><td><input type=radio name=version value="new"></td>'. 66: '<th>Current</th><td>'.localtime($rmtime). 67: '</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'. 68: 'Metadata current version</a></td></tr></table><p>'. 69: '<font size=+1 color=red>Retrieval of an old version will '. 70: 'overwrite the file currently in construction space</font><p>'. 71: '<input type=submit value="Retrieve version"></form>'); 72: } 73: 74: sub phasetwo { 75: my ($r,$fn,$uname,$udom)=@_; 76: if ($ENV{'form.version'}) { 77: my $version=$ENV{'form.version'}; 78: if ($version eq 'new') { 79: $r->print('<h3>Retrieving current (most recent) version</h3>'); 80: } else { 81: $r->print('<h3>Retrieving old version '.$version.'</h3>'); 82: } 83: my $logfile; 84: my $ctarget='/home/'.$uname.'/public_html'.$fn; 85: my $vfn=$fn; 86: if ($version ne 'new') { 87: $vfn=~s/\.(\w+)$/\.$version\.$1/; 88: } 89: my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn; 90: unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) { 91: $r->print( 92: '<font color=red>No write permission to user directory, FAIL</font>'); 93: } 94: print $logfile 95: "\n\n================= Retrieve ".localtime()." ================\n". 96: "Version: $version\nSource: $csource\nTarget: $ctarget\n"; 97: $r->print('<p>Copying file: '); 98: if (copy($csource,$ctarget)) { 99: $r->print('ok<p>'); 100: print $logfile "Copied sucessfully.\n\n"; 101: } else { 102: my $error=$!; 103: $r->print('fail, '.$error.'<p>'); 104: print $logfile "Copy failed: $error\n\n"; 105: } 106: $r->print('<font size=+2><a href="/priv/'.$uname.$fn. 107: '">Back to '.$fn.'</a></font>'); 108: } else { 109: $r->print( 110: '<font size=+1 color=red>Please pick a version to retrieve</font><p>'); 111: &phaseone($r,$fn,$uname,$udom); 112: } 113: } 114: 115: sub handler { 116: 117: my $r=shift; 118: 119: my $fn; 120: 121: if ($ENV{'form.filename'}) { 122: $fn=$ENV{'form.filename'}; 123: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//; 124: } else { 125: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. 126: ' unspecified filename for retrieval', $r->filename); 127: return HTTP_NOT_FOUND; 128: } 129: 130: unless ($fn) { 131: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. 132: ' trying to retrieve non-existing file', $r->filename); 133: return HTTP_NOT_FOUND; 134: } 135: 136: # ----------------------------------------------------------- Start page output 137: 138: my $uname=$ENV{'user.name'}; 139: my $udom=$ENV{'user.domain'}; 140: 141: $r->content_type('text/html'); 142: $r->send_http_header; 143: 144: $r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); 145: 146: $r->print( 147: '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); 148: 149: 150: $r->print('<h1>Retrieve previous versions of <tt>'.$fn.'</tt></h1>'); 151: 152: if ($ENV{'form.phase'} eq 'two') { 153: &phasetwo($r,$fn,$uname,$udom); 154: } else { 155: &phaseone($r,$fn,$uname,$udom); 156: } 157: 158: $r->print('</body></html>'); 159: return OK; 160: }