Annotation of loncom/interface/lonwhatsnew.pm, revision 1.38.2.2
1.2 albertel 1: #
1.38.2.2! albertel 2: # $Id: lonwhatsnew.pm,v 1.38.2.1 2005/12/19 23:24:40 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.18 raeburn 38: use Apache::lonuserstate;
1.1 raeburn 39: use Apache::Constants qw(:common :http);
40: use Time::Local;
1.24 albertel 41: use GDBM_File;
1.1 raeburn 42:
43: #----------------------------
44: # handler
45: #
46: #----------------------------
47:
48: sub handler {
49: my $r = shift;
1.7 raeburn 50: if ($r->header_only) {
51: &Apache::loncommon::content_type($r,'text/html');
52: $r->send_http_header;
53: return OK;
54: }
1.1 raeburn 55: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['command']);
56:
1.36 raeburn 57: my $command = $env{'form.command'};
1.1 raeburn 58:
1.7 raeburn 59: &Apache::loncommon::content_type($r,'text/html');
60: $r->send_http_header;
1.33 raeburn 61: if (! (($env{'request.course.fn'}) && (&Apache::lonnet::allowed('bre',$env{'request.course.id'})))) {
62: # Not in a course, or not allowed to view action items
63: $env{'user.error.msg'}="/adm/whatsnew:bre:0:0:Cannot display what's new screen";
1.1 raeburn 64: return HTTP_NOT_ACCEPTABLE;
65: }
66:
1.36 raeburn 67: my %checkallowed = (
68: coursediscussion => &Apache::lonnet::allowed('pch',$env{'request.course.id'}),
69: handgrading => &Apache::lonnet::allowed('mgr',$env{'request.course.id'}),
70: abovethreshold => &Apache::lonnet::allowed('vgr',$env{'request.course.id'}),
71: haserrors => &Apache::lonnet::allowed('opa',$env{'request.course.id'}),
72: versionchanges => &Apache::lonnet::allowed('opa',$env{'request.course.id'}),
73: coursenormalmail => 1,
74: coursecritmail => 1,
75: );
76:
77: $r->print(&display_header($command,\%checkallowed));
78:
1.7 raeburn 79: &Apache::lonhtmlcommon::clear_breadcrumbs();
1.36 raeburn 80: &Apache::lonhtmlcommon::add_breadcrumb
81: ({href=>'/adm/whatsnew',
82: text=>"Display Action Items"});
1.33 raeburn 83: if (($command eq 'chgthreshold') && (&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) {
1.7 raeburn 84: &Apache::lonhtmlcommon::add_breadcrumb
1.36 raeburn 85: ({href=>'/adm/whatsnew?command=chgthreshold',
1.13 raeburn 86: text=>"Change thresholds"});
1.7 raeburn 87: $r->print(&Apache::lonhtmlcommon::breadcrumbs
1.13 raeburn 88: (undef,'Course Action Items','Course_Action_Items_Thresholds'));
1.36 raeburn 89: } elsif (($command eq 'chginterval') && (&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) {
90: &Apache::lonhtmlcommon::add_breadcrumb
91: ({href=>'/adm/whatsnew?command=chginterval',
92: text=>"Change interval"});
93: $r->print(&Apache::lonhtmlcommon::breadcrumbs
94: (undef,'Course Action Items','Course_Action_Items_Intervals'));
1.7 raeburn 95: } else {
96: $r->print(&Apache::lonhtmlcommon::breadcrumbs
97: (undef,'Course Action Items','Course_Action_Items_Display'));
98: }
1.36 raeburn 99: &display_main_box($r,$command,\%checkallowed);
1.14 albertel 100: return OK;
1.1 raeburn 101: }
102:
103: #------------------------------
104: # display_main_box
105: #
106: # Display all the elements within the main box
107: #------------------------------
108:
109: sub display_main_box {
1.36 raeburn 110: my ($r,$command,$checkallowed) = @_;
1.1 raeburn 111: my $domain=&Apache::loncommon::determinedomain();
1.38.2.2! albertel 112: my $function = &Apache::loncommon::get_users_function();
! 113: my $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
! 114:
1.7 raeburn 115: $r->print('<table width="100%" border="0" cellpadding="5" cellspacing="0"><tr><td width="100%">');
1.13 raeburn 116:
117: my %threshold_titles = (
118: av_attempts => 'Average number of attempts',
119: degdiff => 'Degree of difficulty',
120: numstudents => 'Total number of students with submissions',
121: );
1.36 raeburn 122:
123: my %interval_titles = (
124: -1 => 'since start of course',
125: 2592000 => 'since last month',
126: 604800 => 'since last week',
127: 86400 => 'since yesterday',
128: );
129:
1.15 raeburn 130: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
131: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
132:
1.36 raeburn 133: if (($command eq 'chgthreshold') &&
134: (&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) {
135: &display_threshold_config($r,$command,$tabbg,\%threshold_titles,
136: $cdom,$crs);
137: } elsif (($command eq 'chginterval') &&
138: (&Apache::lonnet::allowed('opa',$env{'request.course.id'}))) {
139: &display_interval_config($r,\%interval_titles);
1.1 raeburn 140: } else {
1.38.2.2! albertel 141: &display_actions_box($r,$tabbg,$command,\%threshold_titles,
! 142: \%interval_titles,$cdom,$crs,$checkallowed);
1.1 raeburn 143: }
144: $r->print(<<END_OF_BLOCK);
145: </td>
146: </tr>
147: </table><br />
148: </body>
149: </html>
150: END_OF_BLOCK
151: }
152:
153: #-------------------------------
154: # display_header
155: #
156: # Display the header information and set
157: # up the HTML
158: #-------------------------------
159:
160: sub display_header{
1.36 raeburn 161: my ($command,$checkallowed) = @_;
1.3 albertel 162: my $html=&Apache::lonxml::xmlbegin();
1.1 raeburn 163: my $bodytag=&Apache::loncommon::bodytag('Course Action Items');
1.36 raeburn 164: my $scripttag;
165: unless ($command eq 'chgthreshold' || $command eq 'chginterval') {
166: $scripttag = <<"END";
167: <script type="text/javascript">
168: function change_display(caller,change) {
169: caller.value = change;
170: document.visible.submit();
171: }
172:
173: function changeAll(change) {
174: END
175: foreach my $item (keys(%{$checkallowed})) {
1.38.2.1 albertel 176: if ($$checkallowed{$item}) {
177: $scripttag.='document.visible.display_'.$item.'.value=change'.
178: "\n";
179: }
1.36 raeburn 180: }
181: $scripttag.='document.visible.submit();
182: }
183: </script>
184: ';
185: }
1.1 raeburn 186: return(<<ENDHEAD);
1.3 albertel 187: $html
1.1 raeburn 188: <head>
189: <title>Course Action Items</title>
1.36 raeburn 190: $scripttag
1.1 raeburn 191: </head>
192: $bodytag
193: ENDHEAD
194: }
195:
196: #-------------------------------
197: # display_actions_box
198: #
199: # Display the action items
200: #
201: #-------------------------------
202:
203: sub display_actions_box() {
1.38.2.2! albertel 204: my ($r,$tabbg,$command,$threshold_titles,$interval_titles,
! 205: $cdom,$crs,$checkallowed) = @_;
! 206:
1.1 raeburn 207: my $rowColor1 = "#ffffff";
208: my $rowColor2 = "#eeeeee";
209:
1.36 raeburn 210: my $udom = $env{'user.domain'};
211: my $uname = $env{'user.name'};
212: my $cid = $env{'request.course.id'};
213:
214: my %lt = &Apache::lonlocal::texthash(
215: 'yacc' => 'You are accessing an invalid course.',
216: 'gtfr' => 'Go to first resource',
217: 'chyp' => 'Change your preferences',
218: 'tsup' => 'to suppress display of this screen when accessing'.
219: ' this course in the future.',
220: 'hial' => 'Hide all',
221: 'shal' => 'Show all',
222: );
223:
1.1 raeburn 224: my %unread = ();
225: my %ungraded = ();
226: my %bombed = ();
1.11 raeburn 227: my %triggered = ();
1.33 raeburn 228: my %changed = ();
1.1 raeburn 229: my @newmsgs = ();
230: my @critmsgs = ();
231: my @newdiscussions = ();
232: my @tograde = ();
233: my @bombs = ();
1.11 raeburn 234: my @warnings = ();
1.33 raeburn 235: my $msgcount = 0;
236: my $critmsgcount = 0;
237:
1.16 raeburn 238: my %res_title = ();
1.33 raeburn 239: my %show = ();
240: my $needitems = 0;
241: my $boxcount = 0;
1.1 raeburn 242:
1.13 raeburn 243: my %threshold = (
1.22 www 244: av_attempts => 2,
245: degdiff => 0.5,
246: numstudents => 2,
1.13 raeburn 247: );
248:
1.36 raeburn 249: unless ($cid) {
250: $r->print('<br /><b><center>'.$lt{'yacc'}.'</center></b><br /><br />');
1.1 raeburn 251: return;
252: }
1.33 raeburn 253:
1.36 raeburn 254: if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
255: &GDBM_READER(),0640)) {
256: my $furl=$bighash{'first_url'};
257: $r->print('<font size="+1"><a href="'.$furl.'">'.$lt{'gtfr'}.
258: '</a></font><a href="/adm/preferences?action=changecourseinit">'.
259: '</font><br />'.$lt{'chyp'}.'</a> '.$lt{'tsup'}.'<br /><hr />');
260: untie(%bighash);
261: }
262:
263: my $result;
264:
265: if ($command eq 'reset') {
266: $result = &process_reset($cdom,$crs);
267: } elsif ($command eq 'update') {
268: $result = &process_update($cdom,$crs,$threshold_titles);
269: } elsif ($command eq 'newinterval') {
270: $result = &store_interval_setting($uname,$udom,$cid,$interval_titles);
271: }
272:
273: my $store_result=&store_display_settings($uname,$udom,$cid,$checkallowed);
274:
275: unless ($store_result eq 'ok') {
276: &Apache::lonnet::logthis('Error storing whatsnew settings: '.
277: $store_result.' for '.'user '.$uname.':'.$udom.' in course '.$cid);
278: $result .= &mt('Unable to store visibility settings due to [_1]',
279: $store_result);
280: }
281:
282: if ($result) {
283: $r->print($result.'<hr width="100%" />');
284: }
285: $r->rflush();
286:
1.33 raeburn 287:
1.36 raeburn 288: my %display_settings = &get_display_settings($uname,$udom,$cid);
289: my $timediff = $display_settings{$cid.':interval'};
290: unless (defined($timediff)) { $timediff = 604800; }
1.35 raeburn 291: my $now = time;
1.36 raeburn 292: my $interval = $$interval_titles{$timediff};
1.35 raeburn 293: if ($timediff == -1) {
294: $timediff = time;
295: }
296: my $starttime = $now - $timediff;
1.37 raeburn 297: my $countunread = 1;
1.33 raeburn 298:
299: my %headings = &Apache::lonlocal::texthash(
300: coursediscussion => 'Unread course discussion posts',
301: handgrading => 'Problems requiring handgrading',
302: haserrors => 'Problems with errors',
303: versionchanges => 'Resources in course with version changes '.$interval,
1.37 raeburn 304: coursenormalmail => 'New course messages',
1.33 raeburn 305: coursecritmail => 'New critical messages in course',
306: );
307:
1.36 raeburn 308: if ($$checkallowed{'abovethreshold'}) {
1.33 raeburn 309: &get_curr_thresholds(\%threshold,$cdom,$crs);
310: }
311:
312: $headings{'abovethreshold'} = &mt('Problems with av. attempts').' ≥ '.$threshold{'av_attempts'}.' '.&mt('or deg. difficulty').' ≥ '.$threshold{'degdiff'}.'<br /> '.&mt('and total number of students with submissions').' ≥ '.$threshold{'numstudents'};
313:
314: my @actionorder = ('handgrading','haserrors','abovethreshold','versionchanges','coursediscussion','coursenormalmail','coursecritmail');
315:
1.36 raeburn 316: foreach my $key (keys(%{$checkallowed})) {
1.33 raeburn 317: $show{$key} = 0;
1.36 raeburn 318: if ($$checkallowed{$key}) {
319: unless ($display_settings{$cid.':'.$key} eq 'hide') {
1.33 raeburn 320: $show{$key} = 1;
321: }
322: }
323: }
324:
325: foreach my $item (@actionorder) {
326: unless ($item eq 'coursenormalmail' || $item eq 'coursecritmail') {
327: if ($show{$item}) {
328: $needitems = 1;
329: last;
330: }
331: }
332: }
333:
334: if ($needitems) {
1.37 raeburn 335: &getitems(\%unread,\%ungraded,\%bombed,\%triggered,\%changed,\@newdiscussions,\@tograde,\@bombs,\@warnings,$rowColor1,$rowColor2,\%threshold,$cdom,$crs,\%res_title,\%show,$starttime,$countunread);
1.1 raeburn 336: }
1.33 raeburn 337: if ($show{'coursenormalmail'}) {
338: &getnormalmail(\@newmsgs);
1.7 raeburn 339: }
1.33 raeburn 340: if ($show{'coursecritmail'}) {
341: &getcritmail(\@critmsgs);
1.11 raeburn 342: }
343:
1.36 raeburn 344: $r->print(qq|<a href="javascript:changeAll('hide');">$lt{'hial'}</a>
345: <a href="javascript:changeAll('show');">$lt{'shal'}</a>
346: <form method="post" name="visible" action="/adm/whatsnew">\n|);
347: foreach my $item (keys(%{$checkallowed})) {
348: if ($$checkallowed{$item}) {
349: $r->print('<input type="hidden" name="display_'.$item.'" />'."\n");
350: }
351: }
1.1 raeburn 352:
1.36 raeburn 353: $r->print('</form><br /><table border="0" width="100%" cellpadding="2" cellspacing="4"><tr><td align="left" valign="top" width="45%">');
1.1 raeburn 354:
1.33 raeburn 355: my $displayed = 0;
1.36 raeburn 356: my $totalboxes = keys(%{$checkallowed});
1.33 raeburn 357: my $halfway = int($totalboxes/2) + $totalboxes%2;
358: foreach my $actionitem (@actionorder) {
1.36 raeburn 359: if ($$checkallowed{$actionitem}) {
1.33 raeburn 360: if ($displayed == $halfway) {
361: $r->print('</td><td width="5%"> </td><td align="left" valign="top" width-"50%">');
1.1 raeburn 362: }
1.37 raeburn 363: &display_launcher($r,$actionitem,$checkallowed,$tabbg,$rowColor1,$rowColor2,\%show,\%headings,\%res_title,\@tograde,\%ungraded,\@bombs,\%bombed,\%changed,\@warnings,\%triggered,\@newdiscussions,\%unread,$msgcount,\@newmsgs,$critmsgcount,\@critmsgs,$interval,$countunread);
1.33 raeburn 364: $displayed ++;
1.1 raeburn 365: }
366: }
367: $r->print('
368: </table>
369: </td>
370: </tr>
1.33 raeburn 371: </table>
372: </td>
373: </tr>
374: </table>');
1.1 raeburn 375: }
376:
1.11 raeburn 377: #-------------------------------
1.36 raeburn 378: # display_threshold_config
1.11 raeburn 379: #
1.13 raeburn 380: # Display the threshold setting screen
1.11 raeburn 381: #
382: #-------------------------------
383:
1.36 raeburn 384: sub display_threshold_config {
1.15 raeburn 385: my ($r,$command,$tabbg,$threshold_titles,$cdom,$crs) = @_;
1.13 raeburn 386: my %threshold = ();
387: my $rowColor1 = "#ffffff";
388: my $rowColor2 = "#eeeeee";
389: my $rowColor;
390:
391: my @thresholditems = ("av_attempts","degdiff","numstudents");
392: my %threshold_titles = (
393: av_attempts => 'Average number of attempts',
394: degdiff => 'Degree of difficulty',
395: numstudents => 'Total number of students with submissions',
396: );
1.15 raeburn 397: &get_curr_thresholds(\%threshold,$cdom,$crs);
1.13 raeburn 398:
1.36 raeburn 399: $r->print('<br /><form name="thresholdform" method="post" action="/adm/whatsnew">
400: <table border="0" cellpadding="2" cellspacing="4">
401: <tr>
402: <td align="left" valign="top" width="45%">
1.13 raeburn 403: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
404: <tr>
405: <td>
406: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000">
407: <tr>
408: <td bgcolor="#ffffff">
409: <table cellspacing="0" cellpadding="4" border="0">
410: <tr bgcolor="'.$tabbg.'">
411: <th>Threshold Name</th>
412: <th>Current value</th>
413: <th>Change?</th>
414: </tr>');
415: my $rowNum =0;
416: foreach my $type (@thresholditems) {
417: my $parameter = 'internal.threshold_'.$type;
418: # onchange is javascript to automatically check the 'Set' button.
419: my $onchange = 'onFocus="javascript:window.document.forms'.
420: "['thresholdform'].elements['".$parameter."_setparmval']".
421: '.checked=true;"';
422: if ($rowNum %2 == 1) {
423: $rowColor = $rowColor1;
424: } else {
425: $rowColor = $rowColor2;
426: }
427: $r->print('
428: <tr bgcolor="'.$rowColor.'">
429: <td>'.$threshold_titles{$type}.'</td>
430: <td>'.&Apache::lonhtmlcommon::textbox($parameter.'_value',
431: $threshold{$type},
432: 10,$onchange).'</td>
433: <td>'
434: .&Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
435: '</td>
436: </tr>');
437: $rowNum ++;
438: }
439: $r->print('</table></td></tr></table></td></tr></table>
440: <br /><input type="submit" name="threshold" value="Make changes" />
1.36 raeburn 441: <input type="hidden" name="command" value="update" />
1.13 raeburn 442: </form>');
1.11 raeburn 443: }
444:
1.36 raeburn 445: #-------------------------------
446: # display_interval_config
447: #
448: # Display the interval setting screen
449: #
450: #-------------------------------
451:
452: sub display_interval_config {
453: my ($r,$interval_titles) = @_;
454: my $current = &get_curr_interval($env{'user.name'},
455: $env{'user.domain'},$env{'request.course.id'});
456: $r->print('<br />'.&mt('Choose the time window to use for display of version changes for resources in the course.'));
457: unless ($current eq '') {
458: $r->print(' '.&mt('Current value is ').$$interval_titles{$current}.'<br /><br />');
459: }
460: $r->print('<br /><br />
461: <form method="post" name="intervalswitch" action="/adm/whatsnew">
462: <input type="hidden" name="command" value="newinterval" />
463: <select name="interval">
464: ');
465: foreach my $key (reverse sort ({$a cmp $b} (keys(%{$interval_titles})))) {
466: $r->print('<option value="'.$key.'">Version changes '.$$interval_titles{$key}.
467: '</option>'."\n");
468: }
469: $r->print('</select>
470: <input type="submit" name="display" value="'.
471: &mt('Change interval').'" /></form>');
472: return;
473: }
474:
1.33 raeburn 475: sub display_launcher {
476: my ($r,$action,$checkallowed,$tabbg,$rowColor1,$rowColor2,$show,
477: $headings,$res_title,$tograde,$ungraded,$bombs,$bombed,$changed,
478: $warnings,$triggered,$newdiscussions,$unread,$msgcount,$newmsgs,
1.37 raeburn 479: $critmsgcount,$critmsgs,$interval,$countunread) = @_;
1.33 raeburn 480:
481: if ($$checkallowed{$action}) {
482: &start_box($r,$tabbg,$show,$headings,$action);
483: if ($$show{$action}) {
484: if ($action eq 'handgrading') { # UNGRADED ITEMS
485: &display_handgrade($r,$tograde,$rowColor1,$rowColor2,
486: $ungraded);
487: } elsif ($action eq 'haserrors') { # BOMBS
488: &display_haserrors($r,$bombs,$rowColor1,$rowColor2,$bombed,
489: $res_title);
490: } elsif ($action eq 'versionchanges') { # VERSION CHANGES
491: &display_versionchanges($r,$changed,$res_title,$rowColor1,
492: $rowColor2,$interval);
493:
494: } elsif ($action eq 'abovethreshold') { # DEGDIFF/AV. TRIES TRIGGERS
495: &display_abovethreshold($r,$warnings,$triggered,$res_title,
496: $rowColor1,$rowColor2);
497: } elsif ($action eq 'coursediscussion') { # UNREAD COURSE DISCUSSION
498: &display_coursediscussion($r,$newdiscussions,$unread,
1.37 raeburn 499: $countunread,$res_title,$rowColor1,$rowColor2);
1.33 raeburn 500: } elsif ($action eq 'coursenormalmail') { # NORMAL MESSAGES
501: &display_coursenormalmail($r,$msgcount,$newmsgs,$rowColor1,
502: $rowColor2);
503: } elsif ($action eq 'coursecritmail') { # CRITICAL MESSAGES
504: &display_coursecritmail($r,$critmsgcount,$critmsgs,$rowColor1,
505: $rowColor2);
506: }
507: }
508: &end_box($r);
509: }
510: return;
511: }
512:
1.1 raeburn 513: sub getitems {
1.33 raeburn 514: my ($unread,$ungraded,$bombed,$triggered,$changed,$newdiscussions,
515: $tograde,$bombs,$warnings,$rowColor1,$rowColor2,$threshold,$cdom,$crs,
1.37 raeburn 516: $res_title,$show,$starttime,$countunread) = @_;
1.1 raeburn 517: my $navmap = Apache::lonnavmaps::navmap->new();
1.26 albertel 518: # force retrieve Resource to seed the part id cache we'll need it later
1.37 raeburn 519: my @allres=$navmap->retrieveResources(undef,
520: sub {if ($_[0]->is_problem) { $_[0]->parts();} return 1;});
1.33 raeburn 521: my %lastreadtime;
522: my %resourcetracker;
1.37 raeburn 523: my $discussiontime;
1.33 raeburn 524:
525: # Resource version changes
526: if ($$show{'versionchanges'}) {
527: &checkversions($cdom,$crs,$navmap,$changed,$starttime);
528: }
529:
1.37 raeburn 530: if ($$show{'coursediscussion'}) {
1.33 raeburn 531: my %lastread = &Apache::lonnet::dump('nohist_'.
532: $env{'request.course.id'}.'_discuss',
533: $env{'user.domain'},$env{'user.name'},'lastread');
534: foreach my $key (keys(%lastread)) {
535: my $newkey = $key;
536: $newkey =~ s/_lastread$//;
537: $lastreadtime{$newkey} = $lastread{$key};
538: }
539: }
540:
541: if ($$show{'abovethreshold'}) {
542: %resourcetracker = &Apache::lonnet::dump('nohist_resourcetracker',
543: $cdom,$crs);
544: }
1.1 raeburn 545:
1.11 raeburn 546: my $warningnum = 0;
1.1 raeburn 547: foreach my $resource (@allres) {
548: my $result = '';
549: my $applies = 0;
550: my $symb = $resource->symb();
1.33 raeburn 551: %{$$bombed{$symb}} = ();
1.1 raeburn 552: %{$$ungraded{$symb}} = ();
1.11 raeburn 553: %{$$triggered{$symb}} = ();
554: $$triggered{$symb}{numparts} = 0;
1.1 raeburn 555: my $title = $resource->compTitle();
1.16 raeburn 556: $$res_title{$symb} = $title;
1.8 albertel 557: my $ressymb = $resource->wrap_symb();
1.33 raeburn 558:
1.37 raeburn 559: # Check if there are unread discussion postings
1.33 raeburn 560: if ($$show{'coursediscussion'}) {
561: &check_discussions($cdom,$crs,$resource,$symb,$ressymb,$title,
1.37 raeburn 562: $newdiscussions,$unread);
1.33 raeburn 563: }
1.1 raeburn 564:
565: # Check for ungraded problems
566: if ($resource->is_problem()) {
1.33 raeburn 567: if ($$show{'handgrading'}) {
568: &check_handgraded($resource,$symb,$title,$cdom,$crs,$ungraded,
569: $tograde);
570: }
1.1 raeburn 571: }
572:
573: # Check for bombs
1.33 raeburn 574: if ($$show{'haserrors'}) {
575: &check_bombed($resource,$symb,$title,$bombs,$bombed);
576: }
577:
578: # Maxtries and degree of difficulty for problem parts, unless handgradeable
579: if ($$show{'abovethreshold'}) {
580: &check_thresholds($resource,$symb,\%resourcetracker,$triggered,
581: $threshold,$warnings,$warningnum,$rowColor1,$rowColor2);
582: }
583:
584: }
1.37 raeburn 585: my $hasdiscussion = @{$newdiscussions};
586: if ($$show{'coursediscussion'} && $hasdiscussion) { # Get time of last post;
587: $discussiontime = $navmap->{DISCUSSION_TIME};
588: foreach my $ressymb (@{$newdiscussions}) {
589: $$unread{$ressymb}{'lastpost'} = $$discussiontime{$ressymb};
590: }
591: if ($countunread) { #Get count of unread postings for each resource
592: my $discussiondata = $navmap->get_discussion_data();
593: foreach my $ressymb (@{$newdiscussions}) {
594: &get_discussions($cdom,$crs,$discussiondata,$ressymb,
595: $unread,\%lastreadtime);
596: }
597: }
598: }
1.33 raeburn 599: }
600:
601: sub check_discussions {
1.37 raeburn 602: my ($cdom,$crs,$resource,$symb,$ressymb,$title,$newdiscussions,
603: $unread) = @_;
1.33 raeburn 604: if ($resource->hasDiscussion()) {
605: %{$$unread{$ressymb}} = ();
606: $$unread{$ressymb}{'title'} = $title;
607: $$unread{$ressymb}{'symb'} = $symb;
1.37 raeburn 608: push(@{$newdiscussions}, $ressymb);
609: }
610: }
611:
612: sub get_discussions {
613: my ($cdom,$crs,$discussiondata,$ressymb,$unread,$lastreadtime) = @_;
614: my $prevread = 0;
615: my $unreadcount = 0;
616: if (defined($$lastreadtime{$ressymb})) {
617: $prevread = $$lastreadtime{$ressymb};
618: }
619: my $version = $$discussiondata{'version:'.$ressymb};
620: if ($version) {
621: my $hiddenflag = 0;
622: my $deletedflag = 0;
623: my ($hidden,$deleted);
624: for (my $id=$version; $id>0; $id--) {
625: my $vkeys=$$discussiondata{$id.':keys:'.$ressymb};
626: my @keys=split(/:/,$vkeys);
627: if (grep/^hidden$/,@keys) {
628: unless ($hiddenflag) {
629: $hidden = $$discussiondata{$id.':'.$ressymb.':hidden'};
630: $hiddenflag = 1;
631: }
1.38 raeburn 632: } elsif (grep/^deleted$/,@keys) {
1.37 raeburn 633: unless ($deletedflag) {
634: $deleted = $$discussiondata{$id.':'.$ressymb.':deleted'};
635: $deletedflag = 1;
636: }
1.38 raeburn 637: } else {
638: unless (($hidden =~/\.$id\./) || ($deleted =~/\.$id\./)) {
639: if ($prevread <$$discussiondata{$id.':'.$ressymb.':timestamp'}) {
1.33 raeburn 640: $unreadcount ++;
1.37 raeburn 641: $$unread{$ressymb}{$unreadcount} = $id.': '.
642: $$discussiondata{$id.':'.$ressymb.':subject'};
1.33 raeburn 643: }
644: }
645: }
1.1 raeburn 646: }
1.37 raeburn 647: $$unread{$ressymb}{'unreadcount'} = $unreadcount;
1.33 raeburn 648: }
649: }
650:
1.37 raeburn 651:
1.33 raeburn 652: sub check_handgraded {
653: my ($resource,$symb,$title,$cdom,$cnum,$ungraded,$tograde) = @_;
654: if ($resource->is_problem()) {
655: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
656: my $partlist=$resource->parts();
657: my $handgradeable;
658: foreach my $part (@$partlist) {
1.31 raeburn 659: if ($resource->handgrade($part) eq 'yes') {
1.33 raeburn 660: $handgradeable=1; last;
1.31 raeburn 661: }
1.33 raeburn 662: }
663: if ($handgradeable) {
1.35 raeburn 664: my @ungraded = &Apache::bridgetask::get_queue_symb_status(
1.33 raeburn 665: 'gradingqueue',$symb,$cdom,$cnum);
666: if (@ungraded > 0) {
667: $$ungraded{$symb}{count} = scalar(@ungraded);
668: $$ungraded{$symb}{title} = $title;
669: push(@{$tograde}, $symb);
1.11 raeburn 670: }
671: }
1.33 raeburn 672: }
673: }
674:
675: sub check_bombed {
676: my ($resource,$symb,$title,$bombs,$bombed) = @_;
677: if ($resource->getErrors()) {
678: my $errors = $resource->getErrors();
679: $errors =~ s/^,//;
680: my @bombs = split(/,/, $errors);
681: my $errorcount = scalar(@bombs);
682: my $errorlink = '<a href="/adm/email?display='.
683: &Apache::lonnet::escape($bombs[0]).'">'.
684: $title.'</a>';
685: $$bombed{$symb}{errorcount} = $errorcount;
686: $$bombed{$symb}{errorlink} = $errorlink;
687: push(@{$bombs}, $symb);
688: }
689: }
690:
691: sub check_thresholds {
692: my ($resource,$symb,$resourcetracker,$triggered,$threshold,$warnings,
693: $warningnum,$rowColor1,$rowColor2) = @_;
694: # Compile maxtries and degree of difficulty for problem parts, unless handgradeable
695: my @parts = @{$resource->parts()};
696: my %stats;
697: my %lastreset = ();
698: my $warning = 0;
699: my $rowColor;
700: foreach my $part (@parts) {
701: if ($resource->handgrade($part) eq 'yes') {
702: next;
703: }
704: %{$stats{$part}} = ();
705: my ($attempts,$users,$corrects,$degdiff,$av_attempts);
706: if (exists($$resourcetracker{$symb."\0".$part."\0attempts"})) {
707: $attempts = $$resourcetracker{$symb."\0".$part."\0attempts"};
708: }
709: if (exists($$resourcetracker{$symb."\0".$part."\0users"})) {
710: $users = $$resourcetracker{$symb."\0".$part."\0users"};
711: }
712: if (exists($$resourcetracker{$symb."\0".$part."\0correct"})) {
713: $corrects = $$resourcetracker{$symb."\0".$part."\0correct"};
714: }
715: if ($attempts > 0) {
716: $degdiff = 1 - ($corrects/$attempts);
717: $degdiff = sprintf("%.2f",$degdiff);
718: }
719: if ($users > 0) {
720: $av_attempts = $attempts/$users;
721: $av_attempts = sprintf("%.2f",$av_attempts);
722: }
723: if ((($degdiff ne '' && $degdiff >= $$threshold{'degdiff'}) || ($av_attempts ne '' && $av_attempts >= $$threshold{'av_attempts'})) && ($users >= $$threshold{'numstudents'})) {
724: $stats{$part}{degdiff} = $degdiff;
725: $stats{$part}{attempts} = $av_attempts;
726: $stats{$part}{users} = $users;
727: $lastreset{$part} = $$resourcetracker{$symb."\0".$part."\0resettime"};
728: if ($lastreset{$part}) {
729: $lastreset{$part} = &Apache::lonnavmaps::timeToHumanString($lastreset{$part});
1.11 raeburn 730: }
1.33 raeburn 731: $warning = 1;
732: }
733: }
734: if ($warning) {
1.35 raeburn 735: if ($warningnum %2 == 1) {
1.33 raeburn 736: $rowColor = $rowColor1;
737: } else {
738: $rowColor = $rowColor2;
739: }
740: $$triggered{$symb}{title} = $resource->title;
741: foreach my $part (@parts) {
742: if (exists($stats{$part}{users})) {
743: my $resetname = 'reset_'.&Apache::lonnet::escape($symb."\0".$part);
744: my $resettitle = 'title_'.&Apache::lonnet::escape($symb."\0".$part);
745: if ($$triggered{$symb}{numparts}) {
746: $$triggered{$symb}{text} .= '<tr bgcolor="'.$rowColor.'">'."\n";
747: }
748: if (@parts > 1) {
749: $$triggered{$symb}{text} .= '
750: <td align="right"><small>part - '.$part.'<small></td>';
751: } else {
1.11 raeburn 752: $$triggered{$symb}{text} .= '
1.33 raeburn 753: <td align="right"><small>single part</small></td>';
1.11 raeburn 754: }
1.33 raeburn 755: $$triggered{$symb}{text} .= '
756: <td align="right"><small>'.$stats{$part}{users}.'</small></td>
757: <td align="right"><small>'.$stats{$part}{attempts}.'</small></td>
758: <td align="right"><small>'.$stats{$part}{degdiff}.'</small></td>
759: <td align="right"><small>'.$lastreset{$part}.'</small></td>
760: <td align="right"><small><input type="checkbox" name="'.$resetname.'" /><input type="hidden" name="'.$resettitle.'" value="'.&Apache::lonnet::escape($$triggered{$symb}{title}).'" /></td>
761: </tr>';
762: $$triggered{$symb}{numparts} ++;
1.11 raeburn 763: }
764: }
1.33 raeburn 765: push(@{$warnings},$symb);
1.35 raeburn 766: $warningnum ++;
1.1 raeburn 767: }
768: }
769:
1.33 raeburn 770:
1.13 raeburn 771: sub get_curr_thresholds {
772: my ($threshold,$cdom,$crs) = @_;
773: my %coursesettings = &Apache::lonnet::dump('environment',
774: $cdom,$crs,'internal.threshold');
775: if (exists($coursesettings{'internal.threshold_av_attempts'})) {
776: $$threshold{'av_attempts'} = $coursesettings{'internal.threshold_av_attempts'};
777: }
778: if (exists($coursesettings{'internal.threshold_degdiff'})) {
779: $$threshold{'degdiff'} = $coursesettings{'internal.threshold_degdiff'};
780: }
781: if (exists($coursesettings{'internal.threshold_numstudents'})) {
782: $$threshold{'numstudents'} = $coursesettings{'internal.threshold_numstudents'};
783: }
784: }
785:
1.36 raeburn 786: sub get_curr_interval {
787: my ($uname,$udom,$cid);
788: my $interval;
789: my %settings = &Apache::lonnet::dump('nohist_whatsnew',$uname,$udom,$cid,':interval');
790: my ($tmp) = %settings;
1.38.2.2! albertel 791:
! 792: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.36 raeburn 793: $interval = $settings{$cid.':interval'};
794: }
795: return $interval;
796: }
797:
1.13 raeburn 798: sub process_reset {
799: my ($dom,$crs) = @_;
800: my $result = '<b>Counters reset for following problems (and parts):</b><br />';
801: my @agg_types = ('attempts','users','correct');
802: my %agg_titles = (
803: attempts => 'Number of submissions',
804: users => 'Students with submissions',
805: correct => 'Number of correct submissions',
806: );
807: my @resets = ();
808: my %titles = ();
1.17 albertel 809: foreach my $key (keys(%env)) {
1.13 raeburn 810: next if ($key !~ /^form\.reset_(.+)$/);
811: my $title = &Apache::lonnet::unescape($env{'form.title_'.$1});
812: my $reset_item = &Apache::lonnet::unescape($1);
813: my %curr_aggregates = &Apache::lonnet::dump('nohist_resourcetracker',$dom,$crs,$reset_item);
814: my %aggregates = ();
1.17 albertel 815: my ($symb,$part) = split(/\0/,$reset_item);
1.13 raeburn 816: foreach my $type (@agg_types) {
817: $aggregates{$reset_item."\0".$type} = 0;
818: }
1.17 albertel 819: $aggregates{$reset_item."\0".'resettime'} = time;
1.13 raeburn 820: my $putresult = &Apache::lonnet::put('nohist_resourcetracker',\%aggregates,
821: $dom,$crs);
822: if ($putresult eq 'ok') {
823: $result .= $title.' -part '.$part.': ';
824: my %new_aggregates = &Apache::lonnet::dump('nohist_resourcetracker',$dom,$crs,$reset_item);
825: foreach my $type (@agg_types) {
826: $result .= $agg_titles{$type}.' = '.$new_aggregates{$reset_item."\0".$type}.'; ';
827: }
828: $result =~ s/; $//;
829: $result .= '<br />';
830: } else {
1.14 albertel 831: $result = $title.' -part '.$part.': '.&mt('Unable to reset counters to zero due to [_1]',$putresult).'.<br />'."\n";
1.13 raeburn 832: }
833: }
834: return $result;
835: }
836:
837: sub process_update {
838: my ($dom,$crs,$threshold_titles) = @_;
1.15 raeburn 839: my $setoutput = '<b>Changes to threshold(s) for problem tracking:</b><br />';
1.13 raeburn 840: foreach (keys %env) {
841: next if ($_!~/^form\.(.+)\_setparmval$/);
842: my $name = $1;
843: my $value = $env{'form.'.$name.'_value'};
844: if ($name && defined($value)) {
845: my $put_result = &Apache::lonnet::put('environment',
846: {$name=>$value},$dom,$crs);
847:
848: my ($shortname) = ($name =~ /^internal\.threshold_(.+)$/);
849: if ($put_result eq 'ok') {
1.14 albertel 850: $setoutput.=&mt('Set threshold for [_1] to [_2]',
851: '<b>'.$$threshold_titles{$shortname}.'</b>',
852: '<b>'.$value.'</b>').'<br />';
853: } else {
854: $setoutput.=&mt('Unable to set threshold for [_1] to [_2] due to [_3].',
855: '<b>'.$name.'</b>','<b>'.$value.'</b>',
856: '<tt>'.$put_result.'</tt>').'<br />';
1.13 raeburn 857: }
858: }
859: }
860: return $setoutput;
861: }
862:
1.33 raeburn 863: sub getnormalmail {
864: my ($newmsgs) = @_;
1.1 raeburn 865: # Check for unread mail in course
866: my $msgcount = 0;
1.3 albertel 867:
1.10 raeburn 868: my @messages = sort(&Apache::lonnet::getkeys('nohist_email'));
1.3 albertel 869: foreach my $message (@messages) {
870: my $msgid=&Apache::lonnet::escape($message);
1.10 raeburn 871: my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
1.1 raeburn 872: &Apache::lonmsg::unpackmsgid($msgid);
1.10 raeburn 873: if (($fromcid) && ($fromcid eq $env{'request.course.id'})) {
1.1 raeburn 874: if (defined($sendtime) && $sendtime!~/error/) {
875: my $numsendtime = $sendtime;
876: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
877: if ($status eq 'new') {
1.10 raeburn 878: $msgcount ++;
879: if ($shortsubj eq '') {
880: $shortsubj = &mt('No subject');
881: }
882: $shortsubj = &Apache::lonnet::unescape($shortsubj);
1.1 raeburn 883: push(@{$newmsgs}, {
884: msgid => $msgid,
885: sendtime => $sendtime,
1.10 raeburn 886: shortsub => $shortsubj,
1.1 raeburn 887: from => $fromname,
888: fromdom => $fromdom
889: });
890: }
891: }
892: }
893: }
1.33 raeburn 894: return $msgcount;
895: }
1.1 raeburn 896:
1.33 raeburn 897: sub getcritmail {
898: my ($critmsgs) = @_;
1.1 raeburn 899: # Check for critical messages in course
900: my %what=&Apache::lonnet::dump('critical');
901: my $result = '';
902: my $critmsgcount = 0;
1.3 albertel 903: foreach my $msgid (sort(keys(%what))) {
1.10 raeburn 904: my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
905: &Apache::lonmsg::unpackmsgid($msgid);
906: if (($fromcid) && ($fromcid eq $env{'request.course.id'})) {
1.1 raeburn 907: if (defined($sendtime) && $sendtime!~/error/) {
908: my $numsendtime = $sendtime;
909: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
910: $critmsgcount ++;
1.10 raeburn 911: if ($shortsubj eq '') {
912: $shortsubj = &mt('No subject');
913: }
914: $shortsubj = &Apache::lonnet::unescape($shortsubj);
1.1 raeburn 915: push(@{$critmsgs}, {
916: msgid => $msgid,
917: sendtime => $sendtime,
1.10 raeburn 918: shortsub => $shortsubj,
1.1 raeburn 919: from => $fromname,
920: fromdom => $fromdom
921: });
922: }
923: }
924: }
1.33 raeburn 925: return $critmsgcount;
926: }
927:
928:
929: sub checkversions {
930: my ($cdom,$crs,$navmap,$changed,$starttime) = @_;
931: my %changes=&Apache::lonnet::dump('versionupdate',$cdom,$crs);
932: my ($tmp) = keys(%changes);
1.38.2.2! albertel 933: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
! 934: if (keys(%changes) > 0) {
1.33 raeburn 935: foreach my $key (sort(keys(%changes))) {
936: if ($changes{$key} > $starttime) {
937: my $version;
938: my ($root,$extension)=($key=~/^(.*)\.(\w+)$/);
939: my $currentversion=&Apache::lonnet::getversion($key);
940: my $revdate =
941: &Apache::lonnet::metadata($root.'.'.$extension,
942: 'lastrevisiondate');
943: $revdate = &Apache::lonlocal::locallocaltime($revdate);
944: my $linkurl=&Apache::lonnet::clutter($key);
945: my $usedversion=$navmap->usedVersion('version_'.$linkurl);
946: my @resources = $navmap->getResourceByUrl($linkurl,1);
947: if (($usedversion) && ($usedversion ne 'mostrecent')) {
948: $version = $usedversion;
949: } else {
950: $version = $currentversion;
951: }
952: foreach my $res (@resources) {
1.35 raeburn 953: if (ref($res) eq 'Apache::lonnavmaps::resource') {
954: my $symb = $res->symb();
955: %{$$changed{$symb}} = (
1.33 raeburn 956: current => $currentversion,
957: version => $version,
958: revdate => $revdate,
1.35 raeburn 959: );
960: }
1.33 raeburn 961: }
962: }
963: }
964: }
965: }
966: return;
967: }
968:
969: sub display_handgrade {
970: my ($r,$tograde,$rowColor1,$rowColor2,$ungraded) = @_;
971: my $rowColor;
972: my %lt = &Apache::lonlocal::texthash(
973: 'prna' => 'Problem Name',
974: 'nmun' => 'Number ungraded',
975: 'nopr' => 'No problems require handgrading',
976: );
977: if (@{$tograde} > 0) {
978: $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'prna'}.'</small></b></td><td align="right"><b><small>'.$lt{'nmun'}.'</small></b></td></tr>');
979: my $rowNum = 0;
980: foreach my $res (@{$tograde}) {
981: if ($rowNum %2 == 1) {
982: $rowColor = $rowColor1;
983: } else {
984: $rowColor = $rowColor2;
985: }
986: my ($map,$id,$url)=&Apache::lonnet::decode_symb($res);
987: my $linkurl=&Apache::lonnet::clutter($url);
988: $linkurl .= '?symb='.&Apache::lonnet::escape($res);
989:
990: $r->print('<tr bgcolor="'.$rowColor.'"><td><a href="'.$linkurl.'"><small>'.$$ungraded{$res}{title}.'</small></a></td><td align="right"><small>'.$$ungraded{$res}{count}.'</small></td></tr>');
991: $rowNum ++;
992: }
993: } else {
994: $r->print('<tr><td bgcolor="#ffffff"><br><center><i><b><small> '.$lt{'nopr'}.' </small><br><br></b></i></td></tr>');
995: }
996: }
997:
998: sub display_haserrors {
999: my ($r,$bombs,$rowColor1,$rowColor2,$bombed,$res_title) = @_;
1000: my $bombnum = 0;
1001: my $rowColor;
1002: my %lt = &Apache::lonlocal::texthash(
1003: reso => 'Resource',
1004: nmer => 'Number of errors',
1005: noer => 'No problems with errors',
1006: );
1007: if (@{$bombs} > 0) {
1008: $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'reso'}.'</small></b></td><td align="right"><b><small>'.$lt{'nmer'}.'</small></b></td></tr>');
1009: @{$bombs} = sort { &cmp_title($a,$b,$res_title) } @{$bombs};
1010: foreach my $bomb (@{$bombs}) {
1011: if ($bombnum %2 == 1) {
1012: $rowColor = $rowColor1;
1013: } else {
1014: $rowColor = $rowColor2;
1015: }
1016: $r->print('<tr bgcolor="'.$rowColor.'"><td><small>'.$$bombed{$bomb}{errorlink}.'</small></td><td align="right"><small>'.$$bombed{$bomb}{errorcount}.'</small></td></tr>');
1017: $bombnum ++;
1018: }
1019: } else {
1020: $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>'.$lt{'noer'}.'</small></i></b></center><br /></td></tr>');
1021: }
1022: return;
1023: }
1024:
1025: sub display_abovethreshold {
1026: my ($r,$warnings,$triggered,$res_title,$rowColor1,$rowColor2) = @_;
1027: my %lt = &Apache::lonlocal::texthash(
1028: reso => 'Resource',
1029: part => 'Part',
1030: nust => 'Num. students',
1031: avat => 'Av. Attempts',
1032: dedi => 'Deg. Diff',
1033: lare => 'Last Reset',
1034: reco => 'Reset Count?',
1035: rese => 'Reset counters to 0',
1036: nopr => 'No problems satisfy threshold criteria',
1037: );
1038: my $rowColor;
1039: my $warningnum = 0;
1040: if (@{$warnings} > 0) {
1041: @{$warnings} = sort { &cmp_title($a,$b,$res_title) } @{$warnings};
1.36 raeburn 1042: $r->print('<form name="reset_tracking" method="post" action="/adm/whatsnew">'.
1043: ' <input type="hidden" name="command" value="reset" />'."\n");
1.33 raeburn 1044: $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'reso'}.'</small></b></td><td align="right"><b><small>'.$lt{'part'}.'</small></b></td><td align="right"><b><small>'.$lt{'nust'}.'</small></b></td><td align="right"><b><small>'.$lt{'avat'}.'</small></b></td><td align="right"><b><small>'.$lt{'dedi'}.'</small></b></td><td align="right"><b><small>'.$lt{'lare'}.'</small></b></td><td align="right"><b><small>'.$lt{'reco'}.'</small></b></td></tr>');
1045: foreach my $res (@{$warnings}) {
1046: if ($warningnum %2 == 1) {
1047: $rowColor = $rowColor1;
1048: } else {
1049: $rowColor = $rowColor2;
1050: }
1051: my ($map,$id,$url)=&Apache::lonnet::decode_symb($res);
1052: my $linkurl=&Apache::lonnet::clutter($url);
1053: my $rowspan;
1054: if ($$triggered{$res}{numparts} > 1) {
1055: $rowspan = 'rowspan="'.$$triggered{$res}{numparts}.'"';
1056: }
1057: $linkurl .= '?symb='.&Apache::lonnet::escape($res);
1058: $r->print('<tr bgcolor="'.$rowColor.'"><td '.$rowspan.'><a href="'.$linkurl.'"><small>'.$$triggered{$res}{title}.'</small></a></td>'.$$triggered{$res}{text});
1059: $warningnum ++;
1060: }
1.35 raeburn 1061: $r->print('<tr bgcolor="#cccccc"><td colspan="7" align="right"><br /><b><small><input type="submit" name="counters" value="'.$lt{'rese'}.'" /></form>');
1.33 raeburn 1062: } else {
1063: $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>'.$lt{'nopr'}.'</small></i></b></center><br /></td></tr>');
1064: }
1065: }
1066:
1067: sub display_versionchanges {
1068: my ($r,$changed,$res_title,$rowColor1,$rowColor2,$interval) = @_;
1069: my %lt = &Apache::lonlocal::texthash(
1070: 'reso' => 'Resource',
1071: 'revd' => 'Last revised',
1072: 'newv' => 'New version',
1073: 'veru' => 'Version used',
1074: 'noup' => 'No updated versions',
1075: );
1076: my $rowColor;
1077: if (keys(%{$changed}) > 0) {
1078: $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'reso'}.'</small></b></td><td><b><small>'.$lt{'revd'}.'</small></b></td><td><b><small>'.$lt{'newv'}.'</small></b></td><td><b><small>'.$lt{'veru'}.'</small></b></td></tr>');
1079:
1080:
1081: my @changes = sort { &cmp_title($a,$b,$res_title) } keys(%{$changed});
1082: my $changenum = 0;
1083: foreach my $item (@changes) {
1084: if ($changenum %2 == 1) {
1085: $rowColor = $rowColor1;
1086: } else {
1087: $rowColor = $rowColor2;
1088: }
1089: my ($map,$id,$url)=&Apache::lonnet::decode_symb($item);
1090: my $linkurl=&Apache::lonnet::clutter($url);
1091: $linkurl .= '?symb='.&Apache::lonnet::escape($item);
1092:
1093: $r->print('<tr bgcolor="'.$rowColor.'"><td><small><a href="'.$linkurl.'">'.$$res_title{$item}.'</a></small></td><td><small>'.$$changed{$item}{'revdate'}.'</small></td><td><small>'.$$changed{$item}{'current'}.'</small></td><td><small>'.$$changed{$item}{'version'}.'</small></td></tr>');
1094: $changenum ++;
1095: }
1096: } else {
1097: $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>'.$lt{'noup'}.' '.$interval.'</small></i></b></center><br /></td></tr>');
1098: }
1099: return;
1100: }
1101:
1102: sub display_coursediscussion {
1.37 raeburn 1103: my ($r,$newdiscussions,$unread,$countunread,$res_title,$rowColor1,
1104: $rowColor2) = @_;
1.33 raeburn 1105: my %lt = &Apache::lonlocal::texthash(
1106: 'loca' => 'Location',
1107: 'type' => 'Type',
1108: 'numn' => 'Number of new posts',
1109: 'noun' => 'No unread posts in course discussions',
1.37 raeburn 1110: 'tmlp' => 'Time of last post',
1.33 raeburn 1111: );
1112: my $rowColor;
1113: if (@{$newdiscussions} > 0) {
1114: $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'loca'}.
1115: '</small></b></td><td><b><small>'.$lt{'type'}.
1.37 raeburn 1116: '</small></b>');
1117: if ($countunread) {
1118: $r->print('<td><b><small>'.$lt{'tmlp'}.'</small></b></td>'.
1119: '<td align="right"><b><small>'.$lt{'numn'}.
1120: '</small></b></td>');
1121: } else {
1122: $r->print('<td align="right"><b><small>'.$lt{'tmlp'}.
1123: '</small></b></td>');
1124: }
1125: $r->print("</tr>\n");
1.33 raeburn 1126: @{$newdiscussions} = sort { &cmp_title($a,$b,$res_title) }
1127: @{$newdiscussions};
1128: my $rowNum = 0;
1129: foreach my $ressymb (@{$newdiscussions}) {
1130: my $forum_title = $$unread{$ressymb}{'title'};
1131: my $type = 'Resource';
1132: my $feedurl=&Apache::lonfeedback::get_feedurl($ressymb);
1133: if ($feedurl =~ /bulletinboard/) {
1134: $type = 'Bulletin Board';
1135: }
1.37 raeburn 1136: if ($rowNum %2 == 1) {
1137: $rowColor = $rowColor1;
1138: } else {
1139: $rowColor = $rowColor2;
1140: }
1141: my $lastpost = &Apache::lonnavmaps::timeToHumanString(
1142: $$unread{$ressymb}{'lastpost'});
1143: $r->print('<tr bgcolor="'.$rowColor.'"><td><small><a href="'.$feedurl.'?symb='.$$unread{$ressymb}{symb}.'">'.$forum_title.'</a> </td><td><small>'.$type.' </small></td>');
1144: if ($countunread) {
1145: my $unreadnum = $$unread{$ressymb}{'unreadcount'};
1146: $r->print('<td><small>'.$lastpost.'<small></td><td align="right">'.
1147: '<small>',$unreadnum.' </small></td>');
1148: } else {
1149: $r->print('<td align="right"><small>'.$lastpost.'</small></td>');
1.33 raeburn 1150: }
1.37 raeburn 1151: $r->print("</tr>\n");
1152: $rowNum ++;
1.33 raeburn 1153: }
1154: } else {
1155: $r->print('<tr><td bgcolor="#ffffff"><br><center> <i><b><small>'.
1156: $lt{'noun'}.'</small></b></i><br><br></td></tr>');
1157: }
1158: }
1159:
1160: sub display_coursenormalmail {
1161: my ($r,$msgcount,$newmsgs,$rowColor1,$rowColor2) = @_;
1162: my $rowColor;
1163: if ($msgcount > 0) {
1164: $r->print('<tr bgcolor="#cccccc"><td><b><small>'.&mt('Number').'</small></b></td><td><b><small>'.&mt('Subject').'</small></b></td><td><b><small>'.&mt('Sender').'</small></b></td><td><b><small>'.&mt('Date/Time').'</small></b></td></tr>');
1165: my $rowNum = 0;
1166: my $mailcount = 1;
1167: foreach my $msg (@{$newmsgs}) {
1168: if ($rowNum %2 == 1) {
1169: $rowColor = $rowColor1;
1170: } else {
1171: $rowColor = $rowColor2;
1172: }
1173: $r->print('<tr bgcolor="'.$rowColor.'"><td valign="top"><small>'.$mailcount.'. </small></td><td valign="top"><small><a href="/adm/communicate">'.$msg->{'shortsub'}.'</a> </small></td><td valign="top"><small> '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' </small></td><td valign="top"><small>'.$msg->{'sendtime'}.'</small></td></tr>');
1174: $rowNum ++;
1175: $mailcount ++;
1176: }
1177: } else {
1178: $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>'.&mt('No new course messages').'</small></i></b><br /><br /></center></td></tr>');
1179: }
1180: }
1181:
1182: sub display_coursecritmail {
1183: my ($r,$critmsgcount,$critmsgs,$rowColor1,$rowColor2) = @_;
1184: my $rowColor;
1185: if ($critmsgcount > 0) {
1186: $r->print('<tr bgcolor="#cccccc"><td><b><small>'.&mt('Number').'</small></b></td><td><b><small>'.&mt('Subject').'</small></b></td><td><b><small>'.&mt('Sender').'</small></b></td><td><b><small>'.&mt('Date/Time').'</small></b></td></tr>');
1187: my $rowNum = 0;
1188: my $mailcount = 1;
1189: foreach my $msg (@{$critmsgs}) {
1190: if ($rowNum %2 == 1) {
1191: $rowColor = $rowColor1;
1192: } else {
1193: $rowColor = $rowColor2;
1194: }
1195: $r->print('<tr bgcolor="'.$rowColor.'"><td valign="top"><small>'.$mailcount.'. <small></td><td valign="top"><small><a href="/adm/email?folder=critical">'.$msg->{'shortsub'}.'</a> </small></td><td valign="top"><small> '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' </small></td><td valign="top"><small>'.$msg->{'sendtime'}.'</small></td></tr>');
1196: $rowNum ++;
1197: $mailcount ++;
1198: }
1199: } else {
1200: $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>'.&mt('No unread critical messages in course').'</small></i></b><br /><br /></center></td></tr>');
1201: }
1.1 raeburn 1202: }
1203:
1204: sub cmp_title {
1.16 raeburn 1205: my ($a,$b,$res_title) = @_;
1206: my ($atitle,$btitle) = (lc($$res_title{$a}),lc($$res_title{$b}));
1.1 raeburn 1207: $atitle=~s/^\s*//;
1208: $btitle=~s/^\s*//;
1209: return $atitle cmp $btitle;
1210: }
1211:
1.33 raeburn 1212: sub get_display_settings {
1.36 raeburn 1213: my ($uname,$udom,$cid) = @_;
1.33 raeburn 1214: my %settings = &Apache::lonnet::dump('nohist_whatsnew',$udom,$uname,$cid);
1215: my ($tmp) = keys(%settings);
1.38.2.2! albertel 1216: if ($tmp=~/^(con_lost|error|no_such_host)/i) {
1.33 raeburn 1217: %settings = ();
1.38.2.2! albertel 1218: unless ($tmp =~ /^error: 2 /) {
! 1219: &Apache::lonnet::logthis('Error retrieving whatsnew settings: '.
! 1220: $tmp.' for '.$uname.':'.$udom.
! 1221: ' for course: '.$cid);
! 1222:
! 1223: }
1.33 raeburn 1224: }
1225: return %settings;
1226: }
1227:
1.36 raeburn 1228: sub store_display_settings {
1229: my ($uname,$udom,$cid,$checkallowed) = @_;
1230: my %whatsnew_settings;
1231: my $result;
1232: foreach my $key (keys(%{$checkallowed})) {
1233: if (exists($env{'form.display_'.$key})) {
1234: unless ($env{'form.display_'.$key} eq '') {
1235: $whatsnew_settings{$cid.':'.$key} = $env{'form.display_'.$key};
1236: }
1237: }
1238: }
1239: if (keys(%whatsnew_settings)) {
1240: $result = &Apache::lonnet::put('nohist_whatsnew',\%whatsnew_settings,
1241: $udom,$uname);
1242: } else {
1243: $result = 'ok';
1244: }
1245: return $result;
1246: }
1247:
1248: sub store_interval_setting {
1249: my ($uname,$udom,$cid,$interval_titles) = @_;
1250: my %interval_settings = ();
1251: my $result;
1252: if (defined($env{'form.interval'})) {
1253: $interval_settings{$cid.':interval'} = $env{'form.interval'};
1254: my $outcome = &Apache::lonnet::put('nohist_whatsnew',
1255: \%interval_settings,$udom,$uname);
1256: if ($outcome eq 'ok') {
1257: $result = &mt('Interval set to version changes [_1]',
1258: '<b>'.$$interval_titles{$env{'form.interval'}}.'</b><br />');
1259:
1260: } else {
1261: &Apache::lonnet::logthis('Error storing whatsnew interval setting'.
1262: ' '.$outcome.' for '.$uname.':'.$udom.' in course '.$cid);
1263: $result = &mt('Unable to set interval to [_1] due to [_2].',
1264: '<b>'.$$interval_titles{$env{'form.interval'}}.'</b>',
1265: '<tt>'.$outcome.'</tt>.<br />');
1266: }
1267: }
1268: return $result;
1269: }
1270:
1.33 raeburn 1271: sub start_box {
1272: my ($r,$tabbg,$show,$heading,$caller) = @_;
1273: my %lt = &Apache::lonlocal::texthash(
1274: chth => 'Change thresholds?',
1275: chin => 'Change interval?',
1276: );
1277: my $showhide;
1278: if ($$show{$caller}) {
1.36 raeburn 1279: $showhide = '<b><a href="javascript:change_display(document.visible.'.
1280: 'display_'.$caller.",'hide'".');">Hide</a></b>';
1.33 raeburn 1281:
1282: } else {
1.36 raeburn 1283: $showhide = '<b><a href="javascript:change_display(document.visible.'.
1284: 'display_'.$caller.",'show'".');">Show</a></b>';
1.33 raeburn 1285: }
1286:
1287: $r->print('
1288: <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
1289: <tr>
1290: <td>
1291: <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
1292: <tr>
1293: <td bgcolor="'.$tabbg.'">
1294: <table width="100%" border="0" cellspacing="0" cellpadding="0">
1295: <tr>
1296: <td><b>'.$$heading{$caller}.'</b></td>
1297: <td valign="top" align="right">'.$showhide.'</td>
1298: </tr>
1299: </table>
1300: </td>
1301: </tr>');
1302: if (($caller eq 'abovethreshold') && ($$show{$caller})) {
1303: $r->print('
1304: <tr>
1305: <td bgcolor="'.$tabbg.'" align="right"><a href="/adm/whatsnew?command=chgthreshold"><b><small>'.$lt{'chth'}.'</small></b></a></td>
1306: </tr>');
1307: } elsif (($caller eq 'versionchanges') && ($$show{$caller})) {
1308: $r->print('
1309: <tr>
1310: <td bgcolor="'.$tabbg.'" align="right"><a href="/adm/whatsnew?command=chginterval"><b><small>'.$lt{'chin'}.'</small></b></a></td>
1311: </tr>');
1312: }
1313: $r->print('
1314: <tr>
1315: <td bgcolor="#ffffff">
1316: <table cellpadding="2" cellspacing="0" border="0" width="100%">
1317: ');
1318: return;
1319: }
1320:
1321: sub end_box {
1322: my ($r) = shift;
1323: $r->print('
1324: </table>
1325: </td>
1326: </tr>
1327: </table>
1328: </td>
1329: </tr>
1330: </table><br />');
1331: return;
1332: }
1333:
1.7 raeburn 1334: 1;
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