1: # The LearningOnline Network with CAPA
2: # Handler to rename files, etc, in construction space
3: #
4: # This file responds to the various buttons and events
5: # in the top frame of the construction space directory.
6: # Each event is processed in two phases. The first phase
7: # presents a page that describes the proposed action to the user
8: # and requests confirmation. The second phase commits the action
9: # and displays a page showing the results of the action.
10: #
11:
12: #
13: # $Id: loncfile.pm,v 1.13 2002/07/29 01:55:51 foxr Exp $
14: #
15: # Copyright Michigan State University Board of Trustees
16: #
17: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
18: #
19: # LON-CAPA is free software; you can redistribute it and/or modify
20: # it under the terms of the GNU General Public License as published by
21: # the Free Software Foundation; either version 2 of the License, or
22: # (at your option) any later version.
23: #
24: # LON-CAPA is distributed in the hope that it will be useful,
25: # but WITHOUT ANY WARRANTY; without even the implied warranty of
26: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27: # GNU General Public License for more details.
28: #
29: # You should have received a copy of the GNU General Public License
30: # along with LON-CAPA; if not, write to the Free Software
31: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
32: #
33: # /home/httpd/html/adm/gpl.txt
34: #
35: # http://www.lon-capa.org/
36: #
37: #
38: # (Handler to retrieve an old version of a file
39: #
40: # (Publication Handler
41: #
42: # (TeX Content Handler
43: #
44: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
45: #
46: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
47: # 03/23 Guy Albertelli
48: # 03/24,03/29 Gerd Kortemeyer)
49: #
50: # 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer)
51: #
52: # 06/23 Gerd Kortemeyer
53: # 05/07/02 Ron Fox:
54: # - Added Debug log output so that I can trace what the heck this
55: # undocumented thingy does.
56: # 05/28/02 Ron Fox:
57: # - Started putting in pod in standard format.
58: =pod
59:
60: =head1 NAME
61:
62: Apache::loncfile - Construction space file management.
63:
64: =head1 SYNOPSIS
65:
66: Content handler for buttons on the top frame of the construction space
67: directory.
68:
69: =head1 INTRODUCTION
70:
71: loncfile is invoked when buttons in the top frame of the construction
72: space directory listing are clicked. All operations procede in two phases.
73: The first phase describes to the user exactly what will be done. If the user
74: confirms the operation, the second phase commits the operation and indicates
75: completion. When the user dismisses the output of phase2, they are returned to
76: an "appropriate" directory listing in general.
77:
78: This is part of the LearningOnline Network with CAPA project
79: described at http://www.lon-capa.org.
80:
81: =head2 Subroutines
82:
83: =cut
84:
85: package Apache::loncfile;
86:
87: use strict;
88: use Apache::File;
89: use File::Copy;
90: use Apache::Constants qw(:common :http :methods);
91: use Apache::loncacc;
92: use Apache::Log ();
93:
94: my $DEBUG=0;
95: my $r; # Needs to be global for some stuff RF.
96:
97: =pod
98:
99: =item Debug($request, $message)
100:
101: If debugging is enabled puts out a debuggin message determined by the
102: caller. The debug message goes to the Apache error log file. Debugging
103: is enabled by ssetting the module global DEBUG variable to nonzero (TRUE).
104:
105: Parameters:
106:
107: =over 4
108:
109: =item $request - The curretn request operation.
110:
111: =item $message - The message to put inthe log file.
112:
113: =back
114:
115: Returns:
116: nothing.
117:
118: =cut
119:
120: sub Debug {
121:
122: # Marshall the parameters.
123:
124: my $r = shift;
125: my $log = $r->log;
126: my $message = shift;
127:
128: # Put out the indicated message butonly if DEBUG is false.
129:
130: if ($DEBUG) {
131: $log->debug($message);
132: }
133: }
134:
135: =pod
136:
137: =item URLToPath($url)
138:
139: Convert a URL to a file system path.
140:
141: In order to manipulate the construction space objects, it is necessary
142: to access url identified objects a filespace objects. This function
143: translates a construction space URL to a file system path.
144: Parameters:
145:
146: =over 4
147:
148: =item Url - string [in] The url to convert.
149:
150: =back
151:
152: Returns:
153:
154: =over 4
155:
156: =item The corresponing file system path.
157:
158: =back
159:
160: Global References
161:
162: =over 4
163:
164: =item $r - Request object [in] Referenced in the &Debug calls.
165:
166: =back
167:
168: =cut
169:
170: sub URLToPath {
171: my $Url = shift;
172: &Debug($r, "UrlToPath got: $Url");
173: $Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
174: $Url=~ s/^http\:\/\/[^\/]+//;
175: &Debug($r, "Returning $Url \n");
176: return $Url;
177: }
178:
179: =pod
180:
181: =item PublicationPath($domain, $user, $dir, $file)
182:
183: Determines the filesystem path corersponding to a published resource
184: specification. The returned value is the path.
185: Parameters:
186:
187: =over 4
188:
189: =item $domain - string [in] Name of the domain within which the resource is
190: stored.
191:
192: =item $user - string [in] Name of the user asking about the resource.
193:
194: =item $dir - Directory pathr elatvie to the top of the resource space0
195:
196: =item $file - name of the resource file itself without path info.
197:
198: =back
199:
200: =over 4
201:
202: Returns:
203:
204: =item string - full path to the file if it exists in publication space.
205:
206: =back
207:
208: =cut
209:
210: sub PublicationPath
211: {
212: my ($domain, $user, $dir, $file)=@_;
213:
214: return '/home/httpd/html/res/'.$domain.'/'.$user.'/'.$dir.'/'.
215: $file;
216: }
217:
218: =pod
219:
220: =item ConstructionPath($domain, $user, $dir, $file)
221:
222: Determines the filesystem path corersponding to a construction space
223: resource specification. The returned value is the path
224: Parameters:
225:
226: =over 4
227:
228: =item $user - string [in] Name of the user asking about the resource.
229:
230: =item $dir - Directory path relatvie to the top of the resource space
231:
232: =item $file - name of the resource file itself without path info.
233:
234: Returns:
235:
236: =item string - full path to the file if it exists in Construction space.
237:
238: =back
239:
240: =cut
241:
242: sub ConstructionPath {
243: my ($user, $dir, $file) = @_;
244:
245: return '/home/'.$user.'/public_html/'.$dir.'/'.$file;
246:
247: }
248: =pod
249:
250: =item ConstructionPathFromRelative($user, $relname)
251:
252: Determines the path to a construction space file given
253: the username and the path relative to the root of construction space.
254:
255: Parameters:
256:
257: =over 4
258:
259: =item $user - string [in] Name of the user in whose construction space the
260: file [will] live.
261:
262: =item $relname - string[in] Path to the file relative to the root of the
263: construction space.
264:
265: =back
266:
267: Returns:
268:
269: =over 4
270:
271: =item string - Full path to the file.
272:
273: =back
274:
275: =cut
276:
277: sub ConstructionPathFromRelative {
278:
279: my ($user, $relname) = @_;
280: return '/home/'.$user.'/public_html'.$relname;
281:
282: }
283:
284: =pod
285:
286: =item exists($user, $domain, $directory, $file)
287:
288: Determine if a resource file name has been publisehd or exists
289: in the construction space.
290:
291: Parameters:
292:
293: =over 4
294:
295: =item $user - string [in] - Name of the user for which to check.
296:
297: =item $domain - string [in] - Name of the domain in which the resource
298: might have been published.
299:
300: =item $dir - string [in] - Path relative to construction or resource space
301: in which the resource might live.
302:
303: =item $file - string [in] - Name of the file.
304:
305: =back
306:
307: Returns:
308:
309: =over 4
310:
311: =item string - Either where the resource exists as an html string that can
312: be embedded in a dialog or an empty string if the resource
313: does not exist.
314:
315: =back
316:
317: =cut
318:
319: sub exists {
320: my ($user, $domain, $dir, $file) = @_;
321:
322: # Create complete paths in publication and construction space.
323:
324: my $published = &PublicationPath($domain, $user, $dir, $file);
325: my $construct = &ConstructionPath($user, $dir, $file);
326:
327: # If the resource exists in either space indicate this fact.
328: # Note that the check for existence in resource space is stricter.
329:
330: my $result;
331: if ( -e $published) {
332: $result.='<p><font color=red>Warning: target file exists, and has been published!</font></p>';
333: }
334: elsif ( -e $construct) {
335: $result.='<p><font color=red>Warning: target file exists!</font></p>';
336: }
337:
338: return $result;
339:
340: }
341:
342: =pod
343:
344: =item checksuffix($old, $new)
345:
346: Determine if a resource filename suffix (the stuff after the .) would change
347: as a result of this operation.
348:
349: Parameters:
350:
351: =over 4
352:
353: =item $old = string [in] Previous filename.
354:
355: =item $new = string [in] Resultant filename.
356:
357: =back
358:
359: Returns:
360:
361: =over 4
362:
363: =item Empty string if everythikng worked.
364:
365: =item String containing an error message if there was a problem.
366:
367: =back
368:
369: =cut
370:
371: sub checksuffix {
372: my ($old,$new) = @_;
373: my $result;
374: my $oldsuffix;
375: my $newsuffix;
376: if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
377: if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
378: if ($oldsuffix ne $newsuffix) {
379: $result.=
380: '<p><font color=red>Warning: change of MIME type!</font></p>';
381: }
382: return $result;
383: }
384: =pod
385:
386: =item CloseForm1($request, $user, $file)
387:
388: Close of a form on the successful completion of phase 1 processing
389:
390: Parameters:
391:
392: =over 4
393:
394: =item $request - Apache Request Object [in] - Apache server request object.
395:
396: =item $cancelurl - the url to go to on cancel.
397:
398: =back
399:
400: =cut
401:
402: sub CloseForm1 {
403: my ($request, $cancelurl) = @_;
404:
405:
406: &Debug($request, "Cancel url is: ".$cancelurl);
407: $request->print('<p><input type=submit value=Continue></p></form>');
408: $request->print('<form action="'.$cancelurl.
409: '" method=GET"><p><input type=submit value=Cancel><p></form>');
410:
411: }
412:
413:
414: =pod
415:
416: =item CloseForm2($request, $user, $directory)
417:
418: Successfully close off the phase 2 form.
419:
420: Parameters:
421:
422: =over 4
423:
424: =item $request - Apache Request object [in] - The request that is being
425: executed.
426:
427: =item $user - string [in] - Name of the user that is initiating the
428: request.
429:
430: =item $directory - string [in] - Directory in which the operation is
431: being done relative to the top level construction space
432: directory.
433:
434: =back
435:
436: =cut
437:
438: sub CloseForm2 {
439: my ($request, $user, $directory) = @_;
440:
441: $request->print('<h3><a=href="/priv/'.$user.$directory.'/">Done </a> </h3>');
442: }
443:
444: =pod
445:
446: =item Rename1($request, $filename, $user, $domain, $dir)
447:
448: Perform phase 1 processing of the file rename operation.
449:
450: Parameters:
451:
452: =over 4
453:
454: =item $request - Apache Request Object [in] The request object for the
455: current request.
456:
457: =item $filename - The filename relative to construction space.
458:
459: =item $user - Name of the user making the request.
460:
461: =item $domain - User login domain.
462:
463: =item $dir - Directory specification of the path to the file.
464:
465: =back
466:
467: Side effects:
468:
469: =over 4
470:
471: =item A new form is displayed prompting for confirmation. The newfilename
472: hidden field of this form is loaded with
473: new filename relative to the current directory ($dir).
474:
475: =back
476:
477: =cut
478:
479: sub Rename1 {
480: my ($request, $filename, $user, $domain, $dir) = @_;
481: &Debug($request, "Username - ".$user." filename: ".$filename."\n");
482: my $conspace = $filename;
483:
484: my $cancelurl = "/priv/".$filename;
485: $cancelurl =~ s/\/home\///;
486: $cancelurl =~ s/\/public_html//;
487:
488: if(-e $conspace) {
489: if($ENV{'form.newfilename'}) {
490: my $newfilename = $ENV{'form.newfilename'};
491: $request->print(&checksuffix($filename, $newfilename));
492: $request->print(&exists($user, $domain, $dir, $newfilename));
493: $request->print('<input type=hidden name=newfilename value="'.
494: $newfilename.
495: '"><p>Rename <tt>'.$filename.'</tt> to <tt>'.
496: $dir.'/'.$newfilename.'</tt>?</p>');
497: &CloseForm1($request, $cancelurl);
498: } else {
499: $request->print('<p>No new filename specified</p></form>');
500: return;
501: }
502: } else {
503: $request->print('<p> No such File </p> </form>');
504: return;
505: }
506:
507: }
508: =pod
509:
510: =item Delete1
511:
512: Performs phase 1 processing of the delete operation. In phase one
513: we just check to be sure the file exists.
514:
515: Parameters:
516:
517: =over 4
518:
519: =item $request - Apache Request Object [in] request object for the current
520: request.
521:
522: =item $user - string [in] Name of session user.
523:
524:
525: =item $filename - string [in] Name fo the file to be deleted:
526: Filename is the full filesystem path to the file.
527:
528: =back
529:
530: =cut
531:
532: sub Delete1 {
533: my ($request, $user, $filename) = @_;
534:
535: my $cancelurl = '/priv/'.$filename;
536: $cancelurl =~ s/\/home\///;
537: $cancelurl =~ s/\/public_html//;
538:
539:
540: if( -e $filename) {
541: $request->print('<input type=hidden name=newfilename value="'.
542: $filename.'">');
543: $request->print('<p> Delete <tt>'.$filename.'</tt>?</p>');
544: &CloseForm1($request, $cancelurl);
545: } else {
546: $request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>');
547: }
548: }
549:
550: =pod
551:
552: =item Copy1($request, $user, $domain, $filename, $newfilename)
553:
554: Performs phase 1 processing of the construction space copy command.
555: Ensure that the source fil eexists. Ensure that a destination exists,
556: also warn if the detination already exists.
557:
558: Parameters:
559:
560: =over 4
561:
562: =item $request - Apache Request Object [in] request object for the current
563: request.
564:
565: =item $user - string [in] Name of the user initiating the request.
566:
567: =item $domain - string [in] Domain the initiating user is logged in as
568:
569: =item $dir - string [in] Directory path.
570:
571: =item $filename - string [in] Source filename.
572:
573: =item $newfilename-string [in] Destination filename.
574:
575: =back
576:
577: =cut
578:
579: sub Copy1 {
580: my ($request, $user, $domain, $dir, $filename, $newfilename) = @_;
581:
582: my $cancelurl = "/priv/".$filename;
583: $cancelurl =~ s/\/home\///;
584: $cancelurl =~ s/\/public_html//;
585:
586:
587:
588: if(-e $filename) {
589: $request->print(&checksuffix($filename,$newfilename));
590: $request->print(&exists($user, $domain, $dir, $newfilename));
591: $request->print('<input type = hidden name = newfilename value = "'.
592: $dir.'/'.$newfilename.
593: '"><p>Copy <tt>'.$filename.'</tt> to'.
594: '<tt>'.$dir.'/'.$newfilename.'</tt>/?</p>');
595: &CloseForm1($request, $cancelurl);
596: } else {
597: $request->print('<p>No such file <tt>'.$filename.'</p></form>');
598: }
599: }
600:
601: =pod
602:
603: =item NewDir1
604:
605: Does all phase 1 processing of directory creation:
606: Ensures that the user provides a new directory name,
607: and that the directory does not already exist.
608:
609: Parameters:
610:
611: =over 4
612:
613: =item $request - Apache Request Object [in] - Server request object for the
614: current url..
615:
616: =item $username - Name of the user that is requesting the directory creation.
617:
618: =item $path - current directory relative to construction spacee.
619:
620: =item $newdir - Name of the directory to be created; path relative to the
621: top level of construction space.
622: =back
623:
624: Side Effects:
625:
626: =over 4
627:
628: =item A new form is displayed. Clicking on the confirmation button
629: causes the newdir operation to transition into phase 2. The hidden field
630: "newfilename" is set with the construction space path to the new directory.
631:
632:
633: =back
634:
635: =cut
636:
637:
638: sub NewDir1
639: {
640: my ($request, $username, $path, $newdir) = @_;
641:
642: my $fullpath = '/home/'.$username.'/public_html/'.
643: $path.'/'.$newdir;
644:
645: my $cancelurl = '/priv/'.$username.'/'.$path;
646:
647: &Debug($request, "Full path is : ".$fullpath);
648:
649: if(-e $fullpath) {
650: $request->print('<p>Directory exists.</p></form>');
651: }
652: else {
653: $request->print('<input type=hidden name=newfilename value="'.
654: $newdir.'"><p>Make new directory <tt>'.
655: $path."/".$newdir.'</tt>?</p>');
656: &CloseForm1($request, $cancelurl);
657:
658: }
659: }
660:
661: =pod
662:
663: =item phaseone($r, $fn, $uname, $udom)
664:
665: Peforms phase one processing of the request. In phase one, error messages
666: are returned if the request cannot be performed (e.g. attempts to manipulate
667: files that are nonexistent). If the operation can be performed, what is
668: about to be done will be presented to the user for confirmation. If the
669: user confirms the request, then phase two is executed, the action
670: performed and reported to the user.
671:
672: Parameters:
673:
674: =over 4
675:
676: =item $r - request object [in] - The Apache request being executed.
677:
678: =item $fn = string [in] - The filename being manipulated by the
679: request.
680:
681: =item $uname - string [in] Name of user logged in and doing this action.
682:
683: =item $udom - string [in] Domain nmae under which the user logged in.
684:
685: =back
686:
687: =cut
688:
689: sub phaseone {
690: my ($r,$fn,$uname,$udom)=@_;
691:
692: $fn=~m:(.*)/([^/]+)\.(\w+)$:;
693: my $dir=$1;
694: my $main=$2;
695: my $suffix=$3;
696:
697: # my $conspace=ConstructionPathFromRelative($uname, $fn);
698:
699:
700: $r->print('<form action=/adm/cfile method=post>'.
701: '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
702: '<input type=hidden name=phase value=two>'.
703: '<input type=hidden name=action value='.$ENV{'form.action'}.'>');
704:
705: if ($ENV{'form.action'} eq 'rename') {
706:
707: &Rename1($r, $fn, $uname, $udom, $dir);
708:
709: } elsif ($ENV{'form.action'} eq 'delete') {
710:
711: &Delete1($r, $uname, $fn);
712:
713: } elsif ($ENV{'form.action'} eq 'copy') {
714: if($ENV{'form.newfilename'}) {
715: my $newfilename = $ENV{'form.newfilename'};
716: &Copy1($r, $uname, $udom, $dir, $fn, $newfilename);
717: }else {
718: $r->print('<p>No new filename specified.</p></form>');
719: }
720: } elsif ($ENV{'form.action'} eq 'newdir') {
721: &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'});
722: }
723:
724: }
725:
726: =pod
727:
728: =item Rename2($request, $user, $directory, $oldfile, $newfile)
729:
730: Performs phase 2 procesing of a rename reequest. This is where the
731: actual rename is performed.
732:
733: Parameters
734:
735: =over 4
736:
737: =item $request - Apache request object [in] The request being processed.
738:
739: =item $user - string [in] The name of the user initiating the request.
740:
741: =item $directory - string [in] The name of the directory relative to the
742: construction space top level of the renamed file.
743:
744: =item $oldfile - Name of the file.
745:
746: =item $newfile - Name of the new file.
747:
748: =back
749:
750: Returns:
751:
752: =over 4
753:
754: =item 1 Success.
755:
756: =item 0 Failure.
757:
758: =cut
759:
760: sub Rename2 {
761:
762: my ($request, $user, $directory, $oldfile, $newfile) = @_;
763:
764: &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
765: " new file ".$newfile."\n");
766: &Debug($request, "Target is: ".$directory.'/'.
767: $newfile);
768:
769: if(-e $oldfile) {
770: unless(rename($oldfile,
771: $directory.'/'.$newfile)) {
772: $request->print('<font color=red>Error: '.$!.'</font>');
773: return 0;
774: } else {}
775: } else {
776: $request->print("<p> No such file: /home".$user.'/public_html'.
777: $oldfile.' </p></form>');
778: return 0;
779: }
780: return 1;
781: }
782: =pod
783:
784: =item Delete2($request, $user, $filename)
785:
786: Performs phase two of a delete. The user has confirmed that they want
787: to delete the selected file. The file is deleted and the results of the
788: delete attempt are indicated.
789:
790: Parameters:
791:
792: =over 4
793:
794: =item $request - Apache Request object [in] the request object for the current
795: delete operation.
796:
797: =item $user - string [in] The name of the user initiating the delete
798: request.
799:
800: =item $filename - string [in] The name of the file, relative to construction space,
801: to delete.
802:
803: =back
804:
805: Returns:
806: 1 - success.
807: 0 - Failure.
808:
809: =cut
810:
811: sub Delete2 {
812: my ($request, $user, $filename) = @_;
813:
814: if(-e $filename) {
815: unless(unlink($filename)) {
816: $request->print('<font color=red>Error: '.$!.'</font>');
817: return 0;
818: }
819: } else {
820: $request->print('<p> No such file. </form');
821: return 0;
822: }
823: return 1;
824: }
825:
826: =pod
827:
828: =item Copy2($request, $username, $dir, $oldfile, $newfile)
829:
830: Performs phase 2 of a copy. The file is copied and the status
831: of that copy is reported back to the user.
832:
833: =over 4
834:
835: =item $request - Apache request object [in]; the apache request currently
836: being executed.
837:
838: =item $username - string [in] Name of the user who is requesting the copy.
839:
840: =item $dir - string [in] Directory path relative to the construction space
841: of the destination file.
842:
843: =item $oldfile - string [in] Name of the source file.
844:
845: =item $newfile - string [in] Name of the destination file.
846:
847:
848: =back
849:
850: Returns 0 failure, and 0 successs.
851:
852: =cut
853:
854: sub Copy2 {
855: my ($request, $username, $dir, $oldfile, $newfile) = @_;
856: &Debug($request ,"Will try to copy $oldfile to $newfile");
857: if(-e $oldfile) {
858: unless (copy($oldfile, $newfile)) {
859: $request->print('<font color=red> Error: '.$!.'</font>');
860: return 0;
861: } else {
862: return 1;
863: }
864: } else {
865: $request->print('<p> No such file </p>');
866: return 0;
867: }
868: return 1;
869: }
870: =pod
871:
872: =item NewDir2($request, $user, $newdirectory)
873:
874: Performs phase 2 processing of directory creation. This involves creating the directory and
875: reporting the results of that creation to the user.
876:
877: Parameters:
878: =over 4
879:
880: =item $request - Apache request object [in]. Object representing the current HTTP request.
881:
882: =item $user - string [in] The name of the user that is initiating the request.
883:
884: =item $newdirectory - string [in] The full path of the directory being created.
885:
886: =back
887:
888: Returns 0 - failure 1 - success.
889:
890: =cut
891:
892: sub NewDir2 {
893: my ($request, $user, $newdirectory) = @_;
894:
895: unless(mkdir($newdirectory, 02770)) {
896: $request->print('<font color=red>Error: '.$!.'</font>');
897: return 0;
898: }
899: unless(chmod(02770, ($newdirectory))) {
900: $request->print('<font color=red> Error: '.$!.'</font>');
901: return 0;
902: }
903: return 1;
904: }
905:
906: =pod
907:
908: =item phasetwo($r, $fn, $uname, $udom)
909:
910: Controls the phase 2 processing of file management
911: requests for construction space. In phase one, the user
912: was asked to confirm the operation. In phase 2, the operation
913: is performed and the result is shown.
914:
915: The strategy is to break out the processing into specific action processors
916: named action2 where action is the requested action and the 2 denotes
917: phase 2 processing.
918:
919: Parameters:
920:
921: =over 4
922:
923: =item $r - Apache Request object [in] The request object for this httpd
924: transaction.
925:
926: =item $fn - string [in] A filename indicating the object that is being
927: manipulated.
928:
929: =item $uname - string [in] The name of the user initiating the file management
930: request.
931:
932: =item $udom - string [in] The login domain of the user initiating the
933: file management request.
934: =back
935:
936: =cut
937:
938: sub phasetwo {
939: my ($r,$fn,$uname,$udom)=@_;
940:
941: &Debug($r, "loncfile - Entering phase 2 for $fn");
942:
943: # Break down the file into it's component pieces.
944:
945: $fn=~/(.*)\/([^\/]+)\.(\w+)$/;
946: my $dir=$1; # Directory path
947: my $main=$2; # Filename.
948: my $suffix=$3; # Extension.
949:
950: my $dest; # On success this is where we'll go.
951:
952: &Debug($r,
953: "loncfile::phase2 dir = $dir main = $main suffix = $suffix");
954: &Debug($r,
955: " newfilename = ".$ENV{'form.newfilename'});
956:
957: my $conspace=$fn;
958:
959: &Debug($r,
960: "loncfile::phase2 Full construction space name: $conspace");
961:
962: &Debug($r,
963: "loncfie::phase2 action is $ENV{'form.action'}");
964:
965: # Select the appropriate processing sub.
966:
967: if ($ENV{'form.action'} eq 'rename') { # Rename.
968: if($ENV{'form.newfilename'}) {
969: if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
970: return;
971: }
972: # Prepend the directory to the new name to form the basis of the
973: # url of the new resource.
974: #
975: $dest = $dir."/".$ENV{'form.newfilename'};
976: }
977: } elsif ($ENV{'form.action'} eq 'delete') {
978: if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) {
979: return ;
980: }
981: # Once a resource is deleted, we just list the directory that
982: # previously held it.
983: #
984: $dest = $dir."/"; # Parent dir.
985: } elsif ($ENV{'form.action'} eq 'copy') {
986: if($ENV{'form.newfilename'}) {
987: if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
988: return
989: }
990: $dest = $ENV{'form.newfilename'};
991:
992: } else {
993: $r->print('<p>No New filename specified</form>');
994: return;
995: }
996:
997: } elsif ($ENV{'form.action'} eq 'newdir') {
998: #
999: # Since the newfilename form field is construction space
1000: # relative, ew need to prepend the current path; now in $fn.
1001: #
1002: my $newdir= $fn.$ENV{'form.newfilename'};
1003: if(!&NewDir2($r, $uname, $newdir)) {
1004: return;
1005: }
1006: $dest = $newdir."/"
1007: }
1008: #
1009: # Substitute for priv for the first home in $dir to get our
1010: # construction space path.
1011: #
1012: &Debug($r, "Final url is: $dest");
1013: $dest =~ s/\/home\//\/priv\//;
1014: $dest =~ s/\/public_html//;
1015: &Debug($r, "Final url after rewrite: $dest");
1016:
1017: $r->print('<h3><a href="'.$dest.'">Done</a></h3>');
1018: }
1019:
1020: sub handler {
1021:
1022: $r=shift;
1023:
1024:
1025: &Debug($r, "loncfile.pm - handler entered");
1026: &Debug($r, " filename: ".$ENV{'form.filename'});
1027: &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
1028:
1029: my $fn;
1030:
1031: if ($ENV{'form.filename'}) {
1032: $fn=$ENV{'form.filename'};
1033: &Debug($r, "loncfile::handler - raw url: $fn");
1034: # $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
1035: # $fn=~s/^http\:\/\/[^\/]+//;
1036: $fn=URLToPath($fn);
1037: &Debug($r, "loncfile::handler - doctored url: $fn");
1038:
1039: } else {
1040: &Debug($r, "loncfile::handler - no form.filename");
1041: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
1042: ' unspecified filename for cfile', $r->filename);
1043: return HTTP_NOT_FOUND;
1044: }
1045:
1046: unless ($fn) {
1047: &Debug($r, "loncfile::handler - doctored url is empty");
1048: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
1049: ' trying to cfile non-existing file', $r->filename);
1050: return HTTP_NOT_FOUND;
1051: }
1052:
1053: # ----------------------------------------------------------- Start page output
1054: my $uname;
1055: my $udom;
1056:
1057: ($uname,$udom)=
1058: &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
1059: &Debug($r,
1060: "loncfile::handler constructaccess uname = $uname domain = $udom");
1061: unless (($uname) && ($udom)) {
1062: $r->log_reason($uname.' at '.$udom.
1063: ' trying to manipulate file '.$ENV{'form.filename'}.
1064: ' ('.$fn.') - not authorized',
1065: $r->filename);
1066: return HTTP_NOT_ACCEPTABLE;
1067: }
1068:
1069: $fn=~s/\/\~(\w+)//;
1070: &Debug($r, "loncfile::handler ~ removed filename: $fn");
1071:
1072: $r->content_type('text/html');
1073: $r->send_http_header;
1074:
1075: $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
1076:
1077: $r->print(
1078: '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
1079:
1080:
1081: $r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>');
1082:
1083: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
1084: $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
1085: '</font></h3>');
1086: }
1087:
1088:
1089: &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} ");
1090: if ($ENV{'form.action'} eq 'delete') {
1091:
1092: $r->print('<h3>Delete</h3>');
1093: } elsif ($ENV{'form.action'} eq 'rename') {
1094: $r->print('<h3>Rename</h3>');
1095: } elsif ($ENV{'form.action'} eq 'newdir') {
1096: $r->print('<h3>New Directory</h3>');
1097: } elsif ($ENV{'form.action'} eq 'copy') {
1098: $r->print('<h3>Copy</h3>');
1099: } else {
1100: $r->print('<p>Unknown Action</body></html>');
1101: return OK;
1102: }
1103: if ($ENV{'form.phase'} eq 'two') {
1104: &Debug($r, "loncfile::handler entering phase2");
1105: &phasetwo($r,$fn,$uname,$udom);
1106: } else {
1107: &Debug($r, "loncfile::handler entering phase1");
1108: &phaseone($r,$fn,$uname,$udom);
1109: }
1110:
1111: $r->print('</body></html>');
1112: return OK;
1113: }
1114:
1115: 1;
1116: __END__
1117:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncfile.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher