Annotation of loncom/homework/lonindexer.pm, revision 1.2
1.1 harris41 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
1.2 ! ng 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;
1.1 harris41 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: }
1.2 ! ng 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: }
1.1 harris41 310:
311: 1;
312: __END__
1.2 ! ng 313:
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 / homework