--- loncom/publisher/lonretrieve.pm 2001/04/01 02:58:51 1.1 +++ loncom/publisher/lonretrieve.pm 2023/07/23 12:24:16 1.53 @@ -1,17 +1,97 @@ # The LearningOnline Network with CAPA # Handler to retrieve an old version of a file # -# (Publication Handler -# -# (TeX Content Handler +# $Id: lonretrieve.pm,v 1.53 2023/07/23 12:24:16 raeburn Exp $ # -# 05/29/00,05/30,10/11 Gerd Kortemeyer) +# Copyright Michigan State University Board of Trustees # -# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer -# 03/23 Guy Albertelli -# 03/24,03/29 Gerd Kortemeyer) +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). # -# 03/31 Gerd Kortemeyer +# 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/ +# +# +### + +=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 package Apache::lonretrieve; @@ -19,63 +99,283 @@ use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); +use Apache::loncommon(); +use Apache::lonlocal; +use Apache::lonnet; +use LONCAPA(); + +# ------------------------------------ Interface for selecting previous version +sub phaseone { + my ($r,$fn,$uname,$udom)=@_; + + my $urldir = "/res/$udom/$uname".$fn; + my $resfn = $r->dir_config('lonDocRoot').$urldir; + + $urldir =~ s{[^/]+$}{}; + my $resdir = $r->dir_config('lonDocRoot').$urldir; + + my ($main,$suffix,$is_meta) = &get_file_info($fn); + + if (-e $resfn) { + $r->print('
'. + ''. + ''. + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''.&mt('Select').''. + ''.&mt('Version').''. + ''.&mt('Published on ...').''); + if (!$is_meta) { + $r->print(''.&mt('Metadata').''); + } + if ($is_meta + || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print(''.&mt('Diffs').''); + } + $r->print(&Apache::loncommon::end_data_table_header_row()); + + opendir(DIR,$resdir); + my @files = grep(/^\Q$main\E\.(\d+)\.\Q$suffix\E$/,readdir(DIR)); + @files = sort { + my ($aver) = ($a=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/); + my ($bver) = ($b=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/); + return $aver <=> $bver; + } (@files); + closedir(DIR); + + foreach my $filename (@files) { + if ($filename=~/^\Q$main\E\.(\d+)\.\Q$suffix\E$/) { + my $version=$1; + my $rmtime=&Apache::lonnet::metadata($resdir.'/'.$filename,'lastrevisiondate'); + $r->print(&Apache::loncommon::start_data_table_row(). + ''.&mt('Previously published version').' '.$version.''. + ''.&Apache::lonlocal::locallocaltime($rmtime).''); + + if (!$is_meta) { + $r->print(''. + &Apache::loncommon::modal_link($urldir.$filename.'.meta', + &mt('Metadata Version [_1]',$version),550,450).''); + } + if ($is_meta + || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print(''. + &Apache::loncommon::modal_link( + '/adm/diff?filename=/priv/'.$udom.'/'.$uname.$fn. + '&versiontwo=priv&versionone='.$version, + &mt('Diffs with Version [_1]',$version),550,450). + ''); + } + $r->print(&Apache::loncommon::end_data_table_row()); + } + } + closedir(DIR); + my $rmtime=&Apache::lonnet::metadata($resfn,'lastrevisiondate'); + $r->print(&Apache::loncommon::start_data_table_row(). + ''. + ''.&mt('Currently published version').''. + ''.&Apache::lonlocal::locallocaltime($rmtime).'' + ); + if (!$is_meta) { + $r->print('', + &Apache::loncommon::modal_link($urldir.$main.'.'.$suffix.'.meta', + &mt('Metadata current version'),550,450).''); + } + if ($is_meta + || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print(''. + &Apache::loncommon::modal_link( + '/adm/diff?filename=/priv/'. + $udom.'/'.$uname.$fn. + '&versiontwo=priv', + &mt('Diffs with current Version'),550,450). + ''); + } + $r->print(&Apache::loncommon::end_data_table_row(). + &Apache::loncommon::end_data_table(). + '

'.''. + &mt('Retrieval of an old version will overwrite the file currently in Authoring Space.').'

'); + if (!$is_meta) { + $r->print('

'.''. + &mt('This will only retrieve the resource. If you want to retrieve the metadata, you will need to do that separately.'). + '

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

