Annotation of loncom/interface/lonwhatsnew.pm, revision 1.3
1.2 albertel 1: #
1.3 ! albertel 2: # $Id: lonwhatsnew.pm,v 1.2 2005/04/07 03:58:02 albertel Exp $
1.2 albertel 3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
26:
27:
1.1 raeburn 28: package Apache::lonwhatsnew;
29:
30: use strict;
31: use lib qw(/home/httpd/lib/perl);
32: use Apache::lonnet;
1.3 ! albertel 33: use Apache::loncommon();
! 34: use Apache::lonhtmlcommon();
1.1 raeburn 35: use Apache::lonlocal;
1.3 ! albertel 36: use Apache::loncoursedata();
! 37: use Apache::lonnavmaps();
1.1 raeburn 38: use Apache::Constants qw(:common :http);
39: use Time::Local;
40:
41: #----------------------------
42: # handler
43: #
44: #----------------------------
45:
46: sub handler {
47: my $r = shift;
48: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['command']);
49:
50: my $command = $ENV{'form.command'};
51:
52: if ($command eq '') {
53: $command = "info";
54: }
55:
56: $r->print(&display_header());
57: if (! (($ENV{'request.course.fn'}) && (&Apache::lonnet::allowed('vsa',$ENV{'request.course.id'})))) {
58: # Not in a course, or not allowed to modify parms
59: $ENV{'user.error.msg'}="/adm/whatsnew:vsa:0:0:Cannot display student activity";
60: return HTTP_NOT_ACCEPTABLE;
61: }
62:
63: &display_main_box($r,$command);
64: }
65:
66: #------------------------------
67: # display_main_box
68: #
69: # Display all the elements within the main box
70: #------------------------------
71:
72: sub display_main_box {
73: my ($r,$command) = @_;
74: my $domain=&Apache::loncommon::determinedomain();
75: my $tabbg=&Apache::loncommon::designparm('coordinator.tabbg',$domain);
76: $r->print(<<END_OF_BLOCK);
77: <br />
78: <br />
79: <table width="100%" border="0" cellpadding="0" cellspacing="0">
80: <tr>
81: <td width="100%" bgcolor="#000000">
82: <table width="100%" border="0" cellpadding="1" cellspacing="0">
83: <tr>
84: <td width="100%" bgcolor="#000000">
85: <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
86: <tr>
87: <td colspan="2" width="100%" bgcolor="$tabbg">
88: <table width="100%" border="0" cellpadding="5" cellspacing="0">
89: <tr>
90: <td width="100%">
91: <table width="100%" border="0" cellpadding="0" cellspacing="0">
92: <tr>
93: <td>
94: <font face="arial,verdana" size="3"><b>Course Action Items</b></font></td>
95: </td>
96: <td align="right">
97: </td>
98: </tr>
99: </table>
100: </td>
101: </tr>
102: </table>
103: </td>
104: </tr>
105: <tr>
106: <td width="100" valign="top" bgcolor="#dddddd" height="100%">
107: <table width="100" border="0" cellpadding="0" cellspacing="0" height="100%">
108: <tr>
109: <td valign="top" height="100%">
110: END_OF_BLOCK
111: &display_nav_box($r,$command);
112: $r->print('</td></tr></table></td>');
113: $r->print('<td width="100%" bgcolor="#ffffff"><table width="100%" border="0" cellpadding="5" cellspacing="0"><tr><td width="100%">');
114:
115: if ($command eq 'config') {
116: &display_config_box($r);
117: } else {
118: &display_actions_box($r);
119: }
120: $r->print(<<END_OF_BLOCK);
121: </td>
122: </tr>
123: </table>
124: </td>
125: </tr>
126: </table>
127: </td>
128: </tr>
129: </table>
130: </td>
131: </tr>
132: </table>
133: </td>
134: </tr>
135: </table><br />
136: </body>
137: </html>
138: END_OF_BLOCK
139: }
140:
141: #------------------------------
142: # display_nav_box
143: #
144: # Display the navigation box
145: #------------------------------
146:
147: sub display_nav_box {
148: my ($r,$command) = @_;
149: $r->print('<table width="100" border="0" cellpadding="3" cellspacing="0">'."\n");
150: if ($command eq "info") {
151: $r->print('<tr><td bgcolor="#ffffff">');
152: $r->print('<small><b>Action Items</b></small><br />');
153: $r->print('</td></tr>');
154: } else {
155: $r->print('<tr><td>');
156: $r->print('<small><a href="/adm/whatsnew?command=info">Current Action Items</a></small><br />');
157: $r->print('</td></tr>');
158: }
159: $r->print('<tr><td> </td></tr>');
160: if ($command eq "config") {
161: $r->print('<tr><td bgcolor="#ffffff">');
162: $r->print('<small><b>Display options</b></small><br />');
163: $r->print('</td></tr>');
164: } else {
165: $r->print('<tr><td>');
166: $r->print('<small><a href="/adm/whatsnew?command=config">Display options</a></small><br />');
167: $r->print('</td></tr>');
168: }
169: $r->print('</table>');
170: }
171:
172: #-------------------------------
173: # display_header
174: #
175: # Display the header information and set
176: # up the HTML
177: #-------------------------------
178:
179: sub display_header{
1.3 ! albertel 180: my $html=&Apache::lonxml::xmlbegin();
1.1 raeburn 181: my $bodytag=&Apache::loncommon::bodytag('Course Action Items');
182: return(<<ENDHEAD);
1.3 ! albertel 183: $html
1.1 raeburn 184: <head>
185: <title>Course Action Items</title>
186: </head>
187: $bodytag
188: ENDHEAD
189: }
190:
191: #-------------------------------
192: # display_actions_box
193: #
194: # Display the action items
195: #
196: #-------------------------------
197:
198: sub display_actions_box() {
199: my $r = shift;
200:
201: my $rowColor1 = "#ffffff";
202: my $rowColor2 = "#eeeeee";
203: my $rowColor;
204:
205: my %unread = ();
206: my %ungraded = ();
207: my %bombed = ();
208: my @newmsgs = ();
209: my @critmsgs = ();
210: my @newdiscussions = ();
211: my @tograde = ();
212: my @bombs = ();
213:
214: my $domain=&Apache::loncommon::determinedomain();
215: my $function;
216: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
217: $function='coordinator';
218: }
219: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
220: $function='admin';
221: }
222:
223: my $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
224: my $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
225:
226: &getitems(\%unread,\%ungraded,\%bombed,\@newdiscussions,\@tograde,\@bombs);
227: my ($msgcount,$critmsgcount) = &getmail(\@newmsgs,\@critmsgs);
228:
229: unless ($ENV{'request.course.id'}) {
230: $r->print('<br /><b><center>You are accessing an invalid course</center></b><br /><br />');
231: return;
232: }
233:
234: $r->print('<b>Course Action Items</b><br /><hr width="100%" /><table border="0" width="100%" cellpadding="2" cellspacing="4" bgcolor="#ffffff"><tr><td align="left" valign="top" width="45%">');
235:
236: ## UNREAD COURSE DISCUSSION POSTS ##
237: $r->print(<<"END");
238: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
239: <tr><td>
240: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
241: <tr>
242: <td bgcolor="$tabbg"><b>Unread course discussion posts:</b></td>
243: </tr>
244: <tr>
245: <td bgcolor="#ffffff">
246: <table cellpadding="2" cellspacing="0" border="0" width="100%">
247: END
248:
249: if (@newdiscussions > 0) {
250: # @newdiscussions = sort { &cmp_title($a,$b) } @newdiscussions;
251: my $rowNum = 0;
252: foreach my $ressymb (@newdiscussions) {
253: my $forum_title = $unread{$ressymb}{'title'};
254: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ressymb);
255: my $feedurl = &Apache::lonnet::clutter($url);
256: # backward compatibility (bulletin boards used to be 'wrapped')
257: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
258: $feedurl=~s|^/adm/wrapper||;
259: }
1.3 ! albertel 260: my $unreadnum = keys(%{$unread{$ressymb}});
1.1 raeburn 261: $unreadnum = $unreadnum - 2;
262: if ($unreadnum > 0) {
263: if ($rowNum %2 == 1) {
264: $rowColor = $rowColor1;
265: } else {
266: $rowColor = $rowColor2;
267: }
268: $r->print('<tr><td bgcolor="'.$rowColor.'"><small><a href="'.$feedurl.'?symb='.$unread{$ressymb}{symb}.'">'.$forum_title.':</a> </td><td bgcolor="'.$rowColor.'" align="right">'.$unreadnum.' </td></tr>');
269: $rowNum ++;
270: }
271: }
272: } else {
273: $r->print('<tr><td bgcolor="#ffffff"><br><center> <i><b><small>No unread posts in course discussions</small></b></i><br><br></td></tr>');
274: }
275: $r->print('</table></td></tr></table></td></tr></table><br />');
276:
277: ## UNGRADED ITEMS ##
278: $r->print(<<END);
279: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
280: <tr><td>
281: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
282: <tr>
283: <td bgcolor="$tabbg"><b>Problems requiring handgrading:</b></td></tr>
284: <tr>
285: <td bgcolor="#ffffff">
286: <table cellpadding="2" cellspacing="0" border="0" width="100%">
287: END
288:
289: if (@tograde > 0) {
290: $r->print('<tr><th bgcolor="#cccccc">Problem Name</th><th>Number ungraded</th></tr>');
291: my $rowNum = 0;
292: foreach my $res (@tograde) {
293: if ($rowNum %2 == 1) {
294: $rowColor = $rowColor1;
295: } else {
296: $rowColor = $rowColor2;
297: }
298:
299: $r->print('<tr bgcolor="'.$rowColor.'"><td>'.$ungraded{$res}{title}.'</td><td>'.$ungraded{$res}{count}.'</td></tr>');
300: $rowNum ++;
301: }
302: } else {
303: $r->print('<tr><td bgcolor="#ffffff"><br><center><i><b><small> No problems require handgrading </small><br><br></b></i></td></tr>');
304: }
305: $r->print('</table></td></tr></table></td></tr></table><br />');
306: $r->print('</td><td width="5%"> </td><td align="left" valign="top" width-"50%">');
307:
308: ## MESSAGES ##
309: $r->print(<<END);
310: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
311: <tr>
312: <td>
313: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
314: <tr>
315: <td bgcolor="$tabbg"><b>New course messages</b></td>
316: </tr>
317: <tr>
318: <td bgcolor="#ffffff">
319: <table width="100%" cellspacing="0" cellpadding="0" border="0">
320: END
321: if ($msgcount > 0) {
322: my $rowNum = 0;
323: my $mailcount = 1;
324: foreach my $msg (@newmsgs) {
325: if ($rowNum %2 == 1) {
326: $rowColor = $rowColor1;
327: } else {
328: $rowColor = $rowColor2;
329: }
330: $r->print('<tr><td bgcolor="'.$rowColor.'" valign="top"><small>'.$mailcount.'. <small></td><td valign="top"><small><a href="/adm/mail?">'.$msg->{'shortsub'}.'</a> </small></td><td valign="top"><small> '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' </small></td><td valign="top"><small>'.$msg->{'sendtime'}.'</small></td></tr>');
331: $rowNum ++;
332: $mailcount ++;
333: }
334: } else {
335: $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>No new course messages</small></i></b><br /><br /></center></td></tr>');
336: }
337:
338: $r->print('</table></td></tr></table></td></tr></table><br />');
339:
340: $r->print(<<END);
341: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
342: <tr>
343: <td>
344: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
345: <tr>
346: <td bgcolor="$tabbg"><b>New critical messages in course</b></td>
347: </tr>
348: <tr> <td bgcolor="#ffffff">
349: <table width="100%" cellspacing="0" cellpadding="0" border="0">
350: END
351:
352: if ($critmsgcount > 0) {
353: my $rowNum = 0;
354: my $mailcount = 1;
355: foreach my $msg (@critmsgs) {
356: if ($rowNum %2 == 1) {
357: $rowColor = $rowColor1;
358: } else {
359: $rowColor = $rowColor2;
360: }
361: $r->print('<tr><td bgcolor="'.$rowColor.'" valign="top"><small>'.$mailcount.'. <small></td><td valign="top"><small><a href="/adm/mail?">'.$msg->{'shortsub'}.'</a> </small></td><td valign="top"><small> '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' </small></td><td valign="top"><small>'.$msg->{'sendtime'}.'</small></td></tr>');
362: $rowNum ++;
363: $mailcount ++;
364: }
365: } else {
366: $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>No unread critical messages in course</small></i></b><br /><br /></center></td></tr>');
367: }
368:
369: $r->print('</table></td></tr></table></td></tr></table><br />');
370:
371: ## BOMBS ##
372: $r->print(<<END);
373: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
374: <tr>
375: <td>
376: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
377: <tr>
378: <td bgcolor="$tabbg"><b>Problems with errors</b></td>
379: </tr>
380: <tr>
381: <td bgcolor="#ffffff">
382: <table width="100%" cellspacing="0" cellpadding="0" border="0">
383: END
384: my $bombnum = 0;
385: if (@bombs > 0) {
386: # @bombs = sort { &cmp_title($a,$b) } @bombs;
387: foreach my $bomb (@bombs) {
388: if ($bombnum %2 == 1) {
389: $rowColor = $rowColor1;
390: } else {
391: $rowColor = $rowColor2;
392: }
393: $r->print('<tr bgcolor="'.$rowColor.'"><td>'.$bombed{$bomb}{errorlink}.'</td></tr>');
394: $bombnum ++;
395: }
396: } else {
397: $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>No problems with errors</small></i></b></center><br /></td></tr>');
398: }
399: $r->print('</table></td></tr></td></tr></table>');
400: $r->print('
401: </table>
402: </td>
403: </tr>
404: </table>');
405: $r->print('</td></tr></table>');
406: }
407:
408: sub getitems {
409: my ($unread,$ungraded,$bombed,$newdiscussions,$tograde,$bombs) = @_;
410: my $navmap = Apache::lonnavmaps::navmap->new();
411: my @allres=$navmap->retrieveResources();
412: my %discussiontime = &Apache::lonnet::dump('discussiontimes',
413: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
414: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
415: my %lastread = &Apache::lonnet::dump('nohist_'.$ENV{'request.course.id'}.'_discuss',$ENV{'user.domain'},$ENV{'user.name'},'lastread');
416: my %lastreadtime = ();
417: my @discussions = ();
418: my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist();
419:
1.3 ! albertel 420: foreach my $key (keys(%lastread)) {
! 421: my $newkey = $key;
! 422: $newkey =~ s/_lastread$//;
! 423: $lastreadtime{$newkey} = $lastread{$key};
1.1 raeburn 424: }
425: foreach my $resource (@allres) {
426: my $result = '';
427: my $applies = 0;
428: my $symb = $resource->symb();
429: %{$$bombed{$symb}} = ();
430: %{$$ungraded{$symb}} = ();
431: my $title = $resource->compTitle();
432: my $ressymb = $symb;
433: if ($ressymb =~ m-(___adm/\w+/\w+)/(\d+)/bulletinboard$-) {
434: $ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard';
435: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
436: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|;
437: }
438: }
439:
440: # Check for unread discussion postings
441: if (defined($discussiontime{$ressymb})) {
442: push(@discussions,$ressymb);
443: my $prevread = 0;
444: my $unreadcount = 0;
445: %{$$unread{$ressymb}} = ();
446: $$unread{$ressymb}{'title'} = $title;
447: $$unread{$ressymb}{'symb'} = $symb;
448: if (defined($lastreadtime{$ressymb})) {
449: $prevread = $lastreadtime{$ressymb};
450: }
451: my %contrib = &Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
452: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
453: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
454: if ($contrib{'version'}) {
455: for (my $id=1;$id<=$contrib{'version'};$id++) {
456: unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
457: if ($prevread <$contrib{$id.':timestamp'}) {
458: $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'};
459: $unreadcount ++;
460: push(@{$newdiscussions}, $ressymb);
461: }
462: }
463: }
464: }
465: }
466:
467: # Check for ungraded problems
468: if ($resource->is_problem()) {
469: my $ctr = 0;
470: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
471: my ($partlist,$handgrade,$responseType) = &Apache::grades::response_type($url,$symb);
472: foreach my $student (keys(%$classlist)) {
1.3 ! albertel 473: my ($uname,$udom) = split(/:/,$student);
1.1 raeburn 474: my %status=&Apache::grades::student_gradeStatus($url,$symb,$udom,$uname,$partlist);
475: my $submitted = 0;
476: my $graded = 0;
477: foreach (keys(%status)) {
478: $submitted = 1 if ($status{$_} ne 'nothing');
479: $graded = 1 if ($status{$_} !~ /^correct/);
480: my ($foo,$partid,$foo1) = split(/\./,$_);
481: if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
482: $submitted = 0;
483: }
484: }
485: next if (!$submitted || !$graded);
486: $ctr ++;
487: }
488: if ($ctr) {
489: $$ungraded{$symb}{count} = $ctr;
490: $$ungraded{$symb}{title} = $title;
491: push(@{$tograde}, $symb);
492: }
493: }
494:
495: # Check for bombs
496: if ($resource->getErrors()) {
497: my $errors = $resource->getErrors();
498: my @bombs = split(/,/, $errors);
499: my $errorcount = scalar(@bombs);
500: my $errorlink = '<a href="/adm/email?display='.
501: &Apache::lonnet::escape($$bombs[0]).'">';
502: $$bombed{$symb}{errorcount} = $errorcount;
503: $$bombed{$symb}{errorlink} = $errorlink;
504: push(@{$bombs}, $symb);
505: }
506: }
507: # Compile maxtries and degree of difficulty.
508: }
509:
510: sub getmail {
511: my ($newmsgs,$critmsgs) = @_;
512: # Check for unread mail in course
513: my $msgcount = 0;
1.3 ! albertel 514:
! 515: my @messages = &Apache::lonnet::getkeys('nohist_email');
! 516: foreach my $message (@messages) {
! 517: my $msgid=&Apache::lonnet::escape($message);
1.1 raeburn 518: my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)=
519: &Apache::lonmsg::unpackmsgid($msgid);
520: if ($fromcid eq $ENV{'request.course.id'}) {
521: if (defined($sendtime) && $sendtime!~/error/) {
522: my $numsendtime = $sendtime;
523: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
524: if ($status eq 'new') {
525: $$msgcount ++;
526: push(@{$newmsgs}, {
527: msgid => $msgid,
528: sendtime => $sendtime,
529: shortsub => &Apache::lonnet::unescape($shortsubj),
530: from => $fromname,
531: fromdom => $fromdom
532: });
533: }
534: }
535: }
536: }
537:
538: # Check for critical messages in course
539: my %what=&Apache::lonnet::dump('critical');
540: my $result = '';
541: my $critmsgcount = 0;
1.3 ! albertel 542: foreach my $msgid (sort(keys(%what))) {
1.1 raeburn 543: my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)=
544: &Apache::lonmsg::unpackmsgid($_);
545: if ($fromcid eq $ENV{'request.course.id'}) {
546: if (defined($sendtime) && $sendtime!~/error/) {
547: my $numsendtime = $sendtime;
548: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
549: $critmsgcount ++;
550: push(@{$critmsgs}, {
551: msgid => $msgid,
552: sendtime => $sendtime,
553: shortsub => &Apache::lonnet::unescape($shortsubj),
554: from => $fromname,
555: fromdom => $fromdom
556: });
557: }
558: }
559: }
560: return ($msgcount,$critmsgcount);
561: }
562:
563: sub cmp_title {
564: my ($atitle,$btitle) = (lc($_[0]->compTitle),lc($_[1]->compTitle));
565: $atitle=~s/^\s*//;
566: $btitle=~s/^\s*//;
567: return $atitle cmp $btitle;
568: }
569:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonwhatsnew.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface