loncom/publisher/lonretrieve.pm - view

File: [LON-CAPA] / loncom / publisher / lonretrieve.pm
Revision 1.36: download - view: text, annotated - select for diffs
Thu Nov 20 18:03:55 2008 UTC (15 years, 6 months ago) by bisitz
Branches: MAIN
CVS tags: HEAD

Localization and Styles:
- Added missing &mt() calls
- Optimized &mt() usages
- Corrected <p> tag closures
- Replaced hardcoded styles by LON-CAPA standard styles
- Optimized some phrases

1: # The LearningOnline Network with CAPA 2: # Handler to retrieve an old version of a file 3: # 4: # $Id: lonretrieve.pm,v 1.36 2008/11/20 18:03:55 bisitz Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # 29: ### 30: 31: =head1 NAME 32: 33: Apache::lonretrieve - retrieves an old version of a file 34: 35: =head1 SYNOPSIS 36: 37: Invoked by /etc/httpd/conf/srm.conf: 38: 39: <Location /adm/retrieve> 40: PerlAccessHandler Apache::lonacc 41: SetHandler perl-script 42: PerlHandler Apache::lonretrieve 43: ErrorDocument 403 /adm/login 44: ErrorDocument 404 /adm/notfound.html 45: ErrorDocument 406 /adm/unauthorized.html 46: ErrorDocument 500 /adm/errorhandler 47: </Location> 48: 49: =head1 INTRODUCTION 50: 51: This module retrieves an old published version of a file. 52: 53: This is part of the LearningOnline Network with CAPA project 54: described at http://www.lon-capa.org. 55: 56: =head1 HANDLER SUBROUTINE 57: 58: This routine is called by Apache and mod_perl. 59: 60: =over 4 61: 62: =item * 63: 64: Get query string for limited number of parameters 65: 66: =item * 67: 68: Start page output 69: 70: =item * 71: 72: print phase relevant output 73: 74: =item * 75: 76: (phase one is to select version; phase two retrieves version) 77: 78: =back 79: 80: =head1 OTHER SUBROUTINES 81: 82: =over 4 83: 84: =item * 85: 86: phaseone() : Interface for selecting previous version. 87: 88: =item * 89: 90: phasetwo() : Interface for presenting specified version. 91: 92: =back 93: 94: =cut 95: 96: package Apache::lonretrieve; 97: 98: use strict; 99: use Apache::File; 100: use File::Copy; 101: use Apache::Constants qw(:common :http :methods); 102: use Apache::loncacc; 103: use Apache::loncommon(); 104: use Apache::lonlocal; 105: use Apache::lonnet; 106: use LONCAPA(); 107: 108: # ------------------------------------ Interface for selecting previous version 109: sub phaseone { 110: my ($r,$fn,$uname,$udom)=@_; 111: my $docroot=$r->dir_config('lonDocRoot'); 112: 113: my $urldir='/res/'.$udom.'/'.$uname.$fn; 114: $urldir=~s/\/[^\/]+$/\//; 115: 116: my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn; 117: my $resdir=$resfn; 118: $resdir=~s/\/[^\/]+$/\//; 119: 120: my ($main,$suffix,$is_meta) = &get_file_info($fn); 121: 122: if (-e $resfn) { 123: $r->print('<form action="/adm/retrieve" method="POST">'. 124: '<input type="hidden" name="filename" value="/~'.$uname.$fn.'" />'. 125: '<input type="hidden" name="phase" value="two" />'. 126: &Apache::loncommon::start_data_table(). 127: &Apache::loncommon::start_data_table_header_row(). 128: '<th>'.&mt('Select').'</th>'. 129: '<th>'.&mt('Version').'</th>'. 130: '<th>'.&mt('Published on ...').'</th>'); 131: if (!$is_meta) { 132: $r->print('<th>'.&mt('Metadata').'</th>'); 133: } 134: if ($is_meta 135: || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { 136: $r->print('<th>'.&mt('Diffs').'</th>'); 137: } 138: $r->print(&Apache::loncommon::end_data_table_header_row()); 139: 140: opendir(DIR,$resdir); 141: my @files = grep(/^\Q$main\E\.(\d+)\.\Q$suffix\E$/,readdir(DIR)); 142: @files = sort { 143: my ($aver) = ($a=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/); 144: my ($bver) = ($b=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/); 145: return $aver <=> $bver; 146: } (@files); 147: closedir(DIR); 148: 149: foreach my $filename (@files) { 150: if ($filename=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/) { 151: my $version=$1; 152: my $rmtime=&Apache::lonnet::metadata($resdir.'/'.$filename,'lastrevisiondate'); 153: $r->print(&Apache::loncommon::start_data_table_row(). 154: '<td><input type="radio" name="version" value="'. 155: $version.'" /></td><td>'.&mt('Previously published version').' '.$version.'</td><td>'. 156: localtime($rmtime).'</td>'); 157: 158: if (!$is_meta) { 159: $r->print('<td><a href="'.$urldir.$filename.'.meta" target=cat>'. 160: &mt('Metadata Version').' '.$version.'</a></td>'); 161: } 162: if ($is_meta 163: || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { 164: $r->print( 165: '<td><a target="cat" href="/adm/diff?filename=/~'. 166: $uname.$fn. 167: '&versiontwo=priv&versionone='.$version. 168: '">'.&mt('Diffs with Version').' '.$version. 169: '</a></td>'); 170: } 171: $r->print(&Apache::loncommon::end_data_table_row()); 172: } 173: } 174: closedir(DIR); 175: my $rmtime=&Apache::lonnet::metadata($resfn,'lastrevisiondate'); 176: $r->print(&Apache::loncommon::start_data_table_row(). 177: '<td><input type="radio" name="version" value="new" /></td>'. 178: '<td><b>'.&mt('Currently published version').'</b></td><td>'.localtime($rmtime). 179: '</td>'); 180: if (!$is_meta) { 181: $r->print('<td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'. 182: &mt('Metadata current version').'</a></td>'); 183: } 184: if ($is_meta 185: || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { 186: $r->print( 187: '<td><a target="cat" href="/adm/diff?filename=/~'. 188: $uname.$fn. 189: '&versiontwo=priv'. 190: '">'.&mt('Diffs with current Version').'</a></td>'); 191: } 192: $r->print(&Apache::loncommon::end_data_table_row(). 193: &Apache::loncommon::end_data_table(). 194: '<p>'.'<span class="LC_warning">'. 195: &mt('Retrieval of an old version will overwrite the file currently in construction space.').'</span></p>'); 196: if (!$is_meta) { 197: $r->print('<p>'.'<span class="LC_warning">'. 198: &mt('This will only retrieve the resource. If you want to retrieve the metadata, you will need to do that separately.'). 199: '</span></p>'); 200: } 201: $r->print('<input type="submit" value="'.&mt('Retrieve version').'" /></form>'); 202: } else { 203: $r->print('<p class="LC_warning">'.&mt('No previous versions published.').'</p>'); 204: } 205: $r->print('<p><a href="/priv/'.$uname.$fn.'">' 206: .&mt('Back to [_1]','<span class="LC_filename">'.$fn.'</span>') 207: .'</a></p>'); 208: } 209: 210: # ---------------------------------- Interface for presenting specified version 211: sub phasetwo { 212: my ($r,$fn,$uname,$udom)=@_; 213: if ($env{'form.version'}) { 214: my $version=$env{'form.version'}; 215: if ($version eq 'new') { 216: $r->print('<h3>'.&mt('Retrieving current (most recent) version').'</h3>'); 217: } else { 218: $r->print('<h3>'.&mt('Retrieving old version').' '.$version.'</h3>'); 219: } 220: my ($main,$suffix,$is_meta) = &get_file_info($fn); 221: 222: my $logfile; 223: my $ctarget='/home/'.$uname.'/public_html'.$fn; 224: my $vfn=$fn; 225: if ($version ne 'new') { 226: $vfn=~s/\.(\Q$suffix\E)$/\.$version\.$1/; 227: } 228: 229: my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn; 230: 231: my $logname = $ctarget; 232: if ($is_meta) { $logname =~ s/\.meta$//; } 233: $logname = $ctarget.'.log'; 234: unless ($logfile=Apache::File->new('>>'.$logname)) { 235: $r->print('<span class="LC_error">' 236: .&mt('No write permission to user directory, FAIL') 237: .'</span>'); 238: } 239: print $logfile 240: "\n\n================= Retrieve ".localtime()." ================\n". 241: "Version: $version\nSource: $csource\nTarget: $ctarget\n"; 242: $r->print('<p>'.&mt('Copying file').': '); 243: if (copy($csource,$ctarget)) { 244: $r->print('<span class="LC_success">' 245: .&mt('ok') 246: .'</span>'); 247: print $logfile "Copied sucessfully.\n\n"; 248: } else { 249: my $error=$!; 250: $r->print('<span class="LC_error">' 251: .&mt('Copy failed: [_1]',$error) 252: .'</span>'); 253: print $logfile "Copy failed: $error\n\n"; 254: } 255: $r->print('</p>' 256: .'<p><a href="/priv/'.$uname.$fn.'">' 257: .&mt('Back to [_1]',$fn) 258: .'</a></p>'); 259: } else { 260: $r->print('<p class="LC_info">'.&mt('Please pick a version to retrieve:').'</p>'); 261: &phaseone($r,$fn,$uname,$udom); 262: } 263: } 264: 265: sub get_file_info { 266: my ($fn) = @_; 267: my ($main,$suffix) = ($fn=~/\/([^\/]+)\.(\w+)$/); 268: my $is_meta=0; 269: if ($suffix eq 'meta') { 270: $is_meta = 1; 271: ($main,$suffix) = ($main=~/(.+)\.(\w+)$/); 272: $suffix .= '.meta'; 273: } 274: return ($main,$suffix,$is_meta); 275: } 276: 277: # ---------------------------------------------------------------- Main Handler 278: sub handler { 279: 280: my $r=shift; 281: 282: my $fn; 283: 284: 285: # Get query string for limited number of parameters 286: 287: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 288: ['filename']); 289: 290: if ($env{'form.filename'}) { 291: $fn=$env{'form.filename'}; 292: $fn=~s/^http\:\/\/[^\/]+//; 293: } else { 294: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. 295: ' unspecified filename for retrieval', $r->filename); 296: return HTTP_NOT_FOUND; 297: } 298: 299: unless ($fn) { 300: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. 301: ' trying to retrieve non-existing file', $r->filename); 302: return HTTP_NOT_FOUND; 303: } 304: 305: # ----------------------------------------------------------- Start page output 306: my $uname; 307: my $udom; 308: 309: ($uname,$udom)= 310: &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); 311: unless (($uname) && ($udom)) { 312: $r->log_reason($uname.' at '.$udom. 313: ' trying to publish file '.$env{'form.filename'}. 314: ' ('.$fn.') - not authorized', 315: $r->filename); 316: return HTTP_NOT_ACCEPTABLE; 317: } 318: 319: $fn=~s{/~($LONCAPA::username_re)}{}; 320: 321: &Apache::loncommon::content_type($r,'text/html'); 322: $r->send_http_header; 323: 324: $r->print(&Apache::loncommon::start_page('Retrieve Published Resources')); 325: 326: 327: $r->print('<h1>' 328: .&mt('Retrieve previous versions of [_1]' 329: ,'<span class="LC_filename">'.$fn.'</span>') 330: .'</h1>'); 331: 332: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { 333: $r->print('<h3><span class="LC_diff_coauthor">'.&mt('Co-Author').': '.$uname. 334: &mt(' at ').$udom. 335: '</span></h3>'); 336: } 337: 338: 339: if ($env{'form.phase'} eq 'two') { 340: &phasetwo($r,$fn,$uname,$udom); 341: } else { 342: &phaseone($r,$fn,$uname,$udom); 343: } 344: 345: $r->print(&Apache::loncommon::end_page()); 346: return OK; 347: } 348: 349: 1; 350: __END__ 351: 352: