Annotation of loncom/publisher/lonpubdir.pm, revision 1.19
1.1 www 1: # The LearningOnline Network with CAPA
1.16 albertel 2: # (Publication Handler
3: #
1.19 ! www 4: # $Id: lonpubdir.pm,v 1.18 2001/12/17 00:57:59 harris41 Exp $
1.16 albertel 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/
1.1 www 27: #
28: #
29: # (TeX Content Handler
30: #
1.17 harris41 31: # YEAR=2000
1.1 www 32: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
33: #
34: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
1.17 harris41 35: # YEAR=2001
1.1 www 36: # 03/23 Guy Albertelli
37: # 03/24,03/29 Gerd Kortemeyer)
1.17 harris41 38: # 03/31,04/03,05/09,06/23,08/18,08/20 Gerd Kortemeyer
39: # 12/15 Scott Harrison
1.19 ! www 40: # 12/28 Gerd Kortemeyer
1.1 www 41: #
1.17 harris41 42: ###
1.1 www 43:
44: package Apache::lonpubdir;
45:
46: use strict;
47: use Apache::File;
48: use File::Copy;
49: use Apache::Constants qw(:common :http :methods);
1.6 www 50: use Apache::loncacc;
1.17 harris41 51: use Apache::loncommon();
1.1 www 52:
53: sub handler {
54:
55: my $r=shift;
56:
57: my $fn;
58:
59: if ($ENV{'form.filename'}) {
60: $fn=$ENV{'form.filename'};
61: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
62: $fn=~s/\/[^\/]+$//;
63: } else {
64: $fn=$r->filename();
65: }
1.6 www 66:
67: my $uname;
68: my $udom;
69:
1.9 www 70: ($uname,$udom)=
1.6 www 71: &Apache::loncacc::constructaccess(
1.9 www 72: $fn,$r->dir_config('lonDefDomain'));
73: unless (($uname) && ($udom)) {
1.6 www 74: $r->log_reason($uname.' at '.$udom.
75: ' trying to publish file '.$ENV{'form.filename'}.
76: ' ('.$fn.') - not authorized',
77: $r->filename);
78: return HTTP_NOT_ACCEPTABLE;
79: }
1.1 www 80:
1.3 www 81: $fn=~s/\/$//;
1.1 www 82:
83: unless ($fn) {
84: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
1.2 www 85: ' trying to list empty directory', $r->filename);
1.1 www 86: return HTTP_NOT_FOUND;
87: }
88:
89: # ----------------------------------------------------------- Start page output
90:
91:
92: $r->content_type('text/html');
93: $r->send_http_header;
94:
95: $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
96:
97: $r->print(
98: '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
99:
100: my $thisdisfn=$fn;
101: $thisdisfn=~s/^\/home\/$uname\/public_html//;
102:
1.3 www 103: $r->print('<h1>Construction Space Directory <tt>'.$thisdisfn.'/</tt></h1>');
1.6 www 104:
105: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
106: $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
107: '</font></h3>');
108: }
109:
1.1 www 110:
111: my $docroot=$r->dir_config('lonDocRoot');
112:
113: my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$thisdisfn;
1.19 ! www 114: my $targetdir=$udom.'/'.$uname.$thisdisfn;
1.1 www 115: my $linkdir='/~'.$uname.$thisdisfn;
116:
1.2 www 117: $r->print('<table border=2>'.
1.19 ! www 118: '<tr><th>Filename</th><th>Metadata</th><th>Modified</th>'.
! 119: '<th>Status</th><th> </th></tr>');
1.1 www 120:
1.2 www 121: my $filename;
122: my $dirptr=16384;
1.1 www 123:
1.2 www 124: opendir(DIR,$fn);
1.10 albertel 125: my @files=sort(readdir(DIR));
1.11 albertel 126: foreach my $filename (@files) {
1.2 www 127: my ($cdev,$cino,$cmode,$cnlink,
128: $cuid,$cgid,$crdev,$csize,
129: $catime,$cmtime,$cctime,
130: $cblksize,$cblocks)=stat($fn.'/'.$filename);
1.12 www 131:
1.10 albertel 132: my $extension='';
133: if ($filename=~/\.(\w+)$/) { $extension=$1; }
1.15 matthew 134: if ($cmode&$dirptr) {
135: my $disfilename=$filename;
136: if ($filename eq '..') {
137: $disfilename='<i>Parent Directory</i>';
138: }
139: unless ((($filename eq '..') && ($thisdisfn eq '')) ||
140: ($filename eq '.')) {
141: $r->print('<tr bgcolor=#BBBBFF'.
142: '><td><a href="'.$linkdir.'/'.$filename.'">'.$disfilename.
1.19 ! www 143: '</a></td><td> </td><td>'.localtime($cmtime).
! 144: '</td><td> </td><td> </td></tr>'
1.15 matthew 145: );
146: }
1.17 harris41 147: } elsif (&Apache::loncommon::fileembstyle($extension) ne 'hdn') {
1.2 www 148: my $status='Unpublished';
149: my $bgcol='#FFBBBB';
1.19 ! www 150: my $title=' ';
1.2 www 151: if (-e $resdir.'/'.$filename) {
152: my ($rdev,$rino,$rmode,$rnlink,
153: $ruid,$rgid,$rrdev,$rsize,
154: $ratime,$rmtime,$rctime,
155: $rblksize,$rblocks)=stat($resdir.'/'.$filename);
156: if ($rmtime>=$cmtime) {
157: $status='Published';
158: $bgcol='#BBFFBB';
1.19 ! www 159: $title=
! 160: '<a href="/res/'.$targetdir.'/'.$filename.'.meta" target=cat>'.
! 161: &Apache::lonnet::metadata($targetdir.'/'.$filename,'title').'</a>';
1.2 www 162: } else {
163: $status='Modified';
164: $bgcol='#FFFFBB';
1.19 ! www 165: $title=
! 166: '<a href="/res/'.$targetdir.'/'.$filename.'.meta" target=cat>'.
! 167: &Apache::lonnet::metadata($targetdir.'/'.$filename,'title').'</a>';
1.5 www 168: if
1.17 harris41 169: (&Apache::loncommon::fileembstyle(($filename=~/\.(\w+)$/)) eq 'ssi') {
1.7 www 170: $status.='<br><a href="/adm/diff?filename=/~'.$uname.
1.12 www 171: $thisdisfn.'/'.$filename.
1.5 www 172: '&versionone=priv" target=cat>Diffs</a>';
173: }
1.2 www 174: }
1.13 www 175: $status.='<br><a href="/adm/retrieve?filename=/~'.$uname.
176: $thisdisfn.'/'.$filename.'" target=cat>Retrieve</a>';
1.2 www 177: }
178: $r->print('<tr bgcolor='.$bgcol.
179: '><td><a href="'.$linkdir.'/'.$filename.'">'.$filename.
1.19 ! www 180: '</a></td><td>'.$title.
! 181: '<td>'.localtime($cmtime).'</td><td>'.$status.'</td>'.
1.12 www 182: '<td><a target="_parent" href="/adm/publish?filename=/~'.$uname.
183: $thisdisfn.'/'.$filename.'">'.
184: 'Publish</a></td></tr>');
1.14 albertel 185: } else {
1.15 matthew 186: # "hidden" extension and not a directory, so hide it away.
1.2 www 187: }
188: }
189: closedir(DIR);
190:
191: $r->print('</table></body></html>');
1.1 www 192: return OK;
193: }
1.4 www 194:
195: 1;
196: __END__
1.17 harris41 197:
198: =head1 NAME
199:
200: Apache::lonpubdir - Publication Handler for Directories
201:
202: =head1 SYNOPSIS
203:
204: Invoked (for various locations) by /etc/httpd/conf/srm.conf:
205:
1.18 harris41 206: <LocationMatch "^/\~.*/$">
207: PerlAccessHandler Apache::loncacc
208: SetHandler perl-script
209: PerlHandler Apache::lonpubdir
210: ErrorDocument 403 /adm/login
211: ErrorDocument 404 /adm/notfound.html
212: ErrorDocument 406 /adm/unauthorized.html
213: ErrorDocument 500 /adm/errorhandler
214: </LocationMatch>
215:
216: <Location /adm/pubdir>
217: PerlAccessHandler Apache::lonacc
218: SetHandler perl-script
219: PerlHandler Apache::lonpubdir
220: ErrorDocument 403 /adm/login
221: ErrorDocument 404 /adm/notfound.html
222: ErrorDocument 406 /adm/unauthorized.html
223: ErrorDocument 500 /adm/errorhandler
224: </Location>
1.17 harris41 225:
226: =head1 INTRODUCTION
227:
1.18 harris41 228: This module publishes a directory of files.
1.17 harris41 229:
230: This is part of the LearningOnline Network with CAPA project
231: described at http://www.lon-capa.org.
232:
233: =head1 HANDLER SUBROUTINE
234:
235: This routine is called by Apache and mod_perl.
236:
237: =over 4
238:
239: =item *
240:
241: read in information
242:
243: =item *
244:
245: start page output
246:
247: =item *
248:
249: run through list of files and attempt to publish unhidden files
250:
251: =back
252:
253: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>