File:  [LON-CAPA] / loncom / homework / Attic / lonindexer.pm
Revision 1.3: download - view: text, annotated - select for diffs
Thu Aug 3 21:19:44 2000 UTC (23 years, 11 months ago) by ng
Branches: MAIN
CVS tags: HEAD

Still working on the lon directory browser, can toggle display now.
 ----------------------------------------------------------------------

    1: # The LearningOnline Network with CAPA
    2: # Directory Indexer
    3: # (Login Screen
    4: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
    5: # 11/23 Gerd Kortemeyer
    6: #
    7: package Apache::lonindexer;
    8: 
    9: use strict;
   10: use Apache::lonnet();
   11: use Apache::Constants qw(:common);
   12: 
   13: sub handler {
   14:     my $r = shift;
   15:     $r->content_type('text/html');
   16:     $r->send_http_header;
   17:     return OK if $r->header_only;
   18: 
   19:     my $iconpath= $r->dir_config('lonIconsURL');
   20:     my $domain  = $r->dir_config('lonDefDomain');
   21:     my $role    = $r->dir_config('lonRole');
   22:     my $loadlim = $r->dir_config('lonLoadLim');
   23:     my $servadm = $r->dir_config('lonAdmEMail');
   24:     my $sysadm  = $r->dir_config('lonSysEMail');
   25:     my $lonhost = $r->dir_config('lonHostID');
   26:     my $tabdir  = $r->dir_config('lonTabDir');
   27: 
   28: # ---------------------------------------------------------------- Print Header
   29:     $r->print(<<ENDHEADER);
   30: <html>
   31: <head>
   32: <title>The LearningOnline Network Directory Browser</title>
   33: </head>
   34: <body bgcolor="#FFFFFF">
   35: ENDHEADER
   36: 
   37:     my $line;
   38:     my (@attrchk,@openpath);
   39:     my $uri=$r->uri;
   40:     my $iconpath="/res/adm/pages/indexericons/";
   41: 
   42:     $r->print("<h2>The LearningOnline Network Directory Browser</h2>\n");
   43: #    $r->print("<hr>Current uri=$uri<br>called uri=$ENV{'form.openuri'}<br>domain=$domain<hr>");
   44: 
   45:     for (my $i=0; $i<=5; $i++) {
   46: 	$attrchk[$i] = "checked" if $ENV{'form.attr'.$i} == 1;
   47:     }
   48:     $r->print(<<END);
   49: <b>Display file attributes</b><br>
   50: <form method="post" name="fileattr" action="$uri" enctype="application/x-www-form-urlencoded">
   51: <table border=0><tr>
   52: <td><input type=checkbox name=attr0 value="1" $attrchk[0]>Size</td>
   53: <td><input type=checkbox name=attr1 value="1" $attrchk[1]>Last access</td>
   54: <td><input type=checkbox name=attr2 value="1" $attrchk[2]>Last modified</td>
   55: </tr><tr>
   56: <td><input type=checkbox name=attr3 value="1" $attrchk[3]>Author</td>
   57: <td><input type=checkbox name=attr4 value="1" $attrchk[4]>Keywords</td>
   58: <td><input type=checkbox name=attr5 value="1" $attrchk[5]>Language</td>
   59: </tr></table>
   60: <input type=hidden name=openuri value="$ENV{'form.openuri'}">
   61: <input type="submit" name="dirlistattr" value="Review">
   62: </form>
   63: END
   64:     my $titleclr="#ddffff";
   65:     my $fileclr="#ffffdd";
   66: 
   67:     $r->print("<table border=0><tr><td bgcolor=#eeeeee>\n");
   68:     $r->print("<table border=0><tr>\n");
   69:     $r->print("<td bgcolor=$titleclr><b>Name</b></td>\n");
   70:     $r->print("<td bgcolor=$titleclr align=right><b>Size (bytes) </b></td>\n") if ($ENV{'form.attr0'} == 1);
   71:     $r->print("<td bgcolor=$titleclr><b>Last accessed</b></td>\n") if ($ENV{'form.attr1'} == 1);
   72:     $r->print("<td bgcolor=$titleclr><b>Last modified</b></td>\n") if ($ENV{'form.attr2'} == 1);
   73:     $r->print("</tr>");
   74: 
   75:     if ($ENV{'dirlist.level'} eq "") {
   76: 	my %dirlevel;
   77: 	$dirlevel{'dirlist.level'}='-2';
   78: 	&Apache::lonnet::appenv(%dirlevel);
   79:     } else {
   80: 	$ENV{'dirlist.level'}='-2';
   81:     }
   82:     if ($ENV{'form.openuri'} =~ /$uri\&/) {
   83: 	my @pathcom = split(/\//,$uri);
   84: 	pop @pathcom;
   85: 	my $splituri = join ('/',@pathcom);
   86: 	$uri = join ('',$splituri,"/");
   87:     }
   88:     &display_line ($r,1,"/res/".$domain."&domain");
   89: #    $domain="/res/".$domain."/";
   90:     &branch($r,"/res/".$domain."/",$uri);
   91: 
   92:     $r->print("</table>");
   93:     $r->print("</td></tr></table>");
   94:     $r->print("</body></html>\n");
   95: #    &display_env($r);
   96: 
   97:     return OK;
   98: }
   99:  
  100: #    my @packlist=&Apache::lonnet::dirlist($uri);
  101: #    print "Dir list<br>".join('<br>',@packlist)."<br>";    
  102: 
  103: sub branch {
  104:     my ($r,$uri,$calluri)=@_;
  105:     my ($line,@list);
  106:     my ($domusr,$foo,$strip,$testdir,$compuri,$chkdir,$diropen);
  107:     my $dirptr=16384;
  108:     $ENV{'dirlist.level'}++;
  109: 
  110:     @list=&get_list($r,$uri);
  111:     foreach $line (@list) {
  112: 	chomp $line;
  113: 
  114: 	($strip,$domusr,$foo,$testdir,$foo)=split(/\&/,$line,5);
  115: 	$compuri=join("",$strip,"/");
  116: 	$chkdir=$testdir&$dirptr;
  117: 	if ($domusr eq "domain" or $domusr eq "user") {
  118: 	    $chkdir = $dirptr;
  119: 	    $testdir = $dirptr;
  120: 	}
  121: 	$diropen = 0;
  122: 	$diropen = 1 if ($compuri eq $calluri);
  123: 	&display_line($r,$diropen,$line);
  124: 
  125: 	&branch($r,$compuri,$calluri) if ($calluri =~ $compuri and $calluri=~/^$uri/ and $chkdir == $dirptr and $testdir ne "");
  126:     }
  127:     $ENV{'dirlist.level'}--;
  128: }
  129: 
  130: # ------ get complete list based on the uri ------
  131: sub get_list {
  132:     my ($r,$uri)=@_;
  133:     my @list;
  134:     my $luri=$uri;
  135:     $luri=~s/\//_/g;
  136:     my $dirlist = "/home/httpd/perl/tmp/$ENV{'user.name'}_dirlist$luri.tmp";
  137:     if (-e $dirlist) {
  138: 	my $FH = Apache::File->new($dirlist);
  139: 	@list=<$FH>;
  140:     } else {
  141: 	@list=&Apache::lonnet::dirlist($uri);
  142: 	my $FH = Apache::File->new(">$dirlist");
  143: 	print $FH join("\n",@list);
  144:     }
  145:     return @list=&match_ext($r,@list);
  146: }
  147: 
  148: # ------ get previously opened path, if any ------
  149: sub get_openpath {
  150:     my $uri=shift;
  151:     my @list;
  152:     my $openlist = "/home/httpd/perl/tmp/$ENV{'user.name'}_dirlist_open_path.tmp";
  153:     if (-e $openlist) {
  154: 	my $FH = Apache::File->new($openlist);
  155: 	@list=<$FH>;
  156: 	close ($FH);
  157: 	my $line;
  158: 	my $FH = Apache::File->new(">$openlist");
  159: 	print $FH "$uri\n" if $list[0] eq "";
  160: 	foreach $line (@list) {
  161: 	    chomp $line;
  162: 	    if ($line eq $uri) {
  163: 		my @pathcom = split(/\//,$uri);
  164: 		pop @pathcom;
  165: 		my $splituri = join ('/',@pathcom);
  166: 		$uri = join ('',$splituri,"/");
  167: 	    } else {
  168: 		print $FH "$line\n";
  169: 	    }
  170: 	}
  171:     } else {
  172: 	my $FH = Apache::File->new(">$openlist");
  173: 	print $FH "$uri\n";
  174:     }
  175:     return $uri;
  176: }
  177: 
  178: sub match_ext {
  179:     my ($r,@packlist)=@_;
  180:     my $line;
  181:     my @trimlist;
  182:     my $nextline;
  183:     my @fileext;
  184:     my $dirptr=16384;
  185: 
  186:     my $tabdir  = $r->dir_config('lonTabDir');
  187:     my $fn = $tabdir."/filetypes.tab";
  188:     if (-e $fn) {
  189: 	my $FH=Apache::File->new($fn);
  190: 	my @content=<$FH>;
  191: 	foreach $line (@content) {
  192: 	    (my $ext,my $foo) = split /\s+/,$line;
  193: 	    push @fileext,$ext;
  194: 	}
  195:     }
  196:     foreach $line (@packlist) {
  197: 	my ($foo,$strip) = split(/\/html/,$line);
  198: 	my @unpacklist = split (/\&/,$strip);
  199: 
  200: 	my @pathfn = split (/\//,$unpacklist[0]);
  201: 	my $fndir = $pathfn[scalar(@pathfn)-1];
  202: 	my @filecom = split (/\./,$fndir);
  203: 	my $curfext = $filecom[scalar(@filecom)-1];
  204: 	my $fnptr = $unpacklist[3]&$dirptr;
  205:  	if ($fnptr == 0 and $unpacklist[3] ne "") {
  206: 	    foreach $nextline (@fileext) {
  207: 		push @trimlist,$strip if $nextline eq $curfext;
  208: 	    }
  209: 	} else {
  210: 	    push @trimlist,$strip;
  211: 	}
  212:     }
  213:     return @trimlist;
  214: }
  215: 
  216: sub display_line{
  217:     my ($r,$diropen,$line)=@_;
  218:     my (@pathfn, $fndir, $fnptr);
  219:     my $dirptr=16384;
  220:     my $fileclr="#ffffe6";
  221:     my $iconpath="/res/adm/pages/indexericons/";
  222: 
  223:     my @filecom = split (/\&/,$line);
  224:     my @pathcom = split (/\//,$filecom[0]);
  225:     my $listname = $pathcom[scalar(@pathcom)-1];
  226:     my $fnptr = $filecom[3]&$dirptr;
  227:     my $indent = $ENV{'dirlist.level'};
  228: 
  229:     my $tabtag="</td>";
  230:     my $nextline;
  231:     my $i=0;
  232: 
  233:     while ($i<=5) {
  234: 	my $key="form.attr".$i;
  235: 	$tabtag=join('',$tabtag,"<td bgcolor=",$fileclr,">&nbsp;</td>") if $ENV{$key} == 1;
  236: 	$i++;
  237:     }
  238: 
  239:     if ($filecom[1] eq "domain") {
  240: 	$r->print("<tr>");
  241: 	$r->print("<td bgcolor=$fileclr valign=bottom>");
  242: 	&begin_form ($r,$filecom[0]);
  243: 	$r->print ("<input src=\"$iconpath");
  244: 	$r->print ("comp.blue.gif\"");
  245: 	$r->print (" name=\"submit\" height=\"22\" type=\"image\" border=\"0\">\n");
  246: 	$r->print("Domain - $listname $tabtag</tr></form>\n");
  247: 	return OK;
  248:     }
  249: 
  250:     if ($filecom[1] eq "user") {
  251: 	$r->print("<tr>");
  252: 	$r->print("<td bgcolor=$fileclr valign=bottom>\n");
  253: 	&begin_form ($r,$filecom[0]);
  254: 	my $count = 0;
  255: 	while ($count <= $ENV{'dirlist.level'}) {
  256: 	    $r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
  257: 	    $count++;
  258: 	}
  259: 	$r->print ("<input src=\"$iconpath");
  260: 	$r->print ("right.gif\"") if $diropen == 0;
  261: 	$r->print ("down.gif\"") if $diropen == 1;
  262: 	$r->print (" name=\"submit\" height=\"22\" type=\"image\" border=\"0\">\n");
  263: 	$r->print("<img src=",$iconpath,"quill.gif border=0>\n");
  264: 	$r->print("$listname $tabtag</tr></form>\n");
  265: 	return OK;
  266:     }
  267: 
  268: # display file
  269:     if ($fnptr == 0 and $filecom[3] ne "") {
  270: 	my @file_ext = split (/\./,$listname);
  271: 	my $curfext = $file_ext[scalar(@file_ext)-1];
  272: 	my $count = 0;
  273: 	$r->print("<tr><td bgcolor=$fileclr>");
  274: 	while ($count <= $ENV{'dirlist.level'}) {
  275: 	    $r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
  276: 	    $count++;
  277: 	}
  278: 	$r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
  279: 	$r->print("<img src=$iconpath$curfext.gif border=0>\n");
  280: 	$r->print(" <a href=$filecom[0]>",$listname,"</a> </td>\n");
  281: 	$r->print("<td bgcolor=$fileclr align=right valign=bottom> ",$filecom[8]," </td>\n") if $ENV{'form.attr0'} == 1;
  282: 	$r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[9]))." </td>\n") if $ENV{'form.attr1'} == 1;
  283: 	$r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[10]))." </td>\n") if $ENV{'form.attr2'} == 1;
  284: 	$r->print("</tr>\n");
  285:     }
  286: 
  287: # display directory
  288:     if ($fnptr == $dirptr) {
  289: 	my @file_ext = split (/\./,$listname);
  290: 	my $curfext = $file_ext[scalar(@file_ext)-1];
  291: 	$r->print("<tr><td bgcolor=$fileclr valign=bottom>");
  292: 	&begin_form ($r,$filecom[0]);
  293: 
  294: 	my $count = 0;
  295: 	while ($count <= $ENV{'dirlist.level'}) {
  296: 	    $r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
  297: 	    $count++;
  298: 	}
  299: 
  300: 	$r->print ("<input src=\"$iconpath");
  301: 	$r->print ("right.gif\"") if $diropen == 0;
  302: 	$r->print ("down.gif\"") if $diropen == 1;
  303: 	$r->print (" name=\"submit\" height=\"22\" type=\"image\" border=\"0\">\n");
  304: 	$r->print("<img src=",$iconpath,"folder.gif border=0>\n") if $diropen == 0;
  305: 	$r->print("<img src=",$iconpath,"folder.open.gif border=0>\n") if $diropen == 1;
  306: 	$r->print("$listname $tabtag</tr></form>\n");
  307:     }
  308: }
  309: 
  310: sub begin_form {
  311:     my ($r,$uri) = @_;
  312:     my $currenturi = $r->uri;
  313:     my $openuri = $ENV{'form.openuri'};
  314:     if ($ENV{'form.openuri'} =~ /$currenturi\&/) {
  315: 	$openuri =~ s/$currenturi\&//;
  316:     } else {
  317: 	$currenturi = join ('',$currenturi,"&");
  318: 	$openuri = join ('&',$ENV{'form.openuri'},$currenturi);
  319: 	$openuri =~ s/\&+/\&/g;
  320:     }
  321:     $r->print ("<form method=\"post\" name=\"dirpath\" action=\"$uri/\" enctype=\"application/x-www-form-urlencoded\">\n");
  322:     $r->print ("<input type=hidden name=openuri value=\"$openuri\">\n");
  323: 
  324:     for (my $i=0; $i<=5; $i++) {
  325: 	$r->print ("<input type=hidden name=attr$i value=\"1\">\n") if $ENV{'form.attr'.$i} == 1;
  326:     }
  327: }
  328: 
  329: sub display_env {
  330:     my $r=shift;
  331:     my %otherenv;
  332:     $otherenv{'hi'}='there';
  333:     $otherenv{'does_this'}='work?';
  334:     &Apache::lonnet::appenv(%otherenv);
  335:     my $envkey;
  336:     foreach $envkey (sort keys %ENV) {
  337: 	$r->print("$envkey: $ENV{$envkey}<br>\n");
  338:     }
  339: #    $r->print("<hr>".&Apache::lonnet::ssi('/res/msu/korte/test.tex')); 
  340: #    $r->print("<hr>".join('<br>',&Apache::lonnet::dirlist('/res/msu/korte/')));
  341: }
  342: 
  343: 1;
  344: __END__
  345: 
  346: 
  347: 
  348: 

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