[BACK]Return to lonretrieve.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / publisher
File:  [LON-CAPA] / loncom / publisher / lonretrieve.pm
Revision 1.16: download - view: text, annotated - select for diffs
Mon Dec 17 00:57:59 2001 UTC (22 years, 6 months ago) by harris41
Branches: MAIN
CVS tags: stable_2002_spring, stable_2002_april, HEAD
adding in POD documentation; changing void context map statements to
foreach statements; removing references to Apache::lonnet::fileembstyle
and using Apache::loncommon::fileembstyle -Scott Harrison

# 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,05/02,05/09,06/23,08/20 Gerd Kortemeyer
# 12/16 Scott Harrison
#
###

package Apache::lonretrieve;

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

    my $urldir='/res/'.$udom.'/'.$uname.$fn;
    $urldir=~s/\/[^\/]+$/\//;

    my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn;
    my $resdir=$resfn;
    $resdir=~s/\/[^\/]+$/\//;

    $fn=~/\/([^\/]+)\.(\w+)$/;
    my $main=$1;
    my $suffix=$2;

    if (-e $resfn) {  
    $r->print('<form action=/adm/retrieve method=post>'.
	      '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
              '<input type=hidden name=phase value=two>'.
              '<table border=2><tr><th>Select</th><th>Version</th>'.
              '<th>Became this version on ...</th>'.
              '<th>Metadata</th></tr>');
    my $filename;
    opendir(DIR,$resdir);
    while ($filename=readdir(DIR)) {
        if ($filename=~/^$main\.(\d+)\.$suffix$/) {
	   my $version=$1;
           my ($rdev,$rino,$rmode,$rnlink,
                $ruid,$rgid,$rrdev,$rsize,
                $ratime,$rmtime,$rctime,
                $rblksize,$rblocks)=stat($resdir.'/'.$filename);
           $r->print('<tr><td><input type=radio name=version value="'.
                     $version.'"></td><th>'.$version.'</th><td>'.
                     localtime($rmtime).'</td><td>'.
                     '<a href="'.$urldir.$filename.'.meta" target=cat>'.
                     'Metadata Version '.$version.'</a>');
           if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
               $r->print(
                    '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename=/~'.
                        $uname.$fn.
                        '&versionone=priv&versiontwo='.$version.
                        '">Diffs with Version '.$version.'</a>');
           }
           $r->print('</a></td></tr>');
        }
    }
    closedir(DIR);
    my ($rdev,$rino,$rmode,$rnlink,
        $ruid,$rgid,$rrdev,$rsize,
        $ratime,$rmtime,$rctime,
        $rblksize,$rblocks)=stat($resfn);
    $r->print('<tr><td><input type=radio name=version value="new"></td>'.
              '<th>Current</th><td>'.localtime($rmtime).
           '</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'.
              'Metadata current version</a>');           
           if (&Apache::loncommon::fileembstyle($suffix) eq 'ssi') {
               $r->print(
                    '&nbsp;&nbsp;<a target=cat href="/adm/diff?filename=/~'.
                        $uname.$fn.
                        '&versionone=priv'.
                        '">Diffs with current Version</a>');
           }
           $r->print('</td></tr></table><p>'.
           '<font size=+1 color=red>Retrieval of an old version will '.
           'overwrite the file currently in construction space</font><p>'.
           '<input type=submit value="Retrieve version"></form>');
} else {
    $r->print('<h3>No previous versions published.</h3>');
}
}

# ---------------------------------- 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('<h3>Retrieving current (most recent) version</h3>');
        } else {
            $r->print('<h3>Retrieving old version '.$version.'</h3>');
        }
        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(
         '<font color=red>No write permission to user directory, FAIL</font>');
        }
        print $logfile 
"\n\n================= Retrieve ".localtime()." ================\n".
"Version: $version\nSource: $csource\nTarget: $ctarget\n";
        $r->print('<p>Copying file: ');
        if (copy($csource,$ctarget)) {
	    $r->print('ok<p>');
            print $logfile "Copied sucessfully.\n\n";
        } else {
            my $error=$!;
	    $r->print('fail, '.$error.'<p>');
            print $logfile "Copy failed: $error\n\n";
        }
        $r->print('<font size=+2><a href="/priv/'.$uname.$fn.
                  '">Back to '.$fn.'</a></font>'); 
    } else {
       $r->print(
   '<font size=+1 color=red>Please pick a version to retrieve</font><p>');
       &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\:\/\/[^\/]+//;
  } else {
     $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 retrieve non-existing file', $r->filename); 
     return HTTP_NOT_FOUND;
  } 

# ----------------------------------------------------------- Start page output
  my $uname;
  my $udom;

  ($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;

  $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');

  $r->print(
   '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');

  
  $r->print('<h1>Retrieve previous versions of <tt>'.$fn.'</tt></h1>');
  
  if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
          $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
               '</font></h3>');
  }


  if ($ENV{'form.phase'} eq 'two') {
      &phasetwo($r,$fn,$uname,$udom);
  } else {
      &phaseone($r,$fn,$uname,$udom);
  }

  $r->print('</body></html>');
  return OK;  
}

1;
__END__

=head1 NAME

Apache::lonretrieve - retrieves an old version of a file

=head1 SYNOPSIS

Invoked by /etc/httpd/conf/srm.conf:

 <Location /adm/retrieve>
 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
 </Location>

=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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.