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

1.1     ! www         1: # The LearningOnline Network with CAPA
        !             2: #
        !             3: # (Publication Handler
        !             4: # 
        !             5: # (TeX Content Handler
        !             6: #
        !             7: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
        !             8: #
        !             9: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
        !            10: # 03/23 Guy Albertelli
        !            11: # 03/24,03/29 Gerd Kortemeyer)
        !            12: #
        !            13: # 03/31 Gerd Kortemeyer
        !            14: 
        !            15: package Apache::lonpubdir;
        !            16: 
        !            17: use strict;
        !            18: use Apache::File;
        !            19: use File::Copy;
        !            20: use Apache::Constants qw(:common :http :methods);
        !            21: 
        !            22: 
        !            23: sub handler {
        !            24: 
        !            25:   my $r=shift;
        !            26: 
        !            27:   my $fn;
        !            28: 
        !            29:   if ($ENV{'form.filename'}) {
        !            30:       $fn=$ENV{'form.filename'};
        !            31:       $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
        !            32:       $fn=~s/\/[^\/]+$//;
        !            33:   } else {
        !            34:       $fn=$r->filename();
        !            35:   }
        !            36:      
        !            37: 
        !            38:   unless ($fn) { 
        !            39:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
        !            40:          ' trying to publish empty directory', $r->filename); 
        !            41:      return HTTP_NOT_FOUND;
        !            42:   } 
        !            43: 
        !            44: # ----------------------------------------------------------- Start page output
        !            45: 
        !            46:   my $uname=$ENV{'user.name'};
        !            47:   my $udom=$ENV{'user.domain'};
        !            48: 
        !            49:   $r->content_type('text/html');
        !            50:   $r->send_http_header;
        !            51: 
        !            52:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
        !            53: 
        !            54:   $r->print(
        !            55:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
        !            56: 
        !            57:   my $thisdisfn=$fn;
        !            58:   $thisdisfn=~s/^\/home\/$uname\/public_html//;
        !            59:   
        !            60:   $r->print('<h1>Construction Space Directory <tt>'.$thisdisfn.'</tt></h1>');
        !            61: 
        !            62:   my $docroot=$r->dir_config('lonDocRoot');
        !            63: 
        !            64:   my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$thisdisfn;
        !            65:   my $linkdir='/~'.$uname.$thisdisfn;
        !            66: 
        !            67:     my $filename;
        !            68:     opendir(DIR,$fn);
        !            69:        while ($filename=readdir(DIR)) {
        !            70:            $filename=~/\.(\w+)$/;
        !            71:            if (($1 ne 'meta') && ($1 ne 'save') && ($1 ne 'log')) {
        !            72: 	      $r->print($resdir.' - '.$linkdir.' = '.$filename.'<br>');
        !            73: 	   }
        !            74:        }
        !            75:     closedir(DIR);
        !            76: 
        !            77: 
        !            78:   $r->print('</body></html>');
        !            79:   return OK;  
        !            80: }

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