[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 5568 - (download) (as text) (annotate)
Thu Oct 25 17:11:59 2007 UTC (12 years, 4 months ago) by sh002i
File size: 5640 byte(s)
new/improved documentation

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9