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