--- 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('
');
-} 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