Annotation of loncom/interface/lonwhatsnew.pm, revision 1.6
1.2 albertel 1: #
1.6 ! raeburn 2: # $Id: lonwhatsnew.pm,v 1.5 2005/04/07 06:56:23 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:
1.5 albertel 50: my $command = $env{'form.command'};
1.1 raeburn 51:
52: if ($command eq '') {
53: $command = "info";
54: }
55:
56: $r->print(&display_header());
1.5 albertel 57: if (! (($env{'request.course.fn'}) && (&Apache::lonnet::allowed('vsa',$env{'request.course.id'})))) {
1.1 raeburn 58: # Not in a course, or not allowed to modify parms
1.5 albertel 59: $env{'user.error.msg'}="/adm/whatsnew:vsa:0:0:Cannot display student activity";
1.1 raeburn 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;
1.5 albertel 216: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.1 raeburn 217: $function='coordinator';
218: }
1.5 albertel 219: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.1 raeburn 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:
1.5 albertel 229: unless ($env{'request.course.id'}) {
1.1 raeburn 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'};
1.4 albertel 254: my $feedurl=&Apache::lonfeedback::get_feedurl($ressymb);
1.3 albertel 255: my $unreadnum = keys(%{$unread{$ressymb}});
1.1 raeburn 256: $unreadnum = $unreadnum - 2;
257: if ($unreadnum > 0) {
258: if ($rowNum %2 == 1) {
259: $rowColor = $rowColor1;
260: } else {
261: $rowColor = $rowColor2;
262: }
263: $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>');
264: $rowNum ++;
265: }
266: }
267: } else {
268: $r->print('<tr><td bgcolor="#ffffff"><br><center> <i><b><small>No unread posts in course discussions</small></b></i><br><br></td></tr>');
269: }
270: $r->print('</table></td></tr></table></td></tr></table><br />');
271:
272: ## UNGRADED ITEMS ##
273: $r->print(<<END);
274: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
275: <tr><td>
276: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
277: <tr>
278: <td bgcolor="$tabbg"><b>Problems requiring handgrading:</b></td></tr>
279: <tr>
280: <td bgcolor="#ffffff">
281: <table cellpadding="2" cellspacing="0" border="0" width="100%">
282: END
283:
284: if (@tograde > 0) {
285: $r->print('<tr><th bgcolor="#cccccc">Problem Name</th><th>Number ungraded</th></tr>');
286: my $rowNum = 0;
287: foreach my $res (@tograde) {
288: if ($rowNum %2 == 1) {
289: $rowColor = $rowColor1;
290: } else {
291: $rowColor = $rowColor2;
292: }
293:
294: $r->print('<tr bgcolor="'.$rowColor.'"><td>'.$ungraded{$res}{title}.'</td><td>'.$ungraded{$res}{count}.'</td></tr>');
295: $rowNum ++;
296: }
297: } else {
298: $r->print('<tr><td bgcolor="#ffffff"><br><center><i><b><small> No problems require handgrading </small><br><br></b></i></td></tr>');
299: }
300: $r->print('</table></td></tr></table></td></tr></table><br />');
301: $r->print('</td><td width="5%"> </td><td align="left" valign="top" width-"50%">');
302:
303: ## MESSAGES ##
304: $r->print(<<END);
305: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
306: <tr>
307: <td>
308: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
309: <tr>
310: <td bgcolor="$tabbg"><b>New course messages</b></td>
311: </tr>
312: <tr>
313: <td bgcolor="#ffffff">
314: <table width="100%" cellspacing="0" cellpadding="0" border="0">
315: END
316: if ($msgcount > 0) {
317: my $rowNum = 0;
318: my $mailcount = 1;
319: foreach my $msg (@newmsgs) {
320: if ($rowNum %2 == 1) {
321: $rowColor = $rowColor1;
322: } else {
323: $rowColor = $rowColor2;
324: }
325: $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>');
326: $rowNum ++;
327: $mailcount ++;
328: }
329: } else {
330: $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>');
331: }
332:
333: $r->print('</table></td></tr></table></td></tr></table><br />');
334:
335: $r->print(<<END);
336: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
337: <tr>
338: <td>
339: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
340: <tr>
341: <td bgcolor="$tabbg"><b>New critical messages in course</b></td>
342: </tr>
343: <tr> <td bgcolor="#ffffff">
344: <table width="100%" cellspacing="0" cellpadding="0" border="0">
345: END
346:
347: if ($critmsgcount > 0) {
348: my $rowNum = 0;
349: my $mailcount = 1;
350: foreach my $msg (@critmsgs) {
351: if ($rowNum %2 == 1) {
352: $rowColor = $rowColor1;
353: } else {
354: $rowColor = $rowColor2;
355: }
356: $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>');
357: $rowNum ++;
358: $mailcount ++;
359: }
360: } else {
361: $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>');
362: }
363:
364: $r->print('</table></td></tr></table></td></tr></table><br />');
365:
366: ## BOMBS ##
367: $r->print(<<END);
368: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
369: <tr>
370: <td>
371: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
372: <tr>
373: <td bgcolor="$tabbg"><b>Problems with errors</b></td>
374: </tr>
375: <tr>
376: <td bgcolor="#ffffff">
377: <table width="100%" cellspacing="0" cellpadding="0" border="0">
378: END
379: my $bombnum = 0;
380: if (@bombs > 0) {
381: # @bombs = sort { &cmp_title($a,$b) } @bombs;
382: foreach my $bomb (@bombs) {
383: if ($bombnum %2 == 1) {
384: $rowColor = $rowColor1;
385: } else {
386: $rowColor = $rowColor2;
387: }
388: $r->print('<tr bgcolor="'.$rowColor.'"><td>'.$bombed{$bomb}{errorlink}.'</td></tr>');
389: $bombnum ++;
390: }
391: } else {
392: $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>No problems with errors</small></i></b></center><br /></td></tr>');
393: }
394: $r->print('</table></td></tr></td></tr></table>');
395: $r->print('
396: </table>
397: </td>
398: </tr>
399: </table>');
400: $r->print('</td></tr></table>');
401: }
402:
403: sub getitems {
404: my ($unread,$ungraded,$bombed,$newdiscussions,$tograde,$bombs) = @_;
405: my $navmap = Apache::lonnavmaps::navmap->new();
406: my @allres=$navmap->retrieveResources();
407: my %discussiontime = &Apache::lonnet::dump('discussiontimes',
1.5 albertel 408: $env{'course.'.$env{'request.course.id'}.'.domain'},
409: $env{'course.'.$env{'request.course.id'}.'.num'});
410: my %lastread = &Apache::lonnet::dump('nohist_'.$env{'request.course.id'}.'_discuss',$env{'user.domain'},$env{'user.name'},'lastread');
1.1 raeburn 411: my %lastreadtime = ();
412: my @discussions = ();
413: my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist();
414:
1.3 albertel 415: foreach my $key (keys(%lastread)) {
416: my $newkey = $key;
417: $newkey =~ s/_lastread$//;
418: $lastreadtime{$newkey} = $lastread{$key};
1.1 raeburn 419: }
420: foreach my $resource (@allres) {
421: my $result = '';
422: my $applies = 0;
423: my $symb = $resource->symb();
424: %{$$bombed{$symb}} = ();
425: %{$$ungraded{$symb}} = ();
426: my $title = $resource->compTitle();
427: my $ressymb = $symb;
1.6 ! raeburn 428: if ($ressymb =~ m-___adm/\w+/\w+/\d+/bulletinboard$-) {
! 429: $ressymb = $resource->wrap_symb();
1.1 raeburn 430: }
431:
432: # Check for unread discussion postings
433: if (defined($discussiontime{$ressymb})) {
434: push(@discussions,$ressymb);
435: my $prevread = 0;
436: my $unreadcount = 0;
437: %{$$unread{$ressymb}} = ();
438: $$unread{$ressymb}{'title'} = $title;
439: $$unread{$ressymb}{'symb'} = $symb;
440: if (defined($lastreadtime{$ressymb})) {
441: $prevread = $lastreadtime{$ressymb};
442: }
1.5 albertel 443: my %contrib = &Apache::lonnet::restore($ressymb,$env{'request.course.id'},
444: $env{'course.'.$env{'request.course.id'}.'.domain'},
445: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1 raeburn 446: if ($contrib{'version'}) {
447: for (my $id=1;$id<=$contrib{'version'};$id++) {
448: unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
449: if ($prevread <$contrib{$id.':timestamp'}) {
450: $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'};
451: $unreadcount ++;
452: push(@{$newdiscussions}, $ressymb);
453: }
454: }
455: }
456: }
457: }
458:
459: # Check for ungraded problems
460: if ($resource->is_problem()) {
461: my $ctr = 0;
462: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
463: my ($partlist,$handgrade,$responseType) = &Apache::grades::response_type($url,$symb);
464: foreach my $student (keys(%$classlist)) {
1.3 albertel 465: my ($uname,$udom) = split(/:/,$student);
1.1 raeburn 466: my %status=&Apache::grades::student_gradeStatus($url,$symb,$udom,$uname,$partlist);
467: my $submitted = 0;
468: my $graded = 0;
469: foreach (keys(%status)) {
470: $submitted = 1 if ($status{$_} ne 'nothing');
471: $graded = 1 if ($status{$_} !~ /^correct/);
472: my ($foo,$partid,$foo1) = split(/\./,$_);
473: if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
474: $submitted = 0;
475: }
476: }
477: next if (!$submitted || !$graded);
478: $ctr ++;
479: }
480: if ($ctr) {
481: $$ungraded{$symb}{count} = $ctr;
482: $$ungraded{$symb}{title} = $title;
483: push(@{$tograde}, $symb);
484: }
485: }
486:
487: # Check for bombs
488: if ($resource->getErrors()) {
489: my $errors = $resource->getErrors();
490: my @bombs = split(/,/, $errors);
491: my $errorcount = scalar(@bombs);
492: my $errorlink = '<a href="/adm/email?display='.
493: &Apache::lonnet::escape($$bombs[0]).'">';
494: $$bombed{$symb}{errorcount} = $errorcount;
495: $$bombed{$symb}{errorlink} = $errorlink;
496: push(@{$bombs}, $symb);
497: }
498: }
499: # Compile maxtries and degree of difficulty.
500: }
501:
502: sub getmail {
503: my ($newmsgs,$critmsgs) = @_;
504: # Check for unread mail in course
505: my $msgcount = 0;
1.3 albertel 506:
507: my @messages = &Apache::lonnet::getkeys('nohist_email');
508: foreach my $message (@messages) {
509: my $msgid=&Apache::lonnet::escape($message);
1.1 raeburn 510: my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)=
511: &Apache::lonmsg::unpackmsgid($msgid);
1.5 albertel 512: if ($fromcid eq $env{'request.course.id'}) {
1.1 raeburn 513: if (defined($sendtime) && $sendtime!~/error/) {
514: my $numsendtime = $sendtime;
515: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
516: if ($status eq 'new') {
517: $$msgcount ++;
518: push(@{$newmsgs}, {
519: msgid => $msgid,
520: sendtime => $sendtime,
521: shortsub => &Apache::lonnet::unescape($shortsubj),
522: from => $fromname,
523: fromdom => $fromdom
524: });
525: }
526: }
527: }
528: }
529:
530: # Check for critical messages in course
531: my %what=&Apache::lonnet::dump('critical');
532: my $result = '';
533: my $critmsgcount = 0;
1.3 albertel 534: foreach my $msgid (sort(keys(%what))) {
1.1 raeburn 535: my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)=
536: &Apache::lonmsg::unpackmsgid($_);
1.5 albertel 537: if ($fromcid eq $env{'request.course.id'}) {
1.1 raeburn 538: if (defined($sendtime) && $sendtime!~/error/) {
539: my $numsendtime = $sendtime;
540: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
541: $critmsgcount ++;
542: push(@{$critmsgs}, {
543: msgid => $msgid,
544: sendtime => $sendtime,
545: shortsub => &Apache::lonnet::unescape($shortsubj),
546: from => $fromname,
547: fromdom => $fromdom
548: });
549: }
550: }
551: }
552: return ($msgcount,$critmsgcount);
553: }
554:
555: sub cmp_title {
556: my ($atitle,$btitle) = (lc($_[0]->compTitle),lc($_[1]->compTitle));
557: $atitle=~s/^\s*//;
558: $btitle=~s/^\s*//;
559: return $atitle cmp $btitle;
560: }
561:
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