| 1 | ################################################################################ |
1 | ################################################################################ |
| 2 | # WeBWorK Online Homework Delivery System |
2 | # WeBWorK Online Homework Delivery System |
| 3 | # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ |
3 | # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ |
| 4 | # $CVSHeader: pg/lib/PGcore.pm,v 1.2 2010/05/14 12:31:19 gage Exp $ |
4 | # $CVSHeader: pg/lib/PGcore.pm,v 1.3 2010/05/14 16:48:21 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. |
| … | |
… | |
| 25 | use PGanswergroup; |
25 | use PGanswergroup; |
| 26 | use PGresponsegroup; |
26 | use PGresponsegroup; |
| 27 | use PGrandom; |
27 | use PGrandom; |
| 28 | use PGalias; |
28 | use PGalias; |
| 29 | use PGloadfiles; |
29 | use PGloadfiles; |
| 30 | use WeBWorK::PG::IO; |
30 | use WeBWorK::PG::IO(); # don't important any command directly |
| 31 | use Tie::IxHash; |
31 | use Tie::IxHash; |
| 32 | |
32 | |
| 33 | ################################## |
33 | ################################## |
| 34 | # Utility macro |
34 | # Utility macro |
| 35 | ################################## |
35 | ################################## |
| … | |
… | |
| 666 | |
666 | |
| 667 | my $self = shift; |
667 | my $self = shift; |
| 668 | my $path = shift; |
668 | my $path = shift; |
| 669 | my $delim = "/"; |
669 | my $delim = "/"; |
| 670 | my $tmpDirectory = $self->tempDirectory(); |
670 | my $tmpDirectory = $self->tempDirectory(); |
|
|
671 | #warn "\nTMP tmpDirectory $tmpDirectory"; |
| 671 | unless ( -e $tmpDirectory) { # if by some unlucky chance the tmpDirectory hasn't been created, create it. |
672 | unless ( -e $tmpDirectory) { # if by some unlucky chance the tmpDirectory hasn't been created, create it. |
| 672 | my $parentDirectory = $tmpDirectory; |
673 | my $parentDirectory = $tmpDirectory; |
| 673 | $parentDirectory =~s|/$||; # remove a trailing / |
674 | $parentDirectory =~s|/$||; # remove a trailing / |
| 674 | $parentDirectory =~s|/\w*$||; # remove last node |
675 | $parentDirectory =~s|/\w*$||; # remove last node |
| 675 | my ($perms, $groupID) = (stat $parentDirectory)[2,5]; |
676 | my ($perms, $groupID) = (stat $parentDirectory)[2,5]; |
|
|
677 | #FIXME where is the parentDirectory defined?? |
|
|
678 | #warn "Creating tmp directory at $tmpDirectory, perms $perms groupID $groupID"; |
| 676 | createDirectory($tmpDirectory, $perms, $groupID) |
679 | $self->createDirectory($tmpDirectory, $perms, $groupID) |
| 677 | or warn "Failed to create directory at $path"; |
680 | or warn "Failed to create parent tmp directory at $path"; |
| 678 | |
681 | |
| 679 | } |
682 | } |
| 680 | # use the permissions/group on the temp directory itself as a template |
683 | # use the permissions/group on the temp directory itself as a template |
| 681 | my ($perms, $groupID) = (stat $tmpDirectory)[2,5]; |
684 | my ($perms, $groupID) = (stat $tmpDirectory)[2,5]; |
| 682 | #warn "&urePathToTmpFile: perms=$perms groupID=$groupID\n"; |
685 | #warn "&urePathToTmpFile: directory=$tmpDirectory, perms=$perms, groupID=$groupID\n"; |
| 683 | |
686 | |
| 684 | # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment |
687 | # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment |
| 685 | $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|; |
688 | $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|; |
| 686 | #$path = convertPath($path); |
689 | #$path = $self->convertPath($path); |
| 687 | |
690 | |
| 688 | # find the nodes on the given path |
691 | # find the nodes on the given path |
| 689 | my @nodes = split("$delim",$path); |
692 | my @nodes = split("$delim",$path); |
| 690 | |
693 | |
| 691 | # create new path |
694 | # create new path |
| 692 | $path = $tmpDirectory; #convertPath("$tmpDirectory"); |
695 | $path = $tmpDirectory; #convertPath("$tmpDirectory"); |
| 693 | |
696 | |
| 694 | while (@nodes>1) { |
697 | while (@nodes>1) { |
| 695 | $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/"); |
698 | $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/"); |
|
|
699 | #warn "\PATH is now $path"; |
| 696 | unless (-e $path) { |
700 | unless (-e $path) { |
| 697 | #system("mkdir $path"); |
701 | #system("mkdir $path"); |
| 698 | #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) |
702 | #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) |
|
|
703 | #warn "PATH $path perms $perms groupID $groupID"; |
| 699 | createDirectory($path, $perms, $groupID) |
704 | $self->createDirectory($path, $perms, $groupID) |
| 700 | or warn "Failed to create directory at $path"; |
705 | or warn "Failed to create directory at $path with permissions $perms and groupID $groupID"; |
| 701 | } |
706 | } |
| 702 | |
707 | |
| 703 | } |
708 | } |
| 704 | |
709 | |
| 705 | $path = $path . shift(@nodes); #convertPath($path . shift(@nodes)); |
710 | $path = $path . shift(@nodes); #convertPath($path . shift(@nodes)); |