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

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: 
        !            23: 
        !            24: sub handler {
        !            25: 
        !            26:   my $r=shift;
        !            27: 
        !            28:   my $fn;
        !            29: 
        !            30:   if ($ENV{'form.filename'}) {
        !            31:       $fn=$ENV{'form.filename'};
        !            32:       $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
        !            33:       $fn=~s/\/[^\/]+$//;
        !            34:   } else {
        !            35:       $fn=$r->filename();
        !            36:   }
        !            37:      
        !            38: 
        !            39:   unless ($fn) { 
        !            40:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
        !            41:          ' trying to publish empty directory', $r->filename); 
        !            42:      return HTTP_NOT_FOUND;
        !            43:   } 
        !            44: 
        !            45: # ----------------------------------------------------------- Start page output
        !            46: 
        !            47:   my $uname=$ENV{'user.name'};
        !            48:   my $udom=$ENV{'user.domain'};
        !            49: 
        !            50:   $r->content_type('text/html');
        !            51:   $r->send_http_header;
        !            52: 
        !            53:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
        !            54: 
        !            55:   $r->print(
        !            56:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
        !            57: 
        !            58:   my $thisdisfn=$fn;
        !            59:   $thisdisfn=~s/^\/home\/$uname\/public_html//;
        !            60:   
        !            61:   $r->print('<h1>Construction Space Directory <tt>'.$thisdisfn.'</tt></h1>');
        !            62: 
        !            63:   my $docroot=$r->dir_config('lonDocRoot');
        !            64: 
        !            65:   my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$thisdisfn;
        !            66:   my $linkdir='/~'.$uname.$thisdisfn;
        !            67: 
        !            68:     my $filename;
        !            69:     opendir(DIR,$fn);
        !            70:        while ($filename=readdir(DIR)) {
        !            71:            $filename=~/\.(\w+)$/;
        !            72:            if (($1 ne 'meta') && ($1 ne 'save') && ($1 ne 'log')) {
        !            73: 	      $r->print($resdir.' - '.$linkdir.' = '.$filename.'<br>');
        !            74: 	   }
        !            75:        }
        !            76:     closedir(DIR);
        !            77: 
        !            78: 
        !            79:   $r->print('</body></html>');
        !            80:   return OK;  
        !            81: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>