[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / Instructor / FileManager.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3086 - (view) (download) (as text)

1 : sh002i 2896 ################################################################################
2 :     # WeBWorK Online Homework Delivery System
3 :     # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4 : dpvc 3086 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm,v 1.6 2004/12/23 02:15:17 dpvc Exp $
5 : sh002i 2896 #
6 :     # This program is free software; you can redistribute it and/or modify it under
7 :     # the terms of either: (a) the GNU General Public License as published by the
8 :     # Free Software Foundation; either version 2, or (at your option) any later
9 :     # version, or (b) the "Artistic License" which comes with this package.
10 :     #
11 :     # This program is distributed in the hope that it will be useful, but WITHOUT
12 :     # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 : sh002i 2944 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14 : sh002i 2896 # Artistic License for more details.
15 :     ################################################################################
16 :    
17 :     package WeBWorK::ContentGenerator::Instructor::FileManager;
18 :     use base qw(WeBWorK::ContentGenerator::Instructor);
19 :    
20 :     use WeBWorK::Utils qw(readDirectory readFile sortByName);
21 :     use WeBWorK::Upload;
22 :     use File::Path;
23 :     use File::Copy;
24 :    
25 :     =head1 NAME
26 :    
27 : sh002i 2944 WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manager for WW files
28 : sh002i 2896
29 :     =cut
30 :    
31 :     use strict;
32 :     use warnings;
33 :     use CGI;
34 :    
35 :     ##################################################
36 :     #
37 : sh002i 2944 # Check that the user is authorized, and then
38 :     # see if there is a download to perform.
39 : sh002i 2896 #
40 :     sub pre_header_initialize {
41 : sh002i 2944 my $self = shift;
42 :     my $r = $self->r;
43 :     my $authz = $r->authz;
44 :     my $user = $r->param('user');
45 : sh002i 2896
46 : sh002i 2898 unless ($authz->hasPermissions($user, "access_instructor_tools")) {
47 :     $self->addbadmessage("You aren't authorized to manage course files");
48 :     return;
49 :     }
50 : sh002i 2896
51 : sh002i 2898 my $action = $r->param('action');
52 :     $self->Download if ($action && $action eq 'Download');
53 :     my $file = $r->param('download');
54 :     $self->downloadFile($file) if (defined $file);
55 : sh002i 2896 }
56 :    
57 :     ##################################################
58 :     #
59 : sh002i 2944 # Download a given file
60 : sh002i 2896 #
61 :     sub downloadFile {
62 : sh002i 2898 my $self = shift;
63 :     my $file = checkName(shift);
64 :     my $pwd = checkPWD(shift || $self->r->param('pwd') || '.');
65 :     return unless $pwd;
66 :     $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd;
67 :     unless (-e "$pwd/$file") {
68 :     $self->addbadmessage("The file you are trying to download doesn't exist");
69 :     return;
70 :     }
71 :     unless (-f "$pwd/$file") {
72 :     $self->addbadmessage("You can only download regular files.");
73 :     return;
74 :     }
75 :     my $type = "application/octet-stream";
76 :     $type = "text/plain" if $file =~ m/\.(pg|pl|pm|txt|def|csv|lst)/;
77 : sh002i 2944 $type = "image/gif" if $file =~ m/\.gif/;
78 : sh002i 2898 $type = "image/jpeg" if $file =~ m/\.(jpg|jpeg)/;
79 : sh002i 2944 $type = "image/png" if $file =~ m/\.png/;
80 : sh002i 2898 $self->reply_with_file($type, "$pwd/$file", $file, 0);
81 : sh002i 2896 }
82 :    
83 :     ##################################################
84 :     #
85 : sh002i 2944 # The main body of the page
86 : sh002i 2896 #
87 :     sub body {
88 : sh002i 2944 my $self = shift;
89 :     my $r = $self->r;
90 :     my $urlpath = $r->urlpath;
91 :     my $db = $r->db;
92 :     my $ce = $r->ce;
93 :     my $authz = $r->authz;
94 :     my $courseRoot = $ce->{courseDirs}{root};
95 :     my $courseName = $urlpath->arg('courseID');
96 :     my $user = $r->param('user');
97 :     my $key = $r->param('key');
98 : sh002i 2896
99 : sh002i 2898 return CGI::em("You are not authorized to access the instructor tools")
100 :     unless $authz->hasPermissions($user, "access_instructor_tools");
101 : sh002i 2896
102 : sh002i 2898 $self->{pwd} = checkPWD($r->param('pwd') || '.');
103 :     return CGI::em("You have specified an illegal working directory!") unless defined $self->{pwd};
104 : sh002i 2896
105 : sh002i 2898 my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName);
106 : sh002i 2944 my $fileManagerURL = $self->systemLink($fileManagerPage, authen => 0);
107 : sh002i 2896
108 : sh002i 2898 print CGI::start_multipart_form(
109 :     -method=>"POST",
110 :     -action=>$fileManagerURL,
111 :     -id=>"FileManager",
112 :     -name=>"FileManager"
113 :     );
114 :     print $self->hidden_authen_fields;
115 : sh002i 2896
116 : sh002i 2898 $self->{courseRoot} = $courseRoot;
117 :     $self->{courseName} = $courseName;
118 : sh002i 2896
119 : sh002i 2898 my $action = $r->param('action') || $r->param('formAction') || 'Refresh';
120 : sh002i 2896
121 : sh002i 2898 for ($action) {
122 : sh002i 2944 /^Refresh/i and do {$self->Refresh; last};
123 :     /^Cancel/i and do {$self->Refresh; last};
124 :     /^\^/i and do {$self->ParentDir; last};
125 :     /^Directory/i and do {$self->Go; last};
126 :     /^Go/i and do {$self->Go; last};
127 :     /^View/i and do {$self->View; last};
128 :     /^Edit/i and do {$self->Edit; last};
129 :     /^Download/i and do {$self->Refresh; last};
130 :     /^Copy/i and do {$self->Copy; last};
131 :     /^Rename/i and do {$self->Rename; last};
132 :     /^Delete/i and do {$self->Delete; last};
133 :     /^New Folder/i and do {$self->NewFolder; last};
134 :     /^New File/i and do {$self->NewFile; last};
135 :     /^Upload/i and do {$self->Upload; last};
136 :     /^Revert/i and do {$self->Edit; last};
137 :     /^Save As/i and do {$self->SaveAs; last};
138 :     /^Save/i and do {$self->Save; last};
139 : sh002i 2898 $self->addbadmessage("Unknown action.");
140 :     $self->Refresh;
141 :     }
142 : sh002i 2896
143 : sh002i 2898 print CGI::hidden({name=>'pwd',value=>$self->{pwd}});
144 :     print CGI::hidden({name=>'formAction'});
145 :     print CGI::end_multipart_form();
146 : sh002i 2896
147 : sh002i 2898 return "";
148 : sh002i 2896 }
149 :    
150 :    
151 :     ##################################################
152 :     #
153 : sh002i 2944 # Display the directory listing and associated buttons
154 : sh002i 2896 #
155 :     sub Refresh {
156 : sh002i 2898 my $self = shift;
157 :     my $pwd = shift || $self->{pwd};
158 :     my $isTop = $pwd eq '.' || $pwd eq '';
159 : sh002i 2896
160 : sh002i 2898 my ($dirs,$dirlabels) = directoryMenu($self->{courseName},$pwd);
161 :     my ($files,$filelabels) = directoryListing($self->{courseRoot},$pwd);
162 : sh002i 2896
163 : sh002i 2898 unless ($files) {
164 :     $self->addbadmessage("The directory you specified doesn't exist");
165 :     $files = []; $filelabels = {};
166 :     }
167 : sh002i 2896
168 : sh002i 2898 #
169 : sh002i 2944 # Some JavaScript to make things easier for the user
170 : sh002i 2898 #
171 :     print CGI::script(<<EOF);
172 :     function doForm(action) {
173 :     var form = window.document.getElementById('FileManager');
174 :     form.formAction.value = action;
175 :     form.submit();
176 :     }
177 :     function disableButton(id,state) {
178 :     var element = window.document.getElementById(id);
179 :     element.disabled = state;
180 :     }
181 :     function checkFiles() {
182 :     var files = window.document.getElementById('files');
183 :     var state = files.selectedIndex < 0;
184 :     disableButton('View',state);
185 :     disableButton('Edit',state);
186 :     disableButton('Download',state);
187 :     disableButton('Rename',state);
188 :     disableButton('Copy',state);
189 :     disableButton('Delete',state);
190 :     }
191 :     function checkFile() {
192 :     var file = window.document.getElementById('file');
193 :     var state = (file.value == "");
194 :     disableButton('Upload',state);
195 :     }
196 : sh002i 2896 EOF
197 :    
198 : sh002i 2898 #
199 : sh002i 2944 # Start the table
200 : sh002i 2898 #
201 :     print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>10, style=>"margin:1em 0 0 3em"});
202 : sh002i 2896
203 : sh002i 2898 #
204 : sh002i 2944 # Directory menu
205 : sh002i 2898 #
206 :     print CGI::Tr(
207 :     CGI::td({colspan=>3},
208 : sh002i 2944 CGI::input({type=>"submit", name=>"action", value => "^", ($isTop? (disabled=>1): ())}),
209 :     CGI::popup_menu(
210 :     -name => "directory",
211 :     -values => $dirs,
212 :     -labels => $dirlabels,
213 :     -style => "width:25em",
214 :     -onChange => "doForm('Go')"
215 :     ),
216 : sh002i 2898 CGI::noscript(CGI::input({type=>"submit",name=>"action",value=>"Go"}))
217 :     )
218 : sh002i 2944 );
219 : sh002i 2896
220 : sh002i 2898 #
221 : sh002i 2944 # Directory Listing
222 : sh002i 2898 #
223 :     my %button = (type=>"submit",name=>"action",style=>"width:10em");
224 :     print CGI::Tr({valign=>"middle"},
225 : sh002i 2944 CGI::td(CGI::scrolling_list(
226 :     -name => "files", id => "files",
227 : dpvc 3063 -style => "font-family:monospace; width:30em",
228 : sh002i 2944 -size => 15,
229 :     -multiple => 1,
230 :     -values => $files,
231 :     -labels => $filelabels,
232 :     -onDblClick => "doForm('View')",
233 :     -onChange => "checkFiles()"
234 :     )),
235 : sh002i 2898 CGI::td({width=>3}),
236 :     CGI::td(
237 :     CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3}),
238 :     CGI::Tr([
239 :     CGI::td(CGI::input({%button,value=>"View",id=>"View"})),
240 :     CGI::td(CGI::input({%button,value=>"Edit",id=>"Edit"})),
241 :     CGI::td(CGI::input({%button,value=>"Download",id=>"Download"})),
242 :     CGI::td(CGI::input({%button,value=>"Rename",id=>"Rename"})),
243 :     CGI::td(CGI::input({%button,value=>"Copy",id=>"Copy"})),
244 :     CGI::td(CGI::input({%button,value=>"Delete",id=>"Delete"})),
245 :     CGI::td({height=>10}),
246 :     CGI::td(CGI::input({%button,value=>"New File"})),
247 :     CGI::td(CGI::input({%button,value=>"New Folder"})),
248 :     CGI::td(CGI::input({%button,value=>"Refresh"})),
249 :     ]),
250 :     CGI::end_table(),
251 :     ),
252 : sh002i 2896 );
253 :    
254 : sh002i 2898 #
255 : sh002i 2944 # Upload button
256 : sh002i 2898 #
257 :     print CGI::Tr([
258 :     CGI::td(),
259 :     CGI::td({colspan=>3},
260 :     CGI::input({type=>"submit",name=>"action",style=>"width:7em",value=>"Upload:",id=>"Upload"}),
261 :     CGI::input({type=>"file",name=>"file",id=>"file",size=>40,onChange=>"checkFile()"}),
262 :     ),
263 : sh002i 2896 ]);
264 :    
265 : sh002i 2898 #
266 : sh002i 2944 # End the table
267 :     #
268 : sh002i 2898 print CGI::end_table();
269 :     print CGI::script("checkFiles(); checkFile();");
270 : sh002i 2896 }
271 :    
272 :     ##################################################
273 :     #
274 : sh002i 2944 # Move to the parent directory
275 : sh002i 2896 #
276 :     sub ParentDir {
277 : sh002i 2898 my $self = shift;
278 :     $self->{pwd} = '.' unless ($self->{pwd} =~ s!/[^/]*$!!);
279 :     $self->Refresh;
280 : sh002i 2896 }
281 :    
282 :     ##################################################
283 :     #
284 : sh002i 2944 # Move to the parent directory
285 : sh002i 2896 #
286 :     sub Go {
287 : sh002i 2898 my $self = shift;
288 :     $self->{pwd} = $self->r->param('directory');
289 :     $self->Refresh;
290 : sh002i 2896 }
291 :    
292 :     ##################################################
293 :     #
294 : sh002i 2944 # Open a directory or view a file
295 : sh002i 2896 #
296 :     sub View {
297 : sh002i 2898 my $self = shift; my $pwd = $self->{pwd};
298 :     my $filename = $self->getFile("view"); return unless $filename;
299 :     my $name = "$pwd/$filename"; $name =~ s!^\./?!!;
300 : sh002i 2896
301 : sh002i 2898 #
302 : sh002i 2944 # Handle directories by making them the working directory
303 : sh002i 2898 #
304 :     my $file = "$self->{courseRoot}/$pwd/$filename";
305 :     if (-d $file) {
306 :     $self->{pwd} .= '/'.$filename;
307 :     $self->Refresh; return;
308 :     }
309 : sh002i 2896
310 : sh002i 2898 unless (-f $file) {
311 :     $self->addbadmessage("You can't view files of that type");
312 :     $self->Refresh; return;
313 :     }
314 : sh002i 2896
315 : sh002i 2898 #
316 : sh002i 2944 # Include a download link
317 : sh002i 2898 #
318 :     my $urlpath = $self->r->urlpath;
319 :     my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $self->{courseName});
320 : sh002i 2944 my $fileManagerURL = $self->systemLink($fileManagerPage, params => {download => $filename, pwd => $pwd});
321 : sh002i 2898 print CGI::div({style=>"float:right"},
322 : sh002i 2896 CGI::a({href=>$fileManagerURL},"Download"));
323 : sh002i 2898 print CGI::p(),CGI::b($name),CGI::p();
324 :     print CGI::hr();
325 : sh002i 2896
326 : sh002i 2898 #
327 : sh002i 2944 # For files, display the file, if possible.
328 :     # If the file is an image, display it as an image.
329 : sh002i 2898 #
330 :     my $data = readFile($file);
331 :     if (isText($data)) {
332 :     print CGI::pre(showHTML($data));
333 :     } elsif ($file =~ m/\.(gif|jpg|png)/i) {
334 :     print CGI::img({src=>$fileManagerURL, border=>0});
335 :     } else {
336 :     print CGI::div({class=>"ResultsWithError"},
337 :     "The file does not appear to be a text file.");
338 :     }
339 : sh002i 2896 }
340 :    
341 :     ##################################################
342 :     #
343 : sh002i 2944 # Edit a file
344 : sh002i 2896 #
345 :     sub Edit {
346 : sh002i 2898 my $self = shift;
347 :     my $filename = $self->getFile('edit'); return unless $filename;
348 :     my $file = "$self->{courseRoot}/$self->{pwd}/$filename";
349 : sh002i 2896
350 : sh002i 2898 if (-d $file) {
351 :     $self->addbadmessage("You can't edit a directory");
352 :     $self->Refresh; return;
353 :     }
354 :     unless (-f $file) {
355 :     $self->addbadmessage("You can only edit text files");
356 :     $self->Refresh; return;
357 :     }
358 :     my $data = readFile($file);
359 :     if (!isText($data)) {
360 :     $self->addbadmessage("The file does not appear to be a text file");
361 :     $self->Refresh; return;
362 :     }
363 : sh002i 2896
364 : sh002i 2898 $self->RefreshEdit($data,$filename);
365 : sh002i 2896 }
366 :    
367 :     ##################################################
368 :     #
369 : sh002i 2944 # Save the edited file
370 : sh002i 2896 #
371 :     sub Save {
372 : sh002i 2898 my $self = shift; my $filename = shift;
373 :     my $pwd = $self->{pwd};
374 :     if ($filename) {
375 :     $pwd = substr($filename,length($self->{courseRoot})+1);
376 : dpvc 3086 $pwd =~ s!(/|^)([^/]*)$!!; $filename = $2;
377 :     $pwd = '.' if $pwd eq '';
378 : sh002i 2898 } else {
379 :     $filename = $self->getFile("save"); return unless $filename;
380 :     }
381 :     my $file = "$self->{courseRoot}/$pwd/$filename";
382 :     my $data = $self->r->param("data");
383 : sh002i 2896
384 : sh002i 2898 if (defined($data)) {
385 :     if (open(OUTFILE,">$file")) {
386 :     eval {print OUTFILE $data; close(OUTFILE)};
387 : sh002i 2944 if ($@) {$self->addbadmessage("Failed to save: $@")}
388 : sh002i 2898 else {$self->addgoodmessage("File saved")}
389 : sh002i 2944 } else {$self->addbadmessage("Can't write to file: $!")}
390 : sh002i 2898 } else {$data = ""; $self->addbadmessage("Error: no file data was submitted!")}
391 : sh002i 2896
392 : sh002i 2898 $self->{pwd} = $pwd;
393 :     $self->RefreshEdit($data,$filename);
394 : sh002i 2896 }
395 :    
396 :     ##################################################
397 :     #
398 : sh002i 2944 # Save the edited file under a new name
399 : sh002i 2896 #
400 :     sub SaveAs {
401 : sh002i 2898 my $self = shift;
402 : sh002i 2896
403 : sh002i 2898 my $newfile = $self->r->param('name');
404 :     my $original = $self->r->param('files');
405 :     $newfile = $self->verifyPath($newfile,$original);
406 :     if ($newfile) {$self->Save($newfile); return}
407 :     $self->RefreshEdit($self->r->param('data'),$original);
408 : sh002i 2896 }
409 :    
410 :     ##################################################
411 :     #
412 : sh002i 2944 # Display the Edit page
413 : sh002i 2896 #
414 :     sub RefreshEdit {
415 : sh002i 2898 my $self = shift; my $data = shift; my $file = shift;
416 :     my $pwd = shift || $self->{pwd};
417 :     my $name = "$pwd/$file"; $name =~ s!^\./?!!;
418 : sh002i 2896
419 : sh002i 2898 my %button = (type=>"submit",name=>"action",style=>"width:6em");
420 :     print CGI::p();
421 :     print CGI::start_table({border=>0,cellspacing=>0,cellpadding=>2, width=>"95%", align=>"center"});
422 :     print CGI::Tr([
423 :     CGI::td({align=>"center",style=>"background-color:#CCCCCC"},CGI::b($name)),
424 :     CGI::td(CGI::textarea(-name=>"data",-default=>$data,-override=>1,-rows=>30,-columns=>80,
425 : sh002i 2896 -style=>"width:100%")), ## can't seem to get variable height to work
426 : sh002i 2898 CGI::td({align=>"center", nowrap=>1},
427 :     CGI::input({%button,value=>"Cancel"}),"&nbsp;",
428 :     CGI::input({%button,value=>"Revert"}),"&nbsp;",
429 :     CGI::input({%button,value=>"Save As:"}),
430 :     CGI::input({type=>"text",name=>"name",size=>20,style=>"width:50%"}),"&nbsp;",
431 :     CGI::input({%button,value=>"Save"}),
432 :     ),
433 : sh002i 2896 ]);
434 : sh002i 2898 print CGI::end_table();
435 :     print CGI::hidden({name=>"files",value=>$file});
436 : sh002i 2896 }
437 :    
438 :     ##################################################
439 :     #
440 : sh002i 2944 # Copy a file
441 : sh002i 2896 #
442 :     sub Copy {
443 : sh002i 2898 my $self = shift;
444 :     my $oldfile = $self->getFile('copy'); return unless $oldfile;
445 :     my $original = $oldfile;
446 :     $oldfile = "$self->{courseRoot}/$self->{pwd}/$oldfile";
447 : sh002i 2896
448 : sh002i 2898 if (-d $oldfile) {
449 : sh002i 2944 # FIXME: need to do recursive directory copy
450 : sh002i 2898 $self->addbadmessage("Directory copies are not yet implemented");
451 :     $self->Refresh;
452 :     return;
453 :     }
454 : sh002i 2896
455 : sh002i 2898 if ($self->r->param('confirmed')) {
456 :     my $newfile = $self->r->param('name');
457 :     if ($newfile = $self->verifyPath($newfile,$original)) {
458 :     if (copy($oldfile, $newfile)) {
459 : sh002i 2896 $self->addgoodmessage("File successfully copied");
460 : sh002i 2898 $self->Refresh; return;
461 :     } else {$self->addbadmessage("Can't copy file: $!")}
462 :     }
463 :     }
464 : sh002i 2896
465 : sh002i 2898 Confirm("Copy file as:","Copy");
466 :     print CGI::hidden({name=>"files",value=>$original});
467 : sh002i 2896 }
468 :    
469 :     ##################################################
470 :     #
471 : sh002i 2944 # Rename a file
472 : sh002i 2896 #
473 :     sub Rename {
474 : sh002i 2898 my $self = shift;
475 :     my $oldfile = $self->getFile('rename'); return unless $oldfile;
476 :     my $original = $oldfile;
477 :     $oldfile = "$self->{courseRoot}/$self->{pwd}/$oldfile";
478 : sh002i 2896
479 : sh002i 2898 if ($self->r->param('confirmed')) {
480 :     my $newfile = $self->r->param('name');
481 :     if ($newfile = $self->verifyPath($newfile,$original)) {
482 :     if (rename $oldfile, $newfile) {
483 : sh002i 2896 $self->addgoodmessage("File successfully renamed");
484 :     $self->Refresh; return;
485 : sh002i 2898 } else {$self->addbadmessage("Can't rename file: $!")}
486 :     }
487 :     }
488 : sh002i 2896
489 : sh002i 2898 Confirm("Rename file as:","Rename");
490 :     print CGI::hidden({name=>"files",value=>$original});
491 : sh002i 2896 }
492 :    
493 :     ##################################################
494 :     #
495 : sh002i 2944 # Delete a file
496 : sh002i 2896 #
497 :     sub Delete {
498 : sh002i 2898 my $self = shift;
499 :     my @files = $self->r->param('files');
500 :     if (scalar(@files) == 0) {
501 :     $self->addbadmessage("You must select at least one file to delete");
502 :     $self->Refresh; return;
503 :     }
504 : sh002i 2896
505 : sh002i 2898 my $pwd = $self->{pwd};
506 :     my $dir = $self->{courseRoot}.'/'.$pwd;
507 :     if ($self->r->param('confirmed')) {
508 : sh002i 2896
509 : sh002i 2898 #
510 : sh002i 2944 # If confirmed, go ahead and delete the files
511 : sh002i 2898 #
512 :     foreach my $file (@files) {
513 :     if (defined checkPWD("$pwd/$file",1)) {
514 : sh002i 2896 if (-d "$dir/$file") {
515 : sh002i 2898 my $removed = eval {rmtree("$dir/$file",0,1)};
516 :     if ($removed) {$self->addgoodmessage("Directory '$file' removed (items deleted: $removed)")}
517 : sh002i 2944 else {$self->addbadmessage("Directory '$file' not removed: $!")}
518 : sh002i 2896 } else {
519 : sh002i 2898 if (unlink("$dir/$file")) {$self->addgoodmessage("File '$file' successfully removed")}
520 :     else {$self->addbadmessage("File '$file' not removed: $!")}
521 : sh002i 2896 }
522 : sh002i 2898 } else {$self->addbadmessage("Illegal file '$file' specified"); last}
523 :     }
524 :     $self->Refresh;
525 : sh002i 2896
526 : sh002i 2898 } else {
527 : sh002i 2896
528 : sh002i 2898 #
529 : sh002i 2944 # Put up the confirmation dialog box
530 : sh002i 2898 #
531 :     print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 5em"});
532 :     print CGI::Tr(
533 :     CGI::td(
534 :     CGI::b("Warning:")," You have requested that the following items be deleted\n",
535 :     CGI::ul(CGI::li(\@files)),
536 :     ((grep { -d "$dir/$_" } @files)?
537 : sh002i 2944 CGI::p({style=>"width:500"},"Some of these files are directories. ",
538 :     "Only delete directories if you really know what you are doing. ",
539 : sh002i 2898 "You can seriously damage your course if you delete the wrong thing."): ""),
540 :     CGI::p({style=>"color:red"},"There is no undo for deleting files or directories!"),
541 :     CGI::p("Really delete the items listed above?"),
542 :     CGI::div({style=>"float:left; padding-left:3ex"},
543 : sh002i 2896 CGI::input({type=>"submit",name=>"action",value=>"Cancel"})),
544 : sh002i 2898 CGI::div({style=>"float:right; padding-right:3ex"},
545 : sh002i 2896 CGI::input({type=>"submit",name=>"action",value=>"Delete"})),
546 : sh002i 2898 ),
547 :     );
548 :     print CGI::end_table();
549 : sh002i 2896
550 : sh002i 2898 print CGI::hidden({name=>"confirmed",value=>1});
551 :     foreach my $file (@files) {print CGI::hidden({name=>"files",value=>$file})}
552 :     }
553 : sh002i 2896 }
554 :    
555 :     ##################################################
556 :     #
557 : sh002i 2944 # Make a new file and edit it
558 : sh002i 2896 #
559 :     sub NewFile {
560 : sh002i 2898 my $self = shift;
561 : sh002i 2896
562 : sh002i 2898 if ($self->r->param('confirmed')) {
563 :     my $name = $self->r->param('name');
564 :     if (my $file = $self->verifyName($name,"file")) {
565 :     if (open(NEWFILE,">$file")) {
566 : sh002i 2896 close(NEWFILE);
567 :     $self->RefreshEdit("",$name);
568 :     return;
569 : sh002i 2898 } else {$self->addbadmessage("Can't create file: $!")}
570 :     }
571 :     }
572 : sh002i 2896
573 : sh002i 2898 Confirm("New file name:","New File");
574 : sh002i 2896 }
575 :    
576 :     ##################################################
577 :     #
578 : sh002i 2944 # Make a new directory
579 : sh002i 2896 #
580 :     sub NewFolder {
581 : sh002i 2898 my $self = shift;
582 : sh002i 2896
583 : sh002i 2898 if ($self->r->param('confirmed')) {
584 :     my $name = $self->r->param('name');
585 :     if (my $dir = $self->verifyName($name,"directory")) {
586 :     if (mkdir $dir, 0750) {
587 : sh002i 2896 $self->{pwd} .= '/'.$name;
588 : sh002i 2898 $self->Refresh; return;
589 :     } else {$self->addbadmessage("Can't create directory: $!")}
590 :     }
591 :     }
592 : sh002i 2896
593 : sh002i 2898 Confirm("New folder name:","New Folder");
594 : sh002i 2896 }
595 :    
596 :     ##################################################
597 :     #
598 : sh002i 2944 # Download a file
599 : sh002i 2896 #
600 :     sub Download {
601 : sh002i 2898 my $self = shift;
602 :     my $filename = $self->getFile("download"); return unless $filename;
603 :     my $pwd = checkPWD($self->r->param('pwd') || '.');
604 :     return unless $pwd;
605 :     my $file = $self->{ce}{courseDirs}{root}.'/'.$pwd.'/'.$filename;
606 : sh002i 2896
607 : sh002i 2898 if (-d $file) {$self->addbadmessage("You can't download directories"); return}
608 :     unless (-f $file) {$self->addbadmessage("You can't download files of that type"); return}
609 : sh002i 2896
610 : sh002i 2898 $self->r->param('download',$filename);
611 : sh002i 2896 }
612 :    
613 :     ##################################################
614 :     #
615 : sh002i 2944 # Upload a file to the server
616 : sh002i 2896 #
617 :     sub Upload {
618 : sh002i 2898 my $self = shift;
619 :     my $dir = "$self->{courseRoot}/$self->{pwd}";
620 :     my $fileIDhash = $self->r->param('file');
621 :     unless ($fileIDhash) {
622 :     $self->addbadmessage("You have not chosen a file to upload.");
623 :     $self->Refresh;
624 :     return;
625 :     }
626 : sh002i 2896
627 : sh002i 2898 my ($id,$hash) = split(/\s+/,$fileIDhash);
628 :     my $upload = WeBWorK::Upload->retrieve($id,$hash,dir=>$self->{ce}{webworkDirs}{uploadCache});
629 : sh002i 2896
630 : sh002i 2898 my $name = uniqueName($dir,checkName($upload->filename));
631 :     if (-e "$dir/$name") {
632 :     $self->addbadmessage("A file with that name already exists");
633 :     $self->Refresh;
634 :     $upload->dispose;
635 :     return;
636 :     }
637 : sh002i 2896
638 : sh002i 2898 $upload->disposeTo("$dir/$name");
639 :     $self->addgoodmessage("File '$name' uploaded successfully");
640 :     $self->Refresh;
641 : sh002i 2896 }
642 :    
643 :     ##################################################
644 :     ##################################################
645 :     #
646 : sh002i 2944 # Print a confirmation dialog box
647 : sh002i 2896 #
648 :     sub Confirm {
649 : sh002i 2898 my $message = shift;
650 :     my $button = shift;
651 : sh002i 2896
652 : sh002i 2898 print CGI::p();
653 :     print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 3em"});
654 :     print CGI::Tr(
655 :     CGI::td(
656 :     $message,
657 :     CGI::input({type=>"text",name=>"name",size=>50}),
658 :     CGI::p(),
659 :     CGI::div({style=>"float:right; padding-right:3ex"},
660 : sh002i 2944 CGI::input({type=>"submit",name=>"action",value=>$button})), # this will be the default
661 : sh002i 2898 CGI::div({style=>"float:left; padding-left:3ex"},
662 : sh002i 2896 CGI::input({type=>"submit",name=>"action",value=>"Cancel"})),
663 : sh002i 2898 ),
664 :     );
665 :     print CGI::end_table();
666 :     print CGI::hidden({name=>"confirmed",value=>1});
667 :     print CGI::script("window.document.FileManager.name.focus()");
668 : sh002i 2896 }
669 :    
670 :     ##################################################
671 :     #
672 : sh002i 2944 # Check that there is exactly one vailid file
673 : sh002i 2896 #
674 :     sub getFile {
675 : sh002i 2898 my $self = shift; my $action = shift;
676 :     my @files = $self->r->param("files");
677 :     if (scalar(@files) > 1) {
678 :     $self->addbadmessage("You can only $action one file at a time.");
679 :     $self->Refresh unless $action eq 'download';
680 :     return;
681 :     }
682 :     if (scalar(@files) == 0 || $files[0] eq "") {
683 :     $self->addbadmessage("You need to select a file to $action.");
684 :     $self->Refresh unless $action eq 'download';
685 :     return;
686 :     }
687 :     my $pwd = checkPWD($self->{pwd} || $self->r->param('pwd') || '.') || '.';
688 :     $self->addbadmessage("You have specified an illegal file")
689 :     unless checkPWD($pwd.'/'.$files[0],1);
690 :     return $files[0];
691 : sh002i 2896 }
692 :    
693 :     ##################################################
694 :     #
695 : sh002i 2944 # Get the entries for the directory menu
696 : sh002i 2896 #
697 :     sub directoryMenu {
698 : sh002i 2898 my $course = shift;
699 : sh002i 2944 my $dir = shift; $dir =~ s!^\.(/|$)!!;
700 : sh002i 2898 my @dirs = split('/',$dir);
701 :     my $menu = ""; my $pwd;
702 :    
703 :     my (@values,%labels);
704 :     while (scalar(@dirs)) {
705 :     $pwd = join('/',(@dirs)[0..$#dirs]);
706 :     $dir = pop(@dirs);
707 :     push(@values,$pwd); $labels{$pwd} = $dir;
708 :     }
709 :     push(@values,'.'); $labels{'.'} = $course;
710 :     return (\@values,\%labels);
711 : sh002i 2896 }
712 :    
713 :     ##################################################
714 :     #
715 : sh002i 2944 # Get the directory listing
716 : sh002i 2896 #
717 :     sub directoryListing {
718 : sh002i 2898 my $root = shift; my $pwd = shift;
719 :     my $dir = $root.'/'.$pwd;
720 :     my (@values,%labels,$size,$data);
721 : sh002i 2896
722 : gage 2904 return unless -d $dir and not -l $dir; #FIXME -- don't follow links
723 : sh002i 2898 my @names = sortByName(undef,grep(/^[^.]/,readDirectory($dir)));
724 :     foreach my $name(@names) {
725 : gage 2904 unless ( $name eq 'DATA') { #FIXME don't view the DATA directory
726 :     push(@values,$name); $labels{$name} = $name;
727 :     $labels{$name} .= '/' if (-d $dir.'/'.$name);
728 :     }
729 : sh002i 2898 }
730 :     return (\@values,\%labels);
731 : sh002i 2896 }
732 :    
733 :     ##################################################
734 :     #
735 : sh002i 2944 # Normalize the working directory and check if it is OK.
736 : sh002i 2896 #
737 :     sub checkPWD {
738 : sh002i 2898 my $pwd = shift;
739 :     my $renameError = shift;
740 : sh002i 2896
741 : sh002i 2944 $pwd =~ s!//+!/!g; # remove duplicate slashes
742 :     $pwd =~ s!(^|/)~!$1_!g; # remove ~user references
743 :     $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories
744 :    
745 :     # remove dir/.. constructions
746 : sh002i 2898 while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {};
747 : sh002i 2944
748 :     $pwd =~ s!/$!!; # remove trailing /
749 :     return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root
750 : sh002i 2896
751 : sh002i 2898 my $original = $pwd;
752 : sh002i 2944 $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories
753 :     $pwd =~ s!^/!!; # remove leading /
754 :     $pwd =~ s![^-_./a-zA-Z0-9 ]!_!g; # no illegal characters
755 : sh002i 2898 return if $renameError && $original ne $pwd;
756 : sh002i 2896
757 : sh002i 2898 $pwd = '.' if $pwd eq '';
758 :     return $pwd;
759 : sh002i 2896 }
760 :    
761 :     ##################################################
762 :     #
763 : sh002i 2944 # Check a name for bad characters, etc.
764 : sh002i 2896 #
765 :     sub checkName {
766 : sh002i 2898 my $file = shift;
767 : sh002i 2944 $file =~ s!.*[/\\]!!; # remove directory
768 :     $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters
769 :     $file = "newfile.txt" unless $file; # no blank names
770 :     $file =~ s/^\./_/; # no initial dot
771 : sh002i 2898 return $file;
772 : sh002i 2896 }
773 :    
774 :     ##################################################
775 :     #
776 : sh002i 2944 # Get a unique name (in case it already exists)
777 : sh002i 2896 #
778 :     sub uniqueName {
779 : sh002i 2898 my $dir = shift; my $name = shift;
780 : dpvc 3086 return $name unless (-e "$dir/$name");
781 : sh002i 2898 my $type = ""; my $n = -1;
782 :     $type = $1 if ($name =~ s/(\.[^.]*)$//);
783 :     $n = $1 if ($name =~ s/(\d+)$//);
784 :     while (-e "$dir/$name$n$type") {if ($n < 0) {$n--} else {$n++}}
785 :     return "$name$n$type";
786 : sh002i 2896 }
787 :    
788 :     ##################################################
789 :     #
790 : sh002i 2944 # Verify that a name can be added tot he current
791 :     # directory.
792 : sh002i 2896 #
793 :     sub verifyName {
794 : sh002i 2898 my $self = shift; my $name = shift; my $object = shift;
795 :     if ($name) {
796 :     unless ($name =~ m!/!) {
797 :     unless ($name =~ m!^\.!) {
798 : sh002i 2896 unless ($name =~ m![^-_.a-zA-Z0-9 ]!) {
799 : sh002i 2898 my $file = "$self->{courseRoot}/$self->{pwd}/$name";
800 :     return $file unless (-e $file);
801 :     $self->addbadmessage("A file with that name already exists");
802 : sh002i 2896 } else {$self->addbadmessage("Your $object name contains illegal characters")}
803 : sh002i 2898 } else {$self->addbadmessage("Your $object name may not begin with a dot")}
804 :     } else {$self->addbadmessage("Your $object name may not contain a path component")}
805 :     } else {$self->addbadmessage("You must specify a $object name")}
806 :     return
807 : sh002i 2896 }
808 :    
809 :     ##################################################
810 :     #
811 : sh002i 2944 # Verify that a file path is valid
812 : sh002i 2896 #
813 :     sub verifyPath {
814 : sh002i 2898 my $self = shift; my $path = shift; my $name = shift;
815 : sh002i 2896
816 : sh002i 2898 if ($path) {
817 :     unless ($path =~ m![^-_.a-zA-Z0-9 /]!) {
818 :     unless ($path =~ m!^/!) {
819 : sh002i 2896 $path = checkPWD($self->{pwd}.'/'.$path,1);
820 :     if ($path) {
821 : sh002i 2898 $path = $self->{courseRoot}.'/'.$path;
822 :     $path .= '/'.$name if -d $path && $name;
823 :     return $path unless (-e $path);
824 :     $self->addbadmessage("A file with that name already exists");
825 : sh002i 2896 } else {$self->addbadmessage("You have specified an illegal path")}
826 : sh002i 2898 } else {$self->addbadmessage("You can not specify an absolute path")}
827 :     } else {$self->addbadmessage("Your file name contains illegal characters")}
828 :     } else {$self->addbadmessage("You must specify a file name")}
829 :     return
830 : sh002i 2896 }
831 :    
832 :     ##################################################
833 :     #
834 : sh002i 2944 # Make HTML symbols printable
835 : sh002i 2896 #
836 :     sub showHTML {
837 : sh002i 2898 my $string = shift;
838 :     return '' unless defined $string;
839 :     $string =~ s/&/\&amp;/g;
840 :     $string =~ s/</\&lt;/g;
841 :     $string =~ s/>/\&gt;/g;
842 :     $string;
843 : sh002i 2896 }
844 :    
845 :     ##################################################
846 :     #
847 : sh002i 2944 # Check if a string is plain text
848 :     # (i.e., doesn't contain three non-regular
849 :     # characters in a row.)
850 : sh002i 2896 #
851 :     sub isText {
852 : sh002i 2898 my $string = shift;
853 :     return $string !~ m/[^\s\x20-\x7E]{3,}/;
854 : sh002i 2896 }
855 :    
856 :     ##################################################
857 :    
858 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9