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>