'.&mt('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('

'.&mt('Retrieving current (most recent) version').'

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

'.&mt('Retrieving old version').' '.$version.'

'); + } + my ($main,$suffix,$is_meta) = &get_file_info($fn); + + my $logfile; + my $ctarget=$r->dir_config('lonDocRoot')."/priv/$udom/$uname".$fn; + my $vfn=$fn; + if ($version ne 'new') { + $vfn=~s/\.(\Q$suffix\E)$/\.$version\.$1/; + } + + my $csource=$r->dir_config('lonDocRoot')."/res/$udom/$uname".$vfn; + + my $logname = $ctarget; + if ($is_meta) { $logname =~ s/\.meta$//; } + $logname = $ctarget.'.log'; + unless ($logfile=Apache::File->new('>>'.$logname)) { + $r->print('' + .&mt('No write permission to user directory, FAIL') + .''); + } + print $logfile +"\n\n================= Retrieve ".localtime()." ================\n". +"Version: $version\nSource: $csource\nTarget: $ctarget\n"; + $r->print('

'.&mt('Copying file').': '); + if (copy($csource,$ctarget)) { + $r->print('' + .&mt('ok') + .''); + print $logfile "Copied sucessfully.\n\n"; + $r->print(&Apache::lonhtmlcommon::scripttag('parent.location.reload();')); + } else { + my $error=$!; + $r->print('' + .&mt('Copy failed: [_1]',$error) + .''); + print $logfile "Copy failed: $error\n\n"; + } + } else { + $r->print('

'.&mt('Please pick a version to retrieve:').'

'); + &phaseone($r,$fn,$uname,$udom); + } +} +sub get_file_info { + my ($fn) = @_; + my ($main,$suffix) = ($fn=~/\/([^\/]+)\.(\w+)$/); + my $is_meta=0; + if ($suffix eq 'meta') { + $is_meta = 1; + ($main,$suffix) = ($main=~/(.+)\.(\w+)$/); + $suffix .= '.meta'; + } + return ($main,$suffix,$is_meta); +} + +# ---------------------------------------------------------------- Main Handler sub handler { my $r=shift; my $fn; - if ($ENV{'form.filename'}) { - $fn=$ENV{'form.filename'}; - $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; - $fn=~s/\/[^\/]+$//; + +# Get query string for limited number of parameters + + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['filename']); + + if ($env{'form.filename'}) { + $fn=$env{'form.filename'}; + $fn =~ s{^https?\://[^/]+}{}; } else { - $fn=$r->filename(); + $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. + ' unspecified filename for retrieval', $r->filename); + return HTTP_NOT_FOUND; } - unless ($fn) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. - ' trying to publish empty directory', $r->filename); + $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. + ' trying to retrieve non-existing file', $r->filename); return HTTP_NOT_FOUND; } # ----------------------------------------------------------- Start page output + my $uname; + my $udom; + my $crsauthor; + + ($uname,$udom) = &Apache::lonnet::constructaccess($fn); + unless (($uname ne '') && ($udom ne '')) { + $r->log_reason($uname.' at '.$udom. + ' trying to publish file '.$env{'form.filename'}. + ' ('.$fn.') - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } - my $uname=$ENV{'user.name'}; - my $udom=$ENV{'user.domain'}; - - $r->content_type('text/html'); + &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - $r->print('LON-CAPA Construction Space'); - - $r->print( - ''); + # Breadcrumbs + my $text = 'Authoring Space'; + my $href = &Apache::loncommon::authorspace($fn); + if ($env{'request.course.id'}) { + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + if ($href eq "/priv/$cdom/$cnum/") { + $text = 'Course Authoring Space'; + $crsauthor = 1; + } + } + &Apache::lonhtmlcommon::clear_breadcrumbs(); + &Apache::lonhtmlcommon::add_breadcrumb({ + 'text' => $text, + 'href' => $href, + }); + &Apache::lonhtmlcommon::add_breadcrumb({ + 'text' => 'Retrieve previous version', + 'href' => '', + }); + + my $londocroot = $r->dir_config('lonDocRoot'); + my $trailfile = $fn; + $trailfile =~ s{^/(priv/)}{$londocroot/$1}; + + $r->print(&Apache::loncommon::start_page('Retrieve Published Resources') + .&Apache::lonhtmlcommon::breadcrumbs() + .&Apache::loncommon::head_subbox( + &Apache::loncommon::CSTR_pageheader($trailfile)) + ); + + $fn=~s{/priv/$LONCAPA::domain_re/$LONCAPA::username_re}{}; + + $r->print('

' + .&mt('Retrieve previous versions of [_1]' + ,''.$fn.'') + .'

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

' + .&mt('Co-Author [_1]' + ,&Apache::loncommon::plainname($uname,$udom) + .' ('.$uname.':'.$udom.')') + .'

'); + } + } - my $thisdisfn=$fn; - $thisdisfn=~s/^\/home\/$uname\/public_html//; - - $r->print('

Construction Space Directory '.$thisdisfn.'

'); - my $docroot=$r->dir_config('lonDocRoot'); + if ($env{'form.phase'} eq 'two') { + &phasetwo($r,$fn,$uname,$udom); + } else { + &phaseone($r,$fn,$uname,$udom); + } - my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$thisdisfn; - my $linkdir='/~'.$uname.$thisdisfn; + $r->print(&Apache::loncommon::end_page()); + return OK; +} - my $filename; - opendir(DIR,$fn); - while ($filename=readdir(DIR)) { - $filename=~/\.(\w+)$/; - if (($1 ne 'meta') && ($1 ne 'save') && ($1 ne 'log')) { - $r->print($resdir.' - '.$linkdir.' = '.$filename.'
'); - } - } - closedir(DIR); +1; +__END__ - $r->print(''); - return OK; -}