Annotation of loncom/interface/lonwhatsnew.pm, revision 1.5
1.2 albertel 1: #
1.5 ! albertel 2: # $Id: lonwhatsnew.pm,v 1.4 2005/04/07 04:22:03 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;
428: if ($ressymb =~ m-(___adm/\w+/\w+)/(\d+)/bulletinboard$-) {
1.4 albertel 429: $ressymb = &Apache::lonfeedback::wrap_symb('bulletin___'.$2.$1.'/'.
430: $2.'/bulletinboard');
1.1 raeburn 431: }
432:
433: # Check for unread discussion postings
434: if (defined($discussiontime{$ressymb})) {
435: push(@discussions,$ressymb);
436: my $prevread = 0;
437: my $unreadcount = 0;
438: %{$$unread{$ressymb}} = ();
439: $$unread{$ressymb}{'title'} = $title;
440: $$unread{$ressymb}{'symb'} = $symb;
441: if (defined($lastreadtime{$ressymb})) {
442: $prevread = $lastreadtime{$ressymb};
443: }
1.5 ! albertel 444: my %contrib = &Apache::lonnet::restore($ressymb,$env{'request.course.id'},
! 445: $env{'course.'.$env{'request.course.id'}.'.domain'},
! 446: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1 raeburn 447: if ($contrib{'version'}) {
448: for (my $id=1;$id<=$contrib{'version'};$id++) {
449: unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
450: if ($prevread <$contrib{$id.':timestamp'}) {
451: $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'};
452: $unreadcount ++;
453: push(@{$newdiscussions}, $ressymb);
454: }
455: }
456: }
457: }
458: }
459:
460: # Check for ungraded problems
461: if ($resource->is_problem()) {
462: my $ctr = 0;
463: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
464: my ($partlist,$handgrade,$responseType) = &Apache::grades::response_type($url,$symb);
465: foreach my $student (keys(%$classlist)) {
1.3 albertel 466: my ($uname,$udom) = split(/:/,$student);
1.1 raeburn 467: my %status=&Apache::grades::student_gradeStatus($url,$symb,$udom,$uname,$partlist);
468: my $submitted = 0;
469: my $graded = 0;
470: foreach (keys(%status)) {
471: $submitted = 1 if ($status{$_} ne 'nothing');
472: $graded = 1 if ($status{$_} !~ /^correct/);
473: my ($foo,$partid,$foo1) = split(/\./,$_);
474: if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
475: $submitted = 0;
476: }
477: }
478: next if (!$submitted || !$graded);
479: $ctr ++;
480: }
481: if ($ctr) {
482: $$ungraded{$symb}{count} = $ctr;
483: $$ungraded{$symb}{title} = $title;
484: push(@{$tograde}, $symb);
485: }
486: }
487:
488: # Check for bombs
489: if ($resource->getErrors()) {
490: my $errors = $resource->getErrors();
491: my @bombs = split(/,/, $errors);
492: my $errorcount = scalar(@bombs);
493: my $errorlink = '<a href="/adm/email?display='.
494: &Apache::lonnet::escape($$bombs[0]).'">';
495: $$bombed{$symb}{errorcount} = $errorcount;
496: $$bombed{$symb}{errorlink} = $errorlink;
497: push(@{$bombs}, $symb);
498: }
499: }
500: # Compile maxtries and degree of difficulty.
501: }
502:
503: sub getmail {
504: my ($newmsgs,$critmsgs) = @_;
505: # Check for unread mail in course
506: my $msgcount = 0;
1.3 albertel 507:
508: my @messages = &Apache::lonnet::getkeys('nohist_email');
509: foreach my $message (@messages) {
510: my $msgid=&Apache::lonnet::escape($message);
1.1 raeburn 511: my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)=
512: &Apache::lonmsg::unpackmsgid($msgid);
1.5 ! albertel 513: if ($fromcid eq $env{'request.course.id'}) {
1.1 raeburn 514: if (defined($sendtime) && $sendtime!~/error/) {
515: my $numsendtime = $sendtime;
516: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
517: if ($status eq 'new') {
518: $$msgcount ++;
519: push(@{$newmsgs}, {
520: msgid => $msgid,
521: sendtime => $sendtime,
522: shortsub => &Apache::lonnet::unescape($shortsubj),
523: from => $fromname,
524: fromdom => $fromdom
525: });
526: }
527: }
528: }
529: }
530:
531: # Check for critical messages in course
532: my %what=&Apache::lonnet::dump('critical');
533: my $result = '';
534: my $critmsgcount = 0;
1.3 albertel 535: foreach my $msgid (sort(keys(%what))) {
1.1 raeburn 536: my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)=
537: &Apache::lonmsg::unpackmsgid($_);
1.5 ! albertel 538: if ($fromcid eq $env{'request.course.id'}) {
1.1 raeburn 539: if (defined($sendtime) && $sendtime!~/error/) {
540: my $numsendtime = $sendtime;
541: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
542: $critmsgcount ++;
543: push(@{$critmsgs}, {
544: msgid => $msgid,
545: sendtime => $sendtime,
546: shortsub => &Apache::lonnet::unescape($shortsubj),
547: from => $fromname,
548: fromdom => $fromdom
549: });
550: }
551: }
552: }
553: return ($msgcount,$critmsgcount);
554: }
555:
556: sub cmp_title {
557: my ($atitle,$btitle) = (lc($_[0]->compTitle),lc($_[1]->compTitle));
558: $atitle=~s/^\s*//;
559: $btitle=~s/^\s*//;
560: return $atitle cmp $btitle;
561: }
562:
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