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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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