Return to lonretrieve.pm CVS log

Up to [LON-CAPA] / loncom / publisher

- Replace terms: "Construction Space" with "Authoring Space"
  for consistency with type of role used to access it, and action taken there.
- de.pm: Update related phrases and remove some duplicate entries

    1: # The LearningOnline Network with CAPA
    2: # Handler to retrieve an old version of a file
    3: #
    4: # $Id: lonretrieve.pm,v 1.52 2013/06/07 16:07:49 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::loncommon();
  103: use Apache::lonlocal;
  104: use Apache::lonnet;
  105: use LONCAPA();
  106: 
  107: # ------------------------------------ Interface for selecting previous version
  108: sub phaseone {
  109:     my ($r,$fn,$uname,$udom)=@_;
  110: 
  111:     my $urldir = "/res/$udom/$uname".$fn;
  112:     my $resfn = $r->dir_config('lonDocRoot').$urldir;
  113: 
  114:     $urldir =~ s{[^/]+$}{};
  115:     my $resdir = $r->dir_config('lonDocRoot').$urldir;
  116: 
  117:     my ($main,$suffix,$is_meta) = &get_file_info($fn);
  118:     
  119:     if (-e $resfn) {  
  120: 	$r->print('<form action="/adm/retrieve?inhibitmenu=yes" method="post">'.
  121: 		  '<input type="hidden" name="filename" value="/priv/'.$udom.'/'.$uname.$fn.'" />'.
  122: 		  '<input type="hidden" name="phase" value="two" />'.
  123: 		  &Apache::loncommon::start_data_table().
  124: 		  &Apache::loncommon::start_data_table_header_row().
  125: 		  '<th>'.&mt('Select').'</th>'.
  126: 		  '<th>'.&mt('Version').'</th>'.
  127: 		  '<th>'.&mt('Published on ...').'</th>');
  128: 	if (!$is_meta) {
  129: 	    $r->print('<th>'.&mt('Metadata').'</th>');
  130: 	}
  131: 	if ($is_meta
  132: 	    || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
  133: 	    $r->print('<th>'.&mt('Diffs').'</th>');
  134: 	}
  135: 	$r->print(&Apache::loncommon::end_data_table_header_row());
  136: 	
  137: 	opendir(DIR,$resdir);
  138: 	my @files = grep(/^\Q$main\E\.(\d+)\.\Q$suffix\E$/,readdir(DIR));
  139: 	@files = sort {
  140: 	    my ($aver) = ($a=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/);
  141: 	    my ($bver) = ($b=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/);
  142: 	    return $aver <=> $bver;
  143: 	} (@files);
  144: 	closedir(DIR);
  145: 	
  146: 	foreach my $filename (@files) {
  147: 	    if ($filename=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/) {
  148: 		my $version=$1;
  149: 		my $rmtime=&Apache::lonnet::metadata($resdir.'/'.$filename,'lastrevisiondate');
  150: 		$r->print(&Apache::loncommon::start_data_table_row().
  151: 			  '<td><input type="radio" name="version" value="'.
  152: 			  $version.'" /></td><td>'.&mt('Previously published version').' '.$version.'</td>'.
  153:               '<td>'.&Apache::lonlocal::locallocaltime($rmtime).'</td>');
  154: 		
  155: 		if (!$is_meta) {
  156: 		    $r->print('<td>'.
  157:                               &Apache::loncommon::modal_link($urldir.$filename.'.meta',
  158: 			      &mt('Metadata Version [_1]',$version),550,450).'</td>');
  159: 		}
  160: 		if ($is_meta
  161: 		    || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
  162: 		    $r->print('<td>'.
  163:                               &Apache::loncommon::modal_link(
  164:                                '/adm/diff?filename=/priv/'.$udom.'/'.$uname.$fn.
  165: 			      '&amp;versiontwo=priv&amp;versionone='.$version,
  166: 			       &mt('Diffs with Version [_1]',$version),550,450).
  167: 			      '</td>');
  168: 		}
  169: 		$r->print(&Apache::loncommon::end_data_table_row());
  170: 	    }
  171: 	}
  172: 	closedir(DIR);
  173: 	my $rmtime=&Apache::lonnet::metadata($resfn,'lastrevisiondate');
  174: 	$r->print(&Apache::loncommon::start_data_table_row().
  175: 		  '<td><input type="radio" name="version" value="new" /></td>'.
  176: 		  '<td><b>'.&mt('Currently published version').'</b></td>'.
  177:           '<td>'.&Apache::lonlocal::locallocaltime($rmtime).'</td>'
  178:     );
  179: 	if (!$is_meta) {
  180: 	    $r->print('<td>',
  181:                       &Apache::loncommon::modal_link($urldir.$main.'.'.$suffix.'.meta',
  182: 		      &mt('Metadata current version'),550,450).'</td>');           
  183: 	}
  184: 	if ($is_meta 
  185: 	    || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
  186: 	    $r->print('<td>'.
  187:                       &Apache::loncommon::modal_link(
  188:                        '/adm/diff?filename=/priv/'.
  189: 		      $udom.'/'.$uname.$fn.
  190: 		      '&amp;versiontwo=priv',
  191: 		      &mt('Diffs with current Version'),550,450).
  192:                       '</td>');
  193: 	}
  194: 	$r->print(&Apache::loncommon::end_data_table_row().
  195: 		  &Apache::loncommon::end_data_table().
  196: 		  '<p>'.'<span class="LC_warning">'.
  197: 		  &mt('Retrieval of an old version will overwrite the file currently in Authoring Space.').'</span></p>');
  198: 	if (!$is_meta) {
  199: 	    $r->print('<p>'.'<span class="LC_warning">'.
  200: 		      &mt('This will only retrieve the resource. If you want to retrieve the metadata, you will need to do that separately.').
  201: 		      '</span></p>');
  202: 	}
  203: 	$r->print('<input type="submit" value="'.&mt('Retrieve selected Version').'" /></form>');
  204:     } else {
  205: 	$r->print('<p class="LC_warning">'.&mt('No previous versions published.').'</p>');
  206:     }
  207: 
  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=$r->dir_config('lonDocRoot')."/priv/$udom/$uname".$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:             $r->print(&Apache::lonhtmlcommon::scripttag('parent.location.reload();'));
  249:         } else {
  250:             my $error=$!;
  251: 	    $r->print('<span class="LC_error">'
  252:                      .&mt('Copy failed: [_1]',$error)
  253:                      .'</span>');
  254:             print $logfile "Copy failed: $error\n\n";
  255:         }
  256:     } else {
  257:        $r->print('<p class="LC_info">'.&mt('Please pick a version to retrieve:').'</p>');
  258:        &phaseone($r,$fn,$uname,$udom);
  259:     }
  260: }
  261: 
  262: sub get_file_info {
  263:     my ($fn) = @_;
  264:     my ($main,$suffix) = ($fn=~/\/([^\/]+)\.(\w+)$/);
  265:     my $is_meta=0;
  266:     if ($suffix eq 'meta') {
  267: 	$is_meta = 1;
  268: 	($main,$suffix) = ($main=~/(.+)\.(\w+)$/);	    
  269: 	$suffix .= '.meta';
  270:     }
  271:     return ($main,$suffix,$is_meta);
  272: }
  273: 
  274: # ---------------------------------------------------------------- Main Handler
  275: sub handler {
  276: 
  277:   my $r=shift;
  278: 
  279:   my $fn;
  280: 
  281: 
  282: # Get query string for limited number of parameters
  283: 
  284:   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  285: 					  ['filename']);
  286: 
  287:   if ($env{'form.filename'}) {
  288:       $fn=$env{'form.filename'};
  289:       $fn =~ s{^https?\://[^/]+}{};
  290:   } else {
  291:      $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
  292:          ' unspecified filename for retrieval', $r->filename); 
  293:      return HTTP_NOT_FOUND;
  294:   }
  295: 
  296:   unless ($fn) { 
  297:      $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
  298:          ' trying to retrieve non-existing file', $r->filename); 
  299:      return HTTP_NOT_FOUND;
  300:   } 
  301: 
  302: # ----------------------------------------------------------- Start page output
  303:   my $uname;
  304:   my $udom;
  305: 
  306:   ($uname,$udom) = &Apache::lonnet::constructaccess($fn);
  307:   unless (($uname ne '') && ($udom ne '')) {
  308:      $r->log_reason($uname.' at '.$udom.
  309:          ' trying to publish file '.$env{'form.filename'}.
  310:          ' ('.$fn.') - not authorized', 
  311:          $r->filename); 
  312:      return HTTP_NOT_ACCEPTABLE;
  313:   }
  314: 
  315:   &Apache::loncommon::content_type($r,'text/html');
  316:   $r->send_http_header;
  317: 
  318:     # Breadcrumbs
  319:     &Apache::lonhtmlcommon::clear_breadcrumbs();
  320:     &Apache::lonhtmlcommon::add_breadcrumb({
  321:         'text'  => 'Authoring Space',
  322:         'href'  => &Apache::loncommon::authorspace($fn),
  323:     });
  324:     &Apache::lonhtmlcommon::add_breadcrumb({
  325:         'text'  => 'Retrieve previous version',
  326:         'href'  => '',
  327:     });
  328: 
  329:     my $londocroot = $r->dir_config('lonDocRoot');
  330:     my $trailfile = $fn;
  331:     $trailfile =~ s{^/(priv/)}{$londocroot/$1};
  332: 
  333:   $r->print(&Apache::loncommon::start_page('Retrieve Published Resources')
  334:            .&Apache::lonhtmlcommon::breadcrumbs()
  335:            .&Apache::loncommon::head_subbox(
  336:                 &Apache::loncommon::CSTR_pageheader($trailfile))
  337:     );
  338: 
  339:   $fn=~s{/priv/$LONCAPA::domain_re/$LONCAPA::username_re}{};
  340: 
  341:   $r->print('<p>'
  342:            .&mt('Retrieve previous versions of [_1]'
  343:                    ,'<span class="LC_filename">'.$fn.'</span>')
  344:            .'</p>');
  345:   
  346:   if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
  347:           $r->print('<p><span class="LC_info">'
  348:                    .&mt('Co-Author [_1]'
  349:                        ,&Apache::loncommon::plainname($uname,$udom)
  350:                        .' ('.$uname.':'.$udom.')')
  351:                    .'</span></p>');
  352:   }
  353: 
  354: 
  355:   if ($env{'form.phase'} eq 'two') {
  356:       &phasetwo($r,$fn,$uname,$udom);
  357:   } else {
  358:       &phaseone($r,$fn,$uname,$udom);
  359:   }
  360: 
  361:   $r->print(&Apache::loncommon::end_page());
  362:   return OK;  
  363: }
  364: 
  365: 1;
  366: __END__
  367: 
  368: