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: # 05/9-05/19/2001 H. K. Ng
9: # 05/21/2001 H. K. Ng
10: # 05/23/2001 H. K. Ng
11: #
12: package Apache::lonindexer;
13:
14: use strict;
15: use Apache::lonnet();
16: use Apache::Constants qw(:common);
17: use Apache::File;
18: use GDBM_File;
19:
20: my %hash;
21: my %dirs;
22: my %language;
23:
24: sub BEGIN {
25: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/language.tab');
26: map {
27: $_=~/(\w+)\s+([\w\s\-]+)/;
28: $language{$1}=$2;
29: } <$fh>;
30: }
31:
32: sub handler {
33: my $r = shift;
34: $r->content_type('text/html');
35: $r->send_http_header;
36: return OK if $r->header_only;
37:
38: my $iconpath= $r->dir_config('lonIconsURL');
39: my $domain = $r->dir_config('lonDefDomain');
40: my $role = $r->dir_config('lonRole');
41: my $loadlim = $r->dir_config('lonLoadLim');
42: my $servadm = $r->dir_config('lonAdmEMail');
43: my $sysadm = $r->dir_config('lonSysEMail');
44: my $lonhost = $r->dir_config('lonHostID');
45: my $tabdir = $r->dir_config('lonTabDir');
46:
47: # ---------------------------------------------------------------- Print Header
48: $r->print(<<ENDHEADER);
49: <html>
50: <head>
51: <title>The LearningOnline Network With CAPA Directory Browser</title>
52:
53: <SCRIPT language="javascript">
54: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
55: var options = "width=" + w + ",height=" + h + ",";
56: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
57: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
58: var newWin = window.open(url, wdwName, options);
59: newWin.focus();
60: }
61: </SCRIPT>
62:
63: </head>
64: <body bgcolor="#FFFFFF">
65: ENDHEADER
66:
67: my $line;
68: my (@attrchk,@openpath);
69: my $uri=$r->uri;
70: my $iconpath="/res/adm/pages/indexericons/";
71:
72: $r->print("<h2><font color=\"\#888888\">The LearningOnline With CAPA Network Directory Browser</font></h2>\n");
73:
74: my $diropen = "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db";
75:
76: if (tie(%hash,'GDBM_File',$diropen,&GDBM_WRCREAT,0640)) {
77:
78: if ($ENV{'form.attrs'} ne "") {
79: for (my $i=0; $i<=5; $i++) {
80: delete $hash{'display_attrs_'.$i};
81: if ($ENV{'form.attr'.$i} == 1) {
82: $attrchk[$i] = "checked";
83: $hash{'display_attrs_'.$i} = 1;
84: }
85: }
86: } else {
87: for (my $i=0; $i<=5; $i++) {
88: $attrchk[$i] = "checked" if $hash{'display_attrs_'.$i} == 1;
89: }
90: }
91: $r->print(<<END);
92: <b><font color="#666666">Display file attributes</font></b><br>
93: <form method="post" name="fileattr" action="$uri" enctype="application/x-www-form-urlencoded">
94: <table border=0><tr>
95: <td><input type=checkbox name=attr0 value="1" $attrchk[0]> Size</td>
96: <td><input type=checkbox name=attr1 value="1" $attrchk[1]> Last access</td>
97: <td><input type=checkbox name=attr2 value="1" $attrchk[2]> Last modified</td>
98: </tr><tr>
99: <td><input type=checkbox name=attr3 value="1" $attrchk[3]> Author</td>
100: <td><input type=checkbox name=attr4 value="1" $attrchk[4]> Keywords</td>
101: <td><input type=checkbox name=attr5 value="1" $attrchk[5]> Language</td>
102: </tr></table>
103: <input type="submit" name="attrs" value="Review">
104: <input type="submit" name="attrs" value="Refresh">
105: </form>
106: END
107:
108: my $titleclr="#ddffff";
109: $r->print("<table border=0><tr><td bgcolor=#eeeeee>\n");
110: $r->print("<table border=0><tr>\n");
111: $r->print("<td bgcolor=$titleclr><b>Name</b></td>\n");
112: $r->print("<td bgcolor=$titleclr align=right><b>Size (bytes) </b></td>\n") if ($hash{'display_attrs_0'} == 1);
113: $r->print("<td bgcolor=$titleclr><b>Last accessed</b></td>\n") if ($hash{'display_attrs_1'} == 1);
114: $r->print("<td bgcolor=$titleclr><b>Last modified</b></td>\n") if ($hash{'display_attrs_2'} == 1);
115: $r->print("<td bgcolor=$titleclr><b>Author(s)</b></td>\n") if ($hash{'display_attrs_3'} == 1);
116: $r->print("<td bgcolor=$titleclr><b>Keywords</b></td>\n") if ($hash{'display_attrs_4'} == 1);
117: $r->print("<td bgcolor=$titleclr><b>Language</b></td>\n") if ($hash{'display_attrs_5'} == 1);
118: $r->print("</tr>");
119:
120: map {
121: if ($_ =~ /^diropen_status_/) {
122: my $key = $_;
123: $key =~ s/^diropen_status_//;
124: $dirs{$key} = $hash{$_};
125: }
126: } keys %hash;
127:
128: if ($ENV{'form.openuri'}) { # take care of review and refresh options
129: my $uri=$ENV{'form.openuri'};
130: if (exists($hash{'diropen_status_'.$uri})) {
131: my $cursta = $hash{'diropen_status_'.$uri};
132: $dirs{$uri} = 'open';
133: $hash{'diropen_status_'.$uri} = 'open';
134: if ($cursta eq 'open') {
135: $dirs{$uri} = 'closed';
136: $hash{'diropen_status_'.$uri} = 'closed';
137: }
138: } else {
139: $hash{'diropen_status_'.$uri} = 'open';
140: $dirs{$uri} = 'open';
141: }
142: }
143:
144: my $toplevel = "/res/";
145: my $indent = 0;
146: &scanDir ($r,$toplevel,$indent);
147:
148: $r->print("</table>");
149: $r->print("</td></tr></table>");
150: $r->print("</body></html>\n");
151: untie(%hash);
152: } else {
153: $r->print("Unable to tie hash to db file");
154: }
155: return OK;
156: }
157:
158:
159: # --------------------recursive scan of a directory
160: sub scanDir {
161: my ($r,$startdir,$indent)=@_;
162: my ($compuri,$curdir);
163: my $dirptr=16384;
164: $indent++;
165:
166: my %dupdirs = %dirs;
167: my @list=&get_list($r,$startdir);
168: foreach my $line (@list) {
169: my ($strip,$dom,$foo,$testdir,$foo)=split(/\&/,$line,5);
170: next if $strip =~ /.*\.meta$/;
171: if ($dom eq "domain") {
172: $compuri = join('',$strip,"/"); # domain list has /res/<domain name>
173: $curdir = $compuri;
174: } else {
175: $compuri = join('',$startdir,$strip,"/"); # user, dir & file having name only, i.e., w/o path
176: $curdir = $startdir;
177: }
178: my $diropen = 0;
179: if (($dirptr&$testdir) or ($dom =~ /^(domain|user)$/)) {
180: while (my ($key,$val)= each %dupdirs) {
181: if ($key eq $compuri and $val eq "open") {
182: $diropen = 1;
183: delete $dupdirs{key},$dirs{$key};
184: }
185: }
186: }
187: &display_line($r,$diropen,$line,$indent,$curdir,@list);
188: &scanDir ($r,$compuri,$indent) if $diropen == 1;
189: }
190: $indent--;
191: }
192:
193: # ----------------- get complete matched list based on the uri ------
194: sub get_list {
195: my ($r,$uri)=@_;
196: my @list;
197: my $luri = $uri;
198: $luri =~ s/\//_/g;
199:
200: if ($ENV{'form.attrs'} eq "Refresh") {
201: map {
202: delete $hash{$_} if ($_ =~ /^dirlist_files_/);
203: } keys %hash;
204: }
205:
206: if ($hash{'dirlist_files'.$luri}) {
207: @list = split(/\n/,$hash{'dirlist_files_'.$luri});
208: } else {
209: @list = &Apache::lonnet::dirlist($uri);
210: $hash{'dirlist_files_'.$luri} = join('\n',@list);
211: }
212: return @list=&match_ext($r,@list);
213: }
214:
215: #-------------------------- filters out files based on extensions
216: sub match_ext {
217: my ($r,@packlist)=@_;
218: my @trimlist;
219: my $nextline;
220: my @fileext;
221: my $dirptr=16384;
222:
223: my $tabdir = $r->dir_config('lonTabDir');
224: my $fn = $tabdir."/filetypes.tab";
225: if (-e $fn) {
226: my $FH=Apache::File->new($fn);
227: my @content=<$FH>;
228: foreach my $line (@content) {
229: (my $ext,my $foo) = split /\s+/,$line;
230: push @fileext,$ext;
231: }
232: }
233: foreach my $line (@packlist) {
234: chomp $line;
235: $line =~ s/^\/home\/httpd\/html//;
236: my @unpackline = split (/\&/,$line);
237: next if ($unpackline[0] eq ".");
238: next if ($unpackline[0] eq "..");
239: my @filecom = split (/\./,$unpackline[0]);
240: my $fext = pop(@filecom);
241: my $fnptr = $unpackline[3]&$dirptr;
242: if ($fnptr == 0 and $unpackline[3] ne "") {
243: foreach my $nextline (@fileext) {
244: push @trimlist,$line if $nextline eq $fext;
245: }
246: } else {
247: push @trimlist,$line;
248: }
249: }
250: @trimlist = sort (@trimlist);
251: return @trimlist;
252: }
253:
254: #------------------- displays one line in appropriate table format
255: sub display_line{
256: my ($r,$diropen,$line,$indent,$startdir,@list)=@_;
257: my (@pathfn, $fndir, $fnptr);
258: my $dirptr=16384;
259: my $fileclr="#ffffe6";
260: my $iconpath="/res/adm/pages/indexericons/";
261:
262: my @filecom = split (/\&/,$line);
263: my @pathcom = split (/\//,$filecom[0]);
264: my $listname = $pathcom[scalar(@pathcom)-1];
265: my $fnptr = $filecom[3]&$dirptr;
266: my $msg = 'View '.$filecom[0].' resources';
267: $msg = 'Close '.$filecom[0].' directory' if $diropen == 1;
268:
269: my $tabtag="</td>";
270: my $i=0;
271:
272: while ($i<=5) {
273: # my $key="form.attr".$i;
274: # $tabtag=join('',$tabtag,"<td bgcolor=",$fileclr,"> </td>") if $ENV{$key} == 1;
275: $tabtag=join('',$tabtag,"<td bgcolor=",$fileclr,"> </td>") if $hash{'display_attrs_'.$i} == 1;
276: $i++;
277: }
278: if ($filecom[1] eq "domain") {
279: $r->print("<tr>");
280: $r->print("<td bgcolor=$fileclr valign=bottom>");
281: &begin_form ($r,$filecom[0].'/');
282: my $anchor = $filecom[0].'/';
283: $anchor =~ s/\///g;
284: $r->print ("<a name=\"".$anchor."\">\n<input src=\"".$iconpath."comp.blue.gif\"");
285: $r->print (" name=\"$msg\" height=\"22\" type=\"image\" border=\"0\">\n");
286: $r->print("Domain - $listname $tabtag</tr></form>\n");
287: return OK;
288: }
289: if ($filecom[1] eq "user") {
290: $r->print("<tr>");
291: $r->print("<td bgcolor=$fileclr valign=bottom>\n");
292: my $curdir = $startdir.$filecom[0].'/';
293: &begin_form ($r,$curdir);
294: my $anchor = $curdir;
295: $anchor =~ s/\///g;
296: # $r->print ("<a name=\"$anchor\">\n<img src=",$iconpath,"white_space_20_22.gif border=0>\n");
297: $r->print ("<a name=\"$anchor\">\n<img src=",$iconpath,"whitespace1.gif border=0>\n");
298: $r->print ("<input src=\"$iconpath");
299: $r->print ("folder_pointer_closed.gif\"") if $diropen == 0;
300: $r->print ("folder_pointer_opened.gif\"") if $diropen == 1;
301: $r->print (" name=\"$msg\" height=\"22\" type=\"image\" border=\"0\">\n");
302: $r->print ("<img src=",$iconpath,"quill.gif border=0>\n");
303: $r->print ("$listname $tabtag</tr></form>\n");
304: return OK;
305: }
306: # display file
307: if ($fnptr == 0 and $filecom[3] ne "") {
308: my @file_ext = split (/\./,$listname);
309: my $curfext = $file_ext[scalar(@file_ext)-1];
310: my $filelink = $startdir.$filecom[0];
311: $r->print("<tr><td bgcolor=$fileclr>");
312:
313: if ($indent < 11) {
314: $r->print("<img src=",$iconpath,"whitespace",$indent,".gif border=0>\n");
315: } else {
316: my $ten = int($indent/10.);
317: my $rem = $indent%10.0;
318: my $count = 0;
319: while ($count < $ten) {
320: $r->print("<img src=",$iconpath,"whitespace10.gif border=0>\n");
321: $count++;
322: }
323: $r->print("<img src=",$iconpath,"whitespace",$rem,".gif border=0>\n") if $rem > 0;
324: }
325:
326: $r->print("<img src=$iconpath$curfext.gif border=0>\n");
327: $r->print(" <a href=$filelink>",$listname,"</a>\n");
328: my $metafile = grep /^$filecom[0]\.meta\&/, @list;
329:
330: $r->print (" (<a href=\"javascript:openWindow('".$filelink.".meta', 'metadatafile', '400', '450', 'no', 'yes')\"; TARGET=_self>metadata</a>) ") if ($metafile == 1);
331:
332: $r=>print("</td>\n");
333: # $r->print("<td bgcolor=$fileclr align=right valign=bottom> ",$filecom[8]," </td>\n") if $ENV{'form.attr0'} == 1;
334: $r->print("<td bgcolor=$fileclr align=right valign=bottom> ",$filecom[8]," </td>\n") if $hash{'display_attrs_0'} == 1;
335: $r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[9]))." </td>\n") if $hash{'display_attrs_1'} == 1;
336: $r->print("<td bgcolor=$fileclr valign=bottom> ".(localtime($filecom[10]))." </td>\n") if $hash{'display_attrs_2'} == 1;
337:
338: if ($hash{'display_attrs_3'} == 1) {
339: my $author = &Apache::lonnet::metadata($filelink,'author') if ($metafile == 1);
340: $author = ' ' if (!$author);
341: $r->print("<td bgcolor=$fileclr valign=bottom> ".$author." </td>\n");
342: }
343: if ($hash{'display_attrs_4'} == 1) {
344: my $keywords = &Apache::lonnet::metadata($filelink,'keywords') if ($metafile == 1);
345: $keywords = ' ' if (!$keywords);
346: $r->print("<td bgcolor=$fileclr valign=bottom> ".$keywords." </td>\n");
347: }
348: if ($hash{'display_attrs_5'} == 1) {
349: my $lang = &Apache::lonnet::metadata($filelink,'language') if ($metafile == 1);
350: $lang = $language{$lang};
351: $lang = ' ' if (!$lang);
352: $r->print("<td bgcolor=$fileclr valign=bottom> ".$lang." </td>\n");
353: }
354: $r->print("</tr>\n");
355: }
356: # -- display directory
357: if ($fnptr == $dirptr) {
358: my @file_ext = split (/\./,$listname);
359: my $curfext = $file_ext[scalar(@file_ext)-1];
360: my $curdir = $startdir.$filecom[0].'/';
361: my $anchor = $curdir;
362: $anchor =~ s/\///g;
363: $r->print("<tr><td bgcolor=$fileclr valign=bottom>");
364: &begin_form ($r,$curdir);
365: my $indentm1 = $indent-1;
366: if ($indentm1 < 11) {
367: $r->print("<img src=",$iconpath,"whitespace",$indentm1,".gif border=0>\n");
368: } else {
369: my $ten = int($indentm1/10.);
370: my $rem = $indentm1%10.0;
371: my $count = 0;
372: while ($count < $ten) {
373: $r->print("<img src=",$iconpath,"whitespace10.gif border=0>\n");
374: $count++;
375: }
376: $r->print("<img src=",$iconpath,"whitespace",$rem,".gif border=0>\n") if $rem > 0;
377: }
378: $r->print ("<a name=\"$anchor\">\n<input src=\"$iconpath");
379: $r->print ("folder_pointer_closed.gif\"") if $diropen == 0;
380: $r->print ("folder_pointer_opened.gif\"") if $diropen == 1;
381: $r->print (" name=\"$msg\" height=\"22\" type=\"image\" border=\"0\">\n");
382: $r->print("<img src=",$iconpath,"folder_closed.gif border=0>\n") if $diropen == 0;
383: $r->print("<img src=",$iconpath,"folder_opened.gif border=0>\n") if $diropen == 1;
384: $r->print("$listname $tabtag</tr></form>\n");
385: }
386:
387: }
388:
389: #---------------------prints the beginning of a form for directory or file link
390: sub begin_form {
391: my ($r,$uri) = @_;
392: my $anchor = $uri;
393: $anchor =~ s/\///g;
394: $r->print ("<form method=\"post\" name=\"dirpath\" action=\"/res/\#$anchor\" enctype=\"application/x-www-form-urlencoded\">\n");
395: $r->print ("<input type=hidden name=openuri value=\"$uri\">\n");
396:
397: # for (my $i=0; $i<=5; $i++) {
398: # $r->print ("<input type=hidden name=attr$i value=\"1\">\n") if $ENV{'form.attr'.$i} == 1;
399: # }
400: }
401:
402: 1;
403: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>