Return to lonretrieve.pm CVS log

Up to [LON-CAPA] / loncom / publisher

- BUG#5014, when modifying .meta files need to advertise that fact in the
     directoy browser
    - additionaly when doing full dir repbulishes, republish if the .meta file has changed
- also add support for retrieving a previoulsy published .meta file
- add support for getting diffs between previous .meta file revisions

    1: # The LearningOnline Network with CAPA
    2: # Handler to retrieve an old version of a file
    3: #
    4: # $Id: lonretrieve.pm,v 1.31 2006/09/13 21:43:26 albertel 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: package Apache::lonretrieve;
   32: 
   33: use strict;
   34: use Apache::File;
   35: use File::Copy;
   36: use Apache::Constants qw(:common :http :methods);
   37: use Apache::loncacc;
   38: use Apache::loncommon();
   39: use Apache::lonlocal;
   40: use Apache::lonnet;
   41: 
   42: # ------------------------------------ Interface for selecting previous version
   43: sub phaseone {
   44:     my ($r,$fn,$uname,$udom)=@_;
   45:     my $docroot=$r->dir_config('lonDocRoot');
   46: 
   47:     my $urldir='/res/'.$udom.'/'.$uname.$fn;
   48:     $urldir=~s/\/[^\/]+$/\//;
   49: 
   50:     my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn;
   51:     my $resdir=$resfn;
   52:     $resdir=~s/\/[^\/]+$/\//;
   53: 
   54:     my ($main,$suffix,$is_meta) = &get_file_info($fn);
   55:     
   56:     if (-e $resfn) {  
   57:     $r->print('<form action=/adm/retrieve method=post>'.
   58: 	      '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
   59:               '<input type=hidden name=phase value=two>'.
   60:               '<table border=2><tr><th>'.&mt('Select').'</th><th>'.
   61: 	      &mt('Version').'</th>'.
   62:               '<th>'.&mt('Published on ...').'</th>');
   63:     if (!$is_meta) {
   64: 	$r->print('<th>'.&mt('Metadata').'</th>');
   65:     }
   66:     if ($is_meta
   67: 	|| &Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
   68: 	$r->print('<th>'.&mt('Diffs').'</th>');
   69:     }
   70:     $r->print('</tr>');
   71:     
   72:     opendir(DIR,$resdir);
   73:     my @files = grep(/^\Q$main\E\.(\d+)\.\Q$suffix\E$/,readdir(DIR));
   74:     @files = sort {
   75: 	my ($aver) = ($a=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/);
   76: 	my ($bver) = ($b=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/);
   77: 	return $aver <=> $bver;
   78:     } (@files);
   79:     closedir(DIR);
   80: 
   81:     foreach my $filename (@files) {
   82:         if ($filename=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/) {
   83: 	   my $version=$1;
   84:            my $rmtime=&Apache::lonnet::metadata($resdir.'/'.$filename,'lastrevisiondate');
   85:            $r->print('<tr><td><input type=radio name=version value="'.
   86:                      $version.'"></td><td>'.&mt('Previously published version').' '.$version.'</td><td>'.
   87:                      localtime($rmtime).'</td>');
   88: 		     
   89: 	   if (!$is_meta) {
   90: 	       $r->print('<td><a href="'.$urldir.$filename.'.meta" target=cat>'.
   91: 			 &mt('Metadata Version').' '.$version.'</a></td>');
   92: 	   }
   93:            if ($is_meta
   94: 	       || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
   95:                $r->print(
   96:                     '<td><a target=cat href="/adm/diff?filename=/~'.
   97:                         $uname.$fn.
   98:                         '&versiontwo=priv&versionone='.$version.
   99: 			 '">'.&mt('Diffs with Version').' '.$version.
  100: 			 '</a></td>');
  101:            }
  102:            $r->print('</tr>');
  103:         }
  104:     }
  105:     closedir(DIR);
  106:     my $rmtime=&Apache::lonnet::metadata($resfn,'lastrevisiondate');
  107:     $r->print('<tr><td><input type=radio name=version value="new"></td>'.
  108:               '<th>'.&mt('Currently published version').'</th><td>'.localtime($rmtime).
  109:            '</td>');
  110:     if (!$is_meta) {
  111: 	$r->print('<td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'.
  112: 		  &mt('Metadata current version').'</a></td>');           
  113:     }
  114:            if ($is_meta 
  115: 	       || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
  116:                $r->print(
  117:                     '<td><a target=cat href="/adm/diff?filename=/~'.
  118:                         $uname.$fn.
  119:                         '&versiontwo=priv'.
  120:                         '">'.&mt('Diffs with current Version').'</a></td>');
  121:            }
  122:            $r->print('</tr></table><p>'.
  123:            '<font size=+1 color=red>'.
  124: &mt('Retrieval of an old version will overwrite the file currently in construction space').'</font><p>'.
  125:            '<input type=submit value="'.&mt('Retrieve version').'"></form>');
  126: } else {
  127:     $r->print('<h3>'.&mt('No previous versions published.').'</h3>');
  128: }
  129:     $r->print('<p><a href="/priv/'.$uname.$fn.'">'.&mt('Back to').' '.$fn.
  130: 	      '</a></p>'); 
  131: }
  132: 
  133: # ---------------------------------- Interface for presenting specified version
  134: sub phasetwo {
  135:     my ($r,$fn,$uname,$udom)=@_;
  136:     if ($env{'form.version'}) {
  137:         my $version=$env{'form.version'};
  138: 	if ($version eq 'new') {
  139: 	    $r->print('<h3>'.&mt('Retrieving current (most recent) version').'</h3>');
  140:         } else {
  141:             $r->print('<h3>'.&mt('Retrieving old version').' '.$version.'</h3>');
  142:         }
  143: 	my ($main,$suffix,$is_meta) = &get_file_info($fn);
  144: 
  145:         my $logfile;
  146:         my $ctarget='/home/'.$uname.'/public_html'.$fn;
  147:         my $vfn=$fn;
  148:         if ($version ne 'new') {
  149: 	    $vfn=~s/\.(\Q$suffix\E)$/\.$version\.$1/;
  150:         }
  151: 
  152:         my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn;
  153: 
  154: 	my $logname = $ctarget;
  155: 	if ($is_meta) { $logname =~ s/\.meta$//; }
  156: 	$logname = $ctarget.'.log';
  157:         unless ($logfile=Apache::File->new('>>'.$logname)) {
  158: 	  $r->print(
  159:          '<font color=red>'.&mt('No write permission to user directory, FAIL').'</font>');
  160:         }
  161:         print $logfile 
  162: "\n\n================= Retrieve ".localtime()." ================\n".
  163: "Version: $version\nSource: $csource\nTarget: $ctarget\n";
  164:         $r->print('<p>'.&mt('Copying file').': ');
  165: 	if (copy($csource,$ctarget)) {
  166: 	    $r->print('ok<p>');
  167:             print $logfile "Copied sucessfully.\n\n";
  168:         } else {
  169:             my $error=$!;
  170: 	    $r->print('fail, '.$error.'<p>');
  171:             print $logfile "Copy failed: $error\n\n";
  172:         }
  173:         $r->print('<font size=+2><a href="/priv/'.$uname.$fn.
  174:                   '">'.&mt('Back to').' '.$fn.'</a></font>'); 
  175:     } else {
  176:        $r->print(
  177:    '<font size=+1 color=red>'.&mt('Please pick a version to retrieve').'</font><p>');
  178:        &phaseone($r,$fn,$uname,$udom);
  179:     }
  180: }
  181: 
  182: sub get_file_info {
  183:     my ($fn) = @_;
  184:     my ($main,$suffix) = ($fn=~/\/([^\/]+)\.(\w+)$/);
  185:     my $is_meta=0;
  186:     if ($suffix eq 'meta') {
  187: 	$is_meta = 1;
  188: 	($main,$suffix) = ($main=~/(.+)\.(\w+)$/);	    
  189: 	$suffix .= '.meta';
  190:     }
  191:     return ($main,$suffix,$is_meta);
  192: }
  193: 
  194: # ---------------------------------------------------------------- Main Handler
  195: sub handler {
  196: 
  197:   my $r=shift;
  198: 
  199:   my $fn;
  200: 
  201: 
  202: # Get query string for limited number of parameters
  203: 
  204:   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  205: 					  ['filename']);
  206: 
  207:   if ($env{'form.filename'}) {
  208:       $fn=$env{'form.filename'};
  209:       $fn=~s/^http\:\/\/[^\/]+//;
  210:   } else {
  211:      $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
  212:          ' unspecified filename for retrieval', $r->filename); 
  213:      return HTTP_NOT_FOUND;
  214:   }
  215: 
  216:   unless ($fn) { 
  217:      $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
  218:          ' trying to retrieve non-existing file', $r->filename); 
  219:      return HTTP_NOT_FOUND;
  220:   } 
  221: 
  222: # ----------------------------------------------------------- Start page output
  223:   my $uname;
  224:   my $udom;
  225: 
  226:   ($uname,$udom)=
  227:     &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
  228:   unless (($uname) && ($udom)) {
  229:      $r->log_reason($uname.' at '.$udom.
  230:          ' trying to publish file '.$env{'form.filename'}.
  231:          ' ('.$fn.') - not authorized', 
  232:          $r->filename); 
  233:      return HTTP_NOT_ACCEPTABLE;
  234:   }
  235: 
  236:   $fn=~s/\/\~(\w+)//;
  237: 
  238:   &Apache::loncommon::content_type($r,'text/html');
  239:   $r->send_http_header;
  240: 
  241:   $r->print(&Apache::loncommon::start_page('Retrieve Published Resources'));
  242: 
  243:   
  244:   $r->print('<h1>'.&mt('Retrieve previous versions of').' <tt>'.$fn.'</tt></h1>');
  245:   
  246:   if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
  247:           $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
  248: 		    &mt(' at ').$udom.
  249:                '</font></h3>');
  250:   }
  251: 
  252: 
  253:   if ($env{'form.phase'} eq 'two') {
  254:       &phasetwo($r,$fn,$uname,$udom);
  255:   } else {
  256:       &phaseone($r,$fn,$uname,$udom);
  257:   }
  258: 
  259:   $r->print(&Apache::loncommon::end_page());
  260:   return OK;  
  261: }
  262: 
  263: 1;
  264: __END__
  265: 
  266: =head1 NAME
  267: 
  268: Apache::lonretrieve - retrieves an old version of a file
  269: 
  270: =head1 SYNOPSIS
  271: 
  272: Invoked by /etc/httpd/conf/srm.conf:
  273: 
  274:  <Location /adm/retrieve>
  275:  PerlAccessHandler       Apache::lonacc
  276:  SetHandler perl-script
  277:  PerlHandler Apache::lonretrieve
  278:  ErrorDocument     403 /adm/login
  279:  ErrorDocument     404 /adm/notfound.html
  280:  ErrorDocument     406 /adm/unauthorized.html
  281:  ErrorDocument	  500 /adm/errorhandler
  282:  </Location>
  283: 
  284: =head1 INTRODUCTION
  285: 
  286: This module retrieves an old published version of a file.
  287: 
  288: This is part of the LearningOnline Network with CAPA project
  289: described at http://www.lon-capa.org.
  290: 
  291: =head1 HANDLER SUBROUTINE
  292: 
  293: This routine is called by Apache and mod_perl.
  294: 
  295: =over 4
  296: 
  297: =item *
  298: 
  299: Get query string for limited number of parameters
  300: 
  301: =item *
  302: 
  303: Start page output
  304: 
  305: =item *
  306: 
  307: print phase relevant output
  308: 
  309: =item *
  310: 
  311: (phase one is to select version; phase two retrieves version)
  312: 
  313: =back
  314: 
  315: =head1 OTHER SUBROUTINES
  316: 
  317: =over 4
  318: 
  319: =item *
  320: 
  321: phaseone() : Interface for selecting previous version.
  322: 
  323: =item *
  324: 
  325: phasetwo() : Interface for presenting specified version.
  326: 
  327: =back
  328: 
  329: =cut