[BACK]Return to lonretrieve.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / publisher

Annotation of loncom/publisher/lonretrieve.pm, revision 1.2

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to retrieve an old version of a file
                      3: #
                      4: # (Publication Handler
                      5: # 
                      6: # (TeX Content Handler
                      7: #
                      8: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
                      9: #
                     10: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
                     11: # 03/23 Guy Albertelli
                     12: # 03/24,03/29 Gerd Kortemeyer)
                     13: #
                     14: # 03/31 Gerd Kortemeyer
                     15: 
                     16: package Apache::lonretrieve;
                     17: 
                     18: use strict;
                     19: use Apache::File;
                     20: use File::Copy;
                     21: use Apache::Constants qw(:common :http :methods);
                     22: 
1.2     ! www        23: sub phaseone {
        !            24:     my ($r,$fn,$uname,$udom)=@_;
        !            25:     my $docroot=$r->dir_config('lonDocRoot');
        !            26: 
        !            27:     my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$fn;
        !            28:     $resdir=~s/\/[^\/]+$/\//;
        !            29: 
        !            30:     $fn=~/^\/(.+)\.(\w+)$/;
        !            31:     my $main=$1;
        !            32:     my $suffix=$2;
        !            33:     
        !            34:     my $filename;
        !            35:     opendir(DIR,$resdir);
        !            36:     while ($filename=readdir(DIR)) {
        !            37:         if ($filename=~/^$main\.(\d+)\.$suffix$/) {
        !            38:            $r->print($resdir.' = '.$filename.'<br>');
        !            39:         }
        !            40:     }
        !            41:     closedir(DIR);
        !            42: }
1.1       www        43: 
                     44: sub handler {
                     45: 
                     46:   my $r=shift;
                     47: 
                     48:   my $fn;
                     49: 
                     50:   if ($ENV{'form.filename'}) {
                     51:       $fn=$ENV{'form.filename'};
1.2     ! www        52:       $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//;
1.1       www        53:   } else {
1.2     ! www        54:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
        !            55:          ' unspecified filename for retrieval', $r->filename); 
        !            56:      return HTTP_NOT_FOUND;
1.1       www        57:   }
                     58: 
                     59:   unless ($fn) { 
                     60:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
1.2     ! www        61:          ' trying to retrieve non-existing file', $r->filename); 
1.1       www        62:      return HTTP_NOT_FOUND;
                     63:   } 
                     64: 
                     65: # ----------------------------------------------------------- Start page output
                     66: 
                     67:   my $uname=$ENV{'user.name'};
                     68:   my $udom=$ENV{'user.domain'};
                     69: 
                     70:   $r->content_type('text/html');
                     71:   $r->send_http_header;
                     72: 
                     73:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
                     74: 
                     75:   $r->print(
                     76:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
                     77: 
                     78:   
1.2     ! www        79:   $r->print('<h1>Retrieve previous versions of <tt>'.$fn.'</tt></h1>');
1.1       www        80: 
1.2     ! www        81:   if ($ENV{'form.phase'} eq 'two') {
        !            82:   } else {
        !            83:       &phaseone($r,$fn,$uname,$udom);
        !            84:   }
1.1       www        85: 
                     86:   $r->print('</body></html>');
                     87:   return OK;  
                     88: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>