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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6058 - (download) (as text) (annotate)
Thu Jun 25 23:28:44 2009 UTC (10 years, 6 months ago) by gage
File size: 5921 byte(s)
syncing pg HEAD with pg2.4.7 on 6/25/2009

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 =head1 NAME
   18 
   19 IO.pl - Input/optput macros that require access to the problem environment.
   20 
   21 =head1 DESCRIPTION
   22 
   23 See notes in L<WeBWorK::PG::Translator>.
   24 
   25 =cut
   26 
   27 # ^function _IO_init
   28 sub _IO_init {}
   29 
   30 # ^function _IO_export
   31 sub _IO_export {
   32   return (
   33     '&send_mail_to',
   34     '&getCourseTempDirectory',
   35     '&surePathToTmpFile',
   36   );
   37 }
   38 
   39 =head1 MACROS
   40 
   41 =head2 [DEPRECATED] send_mail_to
   42 
   43   send_mail_to($address, subject=>$subject, body=>$body)
   44 
   45 Send an email message with the subject $subject and body $body to the address
   46 $address. This used to be used by mail_answers_to in PGbasicmacros.pl, but it no
   47 longer is. Don't use this, I tell yah!
   48 
   49 =cut
   50 
   51 # send_mail_to($user_address,'subject'=>$subject,'body'=>$body)
   52 # ^function send_mail_to
   53 # ^uses $envir{mailSmtpServer}
   54 # ^uses $envir{mailSmtpSender}
   55 # ^uses $REMOTE_HOST
   56 # ^uses $REMOTE_ADDR
   57 # ^uses Net::SMTP::new
   58 sub send_mail_to {
   59   my $user_address = shift; # user must be an instructor
   60   my %options = @_;
   61   my $subject = '';
   62   my $msg_body = '';
   63   my @mail_to_allowed_list = ();
   64   my $out;
   65 
   66   my $server = $envir{mailSmtpServer};
   67   my $sender = $envir{mailSmtpSender};
   68 
   69   $subject = $options{'subject'} if defined $options{'subject'};
   70   $msg_body =$options{'body'} if defined $options{'body'};
   71   @mail_to_allowed_list = @{ $options{'ALLOW_MAIL_TO'} }
   72     if defined $options{'ALLOW_MAIL_TO'};
   73 
   74   # check whether user is an instructor
   75   my $mailing_allowed_flag = 0;
   76 
   77   while (@mail_to_allowed_list) {
   78     if ($user_address eq shift @mail_to_allowed_list ) {
   79       $mailing_allowed_flag = 1;
   80       last;
   81     }
   82   }
   83 
   84   if ($mailing_allowed_flag) {
   85     my  $email_msg = "To: $user_address\n"
   86       . "X-Remote-Host: $REMOTE_HOST($REMOTE_ADDR)\n"
   87       . "Subject: $subject\n"
   88       . "\n"
   89       . $msg_body;
   90     my $smtp = Net::SMTP->new($server, Timeout=>10)
   91       or warn "Couldn't contact SMTP server.";
   92     $smtp->mail($sender);
   93 
   94     if ( $smtp->recipient($user_address)) {
   95       # this one's okay, keep going
   96       $smtp->data( $email_msg)
   97         or warn "Unknown problem sending message data to SMTP server.";
   98     } else {
   99       # we have a problem a problem with this address
  100       $smtp->reset;
  101       warn "SMTP server doesn't like this address: <$user_address>.";
  102     }
  103     $smtp->quit;
  104   } else {
  105     die "There has been an error in creating this problem.\n"
  106       . "Please notify your instructor.\n\n"
  107       . "Mail is not permitted to address $user_address.\n"
  108       . "Permitted addresses are specified in global.conf or course.conf.";
  109     $out = 0;
  110   }
  111 
  112   return $out;
  113 }
  114 
  115 =head2 getCourseTempDirectory
  116 
  117   $path = getCourseTempDirectory()
  118 
  119 Returns the path to the current course's temporary directory.
  120 
  121 =cut
  122 
  123 # ^function getCourseTempDirectory
  124 # ^uses $envir{tempDirectory}
  125 sub getCourseTempDirectory {
  126   return $envir{tempDirectory};
  127 }
  128 
  129 =head2 surePathToTmpFile
  130 
  131   $path = surePathToTmpFile($path);
  132 
  133 Creates all of the intermediate directories between the directory specified by
  134 getCourseTempDirectory() and file specified in $path.
  135 
  136 If $path begins with the path returned by getCourseTempDirectory(), then the
  137 path is treated as absolute. Otherwise, the path is treated as relative the the
  138 course temp directory.
  139 
  140 =cut
  141 
  142 # A very useful macro for making sure that all of the directories to a file have been constructed.
  143 
  144 # ^function surePathToTmpFile
  145 # ^uses getCourseTempDirectory
  146 # ^uses createDirectory
  147 sub surePathToTmpFile {
  148   # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
  149   # the input path must be either the full path, or the path relative to this tmp sub directory
  150 
  151   my $path = shift;
  152   my $delim = "/"; #&getDirDelim();
  153   my $tmpDirectory = getCourseTempDirectory();
  154   unless ( -e $tmpDirectory) {   # if by some unlucky chance the tmpDirectory hasn't been created, create it.
  155       my $parentDirectory =  $tmpDirectory;
  156       $parentDirectory =~s|/$||;  # remove a trailing /
  157       $parentDirectory =~s|/\w*$||; # remove last node
  158       my ($perms, $groupID) = (stat $parentDirectory)[2,5];
  159     createDirectory($tmpDirectory, $perms, $groupID)
  160         or warn "Failed to create directory at $path";
  161 
  162   }
  163   # use the permissions/group on the temp directory itself as a template
  164   my ($perms, $groupID) = (stat $tmpDirectory)[2,5];
  165   #warn "&urePathToTmpFile: perms=$perms groupID=$groupID\n";
  166 
  167   # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
  168   $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
  169   #$path = convertPath($path);
  170 
  171   # find the nodes on the given path
  172         my @nodes = split("$delim",$path);
  173 
  174   # create new path
  175   $path = $tmpDirectory; #convertPath("$tmpDirectory");
  176 
  177   while (@nodes>1) {
  178     $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/");
  179     unless (-e $path) {
  180       #system("mkdir $path");
  181       #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
  182       createDirectory($path, $perms, $groupID)
  183         or warn "Failed to create directory at $path";
  184     }
  185 
  186   }
  187 
  188   $path = $path . shift(@nodes); #convertPath($path . shift(@nodes));
  189   #system(qq!echo "" > $path! );
  190   return $path;
  191 }
  192 
  193 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9