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