--- loncom/publisher/lonretrieve.pm 2001/04/03 21:12:39 1.3 +++ loncom/publisher/lonretrieve.pm 2001/12/17 00:57:59 1.16 @@ -1,17 +1,47 @@ # The LearningOnline Network with CAPA # Handler to retrieve an old version of a file # +# $Id: lonretrieve.pm,v 1.16 2001/12/17 00:57:59 harris41 Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +# # (Publication Handler # # (TeX Content Handler # +# YEAR=2000 # 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 +# YEAR=2001 # 03/23 Guy Albertelli # 03/24,03/29 Gerd Kortemeyer) # -# 03/31,04/03 Gerd Kortemeyer +# 03/31,04/03,05/02,05/09,06/23,08/20 Gerd Kortemeyer +# 12/16 Scott Harrison +# +### package Apache::lonretrieve; @@ -19,7 +49,10 @@ use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); +use Apache::loncacc; +use Apache::loncommon(); +# ------------------------------------ Interface for selecting previous version sub phaseone { my ($r,$fn,$uname,$udom)=@_; my $docroot=$r->dir_config('lonDocRoot'); @@ -31,12 +64,13 @@ sub phaseone { my $resdir=$resfn; $resdir=~s/\/[^\/]+$/\//; - $fn=~/^\/(.+)\.(\w+)$/; + $fn=~/\/([^\/]+)\.(\w+)$/; my $main=$1; my $suffix=$2; - + + if (-e $resfn) { $r->print('
'. - ''. + ''. ''. ''. ''. @@ -54,7 +88,15 @@ sub phaseone { $version.'">'); + 'Metadata Version '.$version.''); + if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print( + '  Diffs with Version '.$version.''); + } + $r->print(''); } } closedir(DIR); @@ -65,19 +107,90 @@ sub phaseone { $r->print(''. '
SelectVersionBecame this version on ...'.$version.''. localtime($rmtime).''. ''. - 'Metadata Version '.$version.'
Current'.localtime($rmtime). ''. - 'Metadata current version

'. + 'Metadata current version'); + if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print( + '  Diffs with current Version'); + } + $r->print('

'. + 'Retrieval of an old version will '. + 'overwrite the file currently in construction space

'. '

'); +} else { + $r->print('

No previous versions published.

'); +} +} + +# ---------------------------------- Interface for presenting specified version +sub phasetwo { + my ($r,$fn,$uname,$udom)=@_; + if ($ENV{'form.version'}) { + my $version=$ENV{'form.version'}; + if ($version eq 'new') { + $r->print('

Retrieving current (most recent) version

'); + } else { + $r->print('

Retrieving old version '.$version.'

'); + } + 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( + 'No write permission to user directory, FAIL'); + } + print $logfile +"\n\n================= Retrieve ".localtime()." ================\n". +"Version: $version\nSource: $csource\nTarget: $ctarget\n"; + $r->print('

Copying file: '); + if (copy($csource,$ctarget)) { + $r->print('ok

'); + print $logfile "Copied sucessfully.\n\n"; + } else { + my $error=$!; + $r->print('fail, '.$error.'

'); + print $logfile "Copy failed: $error\n\n"; + } + $r->print('Back to '.$fn.''); + } else { + $r->print( + 'Please pick a version to retrieve

'); + &phaseone($r,$fn,$uname,$udom); + } } +# ---------------------------------------------------------------- Main Handler sub handler { my $r=shift; my $fn; + +# Get query string for limited number of parameters + + foreach (split(/&/,$ENV{'QUERY_STRING'})) { + my ($name, $value) = split(/=/,$_); + $value =~ tr/+/ /; + $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + if ($name eq 'filename') { + unless ($ENV{'form.'.$name}) { + $ENV{'form.'.$name}=$value; + } + } + } + + if ($ENV{'form.filename'}) { $fn=$ENV{'form.filename'}; - $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//; + $fn=~s/^http\:\/\/[^\/]+//; } else { $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. ' unspecified filename for retrieval', $r->filename); @@ -91,9 +204,20 @@ sub handler { } # ----------------------------------------------------------- Start page output + my $uname; + my $udom; - my $uname=$ENV{'user.name'}; - my $udom=$ENV{'user.domain'}; + ($uname,$udom)= + &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); + unless (($uname) && ($udom)) { + $r->log_reason($uname.' at '.$udom. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + + $fn=~s/\/\~(\w+)//; $r->content_type('text/html'); $r->send_http_header; @@ -105,8 +229,15 @@ sub handler { $r->print('

Retrieve previous versions of '.$fn.'

'); + + if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { + $r->print('

Co-Author: '.$uname.' at '.$udom. + '

'); + } + if ($ENV{'form.phase'} eq 'two') { + &phasetwo($r,$fn,$uname,$udom); } else { &phaseone($r,$fn,$uname,$udom); } @@ -114,3 +245,71 @@ sub handler { $r->print(''); return OK; } + +1; +__END__ + +=head1 NAME + +Apache::lonretrieve - retrieves an old version of a file + +=head1 SYNOPSIS + +Invoked by /etc/httpd/conf/srm.conf: + + + PerlAccessHandler Apache::lonacc + SetHandler perl-script + PerlHandler Apache::lonretrieve + ErrorDocument 403 /adm/login + ErrorDocument 404 /adm/notfound.html + ErrorDocument 406 /adm/unauthorized.html + ErrorDocument 500 /adm/errorhandler + + +=head1 INTRODUCTION + +This module retrieves an old published version of a file. + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 HANDLER SUBROUTINE + +This routine is called by Apache and mod_perl. + +=over 4 + +=item * + +Get query string for limited number of parameters + +=item * + +Start page output + +=item * + +print phase relevant output + +=item * + +(phase one is to select version; phase two retrieves version) + +=back + +=head1 OTHER SUBROUTINES + +=over 4 + +=item * + +phaseone() : Interface for selecting previous version. + +=item * + +phasetwo() : Interface for presenting specified version. + +=back + +=cut