Parent Directory
| 
Revision Log
Experimental xmlrpc WeBWorK webservices
1 #!/usr/bin/perl -w 2 3 use strict; 4 5 =head2 Private functions (not methods) used by PGtranslator for file IO. 6 7 8 9 =cut 10 11 my $REMOTE_HOST = (defined( $ENV{'REMOTE_HOST'} ) ) ? $ENV{'REMOTE_HOST'}: 'unknown host'; 12 my $REMOTE_ADDR = (defined( $ENV{'REMOTE_ADDR'}) ) ? $ENV{'REMOTE_ADDR'}: 'unknown address'; 13 14 15 =head2 includePGtext 16 17 includePGtext($string_ref, $envir_ref) 18 19 Calls C<createPGtext> recursively with the $safeCompartment variable set to 0 20 so that the rendering continues in the current safe compartment. The output 21 is the same as the output from createPGtext. This is used in processing 22 some of the sample CAPA files. 23 24 =cut 25 26 27 sub includePGtext { 28 my $evalString = shift; 29 if (ref($evalString) eq 'SCALAR') { 30 $evalString = $$evalString; 31 } 32 $evalString =~ s/\nBEGIN_TEXT/TEXT\(EV3\(<<'END_TEXT'\)\);/g; 33 $evalString =~ s/\\/\\\\/g; # \ can't be used for escapes because of TeX conflict 34 $evalString =~ s/~~/\\/g; # use ~~ as escape instead, use # for comments 35 no strict; 36 eval("package main; $evalString") ; 37 my $errors = $@; 38 die eval(q! "ERROR in included file:\n$main::envir{probFileName}\n $errors\n"!) if $errors; 39 use strict; 40 ''; 41 } 42 43 44 45 =head2 send_mail_to 46 47 send_mail_to($user_address,'subject'=>$subject,'body'=>$body) 48 49 Returns: 1 if the address is ok, otherwise a fatal error is signaled using wwerror. 50 51 Sends $body to the address specified by $user_address provided that 52 the address appears in C<@{$Global::PG_environment{'ALLOW_MAIL_TO'}}>. 53 54 This subroutine is likely to be fragile and to require tweaking when installed 55 in a new environment. It uses the unix application C<sendmail>. 56 57 =cut 58 59 60 sub send_mail_to { 61 my $user_address = shift; # user must be an instructor 62 my %options = @_; 63 my $subject = ''; 64 $subject = $options{'subject'} if defined($options{'subject'}); 65 my $msg_body = ''; 66 $msg_body =$options{'body'} if defined($options{'body'}); 67 my @mail_to_allowed_list = (); 68 @mail_to_allowed_list = @{ $options{'ALLOW_MAIL_TO'} } if defined($options{'ALLOW_MAIL_TO'}); 69 my $out; 70 71 # check whether user is an instructor 72 my $mailing_allowed_flag =0; 73 74 75 while (@mail_to_allowed_list) { 76 if ($user_address eq shift @mail_to_allowed_list ) { 77 $mailing_allowed_flag =1; 78 last; 79 } 80 } 81 if ($mailing_allowed_flag) { 82 ## mail header text: 83 my $email_msg ="To: $user_address\n" . 84 "X-Remote-Host: $REMOTE_HOST($REMOTE_ADDR)\n" . 85 "Subject: $subject\n\n" . $msg_body; 86 my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>10) || 87 warn "Couldn't contact SMTP server."; 88 $smtp->mail($Global::webmaster); 89 90 if ( $smtp->recipient($user_address)) { # this one's okay, keep going 91 $smtp->data( $email_msg) || 92 warn("Unknown problem sending message data to SMTP server."); 93 } else { # we have a problem a problem with this address 94 $smtp->reset; 95 warn "SMTP server doesn't like this address: <$user_address>."; 96 } 97 $smtp->quit; 98 99 } else { 100 101 Global::wwerror("$0","There has been an error in creating this problem.\n" . 102 "Please notify your instructor.\n\n" . 103 "Mail is not permitted to address $user_address.\n" . 104 "Permitted addresses are specified in the courseWeBWorK.ph file.", 105 "","",""); 106 $out = 0; 107 } 108 109 $out; 110 111 } 112 # only files are loaded first from the macroDirectory and then from the courseScriptsDirectory 113 # files cannot be loaded from other directories. 114 115 116 117 118 # 119 # # these have been copied over from FILE.pl. I don't know if they need to be duplicated or not. 120 # ## these call backs come from PGchoice -- mostly from within the alias command. 121 # 122 123 =head2 read_whole_problem_file 124 125 read_whole_problem_file($filePath); 126 127 Returns: A reference to a string containing 128 the contents of the file. 129 130 Don't use for huge files. The file name will have .pg appended to it if it doesn't 131 already end in .pg. Files may become double spaced.? Check the join below. This is 132 used in importing additional .pg files as is done in the 133 sample problems translated from CAPA. 134 135 =cut 136 137 138 sub read_whole_problem_file { 139 my $filePath = shift; 140 $filePath =~s/^\s*//; # get rid of initial spaces 141 $filePath =~s/\s*$//; # get rid of final spaces 142 $filePath = "$filePath.pg" unless $filePath =~ /\.pg$/; 143 read_whole_file($filePath); 144 } 145 146 sub read_whole_file { 147 my $filePath = shift; 148 local (*INPUT); 149 open(INPUT, "<$filePath")|| die "$0: readWholeProblemFile subroutine: <BR>Can't read file $filePath"; 150 local($/)=undef; 151 my $string = <INPUT>; # can't append spaces because this causes trouble with <<'EOF' \nEOF construction 152 close(INPUT); 153 \$string; 154 } 155 156 157 =head2 convertPath 158 159 $path = convertPath($path); 160 161 Normalizes the delimiters in the path using delimiter from C<&getDirDelim()> 162 which is defined in C<Global.pm>. 163 164 =cut 165 166 ## converts full path names to to use the $dirDelim instead of / 167 168 sub convertPath { 169 &Global::convertPath; 170 } 171 172 # hacks to make this program work independent of Global.pm 173 sub getDirDelim { 174 return ("/"); 175 } 176 sub getCourseTempDirectory { 177 return ($Global::courseTempDirectory); 178 } 179 180 =head2 surePathToTmpFile 181 182 surePathToTmpFile($path) 183 Returns: $path 184 185 Defined in FILE.pl 186 187 Creates all of the subdirectories between the directory specified 188 by C<&getCourseTempDirectory> and the address of the path. 189 190 Uses 191 192 &createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) 193 194 The path may begin with the correct path to the temporary 195 directory. Any other prefix causes a path relative to the temporary 196 directory to be created. 197 198 The quality of the error checking could be improved. :-) 199 200 =cut 201 202 # A very useful macro for making sure that all of the directories to a file have been constructed. 203 204 sub surePathToTmpFile { # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/ 205 # the input path must be either the full path, or the path relative to this tmp sub directory 206 my $path = shift; 207 my $delim = &getDirDelim(); 208 my $tmpDirectory = getCourseTempDirectory(); 209 # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment 210 $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|; 211 $path = convertPath($path); 212 # find the nodes on the given path 213 my @nodes = split("$delim",$path); 214 # create new path 215 $path = convertPath("$tmpDirectory"); 216 217 while (@nodes>1 ) { 218 $path = convertPath($path . shift (@nodes) ."/"); 219 unless (-e $path) { 220 # system("mkdir $path"); 221 createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) || 222 Global::wwerror($0, "Failed to create directory $path","","",""); 223 224 } 225 226 } 227 $path = convertPath($path . shift(@nodes)); 228 229 # system(qq!echo "" > $path! ); 230 231 $path; 232 233 } 234 235 236 =head2 fileFromPath 237 238 $fileName = fileFromPath($path) 239 240 Defined in C<FILE.pl>. 241 242 Uses C<&getDirDelim()> to determine the path delimiter. Returns the last segment 243 of the path (after the last delimiter.) 244 245 =cut 246 247 sub fileFromPath { 248 my $path = shift; 249 my $delim =&getDirDelim(); 250 $path = convertPath($path); 251 $path =~ m|([^$delim]+)$|; 252 $1; 253 254 } 255 256 =head2 directoryFromPath 257 258 259 $directoryPath = directoryFromPath($path) 260 261 Defined in C<FILE.pl>. 262 263 Uses C<&getDirDelim()> to determine the path delimiter. Returns the initial segments 264 of the of the path (up to the last delimiter.) 265 266 =cut 267 268 sub directoryFromPath { 269 my $path = shift; 270 my $delim =&getDirDelim(); 271 $path = convertPath($path); 272 $path =~ s|[^$delim]*$||; 273 $path; 274 } 275 276 =head2 createFile 277 278 createFile($filePath); 279 280 Calls C<FILE.pl> version of createFile with 281 C<createFile($filePath,0660(permission),$Global::numericalGroupID)> 282 283 =cut 284 285 sub createFile { 286 my ($fileName, $permission, $numgid) = @_; 287 open(TEMPCREATEFILE, ">$fileName") || 288 Global::wwerror("File.pl: createFile error", " Can't open $fileName"); 289 my @stat = stat TEMPCREATEFILE; 290 close(TEMPCREATEFILE); 291 292 ## if the owner of the file is running this script (e.g. when the file is first created) 293 ## set the permissions and group correctly 294 if ($< == $stat[4]) { 295 my $tmp = chmod($permission,$fileName) or 296 warn("File.pl: createFile error", " Can't do chmod($permission, $fileName)"); 297 chown(-1,$numgid,$fileName) or 298 warn("File.pl: createFile error", " Can't do chown($numgid, $fileName)"); 299 } 300 } 301 302 sub createDirectory 303 { 304 my ($dirName, $permission, $numgid) = @_; 305 mkdir($dirName, $permission) or 306 warn("$0: createDirectory error", " Can't do mkdir($dirName, $permission)"); 307 chmod($permission, $dirName) or 308 warn("$0: createDirectory error", " Can't do chmod($permission, $dirName)"); 309 unless ($numgid == -1) {chown(-1,$numgid,$dirName) or 310 warn("$0: createDirectory error", " Can't do chown(-1,$numgid,$dirName)");} 311 } 312 313
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |