[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 5000 - (download) (as text) (annotate)
Tue Jun 12 01:02:05 2007 UTC (12 years, 8 months ago) by gage
File size: 4622 byte(s)
done testing

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9