[system] / trunk / pg / macros / IO.pl Repository:
ViewVC logotype

Annotation of /trunk/pg/macros/IO.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 1050 ################################################################################
2 :     # WeBWorK mod-perl (c) 2000-2002 WeBWorK Project
3 :     # $Id$
4 :     ################################################################################
5 :    
6 :     =head1 NAME
7 :    
8 :     IO.pl - Temporary location for IO functions that need access to the problem
9 :     environment. Formerly defined in IO.pm
10 :    
11 :     See notes in Translator.pm
12 :    
13 :     =cut
14 :    
15 :     sub _IO_init {}
16 :     sub _IO_export {
17 :     return (
18 :     '&send_mail_to',
19 :     '&getCourseTempDirectory',
20 :     '&surePathToTmpFile',
21 :     );
22 :     }
23 :    
24 :     # send_mail_to($user_address,'subject'=>$subject,'body'=>$body)
25 :     sub send_mail_to {
26 :     my $user_address = shift; # user must be an instructor
27 :     my %options = @_;
28 :     my $subject = '';
29 :     my $msg_body = '';
30 :     my @mail_to_allowed_list = ();
31 :     my $out;
32 :    
33 :     my $server = $envir{mailSmtpServer};
34 :     my $sender = $envir{mailSmtpSender};
35 :    
36 :     $subject = $options{'subject'} if defined $options{'subject'};
37 :     $msg_body =$options{'body'} if defined $options{'body'};
38 :     @mail_to_allowed_list = @{ $options{'ALLOW_MAIL_TO'} }
39 :     if defined $options{'ALLOW_MAIL_TO'};
40 :    
41 :     # check whether user is an instructor
42 :     my $mailing_allowed_flag = 0;
43 :    
44 :     while (@mail_to_allowed_list) {
45 :     if ($user_address eq shift @mail_to_allowed_list ) {
46 :     $mailing_allowed_flag = 1;
47 :     last;
48 :     }
49 :     }
50 :    
51 :     if ($mailing_allowed_flag) {
52 :     my $email_msg = "To: $user_address\n"
53 :     . "X-Remote-Host: $REMOTE_HOST($REMOTE_ADDR)\n"
54 :     . "Subject: $subject\n"
55 :     . "\n"
56 :     . $msg_body;
57 :     my $smtp = Net::SMTP->new($server, Timeout=>10)
58 :     or warn "Couldn't contact SMTP server.";
59 :     $smtp->mail($sender);
60 :    
61 :     if ( $smtp->recipient($user_address)) {
62 :     # this one's okay, keep going
63 :     $smtp->data( $email_msg)
64 :     or warn "Unknown problem sending message data to SMTP server.";
65 :     } else {
66 :     # we have a problem a problem with this address
67 :     $smtp->reset;
68 :     warn "SMTP server doesn't like this address: <$user_address>.";
69 :     }
70 :     $smtp->quit;
71 :     } else {
72 :     die "There has been an error in creating this problem.\n"
73 :     . "Please notify your instructor.\n\n"
74 :     . "Mail is not permitted to address $user_address.\n"
75 :     . "Permitted addresses are specified in the courseWeBWorK.ph file.";
76 :     $out = 0;
77 :     }
78 :    
79 :     return $out;
80 :     }
81 :    
82 :     sub getCourseTempDirectory {
83 :     return $envir{tempDirectory};
84 :     }
85 :    
86 :     =head2 surePathToTmpFile
87 :    
88 :     surePathToTmpFile($path)
89 :     Returns: $path
90 :    
91 :     Defined in FILE.pl
92 :    
93 :     Creates all of the subdirectories between the directory specified
94 :     by C<&getCourseTempDirectory> and the address of the path.
95 :    
96 :     Uses
97 :    
98 :     &createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
99 :    
100 :     The path may begin with the correct path to the temporary
101 :     directory. Any other prefix causes a path relative to the temporary
102 :     directory to be created.
103 :    
104 :     The quality of the error checking could be improved. :-)
105 :    
106 :     =cut
107 :    
108 :     # A very useful macro for making sure that all of the directories to a file have been constructed.
109 :    
110 :     sub surePathToTmpFile {
111 :     # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
112 :     # the input path must be either the full path, or the path relative to this tmp sub directory
113 :    
114 :     my $path = shift;
115 :     my $delim = "/"; #&getDirDelim();
116 :     my $tmpDirectory = getCourseTempDirectory();
117 :    
118 :     # use the permissions/group on the temp directory itself as a template
119 :     my ($perms, $groupID) = (stat $tmpDirectory)[2,5];
120 :     #warn "&urePathToTmpFile: perms=$perms groupID=$groupID\n";
121 :    
122 :     # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
123 :     $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
124 :     #$path = convertPath($path);
125 :    
126 :     # find the nodes on the given path
127 :     my @nodes = split("$delim",$path);
128 :    
129 :     # create new path
130 :     $path = $tmpDirectory; #convertPath("$tmpDirectory");
131 :    
132 :     while (@nodes>1) {
133 :     $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/");
134 :     unless (-e $path) {
135 :     #system("mkdir $path");
136 :     #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
137 :     createDirectory($path, $perms, $groupID)
138 :     or Global::wwerror($0, "Failed to create directory $path","","","");
139 :     }
140 :    
141 :     }
142 :    
143 :     $path = $path . shift(@nodes); #convertPath($path . shift(@nodes));
144 :     #system(qq!echo "" > $path! );
145 :     return $path;
146 :     }
147 :    
148 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9