loncom/homework/lonindexer.pm - view

File: [LON-CAPA] / loncom / homework / Attic / lonindexer.pm
Revision 1.2: download - view: text, annotated - select for diffs
Wed Aug 2 12:20:28 2000 UTC (23 years, 11 months ago) by ng
Branches: MAIN
CVS tags: HEAD


LON-CAPA Directory Browser current state 8/2/00

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: 44: for (my $i=0; $i<=5; $i++) { 45: $attrchk[$i] = "checked" if $ENV{'form.attr'.$i} == 1; 46: } 47: $r->print(<<END); 48: <b>Display file attributes</b><br> 49: <form method="post" name="fileattr" action="$uri" enctype="application/x-www-form-urlencoded"> 50: <table border=0><tr> 51: <td><input type=checkbox name=attr0 value="1" $attrchk[0]>Size</td> 52: <td><input type=checkbox name=attr1 value="1" $attrchk[1]>Last access</td> 53: <td><input type=checkbox name=attr2 value="1" $attrchk[2]>Last modified</td> 54: </tr><tr> 55: <td><input type=checkbox name=attr3 value="1" $attrchk[3]>Author</td> 56: <td><input type=checkbox name=attr4 value="1" $attrchk[4]>Keywords</td> 57: <td><input type=checkbox name=attr5 value="1" $attrchk[5]>Language</td> 58: </tr></table> 59: <input type="submit" name="dirlistattr" value="Review"> 60: </form> 61: END 62: my $titleclr="#ddffff"; 63: my $fileclr="#ffffdd"; 64: 65: $r->print("<table border=0><tr><td bgcolor=#999999>"); 66: $r->print("<table border=0><tr>"); 67: $r->print("<td bgcolor=$titleclr><b>Name</b></td>\n"); 68: $r->print("<td bgcolor=$titleclr><b>Size (bytes)</b></td>") if ($ENV{'form.attr0'} == 1); 69: $r->print("<td bgcolor=$titleclr><b>Last accessed</b></td>") if ($ENV{'form.attr1'} == 1); 70: $r->print("<td bgcolor=$titleclr><b>Last modified</b></td>") if ($ENV{'form.attr2'} == 1); 71: $r->print("</tr>"); 72: 73: if ($ENV{'dirlist.lvl'} eq "") { 74: my %dirlvl; 75: $dirlvl{'dirlist.lvl'}='-2'; 76: &Apache::lonnet::appenv(%dirlvl); 77: } else { 78: $ENV{'dirlist.lvl'}='-2'; 79: } 80: # $r->print ("original uri=$uri"); 81: my $uri = &get_openpath($uri); 82: # $r->print ("shortened uri=$shorturi"); 83: 84: my $domain="/res/"; 85: &branch($r,$domain,$uri); 86: 87: $r->print("</table>"); 88: $r->print("</td></tr></table>"); 89: $r->print("</body></html>\n"); 90: # &display_env($r); 91: 92: return OK; 93: } 94: 95: # my @packlist=&Apache::lonnet::dirlist($uri); 96: # print "Dir list<br>".join('<br>',@packlist)."<br>"; 97: 98: sub branch { 99: my ($r,$uri,$calluri)=@_; 100: my ($line,@list); 101: my ($domusr,$foo,$strip,$testdir,$compuri,$chkdir,$diropen); 102: my $dirptr=16384; 103: # my $calluri=$r->uri; 104: $ENV{'dirlist.lvl'}++; 105: 106: @list=&get_list($uri); 107: foreach $line (@list) { 108: chomp $line; 109: 110: ($strip,$domusr,$foo,$testdir,$foo)=split(/\&/,$line,5); 111: $compuri=join("",$strip,"/"); 112: 113: $chkdir=$testdir&$dirptr; 114: if ($domusr eq "domain" or $domusr eq "user") { 115: $chkdir = $dirptr; 116: $testdir = $dirptr; 117: } 118: $diropen = 0; 119: $diropen = 1 if ($compuri eq $calluri); 120: &display_line($r,$diropen,$line); 121: 122: &branch($r,$compuri,$calluri) if ($calluri =~ $compuri and $calluri=~/^$uri/ and $chkdir == $dirptr and $testdir ne ""); 123: } 124: $ENV{'dirlist.lvl'}--; 125: } 126: 127: # ------ get complete list based on the uri ------ 128: sub get_list { 129: my $uri=shift; 130: my @list; 131: my $luri=$uri; 132: $luri=~s/\//_/g; 133: my $dirlist = "/home/httpd/perl/tmp/$ENV{'user.name'}_dirlist$luri.tmp"; 134: if (-e $dirlist) { 135: my $FH = Apache::File->new($dirlist); 136: @list=<$FH>; 137: } else { 138: @list=&Apache::lonnet::dirlist($uri); 139: my $FH = Apache::File->new(">$dirlist"); 140: print $FH join("\n",@list); 141: } 142: return @list=&match_ext(@list); 143: } 144: 145: # ------ get previously opened path, if any ------ 146: sub get_openpath { 147: my $uri=shift; 148: my @list; 149: my $openlist = "/home/httpd/perl/tmp/$ENV{'user.name'}_dirlist_open_path.tmp"; 150: if (-e $openlist) { 151: my $FH = Apache::File->new($openlist); 152: @list=<$FH>; 153: close ($FH); 154: my $line; 155: my $FH = Apache::File->new(">$openlist"); 156: print $FH "$uri\n" if $list[0] eq ""; 157: foreach $line (@list) { 158: chomp $line; 159: if ($line eq $uri) { 160: my @pathcom = split(/\//,$uri); 161: pop @pathcom; 162: my $splituri = join ('/',@pathcom); 163: $uri = join ('',$splituri,"/"); 164: } else { 165: print $FH "$line\n"; 166: } 167: } 168: } else { 169: my $FH = Apache::File->new(">$openlist"); 170: print $FH "$uri\n"; 171: } 172: return $uri; 173: } 174: 175: sub match_ext { 176: my @packlist=@_; 177: my $line; 178: my @trimlist; 179: my $nextline; 180: my @fileext; 181: my $dirptr=16384; 182: 183: my $fn="/home/httpd/lonTabs/filetypes.tab"; 184: if (-e $fn) { 185: my $FH=Apache::File->new($fn); 186: my @content=<$FH>; 187: foreach $line (@content) { 188: (my $ext,my $foo) = split /\s+/,$line; 189: push @fileext,$ext; 190: } 191: } 192: foreach $line (@packlist) { 193: my ($foo,$strip) = split(/\/html/,$line); 194: my @unpacklist = split (/\&/,$strip); 195: 196: my @pathfn = split (/\//,$unpacklist[0]); 197: my $fndir = $pathfn[scalar(@pathfn)-1]; 198: my @filecom = split (/\./,$fndir); 199: my $curfext = $filecom[scalar(@filecom)-1]; 200: my $fnptr = $unpacklist[3]&$dirptr; 201: if ($fnptr == 0 and $unpacklist[3] ne "") { 202: foreach $nextline (@fileext) { 203: push @trimlist,$strip if $nextline eq $curfext; 204: } 205: } else { 206: push @trimlist,$strip; 207: } 208: } 209: return @trimlist; 210: } 211: 212: sub display_line{ 213: my ($r,$diropen,$line)=@_; 214: my (@pathfn, $fndir, $fnptr, $disattr); 215: my $dirptr=16384; 216: my $fileclr="#ffffdd"; 217: my $iconpath="/res/adm/pages/indexericons/"; 218: 219: my @filecom = split (/\&/,$line); 220: my @pathcom = split (/\//,$filecom[0]); 221: my $listname = $pathcom[scalar(@pathcom)-1]; 222: my $fnptr = $filecom[3]&$dirptr; 223: my $indent = $ENV{'dirlist.lvl'}; 224: 225: my $tabtag="</td>"; 226: my $nextline; 227: my $i=0; 228: 229: while ($i<=5) { 230: my $key="form.attr".$i; 231: $i++; 232: $tabtag=join('',$tabtag,"<td bgcolor=",$fileclr,"> </td>") if $ENV{$key} == 1; 233: } 234: 235: if ($filecom[1] eq "domain") { 236: $r->print("<tr>"); 237: $r->print("<td bgcolor=$fileclr valign=bottom><a href=$filecom[0]/><img src=$iconpath","comp.blue.gif border=0></a>\n"); 238: $r->print("Domain - $listname $tabtag</tr>"); 239: return OK; 240: } 241: 242: if ($filecom[1] eq "user") { 243: $r->print("<tr>"); 244: $r->print("<td bgcolor=$fileclr valign=bottom>\n"); 245: my $count = 0; 246: while ($count <= $ENV{'dirlist.lvl'}) { 247: $r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n"); 248: $count++; 249: } 250: $r->print("<a href=$filecom[0]/><img src=$iconpath"); 251: $r->print("right.gif border=0></a>\n") if $diropen == 0; 252: $r->print("down.gif border=0></a>\n") if $diropen == 1; 253: $r->print("<img src=",$iconpath,"quill.gif border=0>\n"); 254: $r->print("$listname $tabtag</tr>"); 255: return OK; 256: } 257: 258: # display file 259: if ($fnptr == 0 and $filecom[3] ne "") { 260: my @file_ext = split (/\./,$listname); 261: my $curfext = $file_ext[scalar(@file_ext)-1]; 262: my $count = 0; 263: $r->print("<tr><td bgcolor=$fileclr>"); 264: while ($count <= $ENV{'dirlist.lvl'}) { 265: $r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n"); 266: $count++; 267: } 268: $r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n"); 269: $r->print("<img src=$iconpath$curfext.gif border=0>\n"); 270: $r->print(" <a href=$filecom[0]>",$listname,"</a> </td>"); 271: $r->print("<td bgcolor=$fileclr align=right valign=bottom> ",$filecom[8]," </td>") if $ENV{'form.attr0'} == 1; 272: $r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[9]))." </td>") if $ENV{'form.attr1'} == 1; 273: $r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[10]))." </td>") if $ENV{'form.attr2'} == 1; 274: $r->print("</tr>"); 275: } 276: 277: # display directory 278: if ($fnptr == $dirptr) { 279: my @file_ext = split (/\./,$listname); 280: my $curfext = $file_ext[scalar(@file_ext)-1]; 281: 282: $r->print("<tr><td bgcolor=$fileclr valign=bottom>"); 283: my $count = 0; 284: while ($count <= $ENV{'dirlist.lvl'}) { 285: $r->print("<img src=",$iconpath,"white_space_20_22.gif border=0>\n"); 286: $count++; 287: } 288: $r->print("<a href=$filecom[0]/><img src=$iconpath"); 289: $r->print("right.gif border=0></a>\n") if $diropen == 0; 290: $r->print("down.gif border=0></a>\n") if $diropen == 1; 291: $r->print("<img src=",$iconpath,"folder.gif border=0>\n") if $diropen == 0; 292: $r->print("<img src=",$iconpath,"folder.open.gif border=0>\n") if $diropen == 1; 293: $r->print("$listname $tabtag</tr>"); 294: } 295: } 296: 297: sub display_env { 298: my $r=shift; 299: my %otherenv; 300: $otherenv{'hi'}='there'; 301: $otherenv{'does_this'}='work?'; 302: &Apache::lonnet::appenv(%otherenv); 303: my $envkey; 304: foreach $envkey (sort keys %ENV) { 305: $r->print("$envkey: $ENV{$envkey}<br>\n"); 306: } 307: # $r->print("<hr>".&Apache::lonnet::ssi('/res/msu/korte/test.tex')); 308: # $r->print("<hr>".join('<br>',&Apache::lonnet::dirlist('/res/msu/korte/'))); 309: } 310: 311: 1; 312: __END__ 313: