Parent Directory
| 
Revision Log
Revision 404 - (view) (download) (as text)
| 1 : | sh002i | 404 | 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 |