[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 4998 - (download) (as text) (annotate)
Tue Jun 12 01:00:10 2007 UTC (12 years, 5 months ago) by gage
File size: 4623 byte(s)
testing -- added a space.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9