Annotation of loncom/interface/lonwhatsnew.pm, revision 1.2
1.2 ! albertel 1: #
! 2: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www Exp $
! 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;
33: use Apache::loncommon;
34: use Apache::lonhtmlcommon;
35: use Apache::lonlocal;
36: use Apache::loncoursedata;
37: use Apache::lonnavmaps;
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{
180: my $bodytag=&Apache::loncommon::bodytag('Course Action Items');
181: return(<<ENDHEAD);
182: <html>
183: <head>
184: <title>Course Action Items</title>
185: </head>
186: $bodytag
187: ENDHEAD
188: }
189:
190: #-------------------------------
191: # display_actions_box
192: #
193: # Display the action items
194: #
195: #-------------------------------
196:
197: sub display_actions_box() {
198: my $r = shift;
199:
200: my $rowColor1 = "#ffffff";
201: my $rowColor2 = "#eeeeee";
202: my $rowColor;
203:
204: my %unread = ();
205: my %ungraded = ();
206: my %bombed = ();
207: my @newmsgs = ();
208: my @critmsgs = ();
209: my @newdiscussions = ();
210: my @tograde = ();
211: my @bombs = ();
212:
213: my $domain=&Apache::loncommon::determinedomain();
214: my $function;
215: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
216: $function='coordinator';
217: }
218: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
219: $function='admin';
220: }
221:
222: my $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
223: my $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
224:
225: &getitems(\%unread,\%ungraded,\%bombed,\@newdiscussions,\@tograde,\@bombs);
226: my ($msgcount,$critmsgcount) = &getmail(\@newmsgs,\@critmsgs);
227:
228: unless ($ENV{'request.course.id'}) {
229: $r->print('<br /><b><center>You are accessing an invalid course</center></b><br /><br />');
230: return;
231: }
232:
233: $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%">');
234:
235: ## UNREAD COURSE DISCUSSION POSTS ##
236: $r->print(<<"END");
237: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
238: <tr><td>
239: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
240: <tr>
241: <td bgcolor="$tabbg"><b>Unread course discussion posts:</b></td>
242: </tr>
243: <tr>
244: <td bgcolor="#ffffff">
245: <table cellpadding="2" cellspacing="0" border="0" width="100%">
246: END
247:
248: if (@newdiscussions > 0) {
249: # @newdiscussions = sort { &cmp_title($a,$b) } @newdiscussions;
250: my $rowNum = 0;
251: foreach my $ressymb (@newdiscussions) {
252: my $forum_title = $unread{$ressymb}{'title'};
253: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ressymb);
254: my $feedurl = &Apache::lonnet::clutter($url);
255: # backward compatibility (bulletin boards used to be 'wrapped')
256: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
257: $feedurl=~s|^/adm/wrapper||;
258: }
259: my $unreadnum = keys %{$unread{$ressymb}};
260: $unreadnum = $unreadnum - 2;
261: if ($unreadnum > 0) {
262: if ($rowNum %2 == 1) {
263: $rowColor = $rowColor1;
264: } else {
265: $rowColor = $rowColor2;
266: }
267: $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>');
268: $rowNum ++;
269: }
270: }
271: } else {
272: $r->print('<tr><td bgcolor="#ffffff"><br><center> <i><b><small>No unread posts in course discussions</small></b></i><br><br></td></tr>');
273: }
274: $r->print('</table></td></tr></table></td></tr></table><br />');
275:
276: ## UNGRADED ITEMS ##
277: $r->print(<<END);
278: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
279: <tr><td>
280: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
281: <tr>
282: <td bgcolor="$tabbg"><b>Problems requiring handgrading:</b></td></tr>
283: <tr>
284: <td bgcolor="#ffffff">
285: <table cellpadding="2" cellspacing="0" border="0" width="100%">
286: END
287:
288: if (@tograde > 0) {
289: $r->print('<tr><th bgcolor="#cccccc">Problem Name</th><th>Number ungraded</th></tr>');
290: my $rowNum = 0;
291: foreach my $res (@tograde) {
292: if ($rowNum %2 == 1) {
293: $rowColor = $rowColor1;
294: } else {
295: $rowColor = $rowColor2;
296: }
297:
298: $r->print('<tr bgcolor="'.$rowColor.'"><td>'.$ungraded{$res}{title}.'</td><td>'.$ungraded{$res}{count}.'</td></tr>');
299: $rowNum ++;
300: }
301: } else {
302: $r->print('<tr><td bgcolor="#ffffff"><br><center><i><b><small> No problems require handgrading </small><br><br></b></i></td></tr>');
303: }
304: $r->print('</table></td></tr></table></td></tr></table><br />');
305: $r->print('</td><td width="5%"> </td><td align="left" valign="top" width-"50%">');
306:
307: ## MESSAGES ##
308: $r->print(<<END);
309: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
310: <tr>
311: <td>
312: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
313: <tr>
314: <td bgcolor="$tabbg"><b>New course messages</b></td>
315: </tr>
316: <tr>
317: <td bgcolor="#ffffff">
318: <table width="100%" cellspacing="0" cellpadding="0" border="0">
319: END
320: if ($msgcount > 0) {
321: my $rowNum = 0;
322: my $mailcount = 1;
323: foreach my $msg (@newmsgs) {
324: if ($rowNum %2 == 1) {
325: $rowColor = $rowColor1;
326: } else {
327: $rowColor = $rowColor2;
328: }
329: $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>');
330: $rowNum ++;
331: $mailcount ++;
332: }
333: } else {
334: $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>');
335: }
336:
337: $r->print('</table></td></tr></table></td></tr></table><br />');
338:
339: $r->print(<<END);
340: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
341: <tr>
342: <td>
343: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
344: <tr>
345: <td bgcolor="$tabbg"><b>New critical messages in course</b></td>
346: </tr>
347: <tr> <td bgcolor="#ffffff">
348: <table width="100%" cellspacing="0" cellpadding="0" border="0">
349: END
350:
351: if ($critmsgcount > 0) {
352: my $rowNum = 0;
353: my $mailcount = 1;
354: foreach my $msg (@critmsgs) {
355: if ($rowNum %2 == 1) {
356: $rowColor = $rowColor1;
357: } else {
358: $rowColor = $rowColor2;
359: }
360: $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>');
361: $rowNum ++;
362: $mailcount ++;
363: }
364: } else {
365: $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>');
366: }
367:
368: $r->print('</table></td></tr></table></td></tr></table><br />');
369:
370: ## BOMBS ##
371: $r->print(<<END);
372: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
373: <tr>
374: <td>
375: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
376: <tr>
377: <td bgcolor="$tabbg"><b>Problems with errors</b></td>
378: </tr>
379: <tr>
380: <td bgcolor="#ffffff">
381: <table width="100%" cellspacing="0" cellpadding="0" border="0">
382: END
383: my $bombnum = 0;
384: if (@bombs > 0) {
385: # @bombs = sort { &cmp_title($a,$b) } @bombs;
386: foreach my $bomb (@bombs) {
387: if ($bombnum %2 == 1) {
388: $rowColor = $rowColor1;
389: } else {
390: $rowColor = $rowColor2;
391: }
392: $r->print('<tr bgcolor="'.$rowColor.'"><td>'.$bombed{$bomb}{errorlink}.'</td></tr>');
393: $bombnum ++;
394: }
395: } else {
396: $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>No problems with errors</small></i></b></center><br /></td></tr>');
397: }
398: $r->print('</table></td></tr></td></tr></table>');
399: $r->print('
400: </table>
401: </td>
402: </tr>
403: </table>');
404: $r->print('</td></tr></table>');
405: }
406:
407: sub getitems {
408: my ($unread,$ungraded,$bombed,$newdiscussions,$tograde,$bombs) = @_;
409: my $navmap = Apache::lonnavmaps::navmap->new();
410: my @allres=$navmap->retrieveResources();
411: my %discussiontime = &Apache::lonnet::dump('discussiontimes',
412: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
413: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
414: my %lastread = &Apache::lonnet::dump('nohist_'.$ENV{'request.course.id'}.'_discuss',$ENV{'user.domain'},$ENV{'user.name'},'lastread');
415: my %lastreadtime = ();
416: my @discussions = ();
417: my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist();
418:
419: foreach (keys %lastread) {
420: my $key = $_;
421: $key =~ s/_lastread$//;
422: $lastreadtime{$key} = $lastread{$_};
423: }
424: foreach my $resource (@allres) {
425: my $result = '';
426: my $applies = 0;
427: my $symb = $resource->symb();
428: %{$$bombed{$symb}} = ();
429: %{$$ungraded{$symb}} = ();
430: my $title = $resource->compTitle();
431: my $ressymb = $symb;
432: if ($ressymb =~ m-(___adm/\w+/\w+)/(\d+)/bulletinboard$-) {
433: $ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard';
434: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
435: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|;
436: }
437: }
438:
439: # Check for unread discussion postings
440: if (defined($discussiontime{$ressymb})) {
441: push(@discussions,$ressymb);
442: my $prevread = 0;
443: my $unreadcount = 0;
444: %{$$unread{$ressymb}} = ();
445: $$unread{$ressymb}{'title'} = $title;
446: $$unread{$ressymb}{'symb'} = $symb;
447: if (defined($lastreadtime{$ressymb})) {
448: $prevread = $lastreadtime{$ressymb};
449: }
450: my %contrib = &Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
451: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
452: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
453: if ($contrib{'version'}) {
454: for (my $id=1;$id<=$contrib{'version'};$id++) {
455: unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
456: if ($prevread <$contrib{$id.':timestamp'}) {
457: $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'};
458: $unreadcount ++;
459: push(@{$newdiscussions}, $ressymb);
460: }
461: }
462: }
463: }
464: }
465:
466: # Check for ungraded problems
467: if ($resource->is_problem()) {
468: my $ctr = 0;
469: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
470: my ($partlist,$handgrade,$responseType) = &Apache::grades::response_type($url,$symb);
471: foreach my $student (keys(%$classlist)) {
472: my ($uname,$udom) = split/:/,$student;
473: my %status=&Apache::grades::student_gradeStatus($url,$symb,$udom,$uname,$partlist);
474: my $submitted = 0;
475: my $graded = 0;
476: foreach (keys(%status)) {
477: $submitted = 1 if ($status{$_} ne 'nothing');
478: $graded = 1 if ($status{$_} !~ /^correct/);
479: my ($foo,$partid,$foo1) = split(/\./,$_);
480: if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
481: $submitted = 0;
482: }
483: }
484: next if (!$submitted || !$graded);
485: $ctr ++;
486: }
487: if ($ctr) {
488: $$ungraded{$symb}{count} = $ctr;
489: $$ungraded{$symb}{title} = $title;
490: push(@{$tograde}, $symb);
491: }
492: }
493:
494: # Check for bombs
495: if ($resource->getErrors()) {
496: my $errors = $resource->getErrors();
497: my @bombs = split(/,/, $errors);
498: my $errorcount = scalar(@bombs);
499: my $errorlink = '<a href="/adm/email?display='.
500: &Apache::lonnet::escape($$bombs[0]).'">';
501: $$bombed{$symb}{errorcount} = $errorcount;
502: $$bombed{$symb}{errorlink} = $errorlink;
503: push(@{$bombs}, $symb);
504: }
505: }
506: # Compile maxtries and degree of difficulty.
507: }
508:
509: sub getmail {
510: my ($newmsgs,$critmsgs) = @_;
511: # Check for unread mail in course
512: my $msgcount = 0;
513: my @msgids = sort split(/\&/,&Apache::lonnet::reply
514: ('keys:'.$ENV{'user.domain'}.':'.
515: $ENV{'user.name'}.':nohist_email',
516: $ENV{'user.home'}));
517: foreach my $msgid (@msgids) {
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;
542: foreach my $msgid (sort keys %what) {
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