--- loncom/publisher/lonretrieve.pm 2006/09/13 21:43:26 1.31 +++ loncom/publisher/lonretrieve.pm 2012/10/29 17:38:55 1.49 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to retrieve an old version of a file # -# $Id: lonretrieve.pm,v 1.31 2006/09/13 21:43:26 albertel Exp $ +# $Id: lonretrieve.pm,v 1.49 2012/10/29 17:38:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,106 +28,183 @@ # ### +=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; use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); -use Apache::loncacc; use Apache::loncommon(); use Apache::lonlocal; use Apache::lonnet; +use LONCAPA(); # ------------------------------------ Interface for selecting previous version sub phaseone { my ($r,$fn,$uname,$udom)=@_; - my $docroot=$r->dir_config('lonDocRoot'); - my $urldir='/res/'.$udom.'/'.$uname.$fn; - $urldir=~s/\/[^\/]+$/\//; + my $urldir = "/res/$udom/$uname".$fn; + my $resfn = $r->dir_config('lonDocRoot').$urldir; - my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn; - my $resdir=$resfn; - $resdir=~s/\/[^\/]+$/\//; + $urldir =~ s{[^/]+$}{}; + my $resdir = $r->dir_config('lonDocRoot').$urldir; my ($main,$suffix,$is_meta) = &get_file_info($fn); if (-e $resfn) { - $r->print('
'. - ''. - ''. - ''. - ''); - if (!$is_meta) { - $r->print(''); - } - if ($is_meta - || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { - $r->print(''); - } - $r->print(''); - - 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(''); - - if (!$is_meta) { - $r->print(''); - } - if ($is_meta - || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { - $r->print( - ''); - } - $r->print(''); - } - } - closedir(DIR); - my $rmtime=&Apache::lonnet::metadata($resfn,'lastrevisiondate'); - $r->print(''. - ''); - if (!$is_meta) { - $r->print(''); + $r->print(''. + ''. + ''. + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''. + ''. + ''); + if (!$is_meta) { + $r->print(''); + } + if ($is_meta + || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print(''); + } + $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(). + ''. + ''); + + if (!$is_meta) { + $r->print(''); + } + if ($is_meta + || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print(''); + } + $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(). + ''. + ''. + '' + ); + if (!$is_meta) { + $r->print(''); + } + if ($is_meta + || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { + $r->print(''); + } + $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 construction 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.').'

'); } - if ($is_meta - || &Apache::loncommon::fileembstyle($suffix) eq 'ssi') { - $r->print( - ''); - } - $r->print('
'.&mt('Select').''. - &mt('Version').''.&mt('Published on ...').''.&mt('Metadata').''.&mt('Diffs').'
'.&mt('Previously published version').' '.$version.''. - localtime($rmtime).''. - &mt('Metadata Version').' '.$version.''.&mt('Diffs with Version').' '.$version. - '
'.&mt('Currently published version').''.localtime($rmtime). - ''. - &mt('Metadata current version').''.&mt('Select').''.&mt('Version').''.&mt('Published on ...').''.&mt('Metadata').''.&mt('Diffs').''.&mt('Previously published version').' '.$version.''.&Apache::lonlocal::locallocaltime($rmtime).''. + &Apache::loncommon::modal_link($urldir.$filename.'.meta', + &mt('Metadata Version [_1]',$version),550,450).''. + &Apache::loncommon::modal_link( + '/adm/diff?filename=/priv/'.$udom,'/'.$uname.$fn. + '&versiontwo=priv&versionone='.$version, + &mt('Diffs with Version [_1]',$version),550,450). + ''.&mt('Currently published version').''.&Apache::lonlocal::locallocaltime($rmtime).'', + &Apache::loncommon::modal_link($urldir.$main.'.'.$suffix.'.meta', + &mt('Metadata current version'),550,450).''. + &Apache::loncommon::modal_link( + '/adm/diff?filename=/priv/'. + $udom.'/'.$uname.$fn. + '&versiontwo=priv', + &mt('Diffs with current Version'),550,450). + ''.&mt('Diffs with current Version').'

'. - ''. -&mt('Retrieval of an old version will overwrite the file currently in construction space').'

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

'.&mt('No previous versions published.').'

'); -} - $r->print('

'.&mt('Back to').' '.$fn. - '

'); + } # ---------------------------------- Interface for presenting specified version @@ -143,38 +220,41 @@ sub phasetwo { my ($main,$suffix,$is_meta) = &get_file_info($fn); my $logfile; - my $ctarget='/home/'.$uname.'/public_html'.$fn; + 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 $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').''); + $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('ok

'); + $r->print('' + .&mt('ok') + .''); print $logfile "Copied sucessfully.\n\n"; + $r->print(&Apache::lonhtmlcommon::scripttag('parent.location.reload();')); } else { my $error=$!; - $r->print('fail, '.$error.'

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

'); + $r->print('

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

'); &phaseone($r,$fn,$uname,$udom); } } @@ -206,7 +286,7 @@ sub handler { if ($env{'form.filename'}) { $fn=$env{'form.filename'}; - $fn=~s/^http\:\/\/[^\/]+//; + $fn =~ s{^https?\://[^/]+}{}; } else { $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. ' unspecified filename for retrieval', $r->filename); @@ -223,9 +303,8 @@ sub handler { my $uname; my $udom; - ($uname,$udom)= - &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); - unless (($uname) && ($udom)) { + ($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', @@ -233,20 +312,43 @@ sub handler { return HTTP_NOT_ACCEPTABLE; } - $fn=~s/\/\~(\w+)//; - &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - $r->print(&Apache::loncommon::start_page('Retrieve Published Resources')); - - - $r->print('

'.&mt('Retrieve previous versions of').' '.$fn.'

'); + # Breadcrumbs + &Apache::lonhtmlcommon::clear_breadcrumbs(); + &Apache::lonhtmlcommon::add_breadcrumb({ + 'text' => 'Construction Space', + 'href' => &Apache::loncommon::authorspace($fn), + }); + &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.'') + .'

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

'.&mt('Co-Author').': '.$uname. - &mt(' at ').$udom. - '

'); + $r->print('

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

'); } @@ -263,67 +365,4 @@ sub handler { 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