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