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