[LON-CAPA-cvs] cvs: modules /msu coursecreator.pl
raeburn
lon-capa-cvs@mail.lon-capa.org
Mon, 11 Jul 2005 20:23:10 -0000
This is a MIME encoded message
--raeburn1121113390
Content-Type: text/plain
raeburn Mon Jul 11 16:23:10 2005 EDT
Modified files:
/modules/msu coursecreator.pl
Log:
Add routines to modify course request status on zaphod, after courses successfully created. Other minor bug fixes.:
--raeburn1121113390
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20050711162310.txt"
Index: modules/msu/coursecreator.pl
diff -u modules/msu/coursecreator.pl:1.1 modules/msu/coursecreator.pl:1.2
--- modules/msu/coursecreator.pl:1.1 Wed Apr 27 17:36:57 2005
+++ modules/msu/coursecreator.pl Mon Jul 11 16:23:07 2005
@@ -13,7 +13,7 @@
# course requests in
# /home/httpd/perl/tmp/addcourse/msu/auto/pending
#
-# To be run as a cron process owned by root or www.
+# To be run as a cron process owned by www.
#
# Supply username and domain of a Domain Coordinator
# in the msu domain.
@@ -33,7 +33,7 @@
use Apache::lonnet;
my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
- my $defdom = $$perlvarref{'DefDomain'};
+ my $defdom = $$perlvarref{'lonDefDomain'};
my $url = "http://zaphod.lite.msu.edu/cgi-bin/autocreation.pl";
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new(GET => $url);
@@ -52,61 +52,69 @@
open (my $fh,">>$logfile");
if ($res->is_success) {
- my $timestamp = time;
- my $path = "addcourse/$defdom/auto/pending";
- my $dirpath = "$$perlvarref{'lonDaemons'}/tmp";
- my @dirs = split/\//,$path;
- while (@dirs > 0) {
- $dirpath .= '/'.$dirs[0];
- if (!-e $dirpath) {
- mkdir($dirpath,0755);
+ my $result = $res->content;
+ chomp $result;
+ unless ($result eq '') {
+ my $timestamp = time;
+ my $path = "addcourse/$defdom/auto/pending";
+ my $dirpath = "$$perlvarref{'lonDaemons'}/tmp";
+ my @dirs = split/\//,$path;
+ while (@dirs > 0) {
+ $dirpath .= '/'.$dirs[0];
+ if (!-e $dirpath) {
+ mkdir($dirpath,0755);
+ }
+ shift @dirs;
}
- shift @dirs;
- }
- open(FILE,">$dirpath/$timestamp");
- print FILE $res->content;
- unless ($res->content eq '') {
- open(PIPE, "$$perlvarref{'lonDaemons'}/Autocreate.pl $defdom $dc_uname:$dc_dom |");
+ open(FILE,">$dirpath/$timestamp");
+ print FILE $res->content;
+ close(FILE);
+ open(PIPE, "$$perlvarref{'lonDaemons'}/Autocreate.pl $defdom $dc_uname:$dc_dom |");
my $courseid_str = <PIPE>;
close(PIPE);
-
- $courseid_str =~ s/:$//;
my @courses = split/:/,$courseid_str;
- foreach my $courseid (@courses) {
- my($cdom,$cnum) = ($courseid =~ /^([^_]+)_(\w+)$/);
+ foreach my $courseitem (@courses) {
+ $courseitem = &Apache::lonnet::unescape($courseitem);
+ my ($courseid,$classid) = split/:/,$courseitem;
+ my ($cdom,$cnum) = ($courseid =~ m-^/([^/]+)/([^/]+)$-);
if ($cdom && $cnum) {
+ $coursedata{$courseid}{class} = $classid;
my %settings = &Apache::lonnet::dump('environment',$cdom,$cnum);
- my $owner = $settings{'internal.owner'};
+ my $owner = $settings{'internal.courseowner'};
+ $coursedata{$courseid}{owner} = $owner;
$coursedata{$courseid}{title} = $settings{'description'};
- $coursedata{$courseid}{sections} = $settings{'internal.sections'};
+ $coursedata{$courseid}{sections} = $settings{'internal.sectionnums'};
$coursedata{$courseid}{coursecode} = $settings{'internal.coursecode'};
- if (exists($newcourses{$owner})) {
- push(@{$newcourses{$owner}},$courseid);
- } else {
- @{$newcourses{$owner}} = ($courseid);
+ unless (exists($newcourses{$owner})) {
$newowners ++;
}
+ push(@{$newcourses{$owner}},$courseid);
+ $newowners ++;
}
}
- }
- if ($newowners > 0) {
- foreach my $owner (sort keys (%newcourses)) {
- &send_msg($defdom,$owner,\%coursedata,\%newcourses,$fh);
+ if ($newowners > 0) {
+ foreach my $owner (sort keys (%newcourses)) {
+ my $msgresult = &send_msg($defdom,$owner,\%coursedata,@{$newcourses{$owner}});
+ print $fh $msgresult;
+ }
}
- }
+ my $notifyresult = &creation_notification(\%coursedata);
+ print $fh "$notifyresult\n";
+ unlink("$dirpath/$timestamp");
+ }
}
close($fh);
sub send_msg {
- my ($defdom,$owner,$coursedata,$newcourses,$fh);
- my ($udom,$uname,$email);
+ my ($defdom,$owner,$coursedata,@newcourses) = @_;
+ my ($udom,$uname,$email,$msgresult);
if ($owner =~ /:/) {
- ($uname,$udom) = ($owner =~ /^([^:]):([^:])$/);
+ ($uname,$udom) = ($owner =~ /^([^:]+):([^:]+)$/);
} else {
$uname = $owner;
$udom = $defdom;
- }
+ }
my %userinfo = &Apache::lonnet::dump('environment',$udom,$uname);
my $ownerlast = $userinfo{'lastname'};
if (exists($userinfo{'permanentemail'})) {
@@ -119,7 +127,7 @@
$email = $uname.'@'.$udom.'.edu';
}
}
- my $numcourses = @{$$newcourses{$owner}};
+ my $numcourses = @newcourses;
my $output;
my $courselist;
if ($ownerlast) {
@@ -130,12 +138,15 @@
} else {
$output .= "A new LON-CAPA course has been created for you: \n";
}
- foreach my $course (sort @{$$newcourses{$owner}}) {
+ foreach my $course (sort @newcourses) {
+ my @secnums = ();
+ &identify_sections($$coursedata{$course}{sections},\@secnums);
+ my $seclist = join(", ",@secnums);
$courselist .= " $course";
$output .= qq|
- Title: $coursedata{$course}{coursecode}
- Course Code: $coursedata{$course}{coursecode}
- Sections: $coursedata{$course}{coursecode}
+ Title: $$coursedata{$course}{title}
+ Course Code: $$coursedata{$course}{coursecode}
+ Sections: $seclist
|;
}
$output .= qq|
@@ -210,12 +221,63 @@
if (open(MAIL, "|/usr/lib/sendmail -oi -t -odb")) {
print MAIL $confirm_mail;
close(MAIL);
- print $fh "E-mail sent to $owner ($email) for $courselist\n\n";
+ $msgresult = "E-mail sent to $owner ($email) for $courselist\n\n";
+ foreach my $course (@newcourses) {
+ $$coursedata{$course}{emailed} = 1;
+ }
} else {
- print $fh "Could not send notification e-mail to $owner (email: $email) for $courselist\n\n";
+ $msgresult = "Could not send notification e-mail to $owner (email: $email) for $courselist\n\n";
}
} else {
- print $fh "Invalid email: $email. Could not send notification e-mail to $owner for $courselist\n\n";
+ $msgresult = "Invalid email: $email. Could not send notification e-mail to $owner for $courselist\n\n";
}
+ return $msgresult;
}
+sub creation_notification {
+ my $coursedata = shift;
+ my $ua = LWP::UserAgent->new;
+ my $url = "http://zaphod.lite.msu.edu/cgi-bin/coursecreated.pl";
+ my $courseinfo = '';
+ my $timestamp = time;
+ foreach my $course (keys %{$coursedata}) {
+ my @secnums = ();
+ &identify_sections($$coursedata{$course}{sections},\@secnums);
+ if (@secnums > 0) {
+ foreach my $secnum (@secnums) {
+ $courseinfo .= $$coursedata{$course}{'owner'}.':'.$$coursedata{$course}{'coursecode'}.$secnum.':'.$$coursedata{$course}{'class'}.':'.$$coursedata{$course}{'emailed'}."\n";
+ }
+ }
+ }
+ my $req = POST $url,
+ Content_Type => 'application/x-www-form-urlencoded',
+ Content => [
+ created => $courseinfo,
+ timestamp => $timestamp
+ ];
+ $req->authorization_basic("lonadm","litelite");
+ my $res = $ua->request($req);
+ if ($res->is_success) {
+ return $res->content;
+ } else {
+ return "failed ".$res->status_line;
+ }
+}
+
+sub identify_sections {
+ my ($seclist,$secnums) = @_;
+ if ($seclist =~ /,/) {
+ my @sections = split/,/,$seclist;
+ foreach my $sec (@sections) {
+ $sec =~ s/:[^:]*$//;
+ push(@{$secnums},$sec);
+ }
+ } else {
+ if ($seclist =~ m/^([^:]+):/) {
+ my $sec = $1;
+ if (!grep/^$sec$/,@{$secnums}) {
+ push (@{$secnums},$sec);
+ }
+ }
+ }
+}
--raeburn1121113390--