[system] / trunk / xmlrpc / daemon / IOglue.pl Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/daemon/IOglue.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (view) (download) (as text)

1 : gage 279 #!/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