File:  [LON-CAPA] / loncom / publisher / lonpubdir.pm
Revision 1.21: download - view: text, annotated - select for diffs
Tue Feb 5 12:54:46 2002 UTC (22 years, 4 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
- Rearrange columns and remove color coding.
- Start code restructuring in to functionally distinct subs from soup of code.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: lonpubdir.pm,v 1.21 2002/02/05 12:54:46 foxr 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: # YEAR=2000
   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
   35: # YEAR=2001
   36: # 03/23 Guy Albertelli
   37: # 03/24,03/29 Gerd Kortemeyer)
   38: # 03/31,04/03,05/09,06/23,08/18,08/20 Gerd Kortemeyer
   39: # 12/15 Scott Harrison
   40: # 12/28 Gerd Kortemeyer
   41: #
   42: ###
   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);
   50: use Apache::loncacc;
   51: use Apache::loncommon();
   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:   }
   66: 
   67:   my $uname;
   68:   my $udom;
   69: 
   70:   ($uname,$udom)=
   71:     &Apache::loncacc::constructaccess(
   72:              $fn,$r->dir_config('lonDefDomain')); 
   73:   unless (($uname) && ($udom)) {
   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:   }
   80:      
   81:   $fn=~s/\/$//;
   82: 
   83:   unless ($fn) { 
   84:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
   85:          ' trying to list empty directory', $r->filename); 
   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:   
  103:   $r->print('<h1>Construction Space Directory <tt>'.$thisdisfn.'/</tt></h1>');
  104:   
  105:   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
  106:           $r->print('<h3>Co-Author: '.$uname.' at '.$udom.
  107:                '</h3>');
  108:   }
  109: 
  110: 
  111:   my $docroot=$r->dir_config('lonDocRoot');
  112: 
  113:   my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$thisdisfn;
  114:   my $targetdir=$udom.'/'.$uname.$thisdisfn;
  115:   my $linkdir='/~'.$uname.$thisdisfn;
  116: 
  117:   $r->print('<table border=2>'.
  118:  '<tr><th>Actions</th><th>Name</th><th>Title</th>'.
  119:  '<th>Status</th><th>Last Modified</th></tr>');
  120: 
  121:   my $filename;
  122:   my $dirptr=16384;
  123: 
  124:   opendir(DIR,$fn);
  125:   my @files=sort(readdir(DIR));
  126:   foreach my $filename (@files) {
  127:      my ($cdev,$cino,$cmode,$cnlink,
  128:          $cuid,$cgid,$crdev,$csize,
  129:          $catime,$cmtime,$cctime,
  130:          $cblksize,$cblocks)=stat($fn.'/'.$filename);
  131: 
  132:      my $extension='';
  133:      if ($filename=~/\.(\w+)$/) { $extension=$1; }
  134:      if ($cmode&$dirptr) {
  135: 	 putdirectory($r, $thisdisfn, $linkdir, $filename, $cmtime);
  136:      } elsif (&Apache::loncommon::fileembstyle($extension) ne 'hdn') {
  137:          my $status='Unpublished';
  138:          my $title='&nbsp;';
  139:          if (-e $resdir.'/'.$filename) {
  140:             my ($rdev,$rino,$rmode,$rnlink,
  141:                 $ruid,$rgid,$rrdev,$rsize,
  142:                 $ratime,$rmtime,$rctime,
  143:                 $rblksize,$rblocks)=stat($resdir.'/'.$filename);
  144:             if ($rmtime>=$cmtime) {
  145: 		$status='Published';
  146:                 $title=
  147:  '<a href="/res/'.$targetdir.'/'.$filename.'.meta" target=cat>'.
  148:  &Apache::lonnet::metadata($targetdir.'/'.$filename,'title').'</a>';
  149:             } else {
  150:                 $status='Modified';
  151:                 $title=
  152:  '<a href="/res/'.$targetdir.'/'.$filename.'.meta" target=cat>'.
  153:  &Apache::lonnet::metadata($targetdir.'/'.$filename,'title').'</a>';
  154:                 if 
  155:          (&Apache::loncommon::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>'.
  165: 		   '<td><a target="_parent" href="/adm/publish?filename=/~'.
  166: 		        $uname.$thisdisfn.'/'.$filename.'">'.'Publish</a>'.
  167: 		   '</td>'.
  168: 		   '<td>'.
  169: 		      '<a href="'.$linkdir.'/'.$filename.'">'.$filename.'</a>'.
  170: 		   '</td>'.
  171: 		   '<td>'.$title.'</td>'.
  172: 		   '<td>'.$status.'</td>'.
  173: 		   '<td>'.localtime($cmtime).'</td>'.
  174: 		   '</tr>');
  175:      } else {
  176: 	# "hidden" extension and not a directory, so hide it away.
  177:      }
  178:   }
  179:   closedir(DIR);
  180: 
  181:   $r->print('</table></body></html>');
  182:   return OK;  
  183: }
  184: #
  185: #  Put out a directory table row:
  186: #    putdirectory(r, base, here, dirname, modtime)
  187: #      r       - Apache request object.
  188: #      reqfile - File in request.
  189: #      here    - Where we are in directory tree.
  190: #      dirname - Name of directory special file.
  191: #      modtime - Encoded modification time.
  192: # 
  193: sub putdirectory {
  194:     my ($r, $reqfile, $here, $dirname, $modtime) = @_;
  195:   
  196:     # construct the display filename: the directory name unless ..:
  197:     
  198:     my $disfilename = $dirname;
  199:     if ($dirname eq '..') {
  200: 	$disfilename = '<i>Parent Directory</i>';
  201:     }
  202:     unless (( ($dirname eq '..') && ($reqfile eq '')) ||
  203: 	    ($dirname eq '.')) {
  204: 	$r->print('<tr>'.
  205: 		  '<td>Click to cwd</td>'.
  206: 		  '<td><a href="'.$here.'/'.$dirname.'/">'.
  207: 		  $disfilename.'</a></td>'.
  208: 		        '<td>&nbsp;</td>'.
  209: 		  '<td>&nbsp;</td>'.
  210: 		  '<td>'.localtime($modtime).'</td>'.
  211: 		  '</tr>');
  212:     }	
  213:     return OK;
  214: }
  215: 1;
  216: __END__
  217: 
  218: =head1 NAME
  219: 
  220: Apache::lonpubdir - Publication Handler for Directories
  221: 
  222: =head1 SYNOPSIS
  223: 
  224: Invoked (for various locations) by /etc/httpd/conf/srm.conf:
  225: 
  226:  <LocationMatch "^/\~.*/$">
  227:  PerlAccessHandler       Apache::loncacc
  228:  SetHandler perl-script
  229:  PerlHandler Apache::lonpubdir
  230:  ErrorDocument     403 /adm/login
  231:  ErrorDocument     404 /adm/notfound.html
  232:  ErrorDocument     406 /adm/unauthorized.html
  233:  ErrorDocument	  500 /adm/errorhandler
  234:  </LocationMatch>
  235: 
  236:  <Location /adm/pubdir>
  237:  PerlAccessHandler       Apache::lonacc
  238:  SetHandler perl-script
  239:  PerlHandler Apache::lonpubdir
  240:  ErrorDocument     403 /adm/login
  241:  ErrorDocument     404 /adm/notfound.html
  242:  ErrorDocument     406 /adm/unauthorized.html
  243:  ErrorDocument	  500 /adm/errorhandler
  244:  </Location>
  245: 
  246: =head1 INTRODUCTION
  247: 
  248: This module publishes a directory of files.
  249: 
  250: This is part of the LearningOnline Network with CAPA project
  251: described at http://www.lon-capa.org.
  252: 
  253: =head1 HANDLER SUBROUTINE
  254: 
  255: This routine is called by Apache and mod_perl.
  256: 
  257: =over 4
  258: 
  259: =item *
  260: 
  261: read in information
  262: 
  263: =item *
  264: 
  265: start page output
  266: 
  267: =item *
  268: 
  269: run through list of files and attempt to publish unhidden files
  270: 
  271: =back
  272: 
  273: =cut

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