loncom/publisher/lonpubdir.pm - view

File: [LON-CAPA] / loncom / publisher / lonpubdir.pm
Revision 1.16: download - view: text, annotated - select for diffs
Tue Dec 4 15:34:57 2001 UTC (22 years, 6 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

 - GPL headers added

1: # The LearningOnline Network with CAPA 2: # (Publication Handler 3: # 4: # $Id: lonpubdir.pm,v 1.16 2001/12/04 15:34:57 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # 29: # (TeX Content Handler 30: # 31: # 05/29/00,05/30,10/11 Gerd Kortemeyer) 32: # 33: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer 34: # 03/23 Guy Albertelli 35: # 03/24,03/29 Gerd Kortemeyer) 36: # 37: # 03/31,04/03,05/09,06/23,08/18,08/20 Gerd Kortemeyer 38: 39: package Apache::lonpubdir; 40: 41: use strict; 42: use Apache::File; 43: use File::Copy; 44: use Apache::Constants qw(:common :http :methods); 45: use Apache::loncacc; 46: use Apache::lonnet; 47: 48: 49: sub handler { 50: 51: my $r=shift; 52: 53: my $fn; 54: 55: if ($ENV{'form.filename'}) { 56: $fn=$ENV{'form.filename'}; 57: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; 58: $fn=~s/\/[^\/]+$//; 59: } else { 60: $fn=$r->filename(); 61: } 62: 63: my $uname; 64: my $udom; 65: 66: ($uname,$udom)= 67: &Apache::loncacc::constructaccess( 68: $fn,$r->dir_config('lonDefDomain')); 69: unless (($uname) && ($udom)) { 70: $r->log_reason($uname.' at '.$udom. 71: ' trying to publish file '.$ENV{'form.filename'}. 72: ' ('.$fn.') - not authorized', 73: $r->filename); 74: return HTTP_NOT_ACCEPTABLE; 75: } 76: 77: $fn=~s/\/$//; 78: 79: unless ($fn) { 80: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. 81: ' trying to list empty directory', $r->filename); 82: return HTTP_NOT_FOUND; 83: } 84: 85: # ----------------------------------------------------------- Start page output 86: 87: 88: $r->content_type('text/html'); 89: $r->send_http_header; 90: 91: $r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); 92: 93: $r->print( 94: '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); 95: 96: my $thisdisfn=$fn; 97: $thisdisfn=~s/^\/home\/$uname\/public_html//; 98: 99: $r->print('<h1>Construction Space Directory <tt>'.$thisdisfn.'/</tt></h1>'); 100: 101: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { 102: $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom. 103: '</font></h3>'); 104: } 105: 106: 107: my $docroot=$r->dir_config('lonDocRoot'); 108: 109: my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$thisdisfn; 110: my $linkdir='/~'.$uname.$thisdisfn; 111: 112: $r->print('<table border=2>'. 113: '<tr><th>Filename</th><th>Modified</th><th>Status</th><th> </th></tr>'); 114: 115: my $filename; 116: my $dirptr=16384; 117: 118: opendir(DIR,$fn); 119: my @files=sort(readdir(DIR)); 120: foreach my $filename (@files) { 121: my ($cdev,$cino,$cmode,$cnlink, 122: $cuid,$cgid,$crdev,$csize, 123: $catime,$cmtime,$cctime, 124: $cblksize,$cblocks)=stat($fn.'/'.$filename); 125: 126: my $extension=''; 127: if ($filename=~/\.(\w+)$/) { $extension=$1; } 128: if ($cmode&$dirptr) { 129: my $disfilename=$filename; 130: if ($filename eq '..') { 131: $disfilename='<i>Parent Directory</i>'; 132: } 133: unless ((($filename eq '..') && ($thisdisfn eq '')) || 134: ($filename eq '.')) { 135: $r->print('<tr bgcolor=#BBBBFF'. 136: '><td><a href="'.$linkdir.'/'.$filename.'">'.$disfilename. 137: '</a></td><td>'.localtime($cmtime).'</td><td> </td><td> </td></tr>' 138: ); 139: } 140: } elsif (&Apache::lonnet::fileembstyle($extension) ne 'hdn') { 141: my $status='Unpublished'; 142: my $bgcol='#FFBBBB'; 143: if (-e $resdir.'/'.$filename) { 144: my ($rdev,$rino,$rmode,$rnlink, 145: $ruid,$rgid,$rrdev,$rsize, 146: $ratime,$rmtime,$rctime, 147: $rblksize,$rblocks)=stat($resdir.'/'.$filename); 148: if ($rmtime>=$cmtime) { 149: $status='Published'; 150: $bgcol='#BBFFBB'; 151: } else { 152: $status='Modified'; 153: $bgcol='#FFFFBB'; 154: if 155: (&Apache::lonnet::fileembstyle(($filename=~/\.(\w+)$/)) eq 'ssi') { 156: $status.='<br><a href="/adm/diff?filename=/~'.$uname. 157: $thisdisfn.'/'.$filename. 158: '&versionone=priv" target=cat>Diffs</a>'; 159: } 160: } 161: $status.='<br><a href="/adm/retrieve?filename=/~'.$uname. 162: $thisdisfn.'/'.$filename.'" target=cat>Retrieve</a>'; 163: } 164: $r->print('<tr bgcolor='.$bgcol. 165: '><td><a href="'.$linkdir.'/'.$filename.'">'.$filename. 166: '</a></td><td>'.localtime($cmtime).'</td><td>'.$status.'</td>'. 167: '<td><a target="_parent" href="/adm/publish?filename=/~'.$uname. 168: $thisdisfn.'/'.$filename.'">'. 169: 'Publish</a></td></tr>'); 170: } else { 171: # "hidden" extension and not a directory, so hide it away. 172: } 173: } 174: closedir(DIR); 175: 176: $r->print('</table></body></html>'); 177: return OK; 178: } 179: 180: 1; 181: __END__